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