Mega Code Archive
Türkçe ve 1 trilyona kadar sayıları yazıya çeviri
<![CDATA[
unit Unit1;
{ İnternette dolaşan NumToLetters fonksiyonu bilindiği gibi ingilizce idi ve
4 milyarın üzerine çıkmıyordu. Bikaç değişiklik ve eklenti yaptım.
Form1 üzerinde Edit1 ve Edit 2 olarak iki tane edit penceresi oluşturun,
Edit1'e OnExit Eventini ayarlayın, küçük bi eklenti ile aynı mantık ile
1 trilyon üzerine de çıkabilirsiniz.Ben bunu bi ticari programımda yapmıştım,
artık geliştirmiyorum. }
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
procedure Edit1Exit(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TNumberStr = string[13];
const
Numbers: array[1..19] of TNumberStr = ('bir', 'iki', 'üç', 'dört',
'beş', 'altı', 'yedi', 'sekiz', 'dokuz', 'on', 'onbir', 'oniki',
'onüç', 'ondört', 'onbeş', 'onaltı', 'onyedi', 'onsekiz',
'ondokuz');
Tenths: array[1..9] of TNumberStr = ('on', 'yirmi', 'otuz', 'kırk',
'elli', 'altmış', 'yetmiş', 'seksen', 'doksan');
var
Form1: TForm1;
implementation
{$R *.DFM}
//*---------------------------------------
function RecurseNumbermilyar(N: LongWord): string;
begin
case N of
1..19:
Result:= Numbers[N];
20..99:
Result := Tenths[N div 10] + ' ' + RecurseNumbermilyar(N mod 10);
100..199:
Result := ' yüz ' + RecurseNumbermilyar(N mod 100);
200..999:
Result := Numbers[N div 100] + ' yüz ' + RecurseNumbermilyar(N mod 100);
end;
end;
function RecurseNumber(N: LongWord): string;
begin
case N of
1..19:
Result := Numbers[N];
20..99:
Result := Tenths[N div 10] + ' ' + RecurseNumber(N mod 10);
100..199:
Result := ' yüz ' + RecurseNumber(N mod 100);
200..999:
Result := Numbers[N div 100] + ' yüz ' + RecurseNumber(N mod 100);
1000..1999:
Result := ' bin ' +
RecurseNumber(N mod 1000);
2000..999999:
Result := RecurseNumber(N div 1000) + ' bin ' +
RecurseNumber(N mod 1000);
1000000..999999999:
Result := RecurseNumber(N div 1000000) + ' milyon '
+ RecurseNumber(N mod 1000000);
end;
end;
function NumToLetters(Number: Real): string;
begin
Result := RecurseNumber(Round(Int(Number)));
end;
function NumToLettersmilyar(Number: Real): string;
begin
Result := RecurseNumbermilyar(Round(Int(Number)));
end;
//-----------------------------------------------
procedure TForm1.Edit1Exit(Sender: TObject);
var s1,s2:string;
lol:integer;
begin
if (edit1.text<>'') and (strtofloat(edit1.text)<1000000000000) then
if strtofloat(edit1.text)< 1000000000 then
edit2.text:='('+numtoletters(strtofloat(edit1.text))+')';
if strtofloat(edit1.text)>= 1000000000 then begin
s1:=edit1.text;
case length(s1) of
12:s2:=copy(s1,1,3);
11:s2:=copy(s1,1,2);
10:s2:=copy(s1,1,1);
end;
lol:=length(s2);
delete(s1,1,lol);
edit2.text:='('+numtolettersmilyar(strtofloat(s2))+' milyar '+numtoletters(strtofloat(s1))+')';
end;
end;
end.
]]>