強制應用程式視窗從后臺到前臺（通過來自其他行程的msg）-有解無憂

如果用戶嘗試啟動第二個實體，我將此代碼與互斥體和自定義訊息一起使用，以強制應用程式的第一個實體出現在螢屏上。我的應用程式必須只有 1 個實體正在運行。

看來這段代碼在Win10下不能正常作業，它使應用程式圖示在任務欄上輕彈，但實際視窗并沒有出現在其他Windows之上。

function ForceForeground(AppHandle:HWND): boolean;
const
 SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
 SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
var
 ForegroundThreadID: DWORD;
 ThisThreadID      : DWORD;
 timeout           : DWORD;
 OSVersionInfo     : TOSVersionInfo;
 Win32Platform     : Integer;
begin
 if IsIconic(AppHandle) then ShowWindow(AppHandle, SW_RESTORE);
 if (GetForegroundWindow = AppHandle) then Result := true else
 begin
   Win32Platform := 0;
   OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
   if GetVersionEx(OSVersionInfo) then Win32Platform := OSVersionInfo.dwPlatformId;

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

   if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion > 4)) or
      ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and ((OSVersionInfo.dwMajorVersion > 4) or
      ((OSVersionInfo.dwMajorVersion = 4) and (OSVersionInfo.dwMinorVersion > 0)))) then
   begin
     Result := false;
     ForegroundThreadID := windows.GetWindowThreadProcessID(GetForegroundWindow,nil);
     ThisThreadID := windows.GetWindowThreadPRocessId(AppHandle,nil);
     if AttachThreadInput(ThisThreadID, ForegroundThreadID, true) then
     begin
       BringWindowToTop(AppHandle);
       SetForegroundWindow(AppHandle);
       AttachThreadInput(ThisThreadID, ForegroundThreadID, false);
       Result := (GetForegroundWindow = AppHandle);
     end;
     if not Result then
     begin
       SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
       SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0), SPIF_SENDCHANGE);
       BringWindowToTop(AppHandle);
       SetForegroundWindow(AppHandle);
       SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(timeout), SPIF_SENDCHANGE);
       Result := (GetForegroundWindow = AppHandle);
       if not Result then
         begin
         ShowWindow(AppHandle,SW_HIDE);
         ShowWindow(AppHandle,SW_SHOWMINIMIZED);
         ShowWindow(AppHandle,SW_SHOWNORMAL);
         BringWindowToTop(AppHandle);
         SetForegroundWindow(AppHandle);
         end;
     end;
   end else
   begin
     BringWindowToTop(AppHandle);
     SetForegroundWindow(AppHandle);
   end;
   Result := (GetForegroundWindow = AppHandle);
 end;
end;

uj5u.com熱心網友回復：

我設法制作了一個完整的演示程式，在上面的第二條評論中顯示了我的建議。創建一個新的 VCL 應用程式。將表單重命名為 MainForm，在其上放置一個 TListBox，將其與客戶端對齊，將其重命名為 ListBox，然后為表單的 OnCreate 和 OnDestroy 創建空事件。

然后將這個 PASCAL 源代碼復制/粘貼到主表單的 PAS 檔案中，緊接在“interface”之后，覆寫已經存在的代碼：

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

CONST
  WM_PEEK       = WM_USER 1234;

type
  TMainForm = class(TForm)
    ListBox: TListBox;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    Running     : HWND;
    PROCEDURE   PEEK(VAR MSG : TMessage); MESSAGE WM_PEEK;
    PROCEDURE   CopyData(VAR MSG : TMessage); MESSAGE WM_COPYDATA;
    PROCEDURE   BringForward(Sender : TObject);
    PROCEDURE   SendString(H : HWND ; CONST S : STRING ; E : TEncoding);
    FUNCTION    CommandLine : STRING;
    FUNCTION    MakeAtomName(H : HWND) : STRING;
    FUNCTION    FindGlobalAtom(CONST S : STRING) : ATOM;
    FUNCTION    AddGlobalAtom(CONST S : STRING) : ATOM;
    FUNCTION    GetGlobalAtomName(H : ATOM) : STRING;
    FUNCTION    AtomNameToHandle(CONST S : STRING) : HWND;
    FUNCTION    DeleteGlobalAtom(A : ATOM) : DWORD;
  public
    { Public declarations }
    PROCEDURE   LOG(CONST S : STRING);
  end;

var
  MainForm: TMainForm;

implementation

USES System.Character;

{$R *.dfm}

PROCEDURE TMainForm.FormDestroy(Sender : TObject);
  VAR
    S   : STRING;
    A   : ATOM;

  BEGIN
    S:=MakeAtomName(0);
    REPEAT
      A:=FindGlobalAtom(S);
      IF A=0 THEN BREAK;
    UNTIL DeleteGlobalAtom(A)<>ERROR_SUCCESS
  END;

FUNCTION TMainForm.AddGlobalAtom(CONST S : STRING) : ATOM;
  BEGIN
    Result:=WinAPI.Windows.GlobalAddAtom(PChar(S))
  END;

FUNCTION TMainForm.MakeAtomName(H : HWND) : STRING;
  CONST
    L   = 8*SizeOf(POINTER); // 32 or 64 (number of bits in a handle)

  VAR
    S   : STRING;
    I   : Cardinal;
    C   : CHAR;

  BEGIN
    Result:=ChangeFileExt(ExtractFileName(ParamStr(0)),''); S:='';
    FOR C IN Result DO IF CharInSet(C,['A'..'Z','a'..'z']) THEN S:=S C;
    WHILE LENGTH(S)<L DO S:=S S;
    SetLength(S,L);
    Result:='';
    FOR I:=1 TO L DO BEGIN
      IF H AND $01<>0 THEN C:=S[I].ToUpper ELSE C:=S[I].ToLower;
      Result:=C Result; H:=H SHR 1
    END
  END;

FUNCTION TMainForm.AtomNameToHandle(CONST S : STRING) : HWND;
  VAR
    C   : CHAR;

  BEGIN
    Result:=0;
    FOR C IN S DO BEGIN
      Result:=Result SHL 1;
      IF CharInSet(C,['A'..'Z']) THEN Result:=Result OR 1
    END
  END;

PROCEDURE TMainForm.BringForward(Sender : TObject);
  BEGIN
    SetForegroundWindow(Running);
    SendString(Running,CommandLine,TEncoding.UTF8);
    ExitProcess(0)
  END;

FUNCTION TMainForm.CommandLine : STRING;
  BEGIN
    Result:=GetCommandLine
  END;

PROCEDURE TMainForm.CopyData(VAR MSG : TMessage);
  VAR
    CDS : PCopyDataStruct;
    S   : STRING;
    B   : TBytes;

  BEGIN
    CDS:=PCopyDataStruct(MSG.LParam);
    SetLength(B,CDS.cbData);
    MOVE(CDS.lpData^,POINTER(B)^,LENGTH(B));
    S:=TEncoding.UTF8.GetString(B);
    LOG('Child[' IntToHex(MSG.WParam) ']: ' S)
  END;

FUNCTION TMainForm.DeleteGlobalAtom(A : ATOM) : DWORD;
  BEGIN
    SetLastError(ERROR_SUCCESS);
    WinAPI.Windows.GlobalDeleteAtom(A);
    Result:=GetLastError
  END;

FUNCTION TMainForm.FindGlobalAtom(CONST S : STRING) : ATOM;
  BEGIN
    Result:=WinAPI.Windows.GlobalFindAtom(PChar(S))
  END;

PROCEDURE TMainForm.FormCreate(Sender : TObject);
  VAR
    A   : ATOM;
    H   : HWND;
    S,T : STRING;

  BEGIN
    S:=MakeAtomName(Handle);
    REPEAT
      A:=FindGlobalAtom(S);
      IF A=0 THEN BREAK;
      T:=GetGlobalAtomName(A); H:=AtomNameToHandle(T);
      IF H<>Handle THEN
        IF SendMessage(H,WM_PEEK,NativeInt(A),NativeInt(H))=NativeInt(A) NativeInt(H) THEN BREAK
    UNTIL DeleteGlobalAtom(A)<>ERROR_SUCCESS;
    IF A=0 THEN BEGIN
      A:=AddGlobalAtom(S);
      LOG('Main[' IntToHex(Handle) '] : ' CommandLine)
    END ELSE BEGIN
      Running:=H; OnDestroy:=NIL; OnActivate:=BringForward;
      BorderStyle:=TFormBorderStyle.bsNone;
      SetBounds(-10000,-10000,10,10)
    END
  END;

FUNCTION TMainForm.GetGlobalAtomName(H : ATOM) : STRING;
  BEGIN
    SetLength(Result,255);
    SetLength(Result,WinAPI.Windows.GlobalGetAtomName(H,@Result[LOW(Result)],LENGTH(Result)))
  END;

PROCEDURE TMainForm.LOG(CONST S : STRING);
  BEGIN
    ListBox.ItemIndex:=ListBox.Items.Add(S)
  END;

PROCEDURE TMainForm.PEEK(VAR MSG : TMessage);
  BEGIN
    MSG.Result:=NativeInt(MSG.WParam) MSG.LParam
  END;

PROCEDURE TMainForm.SendString(H : HWND ; CONST S : STRING ; E : TEncoding);
  VAR
    B   : TBytes;
    CDS : TCopyDataStruct;

  BEGIN
    B:=E.GetBytes(S);
    CDS.dwData:=1;
    CDS.cbData:=LENGTH(B);
    CDS.lpData:=POINTER(B);
    SendMessage(H,WM_COPYDATA,Handle,NativeInt(@CDS));
  END;

end.

當您最初運行該應用程式時，它會在 ListBox 中顯示命令列。如果您再次運行它，它會檢測到另一個視窗已經存在（使用位編碼的全域原子來表示初始實體的主表單句柄）并將其移動到前臺（在將自己的視窗放置在螢屏外之后），因此是一個不可見的前景視窗）。然后它將使用 WM_COPYDATA 將新實體的命令列發送到初始實體，然后初始實體將接收到的命令列記錄到串列框。

注意事項：

它是被帶到前面、接收和處理命令列的 MAIN 表單。如果您打開了子表單，則行為未定義（如：我沒有測驗過）。
Atom 名稱是一個 32（或 64）個字符長的名稱，由程式可執行檔案的 AZ 字符的重復模式組成。如果您的應用程式名稱中沒有 AZ 字符，這將失敗。
為了測驗從全域原子解碼的視窗是否是我們識別的視窗，我在該視窗上呼叫 WM_PEEK 訊息。如果您的主實體被允許啟動（并創建 Atom）然后沒有正確終止（因此 Atom 在 FormDestroy 中被洗掉），這可能會導致對外部應用程式的意外訊息呼叫。

轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/314735.html

標籤：德尔福登录德尔福-7

上一篇：獲取已知HWND的路徑

下一篇：C Win32選單欄被繪制在所有者繪制的選單項上