delphi 让窗口一直置顶，并且焦点也不移出

本文整理自网络，侵删。

 
procedure Tfrm.GetFromFouce(Sender: TObject);var  TopHandle: HWND ;begin  TopHandle := FindWindow(nil,ShowHintInfo);  if not (GetParent(TopHandle) = frm.Handle) then     WindowActive(frm.Handle);  end;function Tfrm.WindowActive(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    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      Result := false;      ForegroundThreadID :=      GetWindowThreadProcessID(GetForegroundWindow,nil);      ThisThreadID := GetWindowThreadPRocessId(hwnd,nil);      if AttachThreadInput(ThisThreadID, ForegroundThreadID, true) then      begin        BringWindowToTop(hwnd);        SetForegroundWindow(hwnd);        AttachThreadInput(ThisThreadID, ForegroundThreadID, false);        Result := (GetForegroundWindow = hwnd);      end;      if not Result then      begin        SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0),SPIF_SENDCHANGE);        BringWindowToTop(hwnd);        SetForegroundWindow(hWnd);        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0,TObject(timeout), SPIF_SENDCHANGE);      end;    end    else    begin      BringWindowToTop(hwnd);      SetForegroundWindow(hwnd);    end;    Result := (GetForegroundWindow = hwnd);  end;end;
修正版
//---------www.delphitoip.com ----------//// 放到 timer里 调用 GetFromFouce(nil); 即可//----------------窗口始终置顶procedure TForm2.GetFromFouce(Sender: TObject);var  TopHandle: HWND ;begin  TopHandle := FindWindow(nil,pwidechar(form2.Caption));  if not (GetParent(TopHandle) = Form2.Handle) then     SetActiveWindow(Form2.Handle);end;function WindowActive(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    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      Result := false;      ForegroundThreadID :=      GetWindowThreadProcessID(GetForegroundWindow,nil);      ThisThreadID := GetWindowThreadPRocessId(hwnd,nil);      if AttachThreadInput(ThisThreadID, ForegroundThreadID, true) then      begin        BringWindowToTop(hwnd);        SetForegroundWindow(hwnd);        AttachThreadInput(ThisThreadID, ForegroundThreadID, false);        Result := (GetForegroundWindow = hwnd);      end;      if not Result then      begin        SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0),SPIF_SENDCHANGE);        BringWindowToTop(hwnd);        SetForegroundWindow(hWnd);        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0,TObject(timeout), SPIF_SENDCHANGE);      end;    end    else    begin      BringWindowToTop(hwnd);      SetForegroundWindow(hwnd);    end;    Result := (GetForegroundWindow = hwnd);  end;end;//----------------窗口始终置顶
 

相关阅读 >>

Delphi xe5 for android ttabcontrol 控件

Delphi 除法 "/" 与 div 的不同

Delphi 62 进制的简单实现

Delphi获取网卡mac地址的两种方法

Delphi 如何确定windows安装的语言

Delphi gif 动画建立

Delphi 限制edit输入 多个例子

Delphi研究之驱动开发篇（四）--使用系统内存堆

Delphi tclientdataset的全面剖析

Delphi 获取本地网络连接

更多相关阅读请进入《Delphi》频道 >>

转载请注明出处：木庄网络博客 » delphi 让窗口一直置顶，并且焦点也不移出