[بحث] مكون كتابة الأرقام بالحروف الفرنسية
#1
السلام عليكم : أريد مكون كتابة الأرقام بالحروف الفرنسية بارك الله فيكم
الرد
#2
اضف Button . Edit . Label ثم اضف هذه الدوال 

PHP كود :
implementation

{$R *.DFM}
function 
TForm1.convert(var Aconvertir,Devise:string):string;
var
C, D, centimes, dinars : string;
car : array [1..3] of string;
I, Y, Z : integer;
begin

   
If (Aconvertir='') then // si la chaine S est vide Erreur
 
  begin
    exit
;
 
  end ;
 
  i:=0;// connaitre la position du separateur decimale
 
  While not((Aconvertir[i]=',') or(i > length(Aconvertir))) do
 
   begin
     i
:=i+1;
 
   end;
 
  C:=copy(Aconvertir,i,1);
 
  if C=',' then // s'il y a un nombre decimale
 
   begin
     D
:=copy(Aconvertir,1,(i-1));
 
    dinars:=enLettres(StrToInt(d));
 
    centimes:=copy(Aconvertir, i+1, (Length(Aconvertir)-i));
 
    // remplir un tableau car par des chaines vides
 
    for y:=1 to 3 do     // Le nombre de Zero permit et de 3 maxi !
 
     begin
       car
[y]:='';
 
     end;
 
    y:=0; // Y represente le nombre de Zero apres le separateur decimale
 
    z:=i+1;
 
    While (Aconvertir[z]='0') or(z > length(Aconvertir)) do
 
     begin
       y
:=y+1;
 
      z:=z+1;
 
      car[y]:='Zero ';
 
     end;
 
    //s'il y a des Zero apres le separateur decimale
 
    if y>0 then
      
// il faut l'ecrire -- maxi 3 nombres ont la valeur egal à 0, soit permit
 
     centimes:=' et '+car[1]+car[2]+car[3]+enLettres(StrToInt(centimes))+' Centimes'
 
     else // sinon il n'y a pas de zero à ecrire
 
       centimes:=' et'+enLettres(StrToInt(centimes))+' Centimes';
 
   result :=dinars+' '+ Devise +centimes+' .';
 
   end
   
else // sinon lire la partie entiere
 
   begin
    D
:=copy(Aconvertir,1,(length(Aconvertir)));
 
   dinars:=enLettres(StrToInt(D));
 
   result :=dinars+ Devise+' .' ;
 
   end; // else

end;




Function 
TForm1.EnLettres(N203:Integer):String;

Const
 
 Unite: Array[1..16] of String=('un','deux','trois','quatre','cinq','six',
 
                               'sept','huit','neuf','dix','onze','douze',
 
                               'treize','quatorze','quinze','seize');
 
 Dizaine: Array[2..8] of String=('vingt','trente','quarante','cinquante',
 
                                'soixante','','quatre-vingt');
 
 Coefs:Array[0..3] of String=('cent','mille','million','milliard');
Var
 
 Temp: String;
 
 C,D,U: Byte;
 
 Coef: Byte;
 
 I: Word;
 
 Neg: Boolean;
begin
  If N203 
= 0 then
  begin
    Result 
:= ' Zéro';
 
   Exit;
 
 end;
 
 Result := '';
 
 Neg := N203 <0;
 
 If Neg then N203 := -N203;
 
 Coef := 0;
 
 Repeat
    U 
:= N203 mod 10; N203 := N203 div 10; {Récupère unité et dizaine}
 
   D := N203 mod 10; N203 := N203 div 10; {Récupère dizaine}
 
   If D in [1,7,9] then
    begin
      Dec
(D);
 
     Inc(U, 10);
 
   end;
 
   Temp := '';
 
   If D > 1 then
    begin
      Temp 
:= ' ' + Dizaine[D];
 
     If (D < 8) and ((U = 1) or (U = 11)) then
        Temp 
:= Temp + ' et';
 
   end;
 
   If U > 16 then
    begin
      Temp 
:= Temp + ' ' + Unite[10];
 
     Dec(U,10);
 
   end;
 
   If U > 0 then Temp := Temp + ' ' + Unite[U];
 
   If (Result = '') and (D = 8) and (U = 0) then Result := 's';
 
   Result := Temp + Result;
 
   C := N203 mod 10; N203 := N203 div 10; {Récupère centaine}
 
   If C > 0 then
    begin
      Temp 
:= '';
 
     If C > 1 then Temp := ' ' + Unite[C] + Temp;
 
     Temp := Temp + ' ' + Coefs[0];
 
     If (Result = '') and (C > 1) then Result := 's';
 
     Result := Temp + Result;
 
   end;
 
   If N203 > 0 then
    begin
      Inc
(Coef);
 
     I := N203 mod 1000;
 
     If (I > 1) and (Coef > 1) then Result := 's' + Result;
 
     If I > 0 then Result := ' ' + Coefs[Coef] + Result;
 
     If (I= 1) and (Coef = 1) then Dec(N203);
 
   end;
 
 until N203 = 0;
 
 If Neg then Result := 'Moins' + Result
  else
  Result
[2] := UpCase (Result[2]);
end;




procedure TForm1.Button1Click(Sender: TObject);
var
conv,dev:string;
begin
 conv
:=  edit1.Text ;
 
dev:=' DA';
 
label1.Caption :=convert(conv,dev) ;
end; 
الرد
#3
السلام عليكم : بارك الله فيك أخي لكن حصل لي مشكل في البريمج قال لي لم يتعرف على convert 
مامعناه غير معرفة كيف أعمل لها تعريف سامحني فأنا مبتدئ 
ربي يجازيك أخي الكريم
الرد
#4
كما قلت لك قم باضافة المكونات - دوبل كليك - على button وقم بنسخ الود كامل و عوضة بالكود عند
الرد
#5
السلام عليكم : فعلت كما قلت أخي وضعت الكود الخاص بال Button1Click 
بعد الدوبل كليك في Button1  وال function TForm1.convert   بعد 
implementation

{$R *.dfm}
 فقال لي أن convert  غير معرفة 
فما هو الشيء الناقص 
مشكورا
الرد
#6
السلام عليكم ورحمة الله وبركاته ،
تجد في المرفق مثال كامل عن استعمال الدالتين التي أرسلها bouh25 .
بالتوفيق.


الملفات المرفقة
.7z   SenLettres.7z (الحجم : 3.75 ك ب / التحميلات : 8)
اللهم اجعلني من أهل القرآن ، الذين هم أهلك و خاصتك.
تذكر بأن الوقت الذي تلهو فيه ، غيرك يبني مجده فيه.
[-] كل من 1 user says قال شكرا ل أبو معاذ على المشاركة المفيدة
  • benali137
الرد
#7
(22-12-2018, 12:12 PM)أبو معاذ كتب : السلام عليكم ورحمة الله وبركاته ،
تجد في المرفق مثال كامل عن استعمال الدالتين التي أرسلها bouh25 .
بالتوفيق.

بارك الله فيكما وربي يجازيكم
الرد


التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم