دخول

nabilkeb · 23-10-2009, 01:00 PM

47- اظهار التاريخ و الوقت على نمودج مختار :

كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
 Label1.Caption:=FormatDatetime('d. mmmm yyyy hh:mm:ss', Now);
end ;

48- برمجة Timer (أي شيء موقت)
Uses: mmsystem

كود :
var
  Form1: TForm1;
  fid:Integer;
implementation
{$R *.dfm}
procedure TimeCallBack(TimerID, Msg:Uint; dwUser, dw1, dw2: DWord); pascal;
begin
  //Do something here
  //This procedure will executed each 10 ms  , for example
  form1.Label1.Caption:=form1.Label1.Caption+'%';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  TimeKillEvent(fid);
end;

//Set a new timer with a delay of 10 ms
procedure TForm1.Button1Click(Sender: TObject);
begin
  fid:=TimeSetEvent(10,0,@TimeCallBack,0,TIME_PERIODIC);
end;
end.

49- جعل البرنامج يرمش على شريط المهام (تنبيه):

كود :
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if timer1.tag = 0 then  begin
    flashwindow(application.handle, false);
    timer1.tag := 1;
  end
  else
  begin
    flashwindow(application.handle, true);
    timer1.tag := 0;
  end;
end;

يمكن تعديل المدة على الخاصية : Interval للتايمر.

50- تمكين و تعطيل زر الإغلاق على شريط نافذة البرنامج (برمجيا) :

كود :
procedure TForm1.FormCreate(Sender: TObject); 
begin
  EnableMenuItem( GetSystemMenu( Form1.Handle, LongBool([COLOR=Blue]false[/COLOR])),
  SC_CLOSE, MF_BYCOMMAND or MF_GRAYED);
end;

51- الصياغة و التحكم برسائل الخطأ:

كود :
procedure TForm1.Button1Click(Sender: TObject);
var
lpMsgBuf : PChar;
begin
FormatMessage(
FORMAT_MESSAGE_ALLOCATE_BUFFER OR FORMAT_MESSAGE_FROM_SYSTEM,
nil, GetLastError(), 0, @lpMsgBuf, 0, nil );
Application.MessageBox(lpMsgBuf,0,0);
end;

52- اجبار الفورم أن تظهر الأولى فوق البقية _en premier plan )
-

كود :
function ForceForegroundWindow(hwnd: THandle): boolean;
const
  SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
  SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
var
  ForegroundThreadID: DWORD;
  ThisThreadID : DWORD;
  timeout : DWORD;


begin
  if IsIconic(hwnd) then ShowWindow(hwnd, SW_RESTORE);
  if GetForegroundWindow = hwnd then Result := true
  else begin

// Windows 98/2000 doesn't want to foreground a window when some other
// window has keyboard focus

  if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4)) or
  ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
  ((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and
  (Win32MinorVersion > 0)))) then
   begin

// Code from Karl E. Peterson, www.mvps.org/vb/sample.htm
// Converted to Delphi by Ray Lischner
// Published in The Delphi Magazine 55, page 16

    Result := false;
    ForegroundThreadID :=
    GetWindowThreadProcessID(GetForegroundWindow,nil);
    ThisThreadID := GetWindowThreadPRocessId(hwnd,nil);
    if AttachThreadInput(ThisThreadID, ForegroundThreadID, true) then
    begin
    BringWindowToTop(hwnd); // IE 5.5 related hack
    SetForegroundWindow(hwnd);
    AttachThreadInput(ThisThreadID, ForegroundThreadID, false);
    Result := (GetForegroundWindow = hwnd);
    end;
    if not Result then begin

// Code by Daniel P. Stasinski

     SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
     SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0),
     SPIF_SENDCHANGE);
     BringWindowToTop(hwnd); // IE 5.5 related hack
     SetForegroundWindow(hWnd);
     SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0,
     TObject(timeout), SPIF_SENDCHANGE);
   end;
  end
  else begin
    BringWindowToTop(hwnd); // IE 5.5 related hack
  SetForegroundWindow(hwnd);
  end;

  Result := (GetForegroundWindow = hwnd);
  end;
end; { ForceForegroundWindow }

53- تعطيل شاشة التوقف في تنفيد برنامجك :

كود :
interface
...
private
procedure AppMessage(var msg: TMsg; var handled: boolean);
...
implementation
...
procedure TForm1.AppMessage(var msg : TMsg; var handled : boolean);
begin
if (Msg.Message = WM_SYSCOMMAND) and (Msg.wParam = SC_SCREENSAVE) then
    Handled := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;

54- اخبارك إذا كان المستخدم غير القرص المضغوط
(اخراج أو ادخال_ و لا يتعلق الأمر بفتح و اغلاق قارئ الأقراص بدون القرص) :

كود :
type
  TForm1 = class(TForm)
  private
    { Déclarations privées }
        procedure WMDeviceChange(var Msg: TMessage);
              message WM_DEVICECHANGE;


  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}
procedure TForm1.WMDeviceChange (var Msg: TMessage);
const
  CD_IN  = $8000;
  CD_OUT = $8004;
var
  myMsg : String;
begin
   inherited;
   case Msg.wParam of
     CD_IN  : myMsg := 'CD inserted!';
     CD_OUT : myMsg := 'CD removed!';
   end;
   ShowMessage(myMsg);
end;

end.

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة