delphi useful functions دوال و إجراءات دلفي مفيدة

[S.FATEH]

السلام عليكم

جميعنا لديه بعض الدوال و الاجراءات المفيدة يمكنك وضعها هنا ليستفيد منها الجميع
لدي احساس سنرى كائنات غريبة عفوا اقصد دوال غريبة في الموضوع

[S.FATEH]

سأبدأ انا

للحذف من اليسار تعتمد على نفس برامترات الحذف من اليمين

PHP كود :

procedure DeleteRight(var Str: string; FromPos, ToPos: Integer);
var
  TmpStr: string;
begin
  TmpStr := ReverseString(Str);
  Delete(TmpStr ,FromPos, ToPos);
  Str := ReverseString(TmpStr);
end; 


للحصول على الاسم الاصلي للـ Field من اسم الضهور DisplayName

PHP كود :

function DisplayToOriginName(Dataset: TDataSet; DisplayName: string): string;
var
  I: Integer;
begin
  with TClientDataSet(DataSet) do
  for I := 0 to FieldCount - 1 do
  begin
    if SameStr(Fields[i].DisplayName, DisplayName) then
      Result  := Fields[i].FieldName;
  end;
end; 


لتشكيل حجم الملفات mb, kb, gb الخ ....

PHP كود :

function FormatStringByteSize(TheSize: Int64): string;
var
  Buff: string;
begin
  SetLength(Buff, 20);
  StrFormatByteSizeW( TheSize, PWideChar(Buff), Length(Buff));
  Result := PChar(Buff);
end; 


[SMP3]

ملاحظة : الدالة StrFormatByteSizeW موجودة في الوحدة ShLwApi.

[SMP3]

الدالة Odd تستخدم لمعرفة ان كان الرقم فردي

PHP كود :

if System.Odd(7) then
... 


الدالة TrimLeft لحذف المسافة الزائدة من اليسار .
الدالة TrimRight لحذف المسافة الزائدة من اليمين .
الدالة Trim لحذف المسافة الزائدة من اليمين و اليسار .

PHP كود :

var s:string ;
begin
s:= '   Delphi  XE   ';
Caption:=Trim(s)+'4';
end; 


[S.FATEH]

السلام عليكم

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

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

PHP كود :

function GetScreenCoordinates(AControl: TControl): TPoint;
begin
  if AControl.Parent <> nil then
  begin
    Result := AControl.Parent.ClientToScreen(Point(AContol.Left, AControl.Top));
  end
  else
  begin
    Result := Point(AContol.Left, AControl.Top);
  end;
end; 


[SMP3]

طريقة أخرى

PHP كود :

function GetScreenCoordinates2(AControl: TControl): TPoint;
var
  R: TRect;
begin
  Result := Point(0, 0);
  if AControl is TWinControl then
    begin
      GetWindowRect(TWinControl(AControl).Handle, R);
      Result := Point(R.Left, R.Top);
    end
  else
    begin
      GetWindowRect(AControl.Parent.Handle, R);
      Result := Point(R.Left + AControl.Left, R.Top + AControl.Top);
    end;
end; 


[Najy Ibraheem]

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

لدي وحدة برمجية (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;

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

[Najy Ibraheem]

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

دالة لقبول الحروف العربية فقط (في 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;

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

[S.FATEH]

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

1. دالة للتأكد من أن القيمة المدخلة عدد صحيح:
يمكنك استخدام

PHP كود :

SysUtils.TryStrToInt(); 


2. دالة للتأكد من أن القيمة المدخلة عدد حقيقي:
يمكنك استخدام

PHP كود :

SysUtils.TryStrToFloat(); 


3. دالة للتأكد من أن القيمة المدخلة تاريخ مقبول:
يمكنك استخدام

PHP كود :

SysUtils.TryStrToDate(); 


مثال

PHP كود :

procedure TForm1.Button1Click(Sender: TObject);
var
  Tmp: Integer;
begin
  if not TryStrToInt(Edit1.Text, Tmp) then ShowMessage('ادخل رقم صحيح');
end; 


[S.FATEH]

السلام عليكم
الدالة Coalesce تشبه الموجودة في الـ FireBird انا عن نفسي استخدمها بكثرة
الدالة عملها بسيط تمرر قيمتين اذا كانت القيمة في البرامتر الاول null تعيد لك القيمة في البرامتر الثاني

PHP كود :

uses System.Variants;

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


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

PHP كود :

edtCredit.Value := Coalesce(frmComptoir.cdsCreditTOTAL.Value, 0); 


نافذة ادخال كلمة المرور

PHP كود :

unit Unit2;

interface


uses
  Vcl.Graphics, Winapi.Windows, Vcl.Forms, Vcl.StdCtrls, Vcl.Controls;

function InputBoxPass(const ACaption, APrompt, ADefault: string): string;
function InputSenha(const ACaption, APrompt: string; var Value: string): Boolean;
function GetAveCharSize(Canvas: TCanvas): TPoint;

implementation

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

function InputBoxPass(const ACaption, APrompt, ADefault: string): string;
begin
  Result := ADefault;
  InputSenha(ACaption, APrompt, Result);
end;

function InputSenha(const ACaption, APrompt: string;
  var Value: string): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do
  try
    Canvas.Font := Font;
    DialogUnits := GetAveCharSize(Canvas);
    BorderStyle := bsDialog;
    Caption := ACaption;
    ClientWidth := MulDiv(180, DialogUnits.X, 4);
    ClientHeight := MulDiv(63, DialogUnits.Y, 8);
    Position := poMainformcenter;
    Prompt := TLabel.Create(Form);
    with Prompt do
    begin
      Parent := Form;
      AutoSize := True;
      Left := MulDiv(8, DialogUnits.X, 4);
      Top :=  MulDiv(8, DialogUnits.Y, 8);
      Caption := APrompt;
    end;
    Edit := TEdit.Create(Form);
    with Edit do
    begin
      Parent := Form;
      Left := Prompt.Left;
      Top := MulDiv(19, DialogUnits.Y, 8);
      Width := MulDiv(164, DialogUnits.X, 4);
      {} MaxLength := 255;
      {} Passwordchar := '*';
      {} Font.Color := clBlue;
      Text := Value;
      SelectAll;
    end;
    ButtonTop := MulDiv(41, DialogUnits.Y, 8);
    ButtonWidth := MulDiv(50, DialogUnits.X, 4);
    ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
    with TButton.Create(Form) do
    begin
      Parent := Form;
      Caption := 'Ok';
      ModalResult := mrOk;
      Default := True;
      SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth, ButtonHeight);
    end;
    with TButton.Create(Form) do
    begin
      Parent := Form;
      Caption := 'Annuler';
      ModalResult := mrCancel;
      Cancel := True;
      SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,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;