35. Empêcher la fermeture du programme avec ALT+F4
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:=FALSE;
end;
procedure TForm1.Button1Click(Sender:TObject);
var
handle: THandle;
begin
handle:=GetSystemMenu(Self.Handle,false);
RemoveMenu(handle, 8, mf_byposition);
RemoveMenu(handle, 7, mf_byposition);
RemoveMenu(handle, 6, mf_byposition);
RemoveMenu(handle, 5, mf_byposition);
end;
unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Buttons;
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
private
procedure WMSysCommand(VAR Message: TWMSysCommand); message WM_SYSCOMMAND;
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.DFM}
procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
begin
Inherited;
IF Message.CmdType = $F200 THEN form2.showmodal
end;
procedure TForm1.FormCreate(Sender: TObject);
var
s : string;
begin
s := '&Copyright...';
AppendMenu(GetSystemMenu(Handle, False), MF_STRING, $F200, PChar(s));
end;
43. convertir de l'ASCII en ANSI
procedure TForm1.Button1.Click(Sender:TObject);
var
asciistring:string;
ansistring: string;
begin
asciistring:='äöü';
OEMtoChar(PChar(asciistring), PChar(ansistring));
end;
44. Ouvrir la boite de dialogue formater
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Application.Handle,Pchar('Open'),Pchar('C:\Windows\Rundll32.exe'),Pchar('
Shell32.dll,SHFormatDrive'),Pchar('C:\Windows'),SW_SHOWNORMAL);
end;
45. Extraire le jour, le mois et l'année à partir d'un TDate
procedure TForm1.Button1Click(Sender: TObject);
begin
DecodeDate(Date,Xyr,Xmo,Xday);
B1.Caption:=IntToStr(Xyr);
B2.Caption:=IntToStr(Xmo);
B3.Caption:=IntToStr(Xday);
end;
uses mmsystem;
PlaySound(pChar('SYSTEMSTART'),0,SND_ASYNC);
Autres sons système
SYSTEMSTART
SYSTEMEXIT
SYSTEMHAND
SYSTEMASTERISK
SYSTEMQUESTION
SYSTEMEXCLAMATION
SYSTEMWELCOME
SYSTEMDEFAULT
uses shellapi;
Shellexecute(handle,'open','notepad.exe','',nil,sw_shownormal);
ou
WinExec('C:\Windows\notepad.exe',SW_Show);
48. Lancer un programme et attendre qu'il soit chargé
procedure TForm1.Button1Click(Sender: TObject);
var
StartupInfo: TStartupinfo;
ProcessInfo: TProcessInformation;
begin
FillChar(Startupinfo,Sizeof(TStartupinfo),0);
Startupinfo.cb:=Sizeof(TStartupInfo);
if CreateProcess(nil,'pbrush.exe',nil,nil,false,normal_priority_class,nil,'c:\windows',Startupinfo,ProcessInfo) then
begin
WaitforSingleObject(Processinfo.hProcess, infinite);
CloseHandle(ProcessInfo.hProcess);
ShowMessage('Program closed');
end;
end;
49. Utiliser les paramètres pour le programme
Paramstr(1) est le premier paramètre transmis
Paramstr(0) répertoire de l'application
procedure TForm1.FormShow(Sender: TObject);
var
parameter:string;
begin
parameter:=Paramstr(1);
if parameter='/message' then
begin
ShowMessage('Parameter /message');
end;
if parameter='' then
begin
ShowMessage('No parameter');
end;
end;
50. Formater la date et l'heure dans un string
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:=FormatDatetime('d. mmmm yyyy hh:mm:ss', Now);
end;
51. Programmer un Timer multimédia
uses mmsystem;
var
fid:Integer;
procedure TimeCallBack(TimerID, Msg:Uint; dwUser, dw1, dw2: DWord); pascal;
begin
//Do something here
//This procedure will executed each 10 ms
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;
52. Faire clignoter l'application dans la barre des tâches
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;
53. Geler l'affichage de l'écran
//Geler
LockWindowUpdate(form1.Handle);
//Actualiser
LockWindowUpdate(0)
62. Empêcher
la fermeture d'une Form avec la croix
procedure TForm1.FormCreate(Sender:
TObject);
begin
EnableMenuItem( GetSystemMenu(
Form1.Handle, LongBool(False)),
SC_CLOSE, MF_BYCOMMAND or
MF_GRAYED);
end;
Note: La form peut toujours être
fermée avec Alt-F4
68. Formater les messages d'erreur
var
lpMsgBuf :
PChar;
...
FormatMessage(
FORMAT_MESSAGE_ALLOCATE_BUFFER
OR
FORMAT_MESSAGE_FROM_SYSTEM,
nil, GetLastError(), 0, @lpMsgBuf, 0, nil );
Application.MessageBox(lpMsgBuf,0,0);
71. Forcer une fenêtre à passer en premier plan
Windows 98/2000 doesn't want to foreground a window when some
other
window has the keyboard focus.
ForceForegroundWindow is
an enhanced SetForeGroundWindow function.
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 }
72. Désactiver l'écran de veille dans vos applications
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;
76. Savoir
lorsque l'utilisateur change de CD
type
TForm1 = class(TForm)
private
procedure WMDeviceChange(var Msg:
TMessage);
message WM_DEVICECHANGE;
public
end;
{...}
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;