أخر الأخبار

دروس حيل و أفكار في الدلفي - الجزء الثاني








السلام عليكم ورحمة الله و بركاته اخواني اخواتي متابعي مدونة مينا سوفت للبرمجة
عدنا بعد غياب طويل نوعا ما بحلة جديدة للمدونة اضافة الى مجموعة دروس جديدة من بينها دروس حيل و أفكار في الدلفي
أمور قد تظهر للعيان انها بسيطة و لكن هي جد مهمة للمبرمجين خاصة بالنسبة للمكونات
نبدأ على بركة الله مع الجزء الثاني


تحويل الكتابه عربي > أنكليزي وبالعكس


للتحويل إلى اللغة العربية:


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

للتحويل إلى اللغة الإنكليزية :
كود:
 LOADKEYBOARdlayout('00000409',klf_activate);

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

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



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

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;




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

 uses shellapi;
// ...
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', PChar('c:\a.txt'), nil, nil, SW_SHOW);
// إستبدل إسم الملف
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);







الحصول على تاريخ انشاء مجلد ما 
كود:

أولا نعرف التابع التالي:
function GetFolderDate(Folder: string): TDateTime;
var
Rec: TSearchRec;
Found: Integer;
Date: TDateTime;
begin
if Folder[Length(folder)] = '\' then
Delete(Folder, Length(folder), 1);
Result := 0;
Found := FindFirst(Folder, faDirectory, Rec);
try
if Found = 0 then
begin
Date := FileDateToDateTime(Rec.Time);
Result := Date;
end;
finally
FindClose(Rec);
end;
end;
ثم نضع زر و نكتب بداخله :
var
d: TDateTime;
begin
d := GetFolderDate('e:\fadi');
ShowMessage(FormatDateTime('dddd, d. mmmm yyyy, hh:mm:ss', d));
end;





الحصول على الوقت و التاريخ
كود:

قم بوضع MEMO لعرض التاريخ

ضع زر و اكتب بداخله :



var

lt : TSYSTEMTIME;

st : TSYSTEMTIME;

begin

GetLocalTime(lt);

GetSystemTime(st);

Memo1.Lines.Add('LocalTime = ' +

IntToStr(lt.wmonth) + '/' +

IntToStr(lt.wDay) + '/' +

IntToStr(lt.wYear) + ' ' +

IntToStr(lt.wHour) + ':' +

IntToStr(lt.wMinute) + ':' +

IntToStr(lt.wSecond));

Memo1.Lines.Add('UTCTime = ' +

IntToStr(st.wmonth) + '/' +

IntToStr(st.wDay) + '/' +

IntToStr(st.wYear) + ' ' +

IntToStr(st.wHour) + ':' +

IntToStr(st.wMinute) + ':' +

IntToStr(st.wSecond));

end;




لوضع عنوان انترنت في البرنامج ..~
كود:
اعمل تبديل على الموقع

****************lExecute(0, 'Open', 'http://le site point.com/faq/delphi/fqdph_index.php', nil, nil, SW_SHOWNORMAL);





هذا الكود لإصلاح وضغط قاعدة بيانات من نوع أكسيس 
كود:

uses
 ComObj;

function CompactAndRepair(DB: string): Boolean; {DB = Path to Access Database}
var 
 v: OLEvariant;
begin
 Result := True;
 try
   v := CreateOLEObject('JRO.JetEngine');
   try
     V.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB,
                       'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB+'x;Jet OLEDB:Engine Type=5');
     DeleteFile(DB);
     RenameFile(DB+'x',DB);
   finally
     V := Unassigned;
   end;
 except
   Result := False;
 end;
end;

تحويل الصورة من BMP إلى JPG 
كود:
أضف الوحدة JPEG :

uses JPEG

ثم ضع هذا الكود في المكان المناسب

var jpg:TJPEGImage;
begin
jpg:=TJPEGImage.Create;
with jpg do begin
Assign(Image1.Picture.Bitmap);
SaveToFile('my jpeg.jpg');
end;
end;




تشغيل نسخة واحدة من البرنامج 
كود:



program Project1;

uses
Forms,
Windows, 
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

var
HM: THandle;
function Check: boolean;
begin
HM := OpenMutex(MUTEX_ALL_ACCESS, false, 'MyOwnMutex');
Result := (HM <> 0);
if HM = 0 then
HM := CreateMutex(nil, false, 'MyOwnMutex');
end;

begin
if Check then
Exit;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.



تشغيل ملفات الفلاش في دلفي
كود:


تحتاج إلى تركيب أدات تشغيل الفلاش وذلك بالطريقة التالية :

1- من داخل دلفي توجه للقائمة Componenet وقم بإختيار Import ActiveX Control
2- ستظهر لك قائمة بجميع الـ ActiveX الموجودة في جهازك ، قم بإختيار Shockwave Flash
3- ثم قم بالضغط على الزر Install
4- سيقوم دلفي بإنشاء الملفات الخاصة بتشغيل الـActiveX ووضعها في الباكج الأفتراضيةdclusr.dpk
5- قم بعمل Compile للبكج ومن ثم Install

بعدها ستظهر في أدوات ActiveX أداة جديدة بإسم ShockwaveFlash


ثانياً : لتشغيل الـ Flash في الدلفي ضع الأداة على الـ Form ثم ضع في  الخاصية Movie اسم ملف الفلاش ومن ثم قم بتشغيل الملف بالأمر Play

ثالثاً : للتحكم في طريقة العرض ولإخفاء قائمة الفلاش والعديد من الأشياء استخدم المثال التالي

Delphi Code:

unit uMain;

interface

uses
Windows, Messages, Forms, ShockwaveFlashObjects_TLB,
AppEvnts, ExtCtrls, OleCtrls, Classes, Controls;

type
TForm1 = class(TForm)
ApplicationEvents1: TApplicationEvents;
Panel1: TPanel;
ShockwaveFlash1: TShockwaveFlash;
procedure FormShow(Sender: TObject);
procedure Panel1Resize(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);
begin
Panel1.Align:=alNone;

//I use this method to keep the Flash Screen
//full screen. When you set the Form1.borderstyle = bsNone
//then it will not do alClient alignment unless done this way.
with Panel1 do SetBounds(Left, Top, Width-1, Height-1);
with Panel1 do SetBounds(Left, Top, Width+1, Height+1);
Panel1.Align:=alClient;

ShockwaveFlash1.Play;
end;

procedure TForm1.Panel1Resize(Sender: TObject);
begin
//This is part of keeping the form aligned alClient.
ShockWaveFlash1.SetBounds(0,0,screen.width, screen.height);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//Escape closes the program.
if Key = VK_ESCAPE then
Close;
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if msg.message = WM_RBUTTONDOWN then
begin
//This removes the popupmenu from Macromedia Flash.
Handled := True;
end;
end;

end.




كيف أضيف عدد أيام إلى تاريخ معين .
كود:
uses
  DateUtils;
var
  Date1  : TdateTime;
  NbDay : Integer;
begin
  Date1 := EncodeDate(2010, 3, 1);
  Date1 := IncDay(Date1, NbDay);

حساب عدد الأيام بيت تاريخين :
كود:
uses
  DateUtils;
var
  Date1, Date2 : TDateTime;
  Diff : Extended;
  Day1, Month1, year1 : Word;
  day2, Month2, year2 : Word;
begin
  Date1 := EncodeDate(Year1, Month1, Day1);
  Date2 := EncodeDate(year2, Month2, Day2);
  Diff := DaysBetween(Date2, Date1); 
end;

 حساب عدد الأيام السنة لتاريخ معين :
كود:
uses
  DateUtils;
var
  Date1 : TDateTime;
  NumeroJ : Integer;
begin
  Date1 := Now; {Date système}
  NumeroJ := DayOfTheYear(Date1);
end;
4- حساب عدد الأسابيع السنة لتاريخ معين :

كود:


uses
  DateUtils;
var
  Date1 : TDateTime;
  NumSem : Word;
begin
  Date1 := EncodeDate(2002, 11, 1);
  NumSem := WeekOfTheYear(Date1);
end;

























تعليقات



حجم الخط
+
16
-
تباعد السطور
+
2
-