السلام عليكم...
* أضف الوحدة StrUtils إلى جملة uses.
ضع الكود التالي في القسم implementation :
كود :
// نوع لتحديد طريقة تسمية الأشهر
type
TMonthNameKind = (mnkSystem, mnkTranslatedEn, mnkTranslatedFr, mnkOldArabic, mnkHijri);
// دالة ****** لاختيار إحدى قيمتين حسب الشرط
function IIf(ACondition: Boolean; ATruePart, AFalsePart: string): string;
begin
if ACondition then
Result := ATruePart
else
Result := AFalsePart;
end;
// دالة لتحويل رقم السنة إلى كلمة
function ReadYear(AYear: Word; UseYaa: Boolean): string;
const
ONES: array[1..10] of string = ('واحد', 'اثنان', 'ثلاثة', 'أربعة', 'خمسة',
'ستة', 'سبعة', 'ثمانية', 'تسعة', 'عشرة');
TENS: array[2..9] of string = ('عشرون', 'ثلاثون', 'أربعون', 'خمسون',
'ستون', 'سبعون', 'ثمانون', 'تسعون');
HUNDREDS: array[1..9] of string = ('مائة', 'مائتان', 'ثلاثمائة', 'أربعمائة', 'خمسمائة',
'ستمائة', 'سبعمائة', 'ثمانمائة', 'تسعمائة');
var
InnerNumber, Remainder, Integral: Word;
begin
InnerNumber := AYear;
if (InnerNumber >= 1) and (InnerNumber <= 99) then begin
case InnerNumber of
1, 3..10: Result := ONES[InnerNumber];
2: Result := IIf(UseYaa, 'اثنين', 'اثنان');
11: Result := 'أحد عشر';
12: Result := IIf(UseYaa, 'اثني عشر', 'اثنا عشر');
13..19: begin
Remainder := InnerNumber mod 10;
Result := ONES[Remainder] + ' عشر';
end;
20..99: begin
Remainder := InnerNumber mod 10;
Integral := InnerNumber div 10;
Result := IIf(UseYaa, StuffString(TENS[Integral], Length(TENS[Integral]) - 1, 1, 'ي'), TENS[Integral]);
if Remainder = 2 then
Result := IIf(UseYaa, 'اثنين', 'اثنان') + ' و ' + Result
else if Remainder <> 0 then
Result := ONES[Remainder] + ' و ' + Result;
end;
end;
end
else if (InnerNumber >= 100) and (InnerNumber <= 999) then begin
Remainder := InnerNumber mod 100;
Integral := InnerNumber div 100;
if Integral = 2 then
Result := IIf(UseYaa, 'مائتين', 'مائتان')
else
Result := HUNDREDS[Integral];
if Remainder <> 0 then begin
InnerNumber := Remainder;
Result := Result + ' و ' + ReadYear(InnerNumber, UseYaa);
end;
end
else if (InnerNumber >= 1000) and (InnerNumber <= 9999) then begin
Remainder := InnerNumber mod 1000;
Integral := InnerNumber div 1000;
case Integral of
1: Result := 'ألف';
2: Result := IIf(UseYaa, 'ألفين', 'ألفان');
else Result := ONES[Integral] + ' آلاف';
end;
if Remainder <> 0 then begin
InnerNumber := Remainder;
Result := Result + ' و ' + ReadYear(InnerNumber, UseYaa);
end;
end;
end;
// دالة لتحويل رقم الشهر إلى كلمة
function ReadMonth(AMonth: Word; AMonthNaming: TMonthNameKind): string;
const
MonthsEn: array[1..12] of string = ('يناير', 'فبراير', 'مارس', 'أبريل',
'مايو', 'يونيو', 'يوليو', 'أغسطس',
'سبتمبر', 'أكتوبر', 'نوفمبر', 'ديسمبر');
MonthsFr: array[1..12] of string = ('جانفي', 'فيفري', 'مارس', 'أفريل',
'ماي', 'جوان', 'جويليه', 'أوت',
'سبتمبر', 'أكتوبر', 'نوفمبر', 'ديسمبر');
MonthsAr: array[1..12] of string = ('كانون الثاني', 'شباط', 'آذار', 'بيسان',
'أيار', 'حزيران', 'تموز', 'آب',
'أيلول', 'تشرين الأول', 'تشرين الثاني', 'كانون الأول');
MonthsHijri: array[1..12] of string = ('محرم', 'صفر', 'ربيع الأول', 'ربيع الثاني',
'جمادى الأولى', 'جمادى الثانية', 'رجب', 'شعبان',
'رمضان', 'شوال', 'ذي القعدة', 'ذي الحجة');
begin
case AMonthNaming of
mnkSystem: Result := LongMonthNames[AMonth];
mnkTranslatedEn: Result := MonthsEn[AMonth];
mnkTranslatedFr: Result := MonthsFr[AMonth];
mnkOldArabic: Result := MonthsAr[AMonth];
mnkHijri: Result := MonthsHijri[AMonth];
end;
end;
// دالة لتحويل رقم اليوم إلى كلمة
function ReadDay(ADay: Word; UseYaa: Boolean): string;
const
ONES: array[1..10] of string = ('الحادي', 'الثاني', 'الثالث', 'الرابع', 'الخامس',
'السادس', 'السابع', 'الثامن', 'التاسع', 'العاشر');
begin
case ADay of
1: Result := 'الأول';
2..10: Result := ONES[ADay];
11..19: Result := ONES[ADay mod 10] + ' عشر';
20: Result := IIf(UseYaa, 'العشرين', 'العشرون');
21..29: Result := ONES[ADay mod 10] + ' و ' + IIf(UseYaa, 'العشرين', 'العشرون');
30: Result := IIf(UseYaa, 'الثلاثين', 'الثلاثون');
31: Result := IIf(UseYaa, 'الحادي و الثلاثين', 'الحادي و الثلاثون');
end;
end;
// الدالة الأساسية لتحويل تاريخ إلى نص لفظي
function ReadDate(ADate: TDate; AMonthNaming: TMonthNameKind = TMonthNameKind.mnkSystem;
UseYaa: Boolean = False; UseAam: Boolean = False): string;
var
Y, M, D: Word;
AYearWord: string;
begin
if UseAam then
AYearWord := ' عام '
else
AYearWord := ' سنة ';
DecodeDate(ADate, Y, M, D);
Result := ReadDay(D, UseYaa) + ' من شهر ' + ReadMonth(M, AMonthNaming) + AYearWord + ReadYear(Y, UseYaa);
end;
* بعض التوضيح للكود:
= الدوال الأربع الأولى (IIf و ReadYear و ReadMonth و ReadDay) هي دوال ****** للحصول على جزء من التاريخ بالكلمات (طبعاً باستثناء الدالة IIf).
= البارامتر UseYaa (نوعه Boolean) في أي دالة يحدد استعمال حرف الياء بدل الآلف أو الواو (مثلاً اثنين بدل اثنان، و خمسين بدل خمسون).
= النوع TMonthNameKind لتحديد نوع الأشهر المستخدمة، و قيمه كالتالي:
[INDENT]mnkSystem: استعمال أسماء الأشهر حسب إعدادات النظام Windows.
mnkTranslatedEn: الأسماء المعربة من الإنجليزية (يناير، فبراير، مارس، ...).
mnkTranslatedFr: الأسماء المعربة من الفرنسية (جانفي، فيفري، مارس، ...).
mnkOldArabic: الأسماء العربية القديمة (كانون الثاني، شباط، آذار، ...).
mnkHijri: الأسماء الهجرية (محرم، صفر، ربيع الأول، ...).[/INDENT]
= البارامتر UseYaa في الدالة الأساسية ReadDate بارامتر اختياري، و قيمته الافتراضية هي False و التي تعني استعمال الألف و الواو، و ليس الياء.
= البارامتر UseAam في الدالة الأساسية بارامتر اختياري، و يحدد استخدام كلمة سنة أو عام. قيمته الافتراضية هي False و تعني استعمال كلمة سنة.
*** مثال:
كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := ReadDate(DateTimePicker1.Date, mnkTranslatedFr);
end;
ملاحظة أخيرة: إذا أردت استعمال الدالة ReadDate في وحدات برمجية (Units) أخرى فضع لها تصريحاً في القسم interface (قبل كلمة implementation):
كود :
function ReadDate(ADate: TDate; AMonthNaming: TMonthNameKind = TMonthNameKind.mnkSystem;
UseYaa: Boolean = False; UseAam: Boolean = False): string;
نرجو الاستفادة و السلام.
حول استعمال التاريخ