parayı yazıya çevirme
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Forum kurallarını okuyup, uyunuz!
parayı yazıya çevirme
merhaba arkadaşlar.
elinde parayı yazıya çeviren funksiyonu olan olan varmı.
kolay gelsin.
elinde parayı yazıya çeviren funksiyonu olan olan varmı.
kolay gelsin.
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;
Bişnev in ney çün hikâyet mîküned
Ez cüdâyîhâ şikâyet mîküned
Ez cüdâyîhâ şikâyet mîküned
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;
@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
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
ZAGOR TENAY TÜRK'tür... TÜRK kalacak...
Zoru başarırım, İmkansız zaman alır
FreeMan 35.5
Soru sormaya üşenmiyorsan, sorunun çözümünü yazmaya da üşenme !!!
Zoru başarırım, İmkansız zaman alır
FreeMan 35.5
Soru sormaya üşenmiyorsan, sorunun çözümünü yazmaya da üşenme !!!
@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...
olan satırları aşağıdakilerle değiştirirseniz muadil bir çözüm oluşacaktır...
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 :
- 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);
Kod: Tümünü seç
basamak := Copy(sayi,length(sayi),1);
sayi := Copy(sayi,1,length(sayi)-1);
Örnek :
Kod: Tümünü seç
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(YaziyaCevir(1234567890));
end;
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....
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....
- 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...
- Edit'in change olayına şu şekilde yazarsın...
Kod: Tümünü seç
Form1.Caption := SayiToSozlu(StrToInt(Edit1.TExt));
@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...
İ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...
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.
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.
DOĞUNUN SINIR TAŞI ERZURUM'UN DADAŞ'I
EFE'Sİ VAR İZMİR'İN EĞİLMEZ TÜRK' ÜN BAŞI
EFE'Sİ VAR İZMİR'İN EĞİLMEZ TÜRK' ÜN BAŞI
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.
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.
Kuri Yalnız Jedi
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/
Yazıya çevirirken noktalı sayılarda sorun
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.