التفقيط في الأكسيل "

http://edu.arabsgate.com/showthread.php?t=503287

تفقيط عربي انجليزي لأبي هادي by محمد طاهر
تاريخ الإضافة
30 October 2007 - 07:58 PM
آخر تحديث
30 October 2007 - 07:58 PM
File Size
32.1K (Estimated Download Times)
Views
2574
Downloads
839
Support Topic
إضغط هنا لزيارة موضوع الحوار حول هذا الملف تفقيط عربي انجليزي محدث
للأكسس والأكسل
لأبى هادي

وصلة الموضوع:
[url=http://www.officena.com/ib/index.php?showtopic=315]http://www.officena....p?showtopic=315[/url]

التفقيط بالقرنسية
الكووووود
Function chiffrelettre(s)
Dim a As Variant, gros As Variant
a = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", _
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize", _
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", "Dinars", "billion", _
"milliard", "million", "mille", "Dinar")
sp = Space(1)
chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
s = Str(Int(s)): lg = Len(s) - 1: s = Right(s, lg): lg = Len(s)
If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
s = chaine + s
'billions au centaines
gp = 1
For k = 1 To 5
x = Mid(s, gp, 1): c = a(Val(x))
x = Mid(s, gp + 1, 2): d = a(Val(x))
If k = 5 Then
If t2 <> "" And c & d = "" Then mydz = "Dinars" & sp: GoTo fin
If t <> "" And c = "" And d = "un" Then mydz = "un Dinars" & sp: GoTo fin
If t <> "" And t2 = "" And c & d = "" Then mydz = "d'Dinars" & sp: GoTo fin
If t & c & d = "" Then myct = "": mydz = "": GoTo fin
End If
If c & d = "" Then GoTo fin
If d = "" And c <> "" And c <> "un" Then mydz = c & sp & "cents " & gros(k) & sp: GoTo fin
If d = "" And c = "un" Then mydz = "cent " & gros(k) & sp: GoTo fin
If d = "un" And c = "" Then myct = IIf(k = 4, gros(k) & sp, "un " & gros(k + 5) & sp): GoTo fin
If d <> "" And c = "un" Then mydz = "cent" & sp
If d <> "" And c <> "" And c <> "un" Then mydz = c & sp & "cent" + sp
myct = d & sp & gros(k) & sp
fin:
t2 = mydz & myct
t = t & mydz & myct
mydz = "": myct = ""
gp = gp + 3
Next
d = a(centime)
If t <> "" Then myct = IIf(centime = 1, " centime", " centimes")
If t = "" Then myct = IIf(centime = 1, " centime d'Dinar", " centimes d'Dinar")
If centime = 0 Then d = "": myct = ""
chiffrelettre = t & d & myct
End Function

unit SimpleFigures;التفقيط بالعربي
interface
uses
SysUtils;
function ArabicSimpleFigure(const StrNumber: string; Sex: Boolean; var ResultStr: string; const CurName, CurPartName: string;CurPartLength:Integer=2): Boolean;
implementation
function NoDoubleSpace(vStr: string): string;
var
i: integer;
begin
i := 0;
while i < length(vStr) do
begin
i := i + 1;
if (vStr[i] = ' ') and (vStr[i + 1] = ' ') then
Delete(vStr, i + 1, 1);
end;
Result := vStr;
end;
const
FirstArray: array[1..9, 0..1] of string = (('واحد', 'إحدى'), ('اثنان', 'اثنا'), ('ثلاثة', 'ثلاث'), ('أربعة', 'أربع'),
('خمسة', 'خمس'), ('ستة', 'ست'), ('سبعة', 'سبع'), ('ثمانية', 'ثمان'), ('تسعة', 'تسع'));
FirstArray1: array[1..2, 0..1] of string = (('أحد', 'إحدى'), ('اثنا', 'اثنتا'));
SecondArray: array[1..9, 0..1] of string = (('عشرة', 'عشر'), ('عشرون', 'عشرون'), ('ثلاثون', 'ثلاثون'), ('أربعون', 'أربعون'), ('خمسون', 'خمسون'),
('ستون', 'ستون'), ('سبعون', 'سبعون'), ('ثمانون', 'ثمانون'), ('تسعون', 'تسعون'));
ThirdArray: array[1..9] of string = ('مائة', 'مائتان', 'ثلاثمائة', 'أربعمائة', 'خمسمائة', 'ستمائة',
'سبعمائة', 'ثمانمائة', 'تسعمائة');
function GetNum(var Str1: string; Sex:Boolean; Index: integer): string;
var
StrLen: integer;
Indx: array[1..3] of integer;
TmpArray: array[0..2] of string;
TmpStr: string;
begin
Indx[1] := -1;
Indx[2] := -1;
Indx[3] := -1;
StrLen := Length(Str1);
Indx[1] := StrToInt(Copy(Str1, StrLen, 1));
if (Indx[1] <> 0) then
TmpArray[0] := FirstArray[Indx[1], Ord(Sex)] + ' ';
Dec(StrLen);
if StrLen > 0 then
begin
Indx[2] := StrToInt(Copy(Str1, StrLen, 1));
if (Indx[2] <> 0) then
if (TmpArray[0] <> '') then
TmpArray[1] := SecondArray[Indx[2], Ord(not Sex)] {}
else
TmpArray[1] := SecondArray[Indx[2], Ord(Sex)];
end;
if (Indx[2] > 1) and (TmpArray[0] <> '') then
TmpArray[0] := TmpArray[0] + 'و '
else if (Indx[1] = 1) and (Indx[2] = 1) then
TmpArray[0] := FirstArray1[1, Ord(Sex)]
else if (Indx[1] = 2) and (Indx[2] = 1) then
TmpArray[0] := FirstArray1[2, Ord(Sex)];
Dec(StrLen);
if StrLen > 0 then
begin
Indx[3] := StrToInt(Copy(Str1, StrLen, 1));
if (Indx[3] <> 0) then
TmpArray[2] := ThirdArray[Indx[3]];
end;
if Index = -1 then
if (Indx[3] <> -1) then
Exit;
if (Indx[3] > 0) and ((TmpArray[0] <> '') or (TmpArray[1] <> '')) then
TmpArray[2] := TmpArray[2] + ' و ';
case Index of
-1:
begin
TmpStr := TmpArray[2] + TmpArray[0] + TmpArray[1];
if (Indx[1] > 0) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := SecondArray[Indx[1], Ord(Sex)]
else
Result := TmpStr;
end;
0:
begin
Result := TmpArray[2] + TmpArray[0] + TmpArray[1];
end;
1:
begin
if (Indx[1] = 1) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := ' ألف'
else if (Indx[1] = 2) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := 'ألفان'
else if (Indx[1] > 2) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := TmpArray[0] + ' ألاف'
else if (Indx[1] > 2) and (Indx[2] = 0) and (Indx[3] <> -1) then
Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + ' ألاف'
else if (Indx[1] = 0) and (Indx[2] = 1) and (Indx[3] = -1) then
Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + ' ألاف'
else if (Indx[1] = 0) and (Indx[2] = 0) and (Indx[3] = 0) then
Result := TmpArray[2] + TmpArray[0] + TmpArray[1]
else
Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + ' ألف';
end;
2:
begin
if (Indx[1] = 1) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := ' مليون'
else if (Indx[1] = 2) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := 'مليونان'
else if (Indx[1] > 2) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := TmpArray[0] + 'ملايين'
else if (Indx[1] > 2) and (Indx[2] = 0) and (Indx[3] <> -1) then
Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + 'ملايين'
else if (Indx[1] = 0) and (Indx[2] = 1) and (Indx[3] = -1) then
Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + 'ملايين'
else if (Indx[1] = 0) and (Indx[2] = 0) and (Indx[3] = 0) then
Result := TmpArray[2] + TmpArray[0] + TmpArray[1]
else
Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + ' مليون';
end;
3:
begin
if (Indx[1] = 1) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := ' مليار'
else if (Indx[1] = 2) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := 'ملياران'
else if (Indx[1] > 2) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := TmpArray[0] + 'مليارات'
else if (Indx[1] > 2) and (Indx[2] = -1) and (Indx[3] = -1) then
Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + 'مليارات'
else if (Indx[1] = 0) and (Indx[2] = 1) and (Indx[3] = -1) then
Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + 'مليارات'
else
Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + ' مليار';
end;
end;
end;
function GetArabicSimpleFigure(const StrNumber: string; Sex: Boolean; var ResultStr: string; const CurName: string): Boolean;
var
Parts: array[0..4] of string;
PartStr: array[0..3] of string;
Txt, Str, EndStr: string;
i, StrLength: integer;
begin
Result := True;
Txt := '';
i := -1;
if StrNumber = '0' then
begin
ResultStr := ' صفر';
Exit;
end;
if StrNumber = '' then
begin
ResultStr := '';
Exit;
end;
Str := Trim(StrNumber);
StrLength := Length(StrNumber);
Parts[0] := Str;
while StrLength >= 3 do
begin
StrLength := StrLength - 3;
i := i + 1;
Parts[i] := Copy(Str, StrLength + 1, 3);
Str := Copy(Str, 1, StrLength)
end;
Parts[i + 1] := Str;
for i := 0 to 3 do
if Length(Parts[i]) > 0 then
PartStr[i] := GetNum(Parts[i], Sex, i);
for i := 3 downto 0 do
if Length(PartStr[i]) > 0 then
if (i <> 0) and (Length(PartStr[i - 1]) > 0) then
EndStr := EndStr + ' ' + PartStr[i] + ' و '
else
EndStr := EndStr + ' ' + PartStr[i] + ' ' + CurName;
ResultStr := Trim(EndStr);
ResultStr := NoDoubleSpace(ResultStr);
end;
function ArabicSimpleFigure(const StrNumber: string; Sex: Boolean; var ResultStr: string; const CurName, CurPartName: string;CurPartLength:Integer): Boolean;
var
AfterPoint,BeforePoint,S:string;
L,P:Integer;
begin
p := Pos('.', StrNumber);
if p > 0 then
begin
AfterPoint := Copy(StrNumber, P+1, CurPartLength);
if AfterPoint<>'' then
begin
L:=CurPartLength-Length(AfterPoint);
if L>0 then
AfterPoint:=AfterPoint+StringOfChar('0',L);
AfterPoint:=FloatToStr(StrToFloat(AfterPoint));
end;
BeforePoint := Copy(StrNumber, 0, P-1);
end
else
BeforePoint := StrNumber;
Result:=GetArabicSimpleFigure(BeforePoint,Sex,S,CurName);
ResultStr:=S;
if (AfterPoint <> '') then
begin
GetArabicSimpleFigure(AfterPoint,Sex,S,CurPartName);
ResultStr := ResultStr + ' و ' + s;
end;
end;
end.