TL_YTL örnek kod

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
zengin
Üye
Mesajlar: 233
Kayıt: 06 Ağu 2003 10:13

TL_YTL örnek kod

Mesaj gönderen 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;
Zengin
Kullanıcı avatarı
webaytek
Üye
Mesajlar: 377
Kayıt: 23 Haz 2004 10:58

Mesaj gönderen 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
Cevapla