parayı yazıya çevirme

[ademcicek]

merhaba arkadaşlar.

elinde parayı yazıya çeviren funksiyonu olan olan varmı.

kolay gelsin.

[hdayi]

Kod: Tümünü seç

function tform1.YaziyaCevir(x:double):string;
var sonuc, arasonuc,sayi,basamak, katsayi:string;
    uzunluk,i,j:integer;
begin
    sayi:=FloatToStr(x);
    uzunluk:=Length(sayi);
    sonuc:='';
  for j:=1 to (uzunluk div 3)+1
  do begin
  if sayi='' then break;
  case j of
   1 : katsayi:='';
   2 : katsayi:='Bin';
   3 : katsayi:='Milyon';
   4 : katsayi:='Milyar';
   5 : katsayi:='Trilyon';
  end; {case}

  arasonuc:='';
    for i:=1 to 3
    do begin
      basamak:=MidStr(sayi,length(sayi),1);
      sayi:=LeftStr(sayi,length(sayi)-1);

      if i=1
      then begin
        case StrToInt(basamak) of
          1:begin
              if j=2
              then arasonuc:=''+arasonuc
              else arasonuc:='Bir'+arasonuc

            end;
          2:begin
              arasonuc:='İki'+arasonuc;
            end ;
          3:begin
              arasonuc:='Üç'+arasonuc;
            end ;
          4:begin
              arasonuc:='Dört'+arasonuc;
            end ;
          5:begin
              arasonuc:='Beş'+arasonuc;
            end ;
          6:begin
              arasonuc:='Altı'+arasonuc;
            end ;
          7:begin
              arasonuc:='Yedi'+arasonuc;
            end ;
          8:begin
                arasonuc:='Sekiz'+arasonuc;
            end ;
          9:begin
                arasonuc:='Dokuz'+arasonuc;
            end ;
          0:begin
                arasonuc:=''+arasonuc;
            end ;
        else ;

        end; {case}
      end; {if}

      if i=2
      then begin
        case StrToInt(basamak) of
          1:begin
              arasonuc:='On'+arasonuc;
            end;
          2:begin
              arasonuc:='Yirmi'+arasonuc;
            end ;
          3:begin
              arasonuc:='Otuz'+arasonuc;
            end ;
          4:begin
              arasonuc:='Kırk'+arasonuc;
            end ;
          5:begin
              arasonuc:='Elli'+arasonuc;
            end ;
          6:begin
              arasonuc:='Altmış'+arasonuc;
            end ;
          7:begin
              arasonuc:='Yetmiş'+arasonuc;
            end ;
          8:begin
                arasonuc:='Seksen'+arasonuc;
            end ;
          9:begin
                arasonuc:='Doksan'+arasonuc;
            end ;
          0:begin
                arasonuc:=''+arasonuc;
            end ;
        else ;

        end; {case}

      end; {if}

      if i=3
      then begin
        case StrToInt(basamak) of
          1:begin
              arasonuc:='Yüz'+arasonuc;
            end;
          2:begin
              arasonuc:='İkiyüz'+arasonuc;
            end ;
          3:begin
              arasonuc:='Üçyüz'+arasonuc;
            end ;
          4:begin
              arasonuc:='Dörtyüz'+arasonuc;
            end ;
          5:begin
              arasonuc:='Beşyüz'+arasonuc;
            end ;
          6:begin
              arasonuc:='Altıyüz'+arasonuc;
            end ;
          7:begin
              arasonuc:='Yediyüz'+arasonuc;
            end ;
          8:begin
                arasonuc:='Sekizyüz'+arasonuc;
            end ;
          9:begin
                arasonuc:='Dokuzyüz'+arasonuc;
            end ;
          0:begin
                arasonuc:=''+arasonuc;
            end ;
        else ;

        end; {case}

      end;{if}
      if sayi='' then break;


    end; {for}
    result:=arasonuc+katsayi+result;
  end; {for}

end;

[showtime]

Ya dostum teşekkürler eleştiri olarak yazmıyorum ama bu fonksiyon doğru yazmıyor.

Eğer başka kod varsa memnun olurum.

[hdayi]

Bende tam olarak çalışıyor.

[mussimsek]

Benim kullandığım fonksiyonda şu :

Kod: Tümünü seç

function SayiToSozlu (Number :Double):String;
var
   Text :Array [0..9,0..1] of String;
   Sy,
   Syt,
   S    :String;
function Oku(Deg:String):String;
var
  B1,B2,B3:String;
  P:Integer;
begin
  try
    B1 := Text[strToInt(copy(Deg, 3, 1)), 0];
    B2 := Text[strToInt(Copy(Deg, 2, 1)), 1];
    P := strToInt(Copy(Deg, 1, 1));
  except
  end;

  if P > 1 then
    b3 := Text[P, 0] + 'Yüz'
  else if P = 1 then
    b3 := 'Yüz'
  else b3 := '';

  Oku := b3 + B2 + B1;
end;
begin
   Text[0, 0] :='';
   Text[1, 0] := 'Bir';
   Text[2, 0] := 'İki';
   Text[3, 0] := 'Üç';
   Text[4, 0] := 'Dört';
   Text[5, 0] := 'Beş';
   Text[6, 0] := 'Altı';
   Text[7, 0] := 'Yedi';
   Text[8, 0] := 'Sekiz';
   Text[9, 0] := 'Dokuz';
   Text[1, 1] := 'On';
   Text[2, 1] := 'Yirmi';
   Text[3, 1] := 'Otuz';
   Text[4, 1] := 'Kırk';
   Text[5, 1] := 'Elli';
   Text[6, 1] := 'Altmış';
   Text[7, 1] := 'Yetmiş';
   Text[8, 1] := 'Seksen';
   Text[9, 1] := 'Doksan';

 if Number<=0 then
   begin
     Result:='';
     exit;
   end;

 S := FormatFloat('0',Number);
 S:='000000000000000' + S;
 S := copy(S,length(s)-14,15);
 Sy := '';
 syt := '';

 {Boluk$ := MID$(S$, 13, 3):  Bolok Boluk$, Sy$, Text$()}
  syt := Oku(copy(S, 13, 3));
  if Oku(copy(S, 10, 3)) <> '' then
    if strToInt(copy(S, 10, 3)) = 1 then
      syt := 'Bin' +Syt
    else
      syt := Oku(copy(S, 10, 3))+'Bin' +Syt;

  if Oku(copy(S, 7, 3)) <> '' then
   syt := Oku(copy(S, 7, 3))+'Milyon' + Syt;

  if Oku(copy(S, 4, 3)) <> '' then
   syt := Oku(copy(S, 4, 3))+'Milyar' + Syt;

  if Oku(copy(S, 1, 3)) <> '' then
   syt := Oku(copy(S, 7, 3))+'Trilyon' + Syt;

  SayiToSozlu := syt;
end;

[freeman35]

@showtime yaw kardeşim, Biz bu formu bilgiyi paylaşalım diye kurduk, her canı isteyene program yazalım diye değil. kibar konuşmaya çalışıp eleştirmek istiri olarak yazmıyorum demişsin bide. Yaw adamı eleştir ama bu nebiçim kod , doğru çalışmıyor diye değil, al admın kodunu üzerinde çalış daha iyisini yap, yaz buraya onun altına eleştirmek istemiyorum ama, böyle daha iyi olur de. hah ozaman seni ayakta alkışlayayım.
Daha ilk mesajınmış birde. Biz burda üslübumuza çok dikkat ederiz.Karşımızdakini tanımasak bile nezaket çerçevesi içinde konuşuruz. Şahsına nezaketsizlik yaptın demek değil bu, kızım sana söylüyorum gelinim sen anla.
1-2 gün öncede bir yazışmalar olmuş vatandaş kimse bana cevap yazmadı diye serzenişte bulunmuş, maalesef yazıyı ben görmedim görseydim tek cümlem vardı, SEN KAÇ KİŞİNİN SORUNUNU HALLETTİN bu soruyu tüm üyeler sorsun kendine.
Benimde bu sitede sorularım oldu, tabiki bilmediğim yerler var.Cevapta alamadıklarım var., nefsim tabiki kimse cevap yazmadı ben neden uğraşıyorum diyorum zaman zaman. ama genede galip gelen taraf aklım. Ben anamın karnında öğrenmedim banada yardım edenler oldu,oluyorda bunun borcunuda bilmiyenlere bildiklerimi anlatarak ödemeye çalışıyorum.En doğal hakkım olartakta aynı şeyi burdakilerden istiyorum. nede olsa Tükkan bizim

kolay gele

[mrmarman]

@freeman35

- Sana bu konuda tamamen katılıyorum ve ben de bu konuda çok katıyımdır... Diğer yandan daha ilk mesajında yaptığı hatalı yaklaşımı biraz müsamaha gösterip yapıcı yaklaşabiliriz...

@showtime

- Kod doğru çalışmıyor deyince şu anlam çıkıyor... Kod çalışıyor ama şu rakamı yazdığımda bana başka cevap veriyor... Bu ise sebep lütfen açıklamanızı biraz daha detaylandırın. Mesela deyin ki şu rakamı yazdım hata verdi veya yanlış cevap verdi...

- Bilgisayarınızda kurulu olan Delphi sürümü 7.0'dan düşük ise de kod hiç çalışmadı MidStr olan satırda hata verdi diyebilirdiniz ve kod için bu yönde çözüm arayışınızı belirtebilirdiniz... Yaklaşım bu çerçevede olursa kimse kırılmadan çözümünüze ulaşabilirsiniz...

- Biraz önce kendi bilgisayarımda denedim... Kod hata verdi. Bende Delphi 5 kurulu ama çözümü de basitti...

Kod: Tümünü seç

      basamak:=MidStr(sayi,length(sayi),1); 
      sayi:=LeftStr(sayi,length(sayi)-1); 

olan satırları aşağıdakilerle değiştirirseniz muadil bir çözüm oluşacaktır...

Kod: Tümünü seç

      basamak := Copy(sayi,length(sayi),1);
      sayi    := Copy(sayi,1,length(sayi)-1);

Gözünüzden kaçmışsa diye hatırlatayım, fonksiyona rakam girişi yapacaksınız, dönen değer string olacaktır...

Örnek :

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(YaziyaCevir(1234567890));
end;

[ASE]

Selam arkadaşlar burda yardımlaşma konusunda şikayeti olan arkadaş varsa bence henüz sabretmeyi öğrenememiş gibi geliyor bana. Kendi adıma konuşayım benim sorduğum soruların cevabını bilen birileri varsa mutlaka cevabı geldi.
Ben de buna karşılık Freeman35 in dediği gibi vebalini düşünerek bildiğim birşey varsa ya da bana gelen kodları başka amaçlar için değiştirerek kullandıysam mutlaka buraya yeni haliyle atmaya çalıştım. Biliyorum ki bir butonun altına yazılan kodu buraya göndermem benim programımı hiç bir şekilde deşifre etmiyor çünkü yüzlerce kod ancak bir program oluşturabiliyor. Hatta buradan aldığım bazı kodları programlarımda aynen kullandım ve demosunu linkini paket programlar bölümünde verdim. Eğer incelemişlerse Fahrettin abi ya da husonet aa bu kodu ben yazmıştım bile demiştir eminim. Bu yüzden arkadaşımızbelki henüz buraya ısınamadığındandır diyip kendi soruma geliyorum.

Admin Mustafa abi
Yazdığınız fonksiyonu ben çalıştıramadım. Valla kızma ama nasıl kullanacağım mesela rakam yazdığım editin change events inde

Herkese kolay gelsin....

[mrmarman]

- Yukarda yazılmış her iki fonksiyonda da sorgu parametresi nümerik, dönen değer String...

- Edit'in change olayına şu şekilde yazarsın...

Kod: Tümünü seç

  Form1.Caption := SayiToSozlu(StrToInt(Edit1.TExt));

[showtime]

@freeman35

İlk önce bu forumu ve siteyi kuran yöneten herkesi canı yürekten kutlarım ve bizlere verdiği hizmetlerden dolayı çok teşekkür ederim. Geçen hafta bu siteyi şans eseri firebird hakkında bilgi araken buldum inanın müthiş bir site.

Tabiki kimse benim nasıl biri olduğumu bilmez yani hazır kodlar peşinde koşup koşmadığımı nezaketimi huyumu suyumu bilmez. Bu yüzden beni ağır eleştiren arkadaşlar da bir ön yargı ile davranmış olabilirler. Birçok forumda gezdim gördüm bulundum ve biliyorum ki bazı insanlar hiti az olan kullanıcılara acemi tıfıl bilgisi az forum kuralı adabı bilmez muamelesi yapar. Doğrdur onlar da kendince haklıdır. Her biçim de kızmıyorum kimseye. FAKAT:
-Bu forumun admini olarak tükkan tabiri şaka da olsa güzel değildi.
-Gelinlere laf söylemek için kızları kullanmayın.
-Bu ne biçim kod gibi hayvanca bir tabir asla kullanmam orada yanlışınız var.
-Hiti az olan kullanıcı acemi demek değildir. O forumda yenidir, forumun konusunda değil.
-Evet ben de kod yazıyor araştırıyor ve çırpınıyorum. Nerden biliyorsunuz parayı yazıya çevirme kodu üzerinde çalışmadığımı nerden?
-Bu tür ihtiyaçlarda hazırcı olabileceğim varsayımıyla diyorum ki hangimiz bileşen ve kod parçaları kullanmıyoruz ki . Hayatımızı kolaylaştırmıyorlarmı? Hem Amerikayı tekrar keşfetmeye ne gerek var ki? Yani belki büyük bir projeyle uğraşırken herşeyi baştan mı yazmak lazım.
-Nedir bu sinir bu öfke. Hata yapmış olsam bile bu yaklaşım doğrumu. Bir kişinin kalbi kırılmış benim için önemli değil diğerlerine bakarım düşüncesi doğrumu? Dediğiniz gibi ilk mesajda konuğunuzu terslemeniz yakışırmı size. Forum kurallarında ilk önce yardım et sonra yardım iste diye bir kural mı koyacağız bundan sonra? Hadi ben yaşını almış biri olarak hoş karşılarım da bir genç arkadaş ilk mesajında terslenip küsse iyi olurmu.
-Forumlarda sert tepkilerden dolayı insanlar çoğu zaman soracağını da soramaz yada çekinir korkar.
-Ve ilk hitimde de oldukçada nazik bir dil kullandım çünkü biliyorumki bunlar gelecek başıma.
-Haklısınız çalışmadığı noktayı hatayı yazmam lazımdı. Bu hatamı kabul ediyorum.(Ama yazsaydım da niye uğraşmıyorsun denilebilirdi yine. )
-İnanın kod üzeride çalıştım ve buraya bildiklerimi yazmak için tekrar uğradım.
Saygılarımla...

Neyse biraz iş zamanı:
Kodu deneyip sonuçta hata verince internet bağlantımı kapayıp çalışmaya başladım:

uses bölümüne midstr ve LeftStr fonk.nun çalışması için bunların barındığı strutils i eklemek gerektiğini anladım.
Sayın arkadaşımın dediği gibi bu DELPHI7 de gerekli.

Kod çalıştı fakat translationda hata vardı. örneğin 1000000000 yazdığımda birmilyarmilyonbin verdi.
Bence çok güzel bir algoritma uğraştım çözemedim ama sağlam kafayla baktığımda hatayı buldum.
ben de result ın oraya basit bir eğer atarak çözdüm:
if arasonuc='' then
begin
result:=arasonuc+ result;
end
else
begin
result:=arasonuc+katsayi+ result;
end;
Düşünceleriniz paylaşmak istiyorum.
Kodu ilk veren arkadaşım hata hata deyip durduğumdan dolayı gücenmesin sakın, ona kod için çok teşekkür ederim. Diğer cevap veren arkadaşlara da teşekkür ederim. Tekrardan foruma ve siteye emek veren uğraşan dostlara teşekkür ederim.(show yapmıyorum)
Ama sorularımla ve sorunlarımla ben de burada olacağım yardımlarınız beklerim. Ahenkte problem yarattıysam özür dilerim.
Tüm foruma saygılarımla...

[sako]

buda çalışıyor;


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
procedure Edit1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Sayi : String;
A, B : Integer;
Posi,
Sayac : Byte;
Yazisal : String;
UcSifir : String[3];
Gelen : Array[1..7] Of String[3];
Birler : Array[1..9] Of String[5] = ('Bir','İki','Üç','Dört','Beş','Altı','Yedi','Sekiz','Dokuz');
Onlar : Array[1..9] Of String[6] = ('On','Yirmi','Otuz','Kırk','Elli','Altmış','Yetmiş','Seksen','Doksan');
Ustler : Array[1..7] Of String[9] = ('Bin','Milyon','Milyar','Trilyon','Katrilyon','Trilyar','Katrilyar');


implementation

{$R *.DFM}

function Cevir(Sayi : String) : String;
function StrToInt(Sayi : Char) : Integer;

begin
Val(Sayi, A, B);
StrToInt := A;
end;

begin
For Sayac := 1 To 7 Do Gelen[Sayac] := '';
Sayac := 0;
Yazisal := '';
If (Sayi[1] = '1')
And (Length(Sayi) = 4) Then
Begin
Yazisal := 'Bin';
Delete(Sayi,1,1);
End;
While Sayi > '' Do
Begin
Inc(Sayac);
If Length(Sayi) > 2 Then
Begin
Gelen[Sayac] := Copy(Sayi,Length(Sayi)-2,3);
Delete(Sayi,Length(Sayi)-2,3)
End
Else
Begin
Gelen[Sayac] := Sayi;
Sayi := ''
End;
End;
While Length(Gelen[Sayac]) < 3 Do Gelen[Sayac] := '0'+Gelen[Sayac];
While Sayac > 0 Do
Begin
Posi := 1;
While Posi < 4 Do
Begin
If (Gelen[Sayac][Posi] <> '0') Then
Begin
If (Posi = 1)
And (Gelen[Sayac][Posi] = '1') Then
Yazisal := Yazisal + 'Yüz'
Else
Case Posi Of
1 : Yazisal := Yazisal + Birler[StrToInt(Gelen[Sayac][Posi])] + 'Yüz';
2 : Yazisal := Yazisal + Onlar[StrToInt(Gelen[Sayac][Posi])];
3 : Yazisal := Yazisal + Birler[StrToInt(Gelen[Sayac][Posi])];
End;
End;
Inc(Posi);
End;
UcSifir := Gelen[Sayac];
Dec(Sayac);
If (Sayac > 0)
And (UcSifir <> '000') Then Yazisal := Yazisal + Ustler[Sayac];
End;
Cevir := Yazisal;
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
Sayi := edit1.text;
label1.caption := Cevir(Sayi);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

end.

[Kuri_YJ]

Selamlar,

Sako arkadaşımıza naçizane bir tavsiyede bulunmak istiyorum. Bunu özel mesaj olarak yazacaktım ama örnek teşkil ettiği için listedeki diğera arkadaşların da bilgisi olması açısından belirtmek istedim.

Gönderdiğiniz kod çok okunaksız durumda, bu tür kodlar ile zaman içerisinde boğuşurken zorlanırsınız bu sebeple Sitedeki Borland Kodlama standardlarını bir okursanız sizin açınızdan çok faydalı olacaktır.

Kolay gelsin.

[nugre]

arkadaşlar bu kodlar tamam çalışıyor yanlız basamaklı sayılarda örneğin 1.000.000 yazınca hata veriyor integer değil diye , ama 1000000 yazdığımda hiç bir sorun yok.

[mussimsek]

evet arada nokta olursa Delphi onu sayı olarak değerlendirmez. Sayılar zaten sayı formatında olduğu için direk verebilirsiniz.

Eğer string ifade veriyorsanız, noktaları silen daha sonra da sayıya çeviren bir fonksiyon yapın.

Kolay gelsin.

[P206]

viewtopic.php?t=3709
De noktaları kaldıran bir function var.

kolay gelsin.