Sayilarin yazıya çevrilmesi için yazılmış örnek bir bileşen Delphi

[ALpMontana]

Sayilari yaziya cevirme ile ilgili bir çok çalışma zaten var.

Fakat böyle kodların, bileşenler olarak toparlanması,
gerektiği zaman kodların değişik projelere taşınmasını
daha da kolaylaştırır.

Aşağıdaki örnekte Edit1 kutusuna yazılan bir tam sayı
değerini, bileşende işleyip Edit2 kutusuna yazdırıyoruz.

Bileşen üzerinde çok ufak ve basit bir uyarlama ile kesirli
sayıların da yazıya çevrilmesi sağlanabilir.

Bunun için üzerinde iki edit ve bir düğme bulunan bir form
hazırlanması yeterlidir.

Düğmede çalışacak olan kod aşağıdaki gibi olacaktır.

Bileşenin kodu da aşağıdaki gibidir.




unit SayidanYaziya;

interface

uses
Windows, Messages, SysUtils, Classes, Math;

type
TBaSayidanYaziya = class(TComponent)
private
HGiris, HCikis : String;
function GetCikis: String;
function GetGiris: String;
procedure SetGiris(const Value: String);
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
property Giris : String read GetGiris write SetGiris;
property Cikis : String read GetCikis;
end;

procedure Register;

implementation

const
Birler : array[1..9] of String = ('Bir', 'İki', 'Üç', 'Dört', 'Beş', 'Altı', 'Yedi', 'Sekiz', 'Dokuz');
Onlar : array[1..9] of String = ('On', 'Yirmi', 'Otuz', 'Kırk', 'Elli', 'Altmış', 'Yetmiş', 'Seksen', 'Doksan');
Yuzler : array[1..9] of String = ('Yüz', 'İkiYüz', 'ÜçYüz', 'DörtYüz', 'BeşYüz', 'AltıYüz', 'YediYüz', 'SekizYüz', 'DokuzYüz');
Basamaklar : array[1..6] of String = ('Bin', 'Milyon', 'Milyar', 'Trilyon', 'Katrilyon', 'Katrilyar');

procedure Register;
begin
RegisterComponents('Ba', [TBaSayidanYaziya]);
end;

{ TBaSayidanYaziya }

function TBaSayidanYaziya.GetCikis: String;
begin
Result := HCikis;
end;

function TBaSayidanYaziya.GetGiris: String;
begin
Result := HGiris;
end;

procedure TBaSayidanYaziya.SetGiris(const Value: String);
const
HataliGiris : String = 'Yanlış giriş...';
var
Dizi : Array of Smallint;
Str : String;

function YaziyaCevir(Giris : Integer): String;
var
i, j : Integer;
begin
Result := ";
i := Trunc(Giris / 100);
if i <> 0 then
Result := Yuzler;
j := Giris - i * 100;
i := Trunc(j / 10);
if i <> 0 then
Result := Result + Onlar;
j := j - i * 10;
i := j;
if i <> 0 then
Result := Result + Birler;
end;

procedure Sonuc(var MyStr : String);
var
i : Integer;
begin
for i := High(Dizi) downto 1 do
begin
if Dizi <> 0 then
if i <> 1 then
MyStr := MyStr + YaziyaCevir(Dizi) + Basamaklar
else
begin
if Dizi <> 1 then
MyStr := MyStr + YaziyaCevir(Dizi) + Basamaklar
else
MyStr := MyStr + Basamaklar
end;
end;
MyStr := MyStr + YaziyaCevir(Dizi[0]);
end;

function DiziyiAyarla(var MyStr : String): Boolean;
var
HStr : String;
i, j : Integer;
begin
Result := False;
SetLength(Dizi, Ceil(Length(MyStr) / 3));

for i := 0 to High(Dizi) do
begin
HStr := Copy(MyStr, Length(MyStr) - 2, 3);
j := StrToIntDef(HStr, -1);
if j = -1 then
begin
MyStr := HataliGiris;
Exit;
end;
Dizi := j;
MyStr := Copy(MyStr, 1, Length(MyStr) - 3);
end;
MyStr := ";
Result := True;
end;

begin
Str := Value;

if Length(Str) > 21 then
begin
HCikis := HataliGiris;
Exit;
end;

if DiziyiAyarla(Str) then
Sonuc(Str);

HCikis := Str;

SetLength(Dizi, 0);
end;

end.



Umarım faydalı olur.

Saygılar.