FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
function GetActiveWindowCaption: string; 
var 
  h : hwnd; 
  sz: Integer; 
begin 
  // Nous commençons par récupérer le handle de la fenêtre 
  // située au premier plan 
  h := GetForegroundWindow; 
  
  // Nous changeons la dimension de la chaîne de retour pour qu'elle puisse 
  // contenir le texte dont nous ne connaissons pas encore la longueur. 
  // 255 caractères paraissent suffisant dans cet exemple 
  SetLength(result, 255); 
  
  // Nous appelons la fonction afin d'obtenir le texte de la fenêtre 
  sz:= GetWindowText(h, PChar(result), 255); 
  
  // Nous redimensionnons la chaîne de retour pour éliminer les caractères en trop 
  SetLength(result, sz); 
end;

1
2
3
4
5
6
7
8
Const 
  { Définition du numéro de message} 
  PBM_SETBARCOLOR = WM_USER + 9; 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  { Envoi du message avec la couleur voulue} 
  SendMessage(ProgressBar1.Handle,PBM_SETBARCOLOR,0,clLime); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
{ 
   Retourne un nom de fichier absolu, aléatoire, dans le répertoire  
temporaire. Le fichier est créé, mais fermé. 
   Le préfixe (3 caractères max), optionnel,  sert à "isoler" les fichiers  
temporaires de son application des autres. 
   Si le répertoire temporaire n'est pas trouvé, ce sera le répertoire de  
l'application. 
} 
Function GetScratchName ( Const Prefix : String = 'TMP' ) : String    ; 
Var 
   Path, Name : Array[0..MAX_PATH] Of Char ; 
Begin 
     // Récupération du répertoire temporaire (éventuellement, celui de l'application). 
     If (GetTempPath(MAX_PATH,@Path)=0) Then 
        StrCopy(@Path,PChar(ExtractFileDir(Application.ExeName))); 
     // Création d'un fichier temporaire unique. 
     If (GetTempFileName(@Path,PChar(Prefix),0,@Name)=0) Then Result:=EmptyStr 
     Else Result:=String(@Name); 
End;

1
2
3
4
Var 
   FFrequency    : Int64    ;    // Fréquence du compteur hautes performances. 
   FStart, FStop : Int64    ;    // Valeurs du compteur au début et à la fin du chrono. 
   FElapsed      : Extended ;    // Durée finale, en secondes.

1
2
3
4
5
6
7
8
9
10
// Initialisation du compteur hautes performances, et début du chronométrage. 
If Not QueryPerformanceFrequency(FFrequency) Then 
   Raise Exception.Create('Pas de compteur hautes performances.'); 
QueryPerformanceCounter(FStart) ; 
  
// Insérer ici l'opération à chronométrer, ou un appel de fonction. 
  
// Fin de chronométrage, conversion du temps écoulé en secondes. 
QueryPerformanceCounter(FStop) ; 
FElapsed := (FStop-FStart)/FFrequency ;

1
2
3
4
5
6
7
Uses Windows ; 
  
// Requiert Delphi 4 ou supérieur, ou de réimplémenter des entiers 64 bits. 
function QueryPerformanceCounter(var lpPerformanceCount: TLargeInteger):  
BOOL; stdcall; external kernel32 name 'QueryPerformanceCounter'; 
function QueryPerformanceFrequency(var lpFrequency: TLargeInteger): BOOL;  
stdcall; external kernel32 name 'QueryPerformanceFrequency';

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function RunAndGetExitCode ( Const  
CommandLine : String ) : LongWord ; 
Var 
   StartupInfo : TStartupInfo; 
   ProcessInfo : TProcessInformation; 
Begin 
     FillChar(StartupInfo,SizeOf(StartupInfo),#0); 
     StartupInfo.cb := SizeOf(StartupInfo); 
     If Not CreateProcess( Nil, PChar(CommandLine), Nil, Nil, True, 0, Nil, Nil, StartupInfo, ProcessInfo) Then 
           RaiseLastOSError; 
     // Attente de la fin du processus. 
     WaitForSingleObject(ProcessInfo.hProcess, INFINITE); 
     // Récupération du code de sortie. 
     GetExitCodeProcess(ProcessInfo.hProcess,Result); 
End;

1
2
3
4
5
6
7
8
9
10
Function GetExitCode ( Const PID : LongWord  
) : LongWord ; 
Var 
   hApp     : THandle ; 
   ExitCode : LongWord  ; 
Begin 
     hApp:=OpenProcess(PROCESS_QUERY_INFORMATION,False,PID); 
     // Récupération du code de sortie. 
     GetExitCodeProcess(hApp,Result); 
End;

1
2
3
4
5
6
7
8
9
10
Program  
StopWithExitCode ; 
  
{$APPTYPE CONSOLE} 
  
Begin 
     // Cette instruction arrête le programme proprement, avec un code de sortie. 
     // Par convention, la valeur zéro est utilisée pour indiquer une sortie sans erreur. 
     Halt(3); 
End.

1
2
3
4
5
6
If CreateFile(....)=INVALID_HANDLE_VALUE Then 
   Begin 
   ErrorCode:=GetLastError; 
   // Traitement additionnel. 
   ShowMessage(SysErrorMessage(GetLastError)); 
   End;

1
2
Raise  
 Exception.Create(SysErrorMessage(GetLastError));

1
2
3
4
5
6
7
procedure TFormMain.btnHauteurBarreClick(Sender: TObject); 
Var 
  Rect: TRect; 
begin 
  SystemParametersInfo(SPI_GETWORKAREA, 0, @Rect, 0); 
  ShowMessage(IntToStr(Screen.Height - Rect.Bottom)); 
end;