delphi useful functions دوال و إجراءات دلفي مفيدة
#1
السلام عليكم

جميعنا لديه بعض الدوال و الاجراءات Rolleyes المفيدة يمكنك وضعها هنا ليستفيد منها الجميع
لدي احساس سنرى كائنات غريبة عفوا اقصد دوال غريبة في الموضوع Big Grin
و لرب نازلة يضيق لها الفتى ذرعا و عند الله منها المخرج
ضاقت فلما استحكمت حلقاتها فرجت و كنت اضنها لا تفرج
الرد
#2
سأبدأ انا

للحذف من اليسار تعتمد على نفس برامترات الحذف من اليمين
PHP كود :
procedure DeleteRight(var StrstringFromPosToPosInteger);
var
  
TmpStrstring;
begin
  TmpStr 
:= ReverseString(Str);
  
Delete(TmpStr ,FromPosToPos);
  
Str := ReverseString(TmpStr);
end

للحصول على الاسم الاصلي للـ Field من اسم الضهور DisplayName
PHP كود :
function DisplayToOriginName(DatasetTDataSetDisplayNamestring): string;
var
  
IInteger;
begin
  with TClientDataSet
(DataSet) do
  for 
:= 0 to FieldCount do
  
begin
    
if SameStr(Fields[i].DisplayNameDisplayNamethen
      Result  
:= Fields[i].FieldName;
  
end;
end

لتشكيل حجم الملفات mb, kb, gb الخ ....
PHP كود :
function FormatStringByteSize(TheSizeInt64): string;
var
  
Buffstring;
begin
  SetLength
(Buff20);
  
StrFormatByteSizeWTheSizePWideChar(Buff), Length(Buff));
  
Result := PChar(Buff);
end
و لرب نازلة يضيق لها الفتى ذرعا و عند الله منها المخرج
ضاقت فلما استحكمت حلقاتها فرجت و كنت اضنها لا تفرج
الرد
#3
ملاحظة : الدالة StrFormatByteSizeW موجودة في الوحدة ShLwApi.
Open Your Source .. Open Your Mind
الرد
#4
الدالة Odd تستخدم لمعرفة ان كان الرقم فردي Wink
PHP كود :
if System.Odd(7then
... 
الدالة TrimLeft لحذف المسافة الزائدة من اليسار .
الدالة TrimRight لحذف المسافة الزائدة من اليمين .
الدالة Trim لحذف المسافة الزائدة من اليمين و اليسار .
PHP كود :
var s:string ;
begin
s
:= '   Delphi  XE   ';
Caption:=Trim(s)+'4';
end
Open Your Source .. Open Your Mind
الرد
#5
السلام عليكم

موقع المكون على الـ form يحدد بخاصيتين top و left
لكن اذا كان مكون مثلا Edit داخل مكون اخر حامل مثل panel فان top و left
تكون بالنسبة للمكون الاب في حالتنا panel ماذا اذا كان لدينا مكون panel2 على الـ form
و اردنا انا نحاذيه تحت الـ edit مباشرة نحتاج الى معرفة الاحادثيات المطلقة للمكون يمكن ذلك عن طريقة ClientToScreen

هذه الدالة تقوم باعادة الاحداثيات المطلقة للمكون:

PHP كود :
function GetScreenCoordinates(AControlTControl): TPoint;
begin
  
if AControl.Parent <> nil then
  begin
    Result 
:= AControl.Parent.ClientToScreen(Point(AContol.LeftAControl.Top));
  
end
  
else
  
begin
    Result 
:= Point(AContol.LeftAControl.Top);
  
end;
end
و لرب نازلة يضيق لها الفتى ذرعا و عند الله منها المخرج
ضاقت فلما استحكمت حلقاتها فرجت و كنت اضنها لا تفرج
الرد
#6
طريقة أخرى Smile
PHP كود :
function GetScreenCoordinates2(AControlTControl): TPoint;
var
  
RTRect;
begin
  Result 
:= Point(00);
  if 
AControl is TWinControl then
    begin
      GetWindowRect
(TWinControl(AControl).HandleR);
      
Result := Point(R.LeftR.Top);
    
end
  
else
    
begin
      GetWindowRect
(AControl.Parent.HandleR);
      
Result := Point(R.Left AControl.LeftR.Top AControl.Top);
    
end;
end
Open Your Source .. Open Your Mind
الرد
#7
السلام عليكم...

لدي وحدة برمجية (unit) خاصة أضيف إليها من حين إلى آخر بعض الدوال و الإجراءات التي قد أحتاجها في العديد من المشاريع. هنا بعض الدوال و الإجراءات من تلك الوحدة:

الدوال الثلاث التالية تعتمد على مبدأ محاولة التحويل و اصطياد الخطأ. أستعملها للتأكد من أن المستخدم أدخل البيانات ذات النوع المطلوب (في TEdit مثلاً):

1. دالة للتأكد من أن القيمة المدخلة عدد صحيح:
كود :
function IsInteger(Text: string): Boolean;
begin
    try
        StrToInt(Text);
        Result := True;
    except
        Result := False;
    end;
end;

2. دالة للتأكد من أن القيمة المدخلة عدد حقيقي:
كود :
function IsFloat(Text: string): Boolean;
begin
    try
        StrToFloat(Text);
        Result := True;
    except
        Result := False;
    end;
end;

3. دالة للتأكد من أن القيمة المدخلة تاريخ مقبول:
كود :
function IsDate(Text: string): Boolean;
begin
    try
        StrToDate(Text);
        Result := True;
    except
        Result := False;
    end;
end;

الدالة التالية تتأكد مما إذا كان المفتاح (في لوحة المفاتيح) مضغوطاً أم لا (غالباً قد نحتاجها مع مفاتيح Shift أو Ctrl أو Alt. ثوابتها العددية هي VK_SHIFT و VK_CONTROL و VK_MENU على الترتيب):
كود :
function KeyIsDown(AVirtKey: Integer): Boolean;
const
    KEY_IS_DOWN = $8000;

var
    AKeyState: SmallInt;
begin
    AKeyState := GetKeyState(AVirtKey);
    if (AKeyState and KEY_IS_DOWN) = KEY_IS_DOWN then
        Result := True
    else
        Result := False;
end;

الدالة التالية تتأكد ما إذا كان أحد المفاتيح القلابة مشغل أم لا (المفاتيح القلابة هي التي لها حالة تشغيل/إطفاء، و تشمل CapsLock و NumLock و ScrollLock) و ثوابتها العددية هي على الترتيب: VK_CAPITAL و VK_NUMLOCK و VK_SCROLL:
كود :
function KeyIsToggledOn(AVirtKey: Integer): Boolean;
const
    KEY_IS_ON = $0001;

var
    AKeyState: SmallInt;
begin
    AKeyState := GetKeyState(AVirtKey);
    if (AKeyState and KEY_IS_ON) = KEY_IS_ON then
        Result := True
    else
        Result := False;
end;

نرجو الاستفادة و السلام.
الرد
#8
السشلام عليكم....

دالة لقبول الحروف العربية فقط (في TEdit مثلاً) - مع أو دون السماح بالفراغ:

كود :
const
    ArabicLetters: array[0..35] of Char = 'اىءأإآؤئبتثجحخدذرزسشصضطظعغفقكلمنهوية';
//
//
function IsArabicLetter(AChar: Char; IncludeSpace: Boolean = True): Boolean;
begin
    if AChar = '' then
        Result := False
    else if AChar = ' ' then
        Result := IncludeSpace
    else
        Result := (Pos(AChar, ArabicLetters) <> 0);
end;

// In OnKeyPress event handler of an edit:
    if (Key > #31) and (not IsArabicLetter(Key)) then Key := #0;

نرجو الاستفادة و السلام.
الرد
#9
السلام عليكم الاخ Najy Ibraheem القي نضرة على الوحدة SysUtils مثلا باستخدام الوحدة SysUtils يمكنك :

1. دالة للتأكد من أن القيمة المدخلة عدد صحيح:
يمكنك استخدام
PHP كود :
SysUtils.TryStrToInt(); 
2. دالة للتأكد من أن القيمة المدخلة عدد حقيقي:
يمكنك استخدام
PHP كود :
SysUtils.TryStrToFloat(); 
3. دالة للتأكد من أن القيمة المدخلة تاريخ مقبول:
يمكنك استخدام
PHP كود :
SysUtils.TryStrToDate(); 

مثال
PHP كود :
procedure TForm1.Button1Click(SenderTObject);
var
  
TmpInteger;
begin
  
if not TryStrToInt(Edit1.TextTmpthen ShowMessage('ادخل رقم صحيح');
end
و لرب نازلة يضيق لها الفتى ذرعا و عند الله منها المخرج
ضاقت فلما استحكمت حلقاتها فرجت و كنت اضنها لا تفرج
الرد
#10
السلام عليكم
الدالة Coalesce تشبه الموجودة في الـ FireBird انا عن نفسي استخدمها بكثرة
الدالة عملها بسيط تمرر قيمتين اذا كانت القيمة في البرامتر الاول null تعيد لك القيمة في البرامتر الثاني

PHP كود :
uses System.Variants;

function 
Coalesce(Value1VariantValue2Variant): Variant;
begin
 if not VarIsNull
(Value1then
   Result 
:= Value1
 else
   Result 
:= Value2
end



اذا كانت القيمة Null تعيد لك القيمة التي ترغب فيها  مثال من برنامجي GestPDV

PHP كود :
edtCredit.Value := Coalesce(frmComptoir.cdsCreditTOTAL.Value0); 
نافذة ادخال كلمة المرور
PHP كود :
unit Unit2;

interface


uses
  Vcl
.GraphicsWinapi.WindowsVcl.FormsVcl.StdCtrlsVcl.Controls;

function 
InputBoxPass(const ACaptionAPromptADefaultstring): string;
function 
InputSenha(const ACaptionAPromptstring; var Valuestring): Boolean;
function 
GetAveCharSize(CanvasTCanvas): TPoint;

implementation

function GetAveCharSize(CanvasTCanvas): TPoint;
var
  IInteger;
  Buffer: array[0..51of Char;
begin
  
for := 0 to 25 do Buffer[I] := Chr(Ord('A'));
  for := 0 to 25 do Buffer[26] := Chr(Ord('a'));
  GetTextExtentPoint(Canvas.HandleBuffer52TSize(Result));
  Result.:= Result.X div 52;
end;

function 
InputBoxPass(const ACaptionAPromptADefaultstring): string;
begin
  Result 
:= ADefault;
  InputSenha(ACaptionAPromptResult);
end;

function 
InputSenha(const ACaptionAPromptstring;
  var Valuestring): Boolean;
var
  FormTForm;
  PromptTLabel;
  EditTEdit;
  DialogUnitsTPoint;
  ButtonTopButtonWidthButtonHeightInteger;
begin
  Result 
:= False;
  Form := TForm.Create(Application);
  with Form do
  try
    Canvas.Font := Font;
    DialogUnits := GetAveCharSize(Canvas);
    BorderStyle := bsDialog;
    Caption := ACaption;
    ClientWidth := MulDiv(180DialogUnits.X4);
    ClientHeight := MulDiv(63DialogUnits.Y8);
    Position := poMainformcenter;
    Prompt := TLabel.Create(Form);
    with Prompt do
    begin
      Parent 
:= Form;
      AutoSize := True;
      Left := MulDiv(8DialogUnits.X4);
      Top :=  MulDiv(8DialogUnits.Y8);
      Caption := APrompt;
    end;
    Edit := TEdit.Create(Form);
    with Edit do
    begin
      Parent 
:= Form;
      Left := Prompt.Left;
      Top := MulDiv(19DialogUnits.Y8);
      Width := MulDiv(164DialogUnits.X4);
      {} MaxLength := 255;
      {} Passwordchar := '*';
      {} Font.Color := clBlue;
      Text := Value;
      SelectAll;
    end;
    ButtonTop := MulDiv(41DialogUnits.Y8);
    ButtonWidth := MulDiv(50DialogUnits.X4);
    ButtonHeight := MulDiv(14DialogUnits.Y8);
    with TButton.Create(Form) do
    begin
      Parent 
:= Form;
      Caption := 'Ok';
      ModalResult := mrOk;
      Default := True;
      SetBounds(MulDiv(38DialogUnits.X4), ButtonTopButtonWidthButtonHeight);
    end;
    with TButton.Create(Form) do
    begin
      Parent 
:= Form;
      Caption := 'Annuler';
      ModalResult := mrCancel;
      Cancel := True;
      SetBounds(MulDiv(92DialogUnits.X4), ButtonTopButtonWidth,ButtonHeight);
    end;
    if ShowModal mrOk then
    begin
    Value 
:= Edit.Text;
    Result := True;
    end;
  finally
    Form.Free;
  end;
end;

end
مثال عن الاستخدام

PHP كود :
  Str := InputBoxPass('fenêtre mot de passe''Mot de passe : ''*******');

  if Str '*******' then Exit; 
و لرب نازلة يضيق لها الفتى ذرعا و عند الله منها المخرج
ضاقت فلما استحكمت حلقاتها فرجت و كنت اضنها لا تفرج
[-] كل من 2 users say قال شكرا ل S.FATEH على المشاركة المفيدة
  • B.M.AbdelAziZ, rahiche
الرد


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


مستخدمين يتصفحوا هذا الموضوع: 1 ضيف