TL_YTL örnek kod

[zengin]

Degerli delphiturkiye site üyeleri ve degerli arkadaşlar Eski TL yi Yeni YTL ceviren örnek birkodu siz degerli arkadaşlarla paylaşmak istedim
saygılarımla zengin

Kod: Tümünü seç

procedure TForm1.Edit1Change(Sender: TObject);
var
a:string;
i:integer;
begin
if length(Tedit(Sender).text)>0 then begin
a:=Tedit(sender).text;
for i:=0 to length(a) do begin
delete(a,pos('.',a),1);
end;
keybd_event(vk_end,0,0,0);
keybd_event(vk_end,0,KEYEVENTF_KEYUP,0);
edit2.text:=FormatFloat('#,##0.00 YTL',strtofloat(a) / 1000000);
if CheckBox3.Checked then
begin
Tedit(edit1).text:=FormatFloat('#,##',strtofloat(a));
end;
end;
end;

procedure TForm1.Edit3Change(Sender: TObject);
var
ZEN:string;
i:integer;
begin
if length(Tedit(Sender).text)>0 then begin
ZEN:=Tedit(sender).text;
for i:=0 to length(ZEN) do begin
delete(ZEN,pos('.',ZEN),1);
end;
keybd_event(vk_end,0,0,0);
keybd_event(vk_end,0,KEYEVENTF_KEYUP,0);
edit4.text:=FormatFloat('#,##0. TL',strtofloat(ZEN) *1000000);
if CheckBox2.Checked then
begin
Tedit(edit3).text:=FormatFloat('#,##',strtofloat(ZEN));
end;
end;
end;

[webaytek]

beyler bayanlar - belki beyenirsiniz ben de bi tane yaptım - (YORUMSUZ)

Kod: Tümünü seç

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    yuvarlanmamis: TEdit;
    Button1: TButton;
    saytext: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Image1: TImage;
    yuvarlanmis: TEdit;
    Label4: TLabel;
    ustte: TCheckBox;
    PanodanYapistir_saat: TTimer;
    Image3: TImage;
    Image4: TImage;
    procedure Button1Click(Sender: TObject);
    procedure saytextKeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ustteClick(Sender: TObject);
    procedure Image3Click(Sender: TObject);
    procedure Image4Click(Sender: TObject);
  private
    { Private declarations }
  public
    YTL,sayint,YKrs,YKrsKsrt,say:integer;
  end;

var
  Form1: TForm1;
implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var yuvarlatilmis:integer;
begin
if length(saytext.text) = 0 then
        begin
        saytext.text:='0';
        saytext.SelectAll;
        end
else
        begin
        end;
say:=length(saytext.text);
yKrs:=strtoint(copy(saytext.text,say-5,2));
yuvarlatilmis:=strtoint(copy(saytext.text,say-3,say));
if say > 6 then
        begin
                if strtoint(copy(saytext.text,say-3,2)) < 50 then
                        begin
                        yuvarlanmamis.text:=copy(saytext.text,1,say-6)+' YTL '+inttostr(YKrs)+'.'+inttostr(yuvarlatilmis)+' YKrş';
                        yuvarlanmis.text:='Yuvarlama Yok';
                        end
                else
                        begin
                        yuvarlanmis.text:=copy(saytext.text,1,say-6)+' YTL '+inttostr(YKrs+1)+' YKrş';
                        yuvarlanmamis.text:=copy(saytext.text,1,say-6)+' YTL '+inttostr(YKrs)+'.'+inttostr(yuvarlatilmis)+' YKrş';
                        end;
        end;
if say = 6 then
yuvarlanmamis.text:='0,'+copy(saytext.text,1,1)+copy(saytext.text,2,say)+' YKrş';
if say = 5 then
yuvarlanmamis.text:='0,0'+copy(saytext.text,1,1)+copy(saytext.text,2,say)+' YKrş';
if say = 4 then
yuvarlanmamis.text:='0,00'+copy(saytext.text,1,1)+copy(saytext.text,2,say)+' YKrş';
if say = 3 then
yuvarlanmamis.text:='0,000'+copy(saytext.text,1,1)+copy(saytext.text,2,say)+' YKrş';
if say = 2 then
yuvarlanmamis.text:='0,0000'+copy(saytext.text,1,1)+copy(saytext.text,2,say)+' YKrş';
if say = 1 then
yuvarlanmamis.text:='0,00000'+copy(saytext.text,1,1)+copy(saytext.text,2,say)+' YKrş';
end;

Bence iyi olmuştu ama üzerinde çalıştıkça farkettim ki üzerinde bayaa bi yanlış var... tüm hataları giderince yuvarlanmış hali ve ytl yazılışı (yazı ile) da eklenmiş olacak... yeni tür önerilerinizi bekliyorum