دوال مفيدة جدا للمبتدئين و المتوسطين

دوال مفيدة جدا للمبتدئين و المتوسطين - نسخة قابلة للطباعة

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

دوال مفيدة جدا للمبتدئين و المتوسطين - noor.aldeen.sha - 31-10-2013

السلام عليكم

قمت بجمع بعض الاكواد ذات الاهمية الكبيرة و قررت نشرها في هذا المنتدى حتى يستفيد الجميع

تحويل الكتابه عربي > أنكليزي وبالعكس
للتحويل إلى اللغة العربية :

كود :
LOADKEYBOARdlayout('00000401',klf_activate);

للتحويل إلى اللغة الإنكليزية :

كود :
LOADKEYBOARdlayout('00000409',klf_activate);

لكتابة الأصفار يسار العدد نستخدم الكود التالي :

كود :
label1.Caption := Format('%.*d', [10, 1456]);

تغيير خلفية سطح المكتب من الدلفي
إستخدم الإجراء التالي :

كود :
Uses
 Windows;
procedure ChangeWallpaper(Bitmap: string);
begin
 SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Pchar(Bitmap),
SPIF_UPDATEINIFILE);
end;

هذا الكود لجعل لون الفورم متدرج :

كود :
var
Row,Ht: word;
begin
Ht := (ClientHeight + 255) div 256;
For Row := 0 to 255 Do
With Canvas Do Begin
Brush.Color := Rgb(Row,0,0);
FillRect(Rect(0,Row*Ht,ClientWidth,(Row+1)*Ht));
end;

إخفاء و إظهار شريط المهام Taskbar

اضف هذا السطر إلي الـ private:

كود :
hTaskBar: HWND;

و في حدث انشاء النافذة (OnFormCreate) ضع الكود التالي :

كود :
hTaskBar := FindWindow('Shell_TrayWnd', nil);

لإخفاء شريط المهام :

كود :
ShowWindow(hTaskBar, SW_HIDE);

و لإظهار شريط المهام :

كود :
ShowWindow(hTaskBar, SW_SHOW);

قلب أزرار الماوس
من أجل قلب أزرار الماوس إستخدم
// تغيير زر الماوس الأيمن إلي الأيسر

كود :
SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP, 1, NIL, 0);

ومن أجل إعادتها إلى وضعها إستخدم

// إعادة أزرار الماوس إلي الوضع الطبيعي

كود :
SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP, 0, NIL, 0);

تشغيل برنامج أو ملف برمجيا من داخل تطبيقك :

كود :
uses shellapi;
// ...
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', PChar('c:\a.txt'), nil, nil, SW_SHOW);
// إستبدل إسم الملف
end;

لتعطيل زر إبدأ :

كود :
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn
d', nil),  0, 'Button', nil), false);

لتفعيل زر إبدأ :

كود :
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn
d', nil), 0, 'Button', nil), true);

إخفاء أيقونات سطح المكتب
بإستخدام الإجراء التالي :

كود :
procedure DisableIcons(b:boolean);
var
 
 wnd: HWND;
begin
 
 wnd := FindWindow('progman', nil);
 if wnd <> 0 then
 begin
   if b then
     ShowWindow(wnd, SW_SHOW)
   else
     ShowWindow(wnd, SW_HIDE);
   b := not(b);
 end
 else
   showmessage('Desktop not found');
end;

لإخفاء الأيقونات :

كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
 DisableIcons(false);
end;

لإظهار الأيقونات :

كود :
procedure TForm1.Button2Click(Sender: TObject);
begin
 DisableIcons(true);
 
end;

وضع برنامجك فوق التطبيقات .. في المقدمة دائماً :

كود :
Application.NormalizeTopMosts;
SetWindowPos(form1.Handle, HWND_TOPMOST, 0,0,0,0,
SWP_NOACTIVATE+SWP_NOMOVE+SWP_NOSIZE);

تنفيذ برنامج مع عدم ظهوره فى task bar :

كود :
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);

اكثر من سطر في الهنت :

كود :
Button1.Hint := 'First line' + chr(13) + 'Second line';

اوتو ستارت ... تشغيل تلقائي عند اعادة تشغيل النظام :

كود :
procedure SetAutoStart(AppName, AppTitle: string; bRegister: Boolean);
const
RegKey = '\Software\Microsoft\Windows\CurrentVersion\Run';
var
Registry: TRegistry;
begin
Registry := TRegistry.Create;
try
  Registry.RootKey := HKEY_LOCAL_MACHINE;
  if Registry.OpenKey(RegKey, False) then
  begin
    if bRegister = False then
      Registry.DeleteValue(AppTitle)
    else
      Registry.WriteString(AppTitle, AppName);
  end;
finally
  Registry.Free;
end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
SetAutoStart(ParamStr(0), 'TEST', True);
end;

التأكد من مسار محدد ان كان موجود او لا :

كود :
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 if DirectoryExists('c:\windows') then 
   ShowMessage('Path exists!'); 
end;

هذا الاجراء يجعلك تنقل مؤشر الفارة الى اي عنصر في النموذج

كود :
procedure SetCursorToControl(Control: TControl);
var pt: TPoint;
begin
 
pt:=Control.ClientToScreen(Point(0, 0));
SetCursorPos(pt.X, pt.Y)
 
end;

الحصول على جميع الملفات الموجودة في مجلد

كود :
procedure TForm1.Button1Click(Sender: TObject);
var
  SR : TSearchRec;
  S,sFilePattern : String;
 
Begin
sFilePattern := ExtractFileDir(ParamStr(0)) + '\*.*';
S := '';
if FindFirst(sFilePattern,faAnyFile,SR) = 0 then
  Begin
 
  while FindNext(sr) = 0 do
             memo1.Lines.Add(SR.Name);
      
  End;
 
End;

قلب ازر الماوس من اليمن الي اليسر

كود :
SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP, 1, NIL, 0);

إعادة أزرار الماوس الي مكان عليه

كود :
SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP, 0, NIL, 0);

اخفاء سطح المكتب

كود :
procedure Desktop(Desk:boolean);
begin
 
DID := FindWindow('progman', nil);
if DID <> 0 then
begin
 if Desk then
   ShowWindow(DID, SW_SHOW)
 else
   ShowWindow(DID, SW_HIDE);
 Desk := not(Desk);
end;
 
end

ثم عند أخفاء سطح المكتب

كود :
Desktop(False);

وعند أرجاع سطح المكتب

كود :
Desktop(True);

تقوم الدالة باغلاق الجهاز

كود :
ExitWindowsEx(EWX_LOGOFF or ewx_force,0);

هذه الدالة تقوم بإغلاق حميع العمليات مع المحافظة على بيانات التطبيق المستدعي للدالة

كود :
ExitWindowsEx(EWX_SHUTDOWN or ewx_force,0);

تقوم الدالة بوضع النظام في وضع امن بمعنى انها تقوم بتنظيف الذاكرة المؤقتة وحفظ البيانات على القرص الصلب وتقوم بإيقاف جمبع العمليات

كود :
ExitWindowsEx(EWX_REBOOT or ewx_force,0);

اعادة تشغيل النظام
CODE

كود :
ExitWindowsEx(EWX_FORCE or ewx_force,0);

تقوم العبارة التالية بإغلاق جميع التطلبقات بدون ترسل اليهم الرسائل

WM_QUERYENDSESSION و الWM_ENDSESSIO قد يؤدي هذا الى فقد البينات غير المحفوظة

كود :
ExitWindowsEx(EWX_POWEROFF or ewx_force,0);

اما العبارة التالية فتقوم بغلاق الجهاز مع قطع التلقائي للتيار الكهربائي

كود :
ExitWindowsEx(EWX_FORCEIFHUNG or ewx_force,0);