Utiliser SetForegroundWindow

Question

Bonjour,

  Il m'arrive de lancer Delphi 2 fois et ça me crée des problèmes. Je voudrais bien que l'icône de Delphi 7 sur le bureau, au lieu d'appeler Delphi, lance le petit programme suivant:


IF ProcessExists('Delphi32.exe') THEN
   Begin
      Sm('Delphi est déjà ouvert !');

// Ici une ou plusieurs lignes qui me permettraient de trouver le handle de Delphi 32.exe

IF Winhandle>0 THEN
         SetForegroundwindow(Winhandle); // et le Delphi déjà lancé apparaîtrait en grand.
   End

ELSE
      ShellExecute(0,'Open',Pchar('C:\Program Files'\Borland\Delphi7\Bin\Delphi32.exe'),Nil,Nil,Sw_maximize);

   
   A la place de la ligne "Ici une ou plusieurs lignes ...", je voudrais bien avoir une ligne qui commencerait          par  "WinHandle:=" et qui me donnerait la valeur de WinHandle. 

   Voici quelques procédes que j'ai essayés. Aucun ne marche. 

      
      winhandle:=Findwindow('Delphi32.exe',nil);
      
      winhandle:=findwindow(nil,'Delphi32.exe');

      WinHandle := SysUtils.FileOpen('Delphi32.exe', fmOpenWrite);

      Pid:=GetPidByProcessName('Delphi32.exe');      winhandle:=GetWindowFromID(Pid);

papyvore · Accepted Answer

https://codeoncode.blogspot.com/2016/12/get-processid-by-programname-include.html
tu l'as 1 ou 2 messages plus haut
tu copie les functions dans ton unit 
tu auras peut être a ajouter  Psapi, shellapi,TlHelp32 dans  les uses

papyvore · Answer

salut
un ex pour notepad

procedure TForm4.Button2Click(Sender: TObject);
var
  hNotepadWindow: HWND;
begin
  hNotepadWindow := FindWindow('notepad', nil);
  if hNotepadWindow <> 0 then // if we found notepad
    ShowWindow(hNotepadWindow, SW_MAXIMIZE)
  else
    ShowMessage('not found.');
end;

papyvore · Answer

salut effectivement ça ne marche qu'avec le caption de la forme
si t'as pas trouvé d'autres solutions je te propose ça.
 https://codeoncode.blogspot.com/2016/12/get-processid-by-programname-include.html
qui marche très bien 
procedure TForm1.Button1Click(Sender: TObject);
var
  ProcessHDL: THandle;
  ProcessID: Cardinal;
begin
  ProcessHDL := GetHWndByProgramName('bds.exe'); // 'CoursDeBourseCBT.exe');
  ShowWindow(ProcessHDL,SW_MAXIMIZE ); // SW_SHOWNORMAL);
end; 
 tu remplace bds.exe par le nom de ton programme ,j'ai testé avec plusieurs programmes
ça marche

AbeBar27 · Answer

Une possibilité est d'utiliser les 2 fonctions suivantes :
1. EnumWindows()
2. GetWindowText()


EnumWindows() énumère toutes les fenêtres "top level" du system.
Il faut lui fournir une procédure de callback que le système appelle pour chaque fenêtre. La procédure de callback reçoit en paramètre le handle de la fenêtre et une valeur LPARAM fournit dans l'API
EnumWindows().

Pour ensuite connaître le titre de la fenêtre il faut appeler
GetWindowText().

Ci-dessous une petite appli qui liste dans un memo les fenètres principales de toutes les tâches ouvertes :
unit uMainTasks;
{
 
Il faut utiliser les 2 fonctions suivantes :
1. EnumWindows()
2. GetWindowText()

EnumWindows() énumère toutes les fenêtres "top level" du system.
Il faut lui fournir une procédure de callback que le système appelle pour
chaque fenêtre. La procédure de callback reçoit en paramètre le handle de
la fenêtre et une valeur LPARAM fournit dans l'API
EnumWindows().

Pour ensuite connaître le titre de la fenêtre il faut appeler
GetWindowText().

}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FWndList: TStringList;
  public
    PROCEDURE Add(hwnd: THandle);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

FUNCTION EnumCallBack(hwnd: THandle; param: INTEGER): BOOL; STDCALL;
BEGIN
  Form1.Add(hwnd);
  result:=TRUE;
END;

procedure TForm1.Add(hwnd: THandle);
VAR text: ARRAY[0..128] OF CHAR; l: INTEGER; hwndp: THandle;
begin
  hwndp:=hwnd;
  WHILE hwndp<>0 DO BEGIN
    hwnd:=hwndp;
    hwndp:=GetParent(hwnd);
  END;
  l:=GetWindowText(hwnd,@Text,128);
  IF l=0 THEN Exit;
  FWndList.Add(PChar(@text)+' ['+IntToStr(hwnd)+']');

//  SendMessageTimeOut(hwnd,
//  Memo1.Lines.Add(PChar(@text)+' ['+IntToStr(hwnd)+']');

end;

procedure TForm1.Button1Click(Sender: TObject);
VAR i: INTEGER;
begin
  Memo1.Clear;
  EnumWindows(@EnumCallBack,0);
  FOR i:=0 TO FWndList.Count-1 DO Memo1.Lines.Add(FWndList[i]);
  Label1.Caption:=IntToStr(FWndList.count)+' fenètres';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FWndList:=TStringList.Create;
  FWndList.Sorted:=TRUE;
  FWndList.Duplicates:=dupIgnore;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FWndList.Free;
end;

end.

Et le code de la fiche :
object Form1: TForm1
  Left = 379
  Top = 180
  Caption = 'Form1'
  ClientHeight = 343
  ClientWidth = 392
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 392
    Height = 302
    Align = alClient
    Lines.Strings = (
      'Memo1')
    ScrollBars = ssVertical
    TabOrder = 0
  end
  object Panel1: TPanel
    Left = 0
    Top = 302
    Width = 392
    Height = 41
    Align = alBottom
    TabOrder = 1
    object Label1: TLabel
      Left = 220
      Top = 16
      Width = 32
      Height = 13
      Caption = 'Label1'
    end
    object Button1: TButton
      Left = 86
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Button1'
      TabOrder = 0
      OnClick = Button1Click
    end
  end
end

Dans ton cas, il faudra rechercher dans les titres de fenêtres la chaîne de caractères appropriées, par exemple moi qui utilise Delphi 10.3 Community j'obtiens le résultat suivant :

je devrais donc rechercher la chaîne 'Delphi 10.3 Community Edition'

AbeBar27 · Answer

Ah oui, un dernier truc, appeler ShowWindow(Winhandle, SW_RESTORE); avant SetForegroundWindow, car je pense que si l'appli est à l'état minimisée elle ne sera pas restaurée automatiquement.

papyvore · Answer

tu peut aussi utilser comme ça
procedure TForm1.Button1Click(Sender: TObject);
var
  Winhandle: THandle;
begin
   Winhandle := GetHWndByProgramName('Nom.exe');//('bds.exe'); //
  IF Winhandle > 0 THEN
  begin
     ShowWindow(Winhandle, SW_RESTORE);
    SetForegroundwindow(Winhandle);
  end
  else
  shellexecute(0,'open','C:\TonDossier\Nom.exe',nil,nil,SW_SHOWNORMAL);
end; 
 sans te préoccuper de chercher le titre de la fenêtre

AbeBar27 · Answer

Sans doute mais la fonction 'GetHWndByProgramName' n'est pas (plus ?) répertoriée dans la doc Micro$oft ! Et elle n'apparait pas dans l'unité Winapi.Windows. Tu mets quelle unité dans la clause USES ?

japee · Answer

Salut,

Moi, j'en ai bavé avec "SetForegroundWindow()" qui ne fonctionne qu'en phase de conception (c'est à dire lancé par Delphi), mais pas à partir de l'exécutable, je n'ai pas d'explication à ça.
J'ai résolu le problème en utilisant "PostMessage()"
J'utilise "GetWindowText" qui recherche le string 'Delphi 7' et retourne un handle si trouvé...
Si trouvé, ouvre en avant-plan.
Si pas trouvé, lance avec ShellExecute.
Testé et retesté, ce bout de code fait le job :

uses ShellApi; // ShellExecute

function DelphiIsLaunched(var Wnd: HWND): Boolean;
const
  Delphi = 'Delphi 7';
var
  WndName: array[0..255] of Char;
begin
  Result := False;
  Wnd := FindWindow(nil, nil);
  while Wnd <> 0 do
  begin
    GetWindowText(Wnd, WndName, SizeOf(WndName));
    Result := (WndName = Delphi);
    if Result then Break;
    Wnd := GetWindow(Wnd, GW_HWNDNEXT);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  DelphiPath = 'C:\Program Files (x86)\Borland\Delphi7\Bin\delphi32.exe';
var
  DelphiHandle: HWND;
begin
  if DelphiIsLaunched(DelphiHandle) then
  begin
     ShowMessage('Delphi 7 est lancé, son Handle = ' + IntToStr(DelphiHandle));
     //ShowWindow(DelphiHandle, SW_SHOWMAXIMIZED);
     //SetForegroundWindow(DelphiHandle);   // <- problème !
     PostMessage(DelphiHandle, WM_SYSCOMMAND, SC_RESTORE, 0);  // <- Oui !
  end
  else
  begin
    ShowMessage('Delphi 7 n''est pas lancé');
    ShellExecute(Handle, 'open', PChar(DelphiPath), nil, nil, SW_SHOWNORMAL);
  end;
end; 

Bonne prog'

papyvore · Answer

unit unit Unit2; interface uses Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, System.SysUtils, Psapi, contnrs, shellapi, StdCtrls, TlHelp32, Vcl.ExtCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; // https://codeoncode.blogspot.com/2016/12/get-processid-by-programname-include.html // Get ProcessID By ProgramName (Include Path or Not Include) function GetPIDByProgramName(const APName: string): THandle; // Get Window Handle By ProgramName (Include Path or Not Include) function GetHWndByProgramName(const APName: string): THandle; // Get Window Handle By ProcessID function GetHWndByPID(const hPID: THandle): THandle; // Get ProcessID By Window Handle function GetPIDByHWnd(const hWnd: THandle): THandle; // Get Process Handle By Window Handle function GetProcessHndByHWnd(const hWnd: THandle): THandle; // Get Process Handle By Process ID function GetProcessHndByPID(const hAPID: THandle): THandle; var Form1: TForm1; implementation {$R *.DFM} // Get Window Handle By ProgramName (Include Path or Not Include) function GetHWndByProgramName(const APName: string): THandle; begin Result := GetHWndByPID(GetPIDByProgramName(APName)); end; // Get Process Handle By Window Handle function GetProcessHndByHWnd(const hWnd: THandle): THandle; var PID: DWORD; AhProcess: THandle; begin if hWnd <> 0 then begin GetWindowThreadProcessID(hWnd, @PID); AhProcess := OpenProcess(PROCESS_ALL_ACCESS, false, PID); Result := AhProcess; CloseHandle(AhProcess); end else Result := 0; end; // Get Process Handle By Process ID function GetProcessHndByPID(const hAPID: THandle): THandle; var AhProcess: THandle; begin if hAPID <> 0 then begin AhProcess := OpenProcess(PROCESS_ALL_ACCESS, false, hAPID); Result := AhProcess; CloseHandle(AhProcess); end else Result := 0; end; // Get Window Handle By ProcessID function GetPIDByHWnd(const hWnd: THandle): THandle; var PID: DWORD; begin if hWnd <> 0 then begin GetWindowThreadProcessID(hWnd, @PID); Result := PID; end else Result := 0; end; // Get Window Handle By ProcessID function GetHWndByPID(const hPID: THandle): THandle; type PEnumInfo = ^TEnumInfo; TEnumInfo = record ProcessID: DWORD; hWnd: THandle; end; function EnumWindowsProc(Wnd: DWORD; var EI: TEnumInfo): Bool; stdcall; var PID: DWORD; begin GetWindowThreadProcessID(Wnd, @PID); Result := (PID <> EI.ProcessID) or (not IsWindowVisible(Wnd)) or (not IsWindowEnabled(Wnd)); if not Result then EI.hWnd := Wnd; // break on return FALSE end; function FindMainWindow(PID: DWORD): DWORD; var EI: TEnumInfo; begin EI.ProcessID := PID; EI.hWnd := 0; EnumWindows(@EnumWindowsProc, Integer(@EI)); Result := EI.hWnd; end; begin if hPID <> 0 then Result := FindMainWindow(hPID) else Result := 0; end; // Get ProcessID By ProgramName (Include Path or Not Include) function GetPIDByProgramName(const APName: string): THandle; var isFound: boolean; AHandle, AhProcess: THandle; ProcessEntry32: TProcessEntry32; APath: array [0 .. MAX_PATH] of char; begin Result := 0; AHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); try ProcessEntry32.dwSize := Sizeof(ProcessEntry32); isFound := Process32First(AHandle, ProcessEntry32); while isFound do begin AhProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, ProcessEntry32.th32ProcessID); GetModuleFileNameEx(AhProcess, 0, @APath[0], Sizeof(APath)); if (UpperCase(StrPas(APath)) = UpperCase(APName)) or (UpperCase(StrPas(ProcessEntry32.szExeFile)) = UpperCase(APName)) then begin Result := ProcessEntry32.th32ProcessID; break; end; isFound := Process32Next(AHandle, ProcessEntry32); CloseHandle(AhProcess); end; finally CloseHandle(AHandle); end; end; // Activate a window by its handle function AppActivate(WindowHandle: hWnd): boolean; overload; begin try SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle); SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle); Result := SetForegroundWindow(WindowHandle); except on Exception do Result := false; end; end; procedure TForm1.Button1Click(Sender: TObject); var Winhandle: THandle; Nomfic :string ; begin Nomfic := 'notepad'; Winhandle := GetHWndByProgramName(Nomfic); IF Winhandle > 0 THEN begin ShowWindow(Winhandle, SW_RESTORE); SetForegroundwindow(Winhandle); end else shellexecute(0,'open',pwidechar(Nomfic),nil,nil,SW_SHOWNORMAL); // 'C:\Dossier\NomFic.exe' end; end. dfm object Form1: TForm1 Left = 379 Top = 180 Caption = 'Form1' ClientHeight = 235 ClientWidth = 349 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] PixelsPerInch = 96 TextHeight = 13 object Button1: TButton Left = 144 Top = 128 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 0 OnClick = Button1Click end end voilà si tu peut en faire quelque chose bonne prog

Utiliser SetForegroundWindow

9 réponses

Votre réponse

Discussions similaires