sring sayıyı Yazıya cevirme

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
zengin
Üye
Mesajlar: 233
Kayıt: 06 Ağu 2003 10:13

sring sayıyı Yazıya cevirme

Mesaj gönderen zengin »

S.A

degerli arkadaşlarım

örnek : 90CT6K683AA string olan yazıyı nasıl okunabilir hale getirebilirim

Kod: Tümünü seç

doksan ct altı k altı yüz seksen üc aa
olarak yazıya cevirip yazdırmak istiyorum bunu nasıl yapabilim
Zengin
Kullanıcı avatarı
sabanakman
Kıdemli Üye
Mesajlar: 3081
Kayıt: 17 Nis 2006 08:11
Konum: Ah bi Antalya olaydı keşke (Ankara)

Re: sring sayıyı Yazıya cevirme

Mesaj gönderen sabanakman »

Rakam fonksiyonu sayının okunuşunu verir.

Kod: Tümünü seç

function Rakam(Sayi:Int64):String;
const n=9;
  Basamak:array[0..n]of String=('','Bin','Milyon','Milyar','Trilyon','Katrilyon','Kentrilyon','Sekstilyon','Septilyon','Oktilyon');
  Onlar:array[0..n]of String=('','On','Yirmi','Otuz','Kırk','Elli','Altmış','Yetmiş','Seksen','Doksan');
  Birler:array[0..n]of String=('','Bir','İki','Üç','Dört','Beş','Altı','Yedi','Sekiz','Dokuz');
var i:Byte; UcHane:Word; Yed,UcluHane:String; HangiBasamak:Byte;
    Negatif,BasamakYaz:Boolean;

function Modu(var Sayisi:Word):Byte;
begin
   Result:=Sayisi mod 10;
   Sayisi:=Sayisi div 10;
end;

begin
  if Sayi=0 then
    Result:='Sıfır'
  else begin
    Negatif:=Sayi<0;
    if Negatif then Sayi:=-Sayi;
    Result:='';
    HangiBasamak:=0;
    while Sayi>0 do begin
      UcHane:=Sayi mod 1000;  Sayi:=Sayi div 1000;
      BasamakYaz:=UcHane>0;
      repeat
        UcluHane:='';
        if ((HangiBasamak=1) and (UcHane=1)) then Break;//sadece bin yazılacaksa
        i:=Modu(UcHane); UcluHane:=Birler[i];   //3 hanenin 1. si
        i:=Modu(UcHane); UcluHane:=Onlar[i]+UcluHane; //3 hanenin 2. si
        i:=Modu(UcHane);
        if i>0 then Yed:='Yüz' else Yed:='';
        if i>1 then Yed:=Birler[i]+Yed;
        UcluHane:=Yed+UcluHane;//3 hanenin 3. sü
      until True;
      if BasamakYaz then Result:=UcluHane+Basamak[HangiBasamak]+Result;
      inc(HangiBasamak);
    end;
    if Negatif then Result:='Eksi'+Result
    else //Delete(Result,1,1);
  end;
end;

function StringOlanYaziyiOku(Bilgi:String):String;
var i,n:Integer; S:String;
begin
  Result:='';
  repeat
    i:=1;n:=Length(Bilgi);
    while (i<=n) and (Bilgi[i] in ['0'..'9']) do Inc(i);
    if i>1 then begin
      S:=Copy(Bilgi,1,i-1);
      Delete(Bilgi,1,i-1);
      n:=n-i+1;
      Result:=Result+' '+Rakam(StrToInt(S));
    end;
    while (i<=n) and not (Bilgi[i] in ['0'..'9']) do Inc(i);
    if i>1 then begin
      Result:=Result+' '+Copy(Bilgi,1,i-1);
      Delete(Bilgi,1,i-1);
    end;
  until Bilgi='';
  Result:=Trim(Result);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(StringOlanYaziyiOku('90CT6K683AA'));
end;
Şaban Şahin AKMAN
_________________
Derin olan kuyu değil kısa olan iptir. - .
zengin
Üye
Mesajlar: 233
Kayıt: 06 Ağu 2003 10:13

Re: sring sayıyı Yazıya cevirme

Mesaj gönderen zengin »

s.a

ustacıgım vermiş oldugunuz string cevirme örnegi cok faydalı oldu

cok teşekkür ederim kolay gelsin
Zengin
Cevapla