Kuruşu yazıya çevirmek...

[vkamadan]

Merhaba arkadaşlar,
Elimde ki functionlarlar örnğ , 500 YTL yi BeşYüz YTL olarak yazdırıyorum fakat 500,25 YTL Beşyüz YTL YirmiBeş Ykr olarak yazdıramıyorum,
elinde böyle bir function olan arkadaş varmı?
Teşekkürler.

[husonet]

Forum da bu soruya cevap verdik Arayalım bulalım zaman kazanalım


Kolay Gelsin...

[vkamadan]

evet sayın Husonet
önce arama yaptım ama bulamadım.
Eğer sizin için kolay biryerlerdeyse bir link rica edebilirmiyim,
YTL+yazi , kuruş+yazi ,YTLtoYazi gibi kriterlerde arama yaptırmama rağmen bulamadım.
teşekkürler.

[sako]

Kod: Tümünü seç

procedure TForm1.CeButton1Click(Sender: TObject);
  var
  SAY1,SAY2,TUTAR:currency;
  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 + ' YTL  /   ' + sonuck + '.KR ';
    if tur = 1 then
      result := sonuct + ' TL ';
    if tur = 2 then
      result := sonuck + ' KR ';
  end;
begin
  say1:=strtocurr(edit2.Text);
tutar:=say1 /1000000;
edit1.Text:=currtostr(tutar);
LABEL1.Caption:=(rakyazf(StrToFloat(edit1.text), 0));
end;

procedure TForm1.Edit2Change(Sender: TObject);
  var
  SAY1,SAY2,TUTAR:currency;
  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 + ' - YTL  /   ' + sonuck + '.KR ';
    if tur = 1 then
      result := sonuct + ' TL ';
    if tur = 2 then
      result := sonuck + ' -YKR ';
  end;
begin
  say1:=strtocurr(edit2.Text);
tutar:=say1 /1000000;
edit1.Text:=currtostr(tutar);
LABEL1.Caption:=(rakyazf(StrToFloat(edit1.text), 0));
end;
end.

Not: Kod larınızı Code tag içine alın HUSONET

[vkamadan]

Sayın Sako;
bir yanlışlık oldu herhalde, gönderdiğiniz kodun konumuzla bir ilgisi yok.
Saygılar.

[sako]

Düzelttim

[husonet]

viewtopic.php?t=4401&highlight=say%FDy%FD

Kolay gelsin...

[vkamadan]

Çok teşekkür ederim.
İyi çalışmalar.