19-04-2015, 05:32 PM
السلام عليكم
قام السيد محمد مهند عبادي مشكوراً ببرمجة هذه الوحدة في دلفي
احاول استخدامها في الفاست ريبورت بدون دلفي ولكن لم انجح
فما المطلوب تعديله لكي تعمل ضمن فاست ريبورت؟
ولكم الشكر
قام السيد محمد مهند عبادي مشكوراً ببرمجة هذه الوحدة في دلفي
احاول استخدامها في الفاست ريبورت بدون دلفي ولكن لم انجح
فما المطلوب تعديله لكي تعمل ضمن فاست ريبورت؟
ولكم الشكر
كود :
unit Unit2;
// دالة التفقيط الآلي
// برمجة محمد مهند عبادي 2003
interface
uses SysUtils,StrUtils;
Function words(D : Double; F1 : String = 'واحدة'; F2 :String = 'واحدتين' ; F3 : String = 'واحدات'
; D1 : String = 'جزء' ; D2 : String = 'جزئين'; D3: String = 'أجزاء'; SayJust : Boolean = True) : String;
implementation
Function words(D : Double; F1 : String = 'واحدة'; F2 :String = 'واحدتين' ; F3 : String = 'واحدات'
; D1 : String = 'جزء' ; D2 : String = 'جزئين'; D3: String = 'أجزاء'; SayJust : Boolean = True) : String;
Var
P,P1,P2,P3,P4,w,w1,w2,w3,N,n1 : String;
SD : Int64;
(*------------------------------------------------------------------------*)
Function Swords(N, U1, U2, U3 : String) : String;
Type
TF = array[0..2,0..9] of String;
Const
FNO : TF = (('','واحد','إثنان','ثلاثة','أربعة','خمسة','ستة','سبعة','ثمانية','تسعة'),
('','عشر','عشرون','ثلاثون','أربعون','خمسون','ستون','سبعون','ثمانون','تسعون'),
('','مائة','مائتين','ثلاثمائة','أربعمائة','خمسمائة','ستمائة','سبعمائة','ثمانمائة','تسعمائة'));
Var
s: array[1..3] of Byte;
PU : array[0..2] of String;
A : Tf;
w1,w2,f : String;
E : integer;
Begin
A := FNO;
Pu[0] := '';
PU[1] := U1 ;
Pu[2] := U2 ;
E := StrToInt(N);
If E < 3 then Swords := pu[E]
Else
Begin
N := leftstr('000',3-length(n)) + N ;
For E := 1 to 3 Do S[E] := StrToInt(n[4-E]);
If (s[2] = 0) or (s[1] = 0) Then W2 := '' Else W2 := ' و ';
If (s[3] = 0) Or (s[1]+S[2] = 0) Then W1 := '' Else W1 := ' و ';
If S[2] = 1 Then
Begin
A[0,1] := 'أحد ';
A[0,2] := 'إثنا ' ;
W2 := ' ';
End;
Case strToInt(n[2]+n[3]) of
0 : Begin
A[2, 2] := 'مائتا ';
F := U1;
End;
3..10 : F := U3;
1,2, 11..99 : F := U1;
end;
swords := A[2, S[3]] + w1 + A[0, S[1]] + w2 + A[1, S[2]] + ' ' + F;
End;
End;
(*------------------------------------------------------------------------*)
Begin
If D > 0 Then
Begin
Sd := Trunc(D);
p := Swords(inttostr(round((d-sd)*100)),D1,D2,D3);
N := leftstr('000000000000',12-length(floattostr(Sd))) + floattostr(Sd) ;
P1 := Swords(Copy(N, 10, 3), F1, F2, F3);
P2 := Swords(Copy(N, 7, 3), 'ألف', 'ألفان', 'آلاف');
P3 := Swords(copy(N, 4, 3), 'مليون', 'مليونان', 'ملايين');
P4 := Swords(copy(N, 1, 3), 'مليار', 'ملياران', 'مليارات');
If (P4 = '') Or (P1 + P2 + P3 = '') Then w3 := '' Else w3 := ' و ';
If (P3 = '') Or (P1 + P2 = '') Then w2 := '' Else w2 := ' و ';
If (P2 = '') Or (P1 = '') Then w1 := '' Else w1 := ' و ';
If P1 = '' Then P1 := ' ' + F1;
If P = '' Then w := '' Else w := ' و ';
N := P4 + w3 + P3 + w2 + P2 + w1 + P1 + w + P;
If SayJust Then words := 'فقط ' + N + ' لاغير'Else Words := N;
end;
End;
end.