delphi4arab منتديات دلفي للعرب
delphi useful functions دوال و إجراءات دلفي مفيدة - نسخة قابلة للطباعة

+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : مصادر دلفي مفتوحة تعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=14)
+--- الموضوع : delphi useful functions دوال و إجراءات دلفي مفيدة (/showthread.php?tid=5485)

الصفحات: 1 2


delphi useful functions دوال و إجراءات دلفي مفيدة - S.FATEH - 24-08-2013

السلام عليكم

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


delphi useful functions دوال و إجراءات دلفي مفيدة - S.FATEH - 24-08-2013

سأبدأ انا

للحذف من اليسار تعتمد على نفس برامترات الحذف من اليمين
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; 



delphi useful functions دوال و إجراءات دلفي مفيدة - SMP3 - 24-08-2013

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


delphi useful functions دوال و إجراءات دلفي مفيدة - SMP3 - 24-08-2013

الدالة Odd تستخدم لمعرفة ان كان الرقم فردي Wink
PHP كود :
if System.Odd(7) then
... 
الدالة TrimLeft لحذف المسافة الزائدة من اليسار .
الدالة TrimRight لحذف المسافة الزائدة من اليمين .
الدالة Trim لحذف المسافة الزائدة من اليمين و اليسار .
PHP كود :
var s:string ;
begin
s
:= '   Delphi  XE   ';
Caption:=Trim(s)+'4';
end; 



delphi useful functions دوال و إجراءات دلفي مفيدة - S.FATEH - 26-08-2013

السلام عليكم

موقع المكون على الـ 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; 



delphi useful functions دوال و إجراءات دلفي مفيدة - SMP3 - 26-08-2013

طريقة أخرى Smile
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; 



delphi useful functions دوال و إجراءات دلفي مفيدة - Najy Ibraheem - 27-08-2013

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

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

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


delphi useful functions دوال و إجراءات دلفي مفيدة - Najy Ibraheem - 27-08-2013

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

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

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


delphi useful functions دوال و إجراءات دلفي مفيدة - S.FATEH - 07-09-2013

السلام عليكم الاخ 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; 



RE: delphi useful functions دوال و إجراءات دلفي مفيدة - S.FATEH - 09-01-2018

السلام عليكم
الدالة 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;