Merhaba,
Böyle bir fonksiyon varsa yerini ihbar etseniz ne güzel zaman tasarrufu olur ! Verilen rakamı, faturanın altına yazıyla yazacak YTL ve YKR ye uygun bir fonksiyon arıyorum.
Sayıyı yazıya çevirmek
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Forum kurallarını okuyup, uyunuz!
"sayıyı yazıya" seklinde aratınca hemen cıktı bir tane
yalnız bir kac duzenleme yapılması gerekiyordu,
DecimalSeperator isletim sisteminden alınacak sekilde duzelttim sorunsuz calısıyor...
gule gule kullanın
yalnız bir kac duzenleme yapılması gerekiyordu,
DecimalSeperator isletim sisteminden alınacak sekilde duzelttim sorunsuz calısıyor...
gule gule kullanın
Kod: Tümünü seç
procedure TFrmMain.Button1Click(Sender: TObject);
function rakyazf(tutar: real; tur: integer): string;
const
b1: array[1..9] of string =
('BİR', 'İKİ', 'ÜÇ', 'DÖRT', 'BEŞ', 'ALTI', 'YEDİ', 'SEKİZ', 'DOKUZ');
b2: array[1..9] of string =
('ON', 'YİRMİ', 'OTUZ', 'KIRK', 'ELLİ', 'ALTMIŞ', 'YETMİŞ', 'SEKSEN',
'DOKSAN');
b3: array[1..6] of string =
('KATRİLYON', 'TRİLYON', 'MİLYAR', 'MİLYON', 'BİN', '');
var
gr: array[1..6] of string[3];
sn: array[1..6] of string;
bs: array[1..3] of integer;
tutars, tutart, tutark, sonuct, sonuck: string;
i, l: integer;
begin
tutars := floattostr(tutar);
if pos(DecimalSeparator, tutars) = 0 then
tutars := tutars + DecimalSeparator+'00';
tutart := copy(tutars, 1, (pos(DecimalSeparator, tutars) - 1));
tutark := copy(tutars, (pos(DecimalSeparator, tutars) + 1), 2);
tutart := stringofchar('0', (18 - (length(trim(tutart))))) + tutart;
tutark := tutark + stringofchar('0', (2 - (length(trim(tutark)))));
for i := 1 to 6 do
gr[i] := copy(tutart, 1 + (3 * (i - 1)), 3);
for l := 1 to 6 do
begin
bs[1] := strtoint(copy(gr[l], 1, 1));
if bs[1] <> 0 then
(if bs[1] <> 1 then
sn[l] := sn[l] + b1[bs[1]] + 'YÜZ'
else
sn[l] := sn[l] + 'YÜZ');
bs[2] := strtoint(copy(gr[l], 2, 1));
if bs[2] <> 0 then
sn[l] := sn[l] + b2[bs[2]];
bs[3] := strtoint(copy(gr[l], 3, 1));
if bs[3] <> 0 then
sn[l] := sn[l] + b1[bs[3]];
if length(trim(sn[l])) <> 0 then
sn[l] := sn[l] + b3[l];
end;
if sn[5] = 'BİRBİN' then
sn[5] := 'BİN';
for i := 1 to 6 do
sonuct := sonuct + sn[i];
if strtoint(copy(tutark, 1, 1)) <> 0 then
sonuck := sonuck + b2[strtoint(copy(tutark, 1, 1))];
if strtoint(copy(tutark, 2, 1)) <> 0 then
sonuck := sonuck + b1[strtoint(copy(tutark, 2, 1))];
if tur = 0 then
result := sonuct + '.TL / ' + sonuck + '.KR ';
if tur = 1 then
result := sonuct + '.TL ';
if tur = 2 then
result := sonuck + '.KR ';
end;
begin
ShowMessage(rakyazf(StrToFloat(edit1.text), 0));
end;ÜŞENME,ERTELEME,VAZGEÇME
-
sadettinpolat
- Moderator
- Mesajlar: 2131
- Kayıt: 07 Ara 2003 02:51
- Konum: Ankara
- İletişim:
negatif sayilarda sorun cikartiyordu.
asagidaki gibi degistirilebilir....
asagidaki gibi degistirilebilir....
gkimirti yazdı:"
Kod: Tümünü seç
procedure TFrmMain.Button1Click(Sender: TObject); function rakyazf(tutar: real; tur: integer): string; const b1: array[1..9] of string = ('BİR', 'İKİ', 'ÜÇ', 'DÖRT', 'BEŞ', 'ALTI', 'YEDİ', 'SEKİZ', 'DOKUZ'); b2: array[1..9] of string = ('ON', 'YİRMİ', 'OTUZ', 'KIRK', 'ELLİ', 'ALTMIŞ', 'YETMİŞ', 'SEKSEN', 'DOKSAN'); b3: array[1..6] of string = ('KATRİLYON', 'TRİLYON', 'MİLYAR', 'MİLYON', 'BİN', ''); var gr: array[1..6] of string[3]; sn: array[1..6] of string; bs: array[1..3] of integer; tutars, tutart, tutark, sonuct, sonuck: string; i, l: integer; begin //tutars := floattostr(tutar); //---------------------------------- if para >= 0 Then tutars:=floattostr(Para) else tutars:=floattostr(Para * -1); //---------------------------------- if pos(DecimalSeparator, tutars) = 0 then tutars := tutars + DecimalSeparator+'00'; tutart := copy(tutars, 1, (pos(DecimalSeparator, tutars) - 1)); tutark := copy(tutars, (pos(DecimalSeparator, tutars) + 1), 2); tutart := stringofchar('0', (18 - (length(trim(tutart))))) + tutart; tutark := tutark + stringofchar('0', (2 - (length(trim(tutark))))); for i := 1 to 6 do gr[i] := copy(tutart, 1 + (3 * (i - 1)), 3); for l := 1 to 6 do begin bs[1] := strtoint(copy(gr[l], 1, 1)); if bs[1] <> 0 then (if bs[1] <> 1 then sn[l] := sn[l] + b1[bs[1]] + 'YÜZ' else sn[l] := sn[l] + 'YÜZ'); bs[2] := strtoint(copy(gr[l], 2, 1)); if bs[2] <> 0 then sn[l] := sn[l] + b2[bs[2]]; bs[3] := strtoint(copy(gr[l], 3, 1)); if bs[3] <> 0 then sn[l] := sn[l] + b1[bs[3]]; if length(trim(sn[l])) <> 0 then sn[l] := sn[l] + b3[l]; end; if sn[5] = 'BİRBİN' then sn[5] := 'BİN'; for i := 1 to 6 do sonuct := sonuct + sn[i]; if strtoint(copy(tutark, 1, 1)) <> 0 then sonuck := sonuck + b2[strtoint(copy(tutark, 1, 1))]; if strtoint(copy(tutark, 2, 1)) <> 0 then sonuck := sonuck + b1[strtoint(copy(tutark, 2, 1))]; //---------------------------------- if para < 0 Then sonuct := 'EKSİ ' + sonuct; //---------------------------------- if tur = 0 then result := sonuct + '.TL / ' + sonuck + '.KR '; if tur = 1 then result := sonuct + '.TL '; if tur = 2 then result := sonuck + '.KR '; end; begin ShowMessage(rakyazf(StrToFloat(edit1.text), 0)); end;