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 记事本与计算器的调用

Delphi 得到 winrar 处理解压缩文件的返回值 ？

Delphi webservice 中采用 tsoapattachment 传输文件

Delphi 获取cpu占用时间

Delphi 实现对xml文件的读写操作

Delphi excel表格数据导入数据库

Delphi richedit1 设置字体

Delphi 调用极光推送服务端http api实例

Delphi raise 语句: 抛出异常

Delphi限制edit编辑框的输入

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

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