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 xe8 中tidtcpclient的writeln编码变化

Delphi 获取当前系统版本号

Delphi winapi: getwindowtext - 获取窗口标题

Delphi文件管理类函数

Delphi android调用授权管理打开通知监听服务

Delphi 传输文件例子的核心代码

Delphi 搜索内存偏移函数

Delphi 实现dns上线域名解析（用于远控server）

Delphi木马生成技术

Delphi改变文件夹图标

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

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