FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
begin 
  Application.Initialize; 
  SplashScreen := TSplashScreen.Create(Application); { Création la fenêtre de Splash               } 
  SplashScreen.Show;                                 { Affichage de cette fenêtre                  } 
  SplashScreen.Update;                               { forçage de l'affichage de la fenêtre        } 
    { sinon elle n'apparaît que partiellement     } 
  Application.CreateForm(TForm1, Form1);             { Création des autres fiches de l'application } 
  SplashScreen.Close;                                { Fermeture la fenêtre de Splash              } 
  SplashScreen.Release;                              { Destruction de la fenêtre                   } 
  Application.Run; 
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
{...} 
type 
  TSplashForm = class(TForm) 
    {...} // Les composants de votre form 
    procedure FormCreate(Sender: TObject); 
    procedure FormPaint(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    {...} 
  private 
    FImageDeFond : TBitmap; 
  {...} 
  end; 
  
var 
  SplashForm: TSplashForm; 
  
implementation 
  
{$R *.dfm} 
  
{...} 
  
procedure TSplashForm.FormCreate(Sender: TObject); 
begin 
  //Pour connaître la version de Windows, il faut utiliser Win32MajorVersion et Win32MinorVersion 
  //Dans ce cas, il suffit d'utiliser Win32MajorVersion Win95, 98 et ME ont tous pour version majeure 4 
  if Win32MajorVersion = 4 then 
    begin 
      FImageDeFond := TBitmap.Create; 
      FImageDeFond.width := Screen.width; 
      FImageDeFond.height := Screen.height; 
      FImageDeFond.canvas.CopyRect(ClientRect, Canvas, ClientRect); 
    end; 
end; 
  
procedure TSplashForm.FormPaint(Sender: TObject); 
begin 
  //Remplacement du fond de la fenêtre par l'image capturée 
  if Win32MajorVersion = 4 then 
      4 : canvas.CopyRect(ClientRect, FImageDeFond.Canvas, ClientRect); 
end; 
  
procedure TSplashForm.FormDestroy(Sender: TObject); 
begin 
  //TOUJOURS détruire ses objets 
  if Win32MajorVersion = 4 then 
    FImageDeFond.Free; 
end; 
{...}

1
2
3
4
5
6
7
8
9
10
11
12
13
program Project1; 
  
uses 
  Forms, 
  Unit1 in 'Unit1.pas' {Form1}; 
  
{$R *.RES} 
  
begin 
  Application.Initialize; 
  Application.CreateForm(TForm1, Form1); 
  Application.Run; 
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
program Project1; 
  
uses 
  Windows, Forms, 
  Unit1 in 'Unit1.pas' {Form1}; 
  
{$R *.RES} 
var 
H : THandle; 
Erreur: Integer; 
begin 
  SetLastError(NO_ERROR); 
  H := CreateMutex (nil, False, 'Nom de l application'); 
  Erreur := GetLastError; 
  if ( Erreur = ERROR_ALREADY_EXISTS ) or ( Erreur = ERROR_ACCESS_DENIED ) 
    then Exit; 
  Application.Initialize; 
  Application.CreateForm(TForm1, Form1); 
  Application.Run; 
  CloseHandle(H); 
end.

1
2
3
4
5
6
7
8
9
10
11
begin  
  if IsPrevInstance = 0 then  
  begin  
    Application.Initialize;  
    Application.CreateForm(TMDIForm, MDIForm);  
//[...]  
    Application.Run;  
  end  
  else  
    AfficherInstance(IsPrevInstance);  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
function IsPrevInstance: HWND;  
var  
  ClassName: array[0..255] of char;  
  Title: string;  
begin  
  Title := Application.Title;  
  Application.Title := '';  
  { On change le titre, car on trouverait toujours une application lancée, (la notre). } 
  try  
    GetClassName(Application.Handle, ClassName, 255);  
    { Met dans ClassName le nom de la classe de l'application. } 
    Result := FindWindow(ClassName, PChar(Title));  
    { Renvoie le Handle de la 1ère fenêtre de Class (Type) ClassName, et le titre de l'application. } 
  finally  
    Application.Title := Title; { Restauration du vrai titre. } 
  end;  
end;  
  
procedure AfficherInstance(InstHandle: HWND); 
begin 
  { Restaurer l'application si minimisée } 
  ShowWindow(InstHandle, SW_RESTORE); 
  { Mettre la première instance en premier plan : } 
  SetForegroundWindow(InstHandle); 
  { Fin de la deuxième instance } 
  Application.Terminate; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Application.Initialize; 
Application.CreateForm(TForm1, Form1); 
  
Registre := TRegistry.Create; 
try 
  Registre.RootKey := HKEY_CLASSES_ROOT; 
  Registre.OpenKey('\Software\nom_de_la_clé', True); 
  Registre.WriteInteger('FirstApplicationHandle', Application.Handle); 
  Registre.WriteInteger('FirstFormHandle', Form1.Handle); 
  Registre.CloseKey; 
  Registre.Free; 
except 
  MessageDlg('Une erreur est survenue lors de l''écriture dans la base de registre.', 
    mtError, [mbOk], 0); 
  Registre.Free; 
end; 
  
Application.Run;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Registre := TRegistry.Create; 
try 
  Registre.RootKey := HKEY_CLASSES_ROOT; 
  Registre.OpenKey('\Software\nom_de_la_clé', True); 
  FirstApplicationHandle := Registre.ReadInteger('FirstApplicationHandle'); 
  FirstFormHandle := Registre.ReadInteger('FirstFormHandle'); 
  ShowWindow(FirstApplicationHandle, SW_NORMAL); 
  SetForegroundWindow(FirstFormHandle); 
  Registre.CloseKey; 
  Registre.Free; 
except 
  MessageDlg('Une erreur est survenue lors de la lecture dans la base de registre.', 
    mtError, [mbOk], 0); 
  Registre.Free; 
end;

1
2
3
4
5
6
7
8
9
  
var 
  Tc: Cardinal; 
begin 
  Tc := GetTickCount; 
  repeat 
    Application.ProcessMessages; 
  until Cardinal(GetTickCount - Tc) > {Temps d'attente en ms}; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
type 
  TForm1 = class(TForm) 
    ... 
  private 
    { Déclarations privées } 
    Stop : Boolean; 
    ... 
  end; 
... 
  
procedure TForm1.BoutonMarcheClick(Sender: TObject); 
Var i:Integer; 
begin 
  { Mise à faux de l'arrêt } 
  Stop := False; 
  I    := 0; 
  { Traitement long } 
  Repeat 
    Inc(i); 
    Label1.Caption := IntToStr(i); 
    { Mise à jour des évènements en attente } 
    Application.ProcessMessages; 
  Until (i>=100000000)Or Stop; 
end; 
  
procedure TForm1.BoutonStopClick(Sender: TObject); 
begin 
  { Demande d'arrêt de la boucle } 
  Stop:=True; 
end;

1
2
3
4
5
6
var 
  i: Integer; 
begin 
  for i := 1 to ParamCount do 
    MyListBox.Items.Append(ParamStr(i)); 
end;

1
2
function ShellExecute(hWnd: HWND; Operation, FileName, Parameters, 
Directory: PChar; ShowCmd: Integer): HINST; stdcall;

uses [...], ShellApi;

ShellExecute(0,PChar('open'),...)

ShellExecute(0,'open',...)

ShellExecute(0,'OPEN','Wordpad.exe', Nil, Nil, SW_SHOW);

1
2
3
4
ShellExecute(0,'OPEN','Wordpad.exe','C:\temp\essai.txt',Nil, SW_SHOW); 
  
// Exécution de la commande système "ipconfig /all" 
ShellExecute(Application.Handle,'open','ipconfig','/all',nil,SW_SHOW);

ShellExecute(0,'EXPLORE','C:\MonRépertoire\', Nil, Nil, SW_SHOW);

ShellExecute(0,'OPEN','C:\Temp\Monfichier.txt', Nil, Nil, SW_SHOW);

ShellExecute(0,'PRINT','C:\Temp\Monfichier.doc', Nil, Nil, SW_SHOW);

ShellExecute(Application.handle, 'find', 'c:\temp', Nil, Nil, SW_SHOWNORMAL);

1
2
3
4
5
6
7
ShellExecute( 
Application.Handle, 
'open', 
PChar(GetEnvironmentVariable('ComSpec')), 
'/C batch.bat -param1 -param2', 
'c:\bin', 
SW_SHOW);

1
2
3
4
5
6
7
ShellExecute( 
Application.Handle, 
'open', 
PChar(GetEnvironmentVariable('ComSpec')), 
'/C c:\bin\batch.bat -param1', 
'c:\travail', 
SW_SHOW);

1
2
3
4
5
6
7
ShellExecute( 
Application.Handle, 
'open', 
'C:\Program Files\Microsoft IntelliPoint\dplaunch.exe', 
'Mouse CPL', 
'C:\Program Files\Microsoft IntelliPoint\', 
SW_SHOW);

ShellExecute(0,nil, PChar(GetEnvironmentVariable('ComSpec')), PChar('/C Net View > Resultat.txt'), nil, 0);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Var 
Code : Cardinal ; 
Begin 
// On appelle ShellExecute "normalement". 
Code := ShellExecute (.....) ; 
  
// Ensuite, on vérifie si l'exécution a été correcte : 
// Deux méthodes possibles : avec ou sans exceptions. 
If (Code<=32) Then 
// Affichage du message d'erreur "propre", sans exceptions. 
// Le résultat de SysErrorMessage est une chaîne normale, dans la langue de l'OS. 
ShowMessage(SysErrorMessage(Code)); 
  
If (Code<=32) Then 
// Affichage du message d'erreur "hard", AVEC levée d'exception. 
// Remplacer par RaiseLastWin32Error sur les anciennes versions de Delphi. 
RaiseLastOSError; 
End;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
procedure TForm1.Button1Click(Sender: TObject); 
var 
  StartupInfo: TStartupInfo; 
  ProcessInfo: TProcessInformation; 
  CommandLine: {$IFDEF UNICODE}WideString{$ELSE}string{$ENDIF}; 
  
begin 
  CommandLine := '"Notepad.exe"'; 
  
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); 
  StartupInfo.cb := SizeOf(StartupInfo); 
  
  if CreateProcess(nil, PChar(CommandLine), nil, nil, FALSE, 0, nil, nil, StartupInfo, ProcessInfo) then 
  begin 
    repeat 
      Application.ProcessMessages; 
    until WaitForSingleObject(ProcessInfo.hProcess, 200) <> WAIT_TIMEOUT; 
  
    CloseHandle(ProcessInfo.hProcess); 
    CloseHandle(ProcessInfo.hThread); 
  
    ShowMessage('Terminé'); 
  end 
  else RaiseLastOSError; 
end;

  CommandLine := '"Notepad.exe" "C:\temp\essai.txt"';

  CommandLine := '"C:\MesProg\MonAppli.exe"';

1
2
3
4
5
6
7
var 
  monhandle : THandle; 
Begin 
  //Le second paramètre de FindWindow est le titre de la fenêtre! 
  monhandle := FindWindow(nil,'Calculatrice'); 
  SendMessage(monhandle,WM_CLOSE,0,0); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
procedure RegWriteRunApp(Path: string);  
var  
Reg: TRegistry;  
begin  
Reg := TRegistry.Create;  
try  
  with Reg do begin  
  RootKey := HKEY_CURRENT_USER; // A l'ouverture d'une session d'un utilisateur 
  // RootKey := HKEY_LOCAL_MACHINE; // A l'ouverture d'une session de chaque utilisateurs 
  if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', False) 
  then WriteString('MonAppli', Path);  
  end;  
finally  
  Reg.Free;  
end;  
end;

1
2
3
4
5
6
7
8
9
10
11
12
tagPROCESSENTRY32 = packed record 
    dwSize: DWORD;               // taille de l'enregistrement 
    cntUsage: DWORD;             // Compteur de référence du process, si zéro le process se termine. 
    th32ProcessID: DWORD;        // Identifiant du process 
    th32DefaultHeapID: DWORD;    // Identifiant de la pile par défaut du process 
    th32ModuleID: DWORD;         // Identifiant du module du process 
    cntThreads: DWORD;           // Nombre de thread du process 
    th32ParentProcessID: DWORD;  // Identifiant du process parent ( 'son créateur' ) 
    pcPriClassBase: Longint; // Priorité de base des threads crée par ce process 
    dwFlags: DWORD;              // Réservé 
    szExeFile: array[0..MAX_PATH - 1] of Char; // le nom de l'exécutable. 
  end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
uses TLHelp32; 
  
function ExeRunning(NomApplication : string; StopProcess:Boolean):Boolean; 
// Teste si une application est en cours d'exécution 
// StopProcess indique si on termine l'application 'NomApplication' 
  
// Code proposé par Thunder_nico 
  
var 
  ProcListExec : TProcessentry32; 
  PrhListExec : Thandle; 
  Continu : Boolean; 
  isStarted : Boolean; 
  HandleProcessCourant : Cardinal;    
  PathProcessCourant : string; 
  ProcessCourant :String; 
  
begin 
  // Liste des applications en cours d'exécution 
  // Initialisation des variables et récuperation de la liste des process 
  ProcListExec.dwSize:=sizeof(ProcListExec); 
  Continu := True; 
  isStarted := False; 
  
Try 
  // Récupére la liste des process en cours d'éxécution au moment de l'appel 
  PrhListExec:=CreateToolhelp32Snapshot(TH32CS_SNAPALL,0); 
  if (PrhListExec <> INVALID_HANDLE_VALUE) 
    then 
      begin 
        //On se place sur le premier process 
        Process32First(PrhListExec,ProcListExec); 
  
        // Tant que le process recherché n'est pas trouvé et qu'il reste 
        // des process dans la liste, on parcourt et analyse la liste 
        while Continu do 
          begin 
            ProcessCourant := Uppercase(ExtractFileName(ProcListExec.szExeFile)); 
            ProcessCourant := ChangeFileExt(ProcessCourant,''); 
            isStarted := (ProcessCourant = Uppercase(NomApplication)); 
            if isStarted then 
              begin 
                HandleProcessCourant := ProcListExec.th32ProcessID; 
                PathProcessCourant := ExtractFilepath(ProcListExec.szExeFile); 
                Continu := False; 
              end 
            else // Recherche le process suivant dans la liste 
              Continu := Process32Next(PrhListExec,ProcListExec); 
      end; 
  
    if StopProcess 
      then 
        if isStarted then 
          begin  // Termine le process en indiquant le code de sortie zéro 
            TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,HandleProcessCourant),0); 
            Sleep(500); // Laisse le temps au process en cours de suppression de s'arrêter 
          end; 
  end; 
Finally 
  CloseHandle(PrhListExec); // Libère les ressources 
  Result := isStarted; 
end; 
  
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
  
type  
  TForm1 = class(TForm)  
  private  
    { Déclarations privées }  
  public  
    procedure WMPowerBroadcast(var Msg: TMessage); message WM_POWERBROADCAST;  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.dfm}  
  
procedure TForm1.WMPowerBroadcast(var Msg: TMessage);  
const  
  PBT_APMQUERYSUSPEND = $0000;  
begin  
  if Msg.wParam = PBT_APMQUERYSUSPEND then  
    Msg.Result := BROADCAST_QUERY_DENY;  
end;  
  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
procedure TForm1.Devant; 
Var Proc,Nous:Integer; 
begin 
  Proc:=GetWindowThreadProcessId(GetForeGroundWindow); 
  Nous:=GetCurrentThreadID; 
  If Proc<>Nous Then 
  Begin 
    // Nous ne sommes pas l'application en premier plan 
    AttachThreadInput(Nous,Proc,True); 
    SetForeGroundWindow(Handle); 
    AttachThreadInput(Nous,Proc,False); 
    Application.BringToFront; 
  End Else 
  Begin 
    // Nous sommes déjà en premier plan 
    SetForeGroundWindow(Handle); 
  End; 
end;

1
2
3
4
5
6
//La syntaxe de la fonction est strictement identique à celle de la procédure "Format". 
  
Procedure DebugPrintFmt ( Const FmtString : String ; Const Args : Array Of Const ) ; 
Begin 
  OutputDebugString(PAnsiChar(Format(FmtString,Args))); 
End;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
function KillProcess(const ProcessName : string) : boolean; 
var ProcessEntry32 : TProcessEntry32; 
    HSnapShot : THandle; 
    HProcess : THandle; 
begin 
  Result := False; 
  
  HSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); 
  if HSnapShot = 0 then exit; 
  
  ProcessEntry32.dwSize := sizeof(ProcessEntry32); 
  if Process32First(HSnapShot, ProcessEntry32) then 
  repeat 
    if CompareText(ProcessEntry32.szExeFile, ProcessName) = 0 then 
    begin 
      HProcess := OpenProcess(PROCESS_TERMINATE, False, ProcessEntry32.th32ProcessID); 
      if HProcess <> 0 then 
      begin 
        Result := TerminateProcess(HProcess, 0); 
        CloseHandle(HProcess); 
      end; 
      Break; 
    end; 
  until not Process32Next(HSnapShot, ProcessEntry32); 
  
  CloseHandle(HSnapshot); 
end;

1
2
3
4
5
6
HProcess := OpenProcess(PROCESS_TERMINATE, False, ProcessEntry32.th32ProcessID); 
if HProcess <> 0 then 
begin 
  Result := TerminateProcess(HProcess, 0) or Result; 
  CloseHandle(HProcess); 
end;

1
2
3
const 
  LOGON_WITH_PROFILE = 1; 
  LOGON_NETCREDENTIALS_ONLY = 2;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
procedure runas(sUser, sDomain, sPassword : WideString); 
var 
  wUsername, wDomain, wPassword, wApplicationName: WideString; 
  pwUsername, pwDomain, pwPassword, pwApplicationName: PWideChar; 
  StartupInfo: TStartupInfo; 
  ProcessInfo: TProcessInformation; 
begin 
  wUsername := sUser ; 
  wDomain := sDomain; 
  wPassword := Spassword; 
  wApplicationName := sExecutable ; 
  pwUsername := Addr(wUsername[1]); 
  pwDomain := Addr(wDomain[1]); 
  pwPassword := Addr(wPassword[1]); 
  pwApplicationName := Addr(wApplicationName[1]); 
  
  FillChar(StartupInfo, SizeOf(StartupInfo), 0); 
  StartupInfo.cb := SizeOf(StartupInfo); 
  try 
  if not CreateProcessWithLogon(pwUsername,pwDomain,pwPassword,LOGON_NETCREDENTIALS_ONLY, 
nil,pwApplicationName,CREATE_DEFAULT_ERROR_MODE, 
nil,nil,StartupInfo,ProcessInfo) then 
    RaiseLastOSError; //En cas d'erreur, donne des détails sur l'erreur 
end;

function CreateProcessWithLogon; external 'advapi32.dll' name 'CreateProcessWithLogonW';

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
  
(******************************************************************************) 
(* Fonction pour determiner la version de Windows                             *) 
(* Renvoi True si version Windows NT,2000,XP, sinon renvoit False             *) 
(******************************************************************************) 
  
Function DetermineVersionWindows: Boolean;  
begin 
//Fonctionne pour les versions de Windows autre que 95, 98 et Millenium 
Result := True; 
case Win32MajorVersion of 
//   3: Microsoft Windows NT 3.51 
    4: case Win32MinorVersion of 
0:  case Win32Platform of 
  //   1: Microsoft Windows 95 ou Microsoft Windows 95 OSR2 
      2: Result:= True; 
    else 
      Result:= False; 
    end; 
10, 90: Result := False;          
      else 
Result:= False; 
      end; 
    5: case Win32MinorVersion of //2000, XP et 2003 
0, 1, 2:  Result:= True; 
      else 
Result:= False; 
      end; 
  else 
    Result:= False; 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
  
(******************************************************************************) 
(* Fonction pour désactiver ou activer le gestionnaire de tâches lors de       *) 
(* l'appui sur CTRL + ALT + SUPPR                                              *) 
(* Passer TRUE dans le paramètre Desactiver pour désactiver le gestionnaire   *) 
(* de tâches et sinon passer FALSE pour le réactiver                           *) 
(******************************************************************************) 
  
procedure ActiverDesactiverTaskManager(Desactiver: Boolean); 
var 
  OldVal : Longint; 
  Reg    : Tregistry; 
begin 
  if Desactiver = True then 
  // Désactiver le gestionnaire de tache 
  begin 
    if DetermineVersionWindows then 
    // Cas des versions Windows NT,2000,XP 
    begin 
      reg := TRegistry.Create; 
      reg.RootKey := HKEY_CURRENT_USER; 
      // Test pour savoir si la clé de l'utilisateur courant existe 
      if reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\System', False) then 
      begin 
reg.WriteString('DisableTaskMgr', '1'); 
      end 
      else 
      // Sinon création dans la clé Machine. 
      begin 
reg.RootKey := HKEY_CURRENT_USER; 
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\System', True); 
reg.WriteString('DisableTaskMgr', '1'); 
      end; 
      reg.CloseKey; 
    end 
    else 
    // Cas des versions Windows 95,98,Me 
    begin 
      SystemParametersInfo(SPI_SCREENSAVERRUNNING, word(True), @OldVal, 0); 
    end; 
  end 
  else 
  // Réactiver le gestionnaire de tache 
  begin 
    if DetermineVersionWindows then 
    // Cas des versions Windows NT,2000,XP 
    begin 
      reg := TRegistry.Create; 
      reg.RootKey := HKEY_CURRENT_USER; 
      // Test pour savoir si la clé de l'utilisateur courant existe 
      if reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\System', False) then 
      begin 
reg.DeleteValue('DisableTaskMgr'); 
      end 
      else 
      // Sinon création dans la clé Machine. 
      begin 
reg.RootKey := HKEY_CURRENT_USER; 
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\System', True); 
reg.DeleteValue('DisableTaskMgr'); 
      end; 
      reg.CloseKey; 
    end 
    else 
    // Cas des versions Windows 95,98,Me 
    begin 
      SystemParametersInfo(SPI_SCREENSAVERRUNNING, word(False), @OldVal, 0); 
    end; 
  end; 
end;

1
2
  
AfficheForm(Application.Handle);

1
2
3
4
5
6
  
procedure AfficheForm(AppHandle: THandle); 
begin 
  Application.Handle := AppHandle; 
  { Code de la procédure } 
end;

1
2
3
4
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Form1.Position := poScreenCenter; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
procedure CenterWnd(const Wnd: HWND);  
var  
  R: TRect;  
  SW, SH, W, H: Integer;  
begin  
  SW := GetSystemMetrics(SM_CXSCREEN);  
  SH := GetSystemMetrics(SM_CYSCREEN);  
  GetWindowRect(Wnd, R);  
  W := R.Right - R.Left;  
  H := R.Bottom - R.Top;  
  R.Left := (SW - W) div 2;  
  if R.Left < 0 then R.Left := 0;  
  R.Top := (SH - H) div 2;  
  if R.Top < 0 then R.Top := 0;  
  MoveWindow(Wnd, R.Left, R.Top, W, H, True);  
end;

1
2
3
4
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Form1.WindowState := wsMaximized; 
end;

1
2
3
4
5
  
if (GetKeyState(VK_CAPITAL) and 1) = 0 then  
begin  
  //Traitement...  
end;

IF ShellExecute(Handle,'print','MON_FICHER.PDF',nil,nil,SW_HIDE) <=32 THEN ShowMessage(SysErrorMessage(GetLastError));

1
2
IF ShellExecute(Handle, nil,'acrord32.exe', '/t "D:\DOCUMENTATIONS\fortran.pdf"',nil,SW_HIDE) <= 32 THEN  
    ShowMessage(SysErrorMessage(GetLastError));

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
  
procedure TForm1.CapteInfoControl; 
var WText,ClassName      : Array[0..255] of Char; 
    KeyIndex             : array [0..255] of boolean; 
    NewMousePos,MousePos : Tpoint; 
    HD                   : Hwnd; 
    P                    : Integer; 
    Capt                 : boolean; 
  
begin 
// initialisation 
Fin:=false; 
Capt:=true; 
for P:=0 to 255 do KeyIndex[P]:=false; 
  // boucle de traitement 
repeat 
    // récupération des coordonnées souris 
  if (GetCursorPos(NewMousePos)) and 
      ((NewMousePos.X <> MousePos.X) or (NewMousePos.Y <> MousePos.Y)) then 
      begin 
MousePos:=NewMousePos; 
  
//récupération des information du contrôle 
Hd:=WindowFRomPoint(NewMousePos); 
GetWindowText(hd,WText,SizeOf(WText)); 
GetClassName(hd,ClassName,SizeOf(ClassName)); 
  
//Affichage 
label1.caption:=strfmt('Handle du contrôle : %g - Texte du contrôle: %s  - Classe du contrôle : %s',[Hd,String(WText), 
String(ClassName)]); 
Application.ProcessMessages; 
      end; 
  
    // récupération des états des touches 
    for P:=0 to 255 do KeyIndex[P]:=GetAsyncKeyState(P) <> 0; 
  
    // stocke les informations du contrôle [ClickGauche(1)]+[shift(16)] 
    if KeyIndex[1] and KeyIndex[16] and Capt then 
    begin 
ListBox2.Items.Add(IntToStr(Hd)+' : '+String(WText)+' - '+String(ClassName)); 
Capt:=false; 
    end; 
  
    // autorise une capture des informations   
    // autre que celle la touche de la souris a été relachée 
    Capt:=Not(KeyIndex[1]); 
    Application.ProcessMessages; 
  
until Fin=true; 
end;

1
2
3
4
5
  
procedure TForm1.BoutonClick(HD:Hwnd); 
begin 
    SendMessage(HD,BM_CLICK, 0, 0); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
  
function TForm1.CopyEdit(HD:Hwnd):string; 
var Size : integer; 
begin 
    Result:=''; 
    SendMessage(HD,WM_SETFOCUS, 0, 0); 
  
    Size:=SendMessage(HD,WM_GETTEXTLENGTH,0,0)+1; 
    SetLength(Result,Size); 
  
    SendMessage(HD,WM_GETTEXT,Size,Integer(@Result[1])); 
    SendMessage(HD,WM_KillFOCUS, 0, 0); 
end;

1
2
  
function IsWindowVisible(hWnd: HWND): BOOL; stdcall;

1
2
3
4
5
6
7
8
9
uses printers, shellapi;

procedure TForm1.Button1Click(Sender: TObject);
var param : String;
begin
 param:=format('printui.dll,PrintUIEntry /o /n "%s"',[Printer.Printers[Printer.PrinterIndex]]);
 ShellExecute(0,'open','rundll32.exe',PChar(param),nil,SW_SHOW);
end;