كيف أجعل ال Index للمصفوفة نص ؟

#130 سبتمبر 2009 في 17:39 صاحب الموضوع

السلام عليكم ورحمة الله وبركاته

لقد بحثت هنا وفي الانترنت ولم أجد طريقة مختصرة

كل التعليمات التي وجدتها تفرض أن يكون الـ key رقم integer .

وأقول هذا لأجل الوصول السريعة للقيم بدون معرفة رقم الترتيبي لها .

جربت وضع نوع سجل به key, value ثم وجدت الرقم يلاحقني في المصفوفة

type
  TConfigRec = Record
	 key : string[50];
	 value  : string[50];
	 //input : string;
   end;
   TConfigArr = array of TConfigRec;
var
  Config : TConfigArr;

procedure loadCfg( var aCfg : TConfigArr);
var
  i, n, index: Integer;
  objIni : TIniFile;
  iniFileName : String;
  Sections, KeyList :TStringList;
begin
  iniFileName := GetCurrentDir() + '\cfg.ini';
  if FileExists(iniFileName) Then begin
	try
	  Sections :=TStringList.Create;
	  KeyList := TStringList.Create;
	  objIni := TIniFile.Create(iniFileName);
	  objIni.ReadSections(Sections);
	  for i := 0  to Sections.Count - 1 do begin
		objIni.ReadSection(Sections.ValueFromIndex, KeyList);
		index := Length(aCfg);
		  for n := 0 to KeyList.Count - 1 do begin
			SetLength(aCfg, Length(aCfg) + 1);
			inc(index);
			aCfg[index].key := KeyList[n];
			aCfg[index].value:= objIni.ReadString(Sections.ValueFromIndex, KeyList[n], '');

		  end;
	  end;
	finally
	  Sections.Free;
	  KeyList.Free;
	  objIni.Free;
	end; // try
  end; // if
end;

المطلوب لا أريد

aCfg[index].key := '';
aCfg[index].value:= '';

أريد :

aCfg[KeyList[n]] = objIni.ReadString(Sections.ValueFromIndex, KeyList[n], '');;

تم تعديل هذه المشاركة بواسطة أبو محمد اللحياني في 30 سبتمبر 2009 في 17:51

ولو وافيت ربك دون ذنب *** وناقشك الحساب إذاً هلكتا

ولم يظلمك في عملٍ ولكن *** عسير أن تقوم بما حملتا

#230 سبتمبر 2009 في 22:39

السلام عليكــم ورحمـة الله وبركاتــه ،،

لأ أعتقد أنه يمكن إستخدام نص كمؤشر للمصفوفة لأنه ليس من نمط ترتيبي فقط الأنماط الترتيبية مسموحة

var
 i: Char;
 arr: array ['a'..'d']of Char;
 begin
   for i:= 'a' to 'd' do
	begin
	 arr := i;
	 ShowMessage(Arr);
	end;
 end;

كالنمط Char ولكن إن توصلت لحل أرجو وضعه هنا لنستفيد منه

أتمنى التوفيق

تم تعديل هذه المشاركة بواسطة حسين طي في 30 سبتمبر 2009 في 22:40

#31 أكتوبر 2009 في 01:59

السلام عليكم...

يمكن استعمال بعض الحيل، ليس كمصفوفة تماماً، و لكن لإنجاز ما فهمته من كود الأخ "أبو محمد اللحياني".

في بداية القسم interface نقوم بتعريف الأنواع التالية:

انسخ الكود

TValueHolderArray = array of string;
TValueHolderMap = record
AName: string;
AValue: string;
end;
TValueHolder = class(TObject)
private
FValues: array of TValueHolderMap;
procedure SetValue(const AName, AValue: string);
function GetValue(const AName: string): string;
public
destructor Destroy;
procedure Reset;
function ValuesAsNormalArray: TValueHolderArray;
property Value[const Index: string]: string read GetValue write SetValue; default;
end;

في القسم implementation نضع تعريفات إجراءات الصنف TValueHolder كالتالي:

انسخ الكود

destructor TValueHolder.Destroy;
begin
FValues := nil;
inherited;
end;
procedure TValueHolder.SetValue(const AName, AValue: string);
var
Index, ValueIndex, ValuesCount: Integer;
begin
if FValues = nil then begin
SetLength(FValues, 1);
FValues[0].AName := AName;
FValues[0].AValue := AValue;
end
else begin
ValueIndex := -1;
ValuesCount := Length(FValues);
for Index := 0 to ValuesCount -1 do begin
if SameText(FValues[Index].AName, AName) then begin
ValueIndex := Index;
Break;
end;
end;
if ValueIndex = -1 then begin
SetLength(FValues, ValuesCount + 1);
FValues[ValuesCount].AName := AName;
FValues[ValuesCount].AValue := AValue;
end
else
FValues[ValueIndex].AValue := AValue;
end;
end;
function TValueHolder.GetValue(const AName: string): string;
var
Index, ValuesCount: Integer;
begin
Result := '';
if FValues = nil then
raise Exception.Create('The array contains no elelments');
ValuesCount := Length(FValues);
for Index := 0 to ValuesCount -1 do begin
if SameText(FValues[Index].AName, AName) then begin
Result := FValues[Index].AValue;
Exit;
end;
end;
raise Exception.Create('No array element with such name');
end;
function TValueHolder.ValuesAsNormalArray: TValueHolderArray;
var
Index, ValuesCount: Integer;
begin
Result := nil;
if FValues = nil then
raise Exception.Create('The array contains no elelments');
ValuesCount := Length(FValues);
SetLength(Result, ValuesCount);
for Index := 0 to ValuesCount -1 do
Result[Index] := FValues[Index].AValue;
end;
procedure TValueHolder.Reset;
begin
FValues := nil;
end;

في القسم implementation أو interface نقوم بتعريف متغير من النوع TValueHolder كالتالي مثلاً:

انسخ الكود

MyArr: TValueHolder;

ثم نقوم بإنشاء الكائن في الحدث OnCreate للـ Form

انسخ الكود

MyArr := TValueHolder.Create;

نلاحظ أننا قمنا بتعريف الخاصية Value كخاصية مفهرسة (Indexed Property) و أن مؤشرها من النوع String بالإضافة إلى تحديدها كخاصية افتراضية (Default)، و بالتالي فإن:

انسخ الكود

// الجملة التالية:
MyArr.Value['abc'] := 'This is test text';
// مكافئة الجملة التالية:
MyArr['abc'] := 'This is test text';

أي أنه يمكننا إهمال اسم الخاصية Value لأنها هي الخاصية الافتراضية للكائن، و بالتالي يمكننا التعامل مع اسم الكائن كأنه مصفوفة (متبوعاً بقوسين مربعين بينهما مؤشر Index نصي).

نلاحظ هنا أن الكائن يعمل كمصفوفة غير محدودة العناصر، حيث أن الإجراء SetValue إذا لم يجد عنصراً بالاسم المطلوب فإنه يقوم بإنشاء عنصر بذلك الاسم و حفظ القيمة الجديدة فيه. بالمقابل فإن قراءة قيمة من الكائن (المصفوفة) يجب أن تشير إلى اسم عنصر موجود و إلا يحدث خطأ (كما هو مبين في الدالة GetValue).

إذن للتعامل مع الكائن:

انسخ الكود

// تخزين قيمة:
MyArr['abc'] := 'This Is Text1';
// قراءة قيمة:
StrVar := MyArr['abc'];

أخيراً: ربما نحتاج إلى التعامل مع عناصر الكائن كمصفوفة اعتيادية (في حلقة For مثلاً)، و لهذا أنشأت الوظيفة ValuesAsNormalArray، و التي يمكن استعمالها كالتالي مثلاً:

انسخ الكود

procedure TFRtlForm1.Button3Click(Sender: TObject);
var
StrArr: TValueHolderArray;
Index: Integer;
begin
StrArr := MyArr.ValuesAsNormalArray;
for Index := 0 to Length(StrArr) - 1 do
ShowMessage(StrArr[Index]);
end;

و لتصفير (إعادة ضبط) الكائن - أي حذف كل عناصره - نستعمل الوظيفة Reset للكائن:

انسخ الكود

MyArr.Reset;

نرجو الاستفادة و السلام.

وَ قُلِ اعْمَلُوا فَسَيَرَى اللهُ عَمَلَكُمْ وَ رَسُولُهُ وَ الْمُؤْمِنُونَ

صدق الله العظيم

#41 أكتوبر 2009 في 02:06

بسم الله ما شاء الله تبارك الله

الله يعطيك العافية

كنت أريد أن أرد بكلاس أضعف مما ذكرت لأني شاهد شبيه بمثله في الوحدة hashes.pas ، ولكنك يا أخي najy_z قطعت قول كل خطيب .

ولو وافيت ربك دون ذنب *** وناقشك الحساب إذاً هلكتا

ولم يظلمك في عملٍ ولكن *** عسير أن تقوم بما حملتا

#51 أكتوبر 2009 في 03:44

لعله يغني عن الوظيفة ValuesAsNormalArray وضع خاصية تقرأ من FValues مباشرة .

TValueHolderArray = array of TValueHolderMap;

.....

public

		property data : TValueHolderArray read FValues;

ثم يكون الإستخدام كالتالي :

procedure TForm1.btnViewClick(Sender: TObject);
var I : integer;
begin
  listbox1.Clear;		  
  for I := 0 to MyArr.GetCount - 1 do
	ListBox1.Items.Add(MyArr.data.AName+':='+MyArr.data.AValue );
end;

ولو وافيت ربك دون ذنب *** وناقشك الحساب إذاً هلكتا

ولم يظلمك في عملٍ ولكن *** عسير أن تقوم بما حملتا

#61 أكتوبر 2009 في 16:28

السلام عليكم...

الفائدة من طرح المواضيع و الأكواد هي المناقشة و الوصول لأفضل الحلول. و طالما وصلنا إلى الفكرة فإنه يمكننا تعديلها و تطويرها بما يتناسب مع احتياجاتنا. أشكرك و أرجو لك التوفيق.

و السلام.

وَ قُلِ اعْمَلُوا فَسَيَرَى اللهُ عَمَلَكُمْ وَ رَسُولُهُ وَ الْمُؤْمِنُونَ

صدق الله العظيم

#71 أكتوبر 2009 في 22:28

السلام عليكم

أولا شكرا على الطريقة التي قدمتها أخي ناجي ولكن لديّا سؤال لو سمحت هل الكلام الذي ذكرته أنا دقيق مئة بالمئة أم لايزال هنالك طريقة للإلتفاف بإستخدام مصفوفة

#84 أكتوبر 2009 في 07:16

السلام عليكم ورحمة الله وبركاته

أشكرك يا أخي على إيصال الفكرة ولكن لا مانع من إضافة بعض الفوائد لأمثالي البعيدين العهد عن الدلفي ، لأني الآن راجع وأحاول تجميع أوراقي وأتآلف معها أكثر .

حاولت أن أصمم الكلاس من جديد مستفيد من الأفكار الموجودة في مشاركة الأخ ناجي . وعملت واجهة اختبارية للكائن ، كما في الصورة في المرفقات ، لأن هذا الكائن هو الذي أريده وأبني عليه بعض التطبيقات .

هذا الكلاس الذي عملته هو لأجل تخزين النصوص، كما عمله الأخ الموفق ناجي، ويعمل البرنامج معه تماماً بدون مشاكل .

وظهر لدي استفسار وهو أني أريد الاشتقاق منه مكوّن خاص بالأرقام ليكون الكود كالتالي :

var 
	level : TIntConfig;
	permit : TIntConfig;
//========
level:= TIntConfig.Create();
permit:= TIntConfig.Create();

// USAGE
if (permit['mytable.view'] > level['username']) then
	/// Access forbidden

فإذا تمت عملية الاشتقاق لن يتغير من الدوال إلا اثنين فقط وهما SetItem و GetItem ، لأن سائر الدوال الباقية ليس لها علاقة بنوع حقل المصفوفة.

ولكن لم تنجح عملية الاشتقاق ولا أريد إعادة كتابة الكائن كله من جديد لأجل الأرقام

تجدون الاختبار لأجل الأرقام في unit1.pas كتعليقات لأجل تسهيل الفهم .

والله الموفق .

testConfig.zip

ولو وافيت ربك دون ذنب *** وناقشك الحساب إذاً هلكتا

ولم يظلمك في عملٍ ولكن *** عسير أن تقوم بما حملتا

#95 أكتوبر 2009 في 03:14

مرحبا أخي أبو محمد لكن على العكس منكم نستفيد إن شاء

التعديل يجب أن يتم على السجل أي إنشاء سجل أخر جرب هذا المرفق وإن شاء الله بيمشي الحال

Test.rar

#105 أكتوبر 2009 في 15:18

الحمد لله وكفى

محاولة جيدة أخي حسين.

ولكن المشكلة هي أن السجل الجديد في الصنف الابن لا تتعامل معه دوال وإجراءات الصنف الأب إلا بعد إعادة كتابتها من جديد في الصنف الأبن ، لأنها (في الأب) تعتبر الحقل والخصائص المرتبطة به في الصنف الابن أمر لا يسمح بالوصول إليه . ( خطأ في الوصول إلى الذاكرة). مع أن الحقل والخصائص تحمل نفس الاسم .

هذه هي المشكلة بالتحديد.

فمثلاً في المرفق إجراءات في الصنف الأب يجب ألا يعاد كتابتها في الأصناف الأبناء لأنه لا علاقة لها بنوع القيمة التي يحملها الحقل هي تتعامل مع الاسم فقط وهو نص في الجميع . وهذه الإجراءات هي remove, indexOf, seve, ...

بينما الدالة reset تعمل والله أعلم.

هذا المرفق من جديد مع بعض التحسين ، وأريد النقاش يكون حوله، لأن فيه الدوال التي المفترض أن يرثها الكائن الابن ولكنها تتبرأ من حقوله .

testConfig.zip

تم تعديل هذه المشاركة بواسطة أبو محمد اللحياني في 5 أكتوبر 2009 في 15:20

ولو وافيت ربك دون ذنب *** وناقشك الحساب إذاً هلكتا

ولم يظلمك في عملٍ ولكن *** عسير أن تقوم بما حملتا

#117 أكتوبر 2009 في 03:30

السلام عليكم...

هذه هي محتويات الوحدة Configs بعد إجراء التعديلات عليها. و هي الآن تدعم الأنواع String و Integer و Real (أو Float) و Boolean و TDateTime. و يمكن بتعديلات بسيطة أن تدعم أنواعاً أخرى. مع ملاحظة أني لم أقم بمراجعة الوظيفتين Reset و Remove.

ملاحظة: كتبت بعض الملاحظات باللغة الإنجليزية - و ليس بالعربي - تجنباً لعدم إظهار النص العربي بشكل غير سليم.

المشروع أيضاً موجود في المرفقات.

انسخ الكود

unit Configs;
interface
uses SysUtils, Classes, Dialogs, IniFiles, DateUtils;
Type
TConfigDataType = (ctsStr, ctsInt, ctsReal, ctsBool, ctsDate);
TConfigRec = Record
Key : string[50];
CDF: TConfigDataType;
case TConfigDataType of
ctsStr: (AsString: string[255]);
ctsInt: (AsInteger: Integer);
ctsReal: (AsFloat: Real);
ctsBool: (AsBoolean: Boolean);
ctsDate: (AsDateTime: TDateTime);
end;
TConfigArr = array of TConfigRec;
TConfigFile = file of TConfigRec;
// Base configuration class (TConfigBase):
// NOTE: DO NOT instantiate this class (i.e. DO NOT create objects from it).
TConfigBase = class
Private
FItems: TConfigArr;
FCount: Integer;
function GetCount: Integer;
procedure SetItemValue(const Index: Integer; const Value: Variant; ADataType: TConfigDa
taType);
function GetItem(const Key: string; ADataType: TConfigDataType): Variant;
procedure SetItem(const Key: string; const Value: Variant; ADataType: TConfigDataType);
procedure LoadFromIni(const FileData: string; const isReset: Boolean; ADataType: TConfi
gDataType);
public
procedure Reset;
procedure Load(const FileData: string; const isReset: Boolean = True);
procedure Save(const FileData: string);
procedure Remove(const Key: string);
property Count: Integer read GetCount;
property ItemOf : TConfigArr read FItems;
end;
// Derived classes:
// TStrConfig: for strings.
TStrConfig = class(TConfigBase)
Private
function GetItem(const Key: string): string;
procedure SetItem(const Key: string; const Value: string);
public
procedure LoadIni(const FileData: string; const isReset: Boolean = True);
property Items[const Key: string]: string read GetItem write SetItem; default;
end;
//---------------------------------------
// TIntConfig: for integers.
TIntConfig = class(TConfigBase)
Private
function GetItem(const Key: string): Integer;
procedure SetItem(const Key: string; const Value: Integer);
public
procedure LoadIni(const FileData: string; const isReset: Boolean = True);
property Items[const Key: string]: Integer read GetItem write SetItem; default;
end;
//---------------------------------------
//TFloatConfig: for reals:
TFloatConfig = class(TConfigBase)
Private
function GetItem(const Key: string): Real;
procedure SetItem(const Key: string; const Value: Real);
public
procedure LoadIni(const FileData: string; const isReset: Boolean = True);
property Items[const Key: string]: Real read GetItem write SetItem; default;
end;
//---------------------------------------
//TBooleanConfig: for booleans:
TBooleanConfig = class(TConfigBase)
Private
function GetItem(const Key: string): Boolean;
procedure SetItem(const Key: string; const Value: Boolean);
public
procedure LoadIni(const FileData: string; const isReset: Boolean = True);
property Items[const Key: string]: Boolean read GetItem write SetItem; default;
end;
//---------------------------------------
//TDateTimeConfig: for TDateTime:
TDateTimeConfig = class(TConfigBase)
Private
function GetItem(const Key: string): TDateTime;
procedure SetItem(const Key: string; const Value: TDateTime);
public
procedure LoadIni(const FileData: string; const isReset: Boolean = True);
property Items[const Key: string]: TDateTime read GetItem write SetItem; default;
end;
//---------------------------------------
const
// NOTE: if the type TConfigDataType (above) changed, values assigned to
// this constant should be changed accordingly.
CONFIG_DATA_SET = [ctsStr, ctsInt, ctsReal, ctsBool, ctsDate];
implementation
// TConfigBase class members:
//===========================
// A. Private procs and funcs:
function TConfigBase.GetCount: Integer;
begin
Result := 0;
if FCount > 0 then
Result := FCount;
end;
procedure TConfigBase.SetItemValue(const Index: Integer; const Value: Variant; ADataType: TConf
igDataType);
begin
case ADataType of
ctsStr: FItems[Index].AsString := Value;
ctsInt: FItems[Index].AsInteger := Value;
ctsReal: FItems[Index].AsFloat := Value;
ctsBool: FItems[Index].AsBoolean := Value;
ctsDate: FItems[Index].AsDateTime := Value;
else
raise Exception.Create('The given data type is not supported now');
end;
end;
function TConfigBase.GetItem(const Key: string; ADataType: TConfigDataType): Variant;
var
I, FoundIndex: integer;
begin
if FItems = nil then
raise Exception.Create('The array contains no elements');
FoundIndex := -1;
Result := '';
for I := 0 to Count - 1 do begin
if FItems[i].key = Key then begin
FoundIndex := I;
Break;
end;
end;
if FoundIndex = -1 then
raise Exception.Create('The name ' + Key + ' does not exist among the items')
else begin
case ADataType of
ctsStr: Result := FItems[FoundIndex].AsString;
ctsInt: Result := FItems[FoundIndex].AsInteger;
ctsReal: Result := FItems[FoundIndex].AsFloat;
ctsBool: Result := FItems[FoundIndex].AsBoolean;
ctsDate: Result := FItems[FoundIndex].AsDateTime;
else
raise Exception.Create('The given data type is not supported now');
end;
end;
end;
procedure TConfigBase.SetItem(const Key: string; const Value: Variant; ADataType: TConfigDataTy
pe);
var
I: integer;
begin
if not (ADataType in CONFIG_DATA_SET) then
raise Exception.Create('The given data type is not supported now');
if FItems = nil then begin
SetLength(FItems, 1);
FItems[0].Key := Key ;
FItems[0].CDF := ADataType ;
SetItemValue(0, Value, ADataType);
Inc(FCount);
Exit;
end;
for I := 0 to FCount - 1 do begin
if FItems[I].Key = Key then begin
FItems[I].CDF := ADataType;
SetItemValue(I, Value, ADataType);
Exit;
end;
end;
SetLength(FItems, FCount + 1);
FItems[FCount].Key := Key ;
FItems[FCount].CDF := ADataType ;
SetItemValue(FCount, Value, ADataType);
Inc(FCount);
end;
procedure TConfigBase.LoadFromIni(const FileData: string; const isReset: Boolean; ADataType: TC
onfigDataType);
var
I, N: Integer;
objIni: TIniFile;
Sections, KeyList :TStringList;
begin
if isReset then self.Reset;
if FileExists(FileData) Then begin
try
Sections :=TStringList.Create;
KeyList := TStringList.Create;
objIni := TIniFile.Create(FileData);
objIni.ReadSections(Sections);
for I := 0 to Sections.Count - 1 do begin
objIni.ReadSection(Sections.ValueFromIndex[I], KeyList);
for N := 0 to KeyList.Count - 1 do begin
case ADataType of
ctsStr: SetItem(KeyList[N], objIni.ReadString(Sections.ValueFromIndex[I
], KeyList[N], ''), ctsStr);
ctsInt: SetItem(KeyList[N], objIni.ReadInteger(Sections.ValueFromIndex[
I], KeyList[N], 0), ctsInt);
ctsReal: SetItem(KeyList[N], objIni.ReadFloat(Sections.ValueFromIndex[I
], KeyList[N], 0), ctsReal);
ctsBool: SetItem(KeyList[N], objIni.ReadBool(Sections.ValueFromIndex[I]
, KeyList[N], False), ctsBool);
ctsDate: SetItem(KeyList[N], objIni.ReadDateTime(Sections.ValueFromInde
x[I], KeyList[N], EncodeDateTime(1899, 12, 30, 0, 0, 0, 0)), ctsDate);
end;
end;
end;
finally
Sections.Free;
KeyList.Free;
objIni.Free;
end; // try
end // end if exists file
else
ShowMessage('The file ' + FileData + ' is not found.');
end;
// B. Public procs and funcs (Methods):
procedure TConfigBase.Reset;
begin
FItems := nil;
FCount := 0;
end;
procedure TConfigBase.Load(const FileData: string; const isReset: Boolean);
var
F: TConfigFile;
cfg: TConfigRec;
begin
if isReset then self.Reset;
if FileExists(fileData) Then begin
try
AssignFile(F, FileData) ;
FileMode := fmOpenRead;
System.Reset(F) ;
while not Eof(F) do begin
System.Read(F, cfg);
case cfg.CDF of
ctsStr: SetItem(cfg.key, cfg.AsString, ctsStr);
ctsInt: SetItem(cfg.key, cfg.AsInteger, ctsInt);
ctsReal: SetItem(cfg.key, cfg.AsFloat, ctsReal);
ctsBool: SetItem(cfg.key, cfg.AsBoolean, ctsBool);
ctsDate: SetItem(cfg.key, cfg.AsDateTime, ctsDate);
end;
end;
finally
CloseFile(F) ;
end;
end // end if exists file
else
ShowMessage('The file ' + FileData + ' is not found.');
end;
procedure TConfigBase.Save(const FileData: String);
var
F : TConfigFile;
I : integer;
begin
try
AssignFile(F, FileData) ;
FileMode := fmOpenWrite;
ReWrite(F);
for I := 0 to FCount - 1 do
Write(F, FItems[I]);
finally
CloseFile(F) ;
end;
end;
procedure TConfigBase.Remove(const Key: string);
var
P, I: Integer;
begin
P := -1;
for I := 0 to FCount - 1 do begin
if FItems[i].Key = Key then begin
P := I;
Break;
end;
end;
if P = -1 then
raise Exception.Create('The name: ' + Key + ' does not exist among the items');
if P = FCount - 1 then begin // key in last FItems
Setlength(FItems, FCount -1);
FCount := FCount - 1;
Exit;
end;
for I := P to FCount - 2 do
FItems[I] := FItems[I + 1];
FCount := FCount - 1;
SetLength(FItems, FCount - 1); //now we have one element less
end;
// End of TConfigBase class
// =============================================================================
// ============================ Derived Classes ================================
// TStrConfig class:
// =================
function TStrConfig.GetItem(const Key: string): string;
begin
Result := string(inherited GetItem(Key, ctsStr));
end;
procedure TStrConfig.SetItem(const Key: string; const Value: string);
begin
inherited SetItem(Key, Value, ctsStr);
end;
procedure TStrConfig.LoadIni(const FileData: string; const isReset: Boolean = True);
begin
LoadFromIni(FileData, isReset, ctsStr); // inherited.
end;
// =============================================================================
// TIntConfig:
// =================
function TIntConfig.GetItem(const Key: string): Integer;
begin
Result := Integer(inherited GetItem(Key, ctsInt));
end;
procedure TIntConfig.SetItem(const Key: string; const Value: Integer);
begin
inherited SetItem(Key, Value, ctsInt);
end;
procedure TIntConfig.LoadIni(const FileData: string; const isReset: Boolean = True);
begin
LoadFromIni(FileData, isReset, ctsInt);
end;
// =============================================================================
//(ctsStr, ctsInt, ctsReal, ctsBool, ctsDate);
// TFloatConfig:
// =================
function TFloatConfig.GetItem(const Key: string): Real;
begin
Result := Real(inherited GetItem(Key, ctsReal));
end;
procedure TFloatConfig.SetItem(const Key: string; const Value: Real);
begin
inherited SetItem(Key, Value, ctsReal);
end;
procedure TFloatConfig.LoadIni(const FileData: string; const isReset: Boolean = True);
begin
LoadFromIni(FileData, isReset, ctsReal);
end;
// =============================================================================
// TBooleanConfig:
// =================
function TBooleanConfig.GetItem(const Key: string): Boolean;
begin
Result := Boolean(inherited GetItem(Key, ctsBool));
end;
procedure TBooleanConfig.SetItem(const Key: string; const Value: Boolean);
begin
inherited SetItem(Key, Value, ctsBool);
end;
procedure TBooleanConfig.LoadIni(const FileData: string; const isReset: Boolean = True);
begin
LoadFromIni(FileData, isReset, ctsBool);
end;
// =============================================================================
// TDateTimeConfig:
// =================
function TDateTimeConfig.GetItem(const Key: string): TDateTime;
begin
Result := TDateTime(inherited GetItem(Key, ctsDate));
end;
procedure TDateTimeConfig.SetItem(const Key: string; const Value: TDateTime);
begin
inherited SetItem(Key, Value, ctsDate);
end;
procedure TDateTimeConfig.LoadIni(const FileData: string; const isReset: Boolean = True);
begin
LoadFromIni(FileData, isReset, ctsDate);
end;
// =============================================================================
end.

الصنف (Class) الأساسي هو TConfigBase و هو الذي يحتوي على معظم (بل كل) الكود المطلوب، لكن لا يجب أن ننشئ منه كائنات (Objects) و إنما يتم إنشاء الكائنات من الأصناف المشتقة منه: TStrConfig و TIntConfig و TFloatConfig و TBooleanConfig و TDateTimeConfig، بالإضافة إلى أية أصناف أخرى يتم اشتقاقها منه (أي الصنف TConfigBase).

نلاحظ أن عملية الاشتقاق سهلة: إعادة كتابة الدالة GetItem و الإجرائين SetItem و LoadIni. و نلاحظ أن إعادة كتابة هذه الإجراءات لا تعني إعادة كامل الكود، بل تحتاج كل منها إلى سطر واحد فقط لأنها تعتمد على استدعاء الإجراءات الأصلية الموروثة (inherited) مع تمرير نوع البيانات. بالإضافة إلى تعريف الخاصية Items لكل صنف مشتق حسب نوعه.

هناك نقطة واحدة هنا قد تتعارض مع مفاهيم الـ (Object Oriented Programming = OOP) و هي أنه إذا أردنا إنشاء أصناف مشتقة جديدة (غير الموجودة حالياً في الكود) فإننا نحتاج إلى إجراء بعض التعديلات في بعض إجراءات النوع الأساس TConfigBase، أو - إذا أمكن - أن نقوم بنوع من التحويل بين نوع البيانات الجديد و أحد الأنواع المعرفة سابقاً حتى لا نقوم بتغيير الكود الأصلي للصنف TConfigBase

TestConfig02.rar

على أية حال نرجو الاستفادة و السلام.

وَ قُلِ اعْمَلُوا فَسَيَرَى اللهُ عَمَلَكُمْ وَ رَسُولُهُ وَ الْمُؤْمِنُونَ

صدق الله العظيم

#127 أكتوبر 2009 في 11:14

السلام عليكــم ورحمـة الله وبركاتــه ،،

شكرا لك أخي ناجي حقيقتا كنت أفكر بإستخدام توابع مثل AsInteger كما في المكون ClientDataSet لم أكن أعرف أنه يمكن إستخدام case of عند التصريح

شكرا ثانية

#137 أكتوبر 2009 في 23:29

أعتذر عن تأخري عن الرد لانقطاع الإنترنت !!

في الحقيقة يا أخ ناجي امتعتنا بفوائدك ، لا حرمك الله الأجر .

وإن كنت أنا أتوقف كثيراً في استخدام النوع Variant ، لأنهم قالوا عنه أنه بطئء ، ولذلك أحببت إستخدام ( ملف ، ومصفوفة ، وسجل) كلها من نوع واحد لأجل التهرب من تحويل الأنواع في كل عملية إسناد واستخراج.

فقط لإثراء الموضوع ولإختصار الكود، ( مع أني محرج من الأخ الموفق ناجي من كثرة التغيير !! في الكود )::

لماذا لا يكون المتغير ADataType حقل في الكائن الأساس ؟

Private
	 FDataType : TConfigDataType;
public
	property DataType : TConfigDataType read FDataType;
//----------------------------------
constructor TConfigBase.Create(ADataType: TConfigDataType);
begin
  FDataType := ADataType;
end;
// -----------------------------
var
  content: TConfigBase;
//---------
content := TConfigBase.Create(ctsStr);
//---------------------------
case content.DataType of 
	ctsStr : AValue := content.ItemOf.AsString;
	ctsInt : AValue := IntToStr(content.ItemOf.AsInteger);
	ctsReal : AValue := FloatToStr(content.ItemOf.AsFloat);
	ctsBool : AValue := BoolToStr(content.ItemOf.AsBoolean);
	ctsDate : AValue := DateTimeToStr(content.ItemOf.AsDateTime);
end;

ثم غيِّر ما يلزم .

أشكر الجميع والله الموفق

والسلام عليكم ورحمة الله وبركاته .

ولو وافيت ربك دون ذنب *** وناقشك الحساب إذاً هلكتا

ولم يظلمك في عملٍ ولكن *** عسير أن تقوم بما حملتا

#147 أكتوبر 2009 في 23:55

في الحقيقة الاقتراح السابق لا يغني عن الاشتقاق من الصنف الأساس لأصناف تدعم نوع المتغير

فإذا كنا نريد البساطة التي سألنا عنها أول الموضوع لا بد من اشتقاق كما فعل الأخ ناجي ولا يكتفى باستخدام الصنف TConfigBase كما في مشاركتي الأخيرة .

والله أعلم .

ولو وافيت ربك دون ذنب *** وناقشك الحساب إذاً هلكتا

ولم يظلمك في عملٍ ولكن *** عسير أن تقوم بما حملتا

كيف أجعل ال Index للمصفوفة نص ؟

مواضيع مشابهة