Yazılan Fiyatı Metine Çevirmek

Reklam Alanı

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
procedure Edit1Exit(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
const
Birler : Array[0..9] of string = (”,’Bir’,'İki’,'Üç’,'Dört’,'Beş’,'Altı’,'Yedi’,'Sekiz’,'Dokuz’);
YirmiyeKadar : Array[0..19] of string = (”,’Bir’,'İki’,'Üç’,'Dört’,'Beş’,'Altı’,'Yedi’,'Sekiz’,'Dokuz’,'On’,'Onbir’,'Oniki’,'Onüç’,'Ondört’,'Onbeş’,'Onaltı’,'Onyedi’,'Onsekiz’,'Ondokuz’);
Onluklar : Array[2..9] of string = (‘Yirmi’,'Otuz’,'Kırk’,'Elli’,'Atmış’,'Yetmiş’,'Seksen’,'Doksan’);
implementation

{$R *.dfm}

function UcluyuCevir(CevirilecekSayi: Integer): string;
var
Donecek: String;
begin
Donecek := ”;
if Length(IntToStr(CevirilecekSayi)) = 3 then
begin

Donecek := Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))]+’Yüz’;
if StrToInt(Copy(IntToStr(CevirilecekSayi),2,2)) < 20 then Donecek := Donecek + YirmiyeKadar[StrToInt(Copy(IntToStr(CevirilecekSayi),2,2))];
if StrToInt(Copy(IntToStr(CevirilecekSayi),2,2)) >= 20 then
begin
Donecek := Donecek + Onluklar[StrToInt(Copy(IntToStr(CevirilecekSayi),2,1))];
Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),3,1))];
end;
end;
if Length(IntToStr(CevirilecekSayi)) = 2 then
begin
if StrToInt(Copy(IntToStr(CevirilecekSayi),1,2)) < 20 then Donecek := Donecek + YirmiyeKadar[StrToInt(Copy(IntToStr(CevirilecekSayi),1,2))];
if StrToInt(Copy(IntToStr(CevirilecekSayi),1,2)) >= 20 then
begin
Donecek := Donecek + Onluklar[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))];
Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),2,1))];
end;
end;
if Length(IntToStr(CevirilecekSayi)) = 1 then
begin
if StrToInt(Copy(IntToStr(CevirilecekSayi),1,1)) = 0 then Exit;
Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))];
end;
Result := Donecek;
end;

function YaziyaCevir(CevirilecekSayi: Real): string;
var
a,AlinacakYer,Bolum,Kalan,YaziUzunlugu: Integer;
Yazi,Parca: String;
begin
if CevirilecekSayi = 0 then
begin
Result := ‘Sıfır’; Exit;
end;
// Tamsayı kısmı *************************************************************
Yazi := ”;
Bolum := Length(FloatToStr(int(CevirilecekSayi))) div 3;
Kalan := Length(FloatToStr(Trunc(CevirilecekSayi))) mod 3;
YaziUzunlugu := Length(FloatToStr(Trunc(CevirilecekSayi)));
for a := 1 to Bolum do
begin
AlinacakYer := YaziUzunlugu-(a*3)+1;
Parca := ”;
Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),AlinacakYer,3)));
if  a = 1 then Yazi := Parca;
if (a = 2) and (Parca <> ”) then Yazi := Parca+’Bin’+Yazi;
if (a = 3) and (Parca <> ”) then Yazi := Parca+’Milyon’+Yazi;
if (a = 4) and (Parca <> ”) then Yazi := Parca+’Milyar’+Yazi;
if (a = 5) and (Parca <> ”) then Yazi := Parca+’Trilyon’+Yazi;
end;
if Kalan > 0 then
begin
if a = 0 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),1,Kalan)));
if a = 2 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),1,Kalan)))+’Bin’+Yazi;
if a = 3 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),1,Kalan)))+’Milyon’+Yazi;
if a = 4 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),1,Kalan)))+’Milyar’+Yazi;
if a = 5 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),1,Kalan)))+’Trilyon’+Yazi;
end;
// Virgüllü kısmı ************************************************************
Parca := ”;
a := Pos(‘,’,FloatToStr(CevirilecekSayi));
if a > 0 then
begin
if Length(Copy(FloatToStr(CevirilecekSayi),a+1,2)) = 1 then
Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),a+1,2)+’0′)) else
Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),a+1,2)));
if Parca <> ” then Parca := ‘ ‘ + Parca + ‘ KURUŞ’;
end;
if Yazi <> ” then Result := Yazi + ‘ TL’ + Parca;
if Yazi = ” then
begin
Delete(Parca,1,5);
Result := Parca;

END;
END;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(YaziyaCevir(StrToFloat(edit1.Text)));
end;

procedure TForm1.Edit1Exit(Sender: TObject);
begin
edit2.Text:=(YaziyaCevir(StrToFloat(edit1.Text)));
end;

end.

Benzer Yazılar:

  1. ASCII Kodlarını Bulmak
  2. Merkez Bankasindan Gunluk Doviz Kurlarini Alma Kodu
  3. Listbox İtemlerinin Sırasını Mause ile sürükleyerek Değiştirmek
  4. Tüm Dosya ve Klasörlerin Listesini Almak
  5. Delphi ile Mp3 dosya çalmak çaldırmak
  6. Bilgisayardaki Sürücü Listesini Almak
  7. Ekran Klavyesi
  8. Dosya Uzantısından Programın Tespiti
  9. Metin İçerisinden Bir Karakter Silmek
  10. Dosya Kopyalama
Etiketler:

Eğer yazıyı beğendiyseniz ya da ekleyecekleriniz varsa, lütfen yorumunuz yazın veya RSS aboneliği ile yeni yazılardan anında haberdar olun.

Yorum yapın

*

Gizlilik Politikası