Kod: Tümünü seç
unit RakmYazi;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Mask;
type
Tfrm_RakamYazi = class(TForm)
Label1: TLabel;
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Button2: TButton;
procedure FormShow(Sender: TObject);
procedure Edit1Exit(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
function Rakam_Yazi(Sayi_Rakam: Double): String;
var
frm_RakamYazi: Tfrm_RakamYazi;
a: String;
ErrorCode: Integer;
implementation
{$T+}
{$R *.DFM}
function Rakam_Yazi(Sayi_Rakam: Double): String;
Label 1,2;
const
b: array[0..9] of String = ('','Bir','İki','Üç','Dört','Beş','Altı',
'Yedi','Sekiz','Dokuz');
y: array[0..9] of String = ('','On','Yirmi','Otuz','Kırk','Elli','Altmış',
'Yetmiş','Seksen','Doksan');
m: array[0..5] of String = ('Katrilyon','Trilyon','Milyar','Milyon','Bin','');
var
//a,e,s:String;
e,s: String;
Pozitif: Boolean;
v: array[1..30] of Integer;
c: array[1..3] of Integer;
x: Integer;
begin
a:= FloatToStr(Sayi_Rakam);
if Sayi_Rakam >= 0 then
Pozitif:= True
else Pozitif:= False;
if not Pozitif then a:= Copy(a,2,Length(a)-1);
for x:= 1 to Length(a) do
begin
if (Ord(a[x]) > Ord('9')) or (Ord(a[x]) < Ord('0')) then goto 1;
end;
//if Length(a) > 21 then goto 1;
if Length(a) > 18 then goto 1;
//a:=StringOfChar('0',21-Length(a))+a;
a:= StringOfChar('0',18 - Length(a)) + a;
//for x:=1 to 21 do
for x:= 1 to 18 do
begin
v[x]:= StrToInt(a[x]);
end;
s:= '';
//for x:=0 to 6 do
for x:= 0 to 5 do
begin
c[1]:= v[(x*3) + 1];
c[2]:= v[(x*3) + 2];
c[3]:= v[(x*3) + 3];
{ShowMessage('c[1] = '+FloatToStr(c[1])+#10+'c[2] = '+
FloatToStr(c[2])+#10+'c[3] = '+FloatToStr(c[3])+#10+'s = '+s+#10+
'x = '+IntToStr(x));}
if c[1] = 0 then
e:= ''
else if c[1] = 1 then
e:= 'Yüz'
else e:= b[c[1]] + 'Yüz';
e:= e + y[c[2]] + b[c[3]];
if e <> '' then e:= e + m[x];
//if (x=5) and (e='BirBin') then e:='Bin';
if (x = 4) and (e = 'BirBin') then e:= 'Bin';
s:= s + e;
{ShowMessage('b[c[1]] = '+b[c[1]]+#10+'y[c[2]] = '+y[c[2]]+#10+
'b[c[3]] = '+b[c[3]]+#10+'m[x] = '+m[x]);}
end;
if s= '' then s:= 'Sıfır';
if not Pozitif then s:= '- ' + s;
Result:= s;
goto 2;
1:Result:= 'Girilen Değer Hatalı ...!'; //Hatalı Çıktı
2://Hatasız Çıktı
end;
procedure Tfrm_RakamYazi.FormShow(Sender: TObject);
begin
ErrorCode:= 0;
Label1.Caption:= '';
end;
procedure Tfrm_RakamYazi.Edit1Exit(Sender: TObject);
begin
if Edit1.Text <> '' then
try
Label1.Caption:= 'Yalnız, ' + Rakam_Yazi(StrToFloat(Edit1.Text)) +
' TL.''sıdır.';
except on EConvertError do
begin
MessageDlg('Lütfen, sayısal bir değer giriniz...!', mtError,
mbOKCancel, 0);
Edit1.SetFocus;
Edit1.Text:= '';
end;
end
else Edit1.Text:= '0';
//PostMessage(Edit1.Handle,WM_KEYDOWN,VK_END,0);
end;
procedure Tfrm_RakamYazi.Button1Click(Sender: TObject);
begin
Close;
end;
procedure Tfrm_RakamYazi.Button2Click(Sender: TObject);
var
I, Code: Integer;
begin
Val(Edit2.Text, I, Code);
ErrorCode:= Code;
if code <> 0 then
MessageDlg('Hata Kodu = ' + IntToStr(Code) + ' ( ' +
SysErrorMessage(ErrorCode) + ' )', mtWarning, [mbOk], 0)
else Canvas.TextOut(10, 10, 'Value = ' + IntToStr(I));
end;
procedure Tfrm_RakamYazi.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if (Edit1.Text <> '') and (Key = #13) then Edit1Exit(Edit1);
end;
end.Bu küçük uygulama Delphi 2.0 ile yazdım. Delphi 5.0'de uses hatası verdi
sen artık kendine göre ayarlarsın.
1 katrilyona kadar hatasız çalışıyor (999 trilyon999 milyar999milyon999bin999)
yakında aramaya başlarsınız kuruşları 