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;//----------------窗口始终置顶

相关阅读 >>

Delphi2010 图片格式转换bmp, png,jpeg, gif, tiff , wmphoto

Delphi 解决Delphi indy10下 utf8码转换的问题

Delphi isthisleapyear 判断闰年

Delphi隐藏桌面图片和显示桌面图标

dekphi 智能《疯狂刷新》辅助工具v3.1更新开源

Delphi xe 制作的萤光时钟,可改作屏保

Delphi 遍历控件

Delphi程序支持外部参数

Delphi 一个定时器timer1相关的简单例子

Delphi 在vcl中显示一个非激活状态的窗口

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



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...