实现 QQ面板的两个功能 :
1.接近屏幕边缘时,自动隐藏。
2. 收缩式面板;
一。自动隐藏:
procedure TForm1.WMMOVING(var Msg: TMessage); begin inherited; with PRect(Msg.LParam)^ do begin Left := Min(Max(0, Left), Screen.Width - Width); Top := Min(Max(0, Top), Screen.Height - Height); Right := Min(Max(Width, Right), Screen.Width); Bottom := Min(Max(Height, Bottom), Screen.Height); FAnchors := []; if Left = 0 then Include(FAnchors, akLeft); if Right = Screen.Width then Include(FAnchors, akRight); if Top = 0 then Include(FAnchors, akTop); if Bottom = Screen.Height then Include(FAnchors, akBottom); Timer1.Enabled := FAnchors <> []; setwindowpos(application.handle,HWND_TOPMOST,0,0,0,0,swp_hidewindow); end; end;
在from 中加一控件:TIMER。设定
procedure TForm1.Timer1Timer(Sender: TObject); function FindPopupControl(const Pos: TPoint): TControl; var Window: TWinControl; begin Result := nil; Window := FindVCLWindow(Pos); if Window <> nil then begin Result := Window.ControlAtPos(Pos, False); if Result = nil then Result := Window; end; end;
const cOffset = 2; var vHandle: THandle; begin try begin vHandle := WindowFromPoint(Mouse.CursorPos); while (vHandle <> 0) and (vHandle <> Handle) do vHandle := GetParent(vHandle); if ( vHandle = Handle ) then begin if akLeft in FAnchors then Left := 0; if akTop in FAnchors then Top := 0; if akRight in FAnchors then Left := Screen.Width - Width; if akBottom in FAnchors then Top := Screen.Height - Height; if BIsShow then //这一段是我在程序中加的。让隐藏与显示的同时刷新我的一个数据。 begin BIsShow:=not BIsShow; btfind.Click ;
end; end else begin if akLeft in FAnchors then Left := -Width + cOffset; if akTop in FAnchors then Top := -Height + cOffset; if akRight in FAnchors then Left := Screen.Width - cOffset; if akBottom in FAnchors then Top := Screen.Height - cOffset; BIsShow:=true; end; end; except end; end;
|
请发表评论