如何使form想oicq那样一到窗口边缘就自动缩进

eggbaby 2000-07-18 11:48:00
...全文
185 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
LaoZheng 2000-07-27
  • 打赏
  • 举报
回复
有种简单办法:
设置一时钟MouseMoveCheckLMDHiTimer;


procedure TMainICQForm.MouseMoveCheckLMDHiTimerTimer(Sender: TObject);
var
P:TPoint;
Px,Py:Integer;
begin
MouseMoveCheckLMDHiTimer.enabled:=False;
if (Visible) and (AutoMove ) and (not IsProc ) then
begin
P:=mouse.CursorPos;
Px:=P.x;
Py:=P.y;
if (P.x > MainICQForm.Left-5) and (P.x < MainICQForm.Left + MainICQForm.Width+5) and (P.y <MainICQForm.Top + MainICQForm.Height+5) then
begin
if not OnDeskTop then
WinPushOut
else CanPushIn:=True;
end
else
if MainICQForm.Top<=0 then
begin
if OnDeskTop then
if CanPushIn then
WinPushIn;
end;
end;
MouseMoveCheckLMDHiTimer.enabled:=True;
end;
procedure TMainICQForm.setAutoMove(nAutoMove:Boolean);
begin
if nAutoMove<>AutoMove then
begin
AutoMove:=nAutoMove;
if AutoMove then
MouseMoveCheckLMDHiTimer.Enabled:=True
else MouseMoveCheckLMDHiTimer.Enabled:=False;
end;
end;

procedure ThreadFuncsPushIn;StdCall;
var
i:integer;
j:integer;
StepY:Integer;
HasLeft:Boolean;
OldTop:Integer;
NewTop:Integer;
begin
MainICQForm.IsProc:=True;
HasLeft:=False;
OldTop:=MainICQForm.Top;
StepY:=(MainICQForm.Height-2+MainICQForm.Top) div MoveStepIn;
if StepY*MoveStepIn<>(MainICQForm.Height-2+MainICQForm.top) then
HasLeft:=True;
for i:=1 to StepY do
begin
MainICQForm.Top :=OldTop-i*MoveStepIn;
Application.ProcessMessages;
end;
if HasLeft then
MainICQForm.Top:=2-MainICQForm.Height;
MainICQForm.OnDeskTop:=False;
MainICQForm.IsProc:=False;
end;

procedure ThreadFuncsPushOut;StdCall;
var
i:integer;
j:integer;
StepY:Integer;
HasLeft:Boolean;
OldTop:Integer;
begin
MainICQForm.IsProc:=True;
HasLeft:=False;
OldTop:=MainICQForm.Top;
StepY:=(MainICQForm.Height-2) div MoveStepOut;
if StepY*MoveStepOut<>(MainICQForm.Height-2) then
HasLeft:=True;
for i:=1 to StepY do
begin
MainICQForm.Top :=OldTop+i*MoveStepOut;
Application.ProcessMessages;
end;
if HasLeft then
MainICQForm.Top:=0;
MainICQForm.OnDeskTop:=True;
MainICQForm.IsProc:=False;
end;


procedure TMainICQForm.WinPushIn;
var
ThreadID:DWORD;
ThreadHandle:DWORD;
begin
ThreadHandle:=CreateThread(nil,4096,@ThreadFuncsPushIn,nil,CREATE_SUSPENDED, ThreadID);
ResumeThread(ThreadHandle);
end;

procedure TMainICQForm.WinPushOut;
var
ThreadID:DWORD;
ThreadHandle:DWORD;
begin
ThreadHandle:=CreateThread(nil,4096,@ThreadFuncsPushOut,nil,CREATE_SUSPENDED, ThreadID);
ResumeThread(ThreadHandle);
end;

JGTM2000 2000-07-23
  • 打赏
  • 举报
回复
等着哥们儿给你写一个,这两天有点儿忙。思路是这样的:

1,为了方便和可重用,通过在一个新类中subclassing给定的form实例为任何TCustomForm派生类增加dock to screen edge功能;

2,利用Shell API中的Desktop Application Bar实现主要功能。
eggbaby 2000-07-19
  • 打赏
  • 举报
回复
有样例吗?我想要,第一个给能用样例的给满分
Firing_Sky 2000-07-19
  • 打赏
  • 举报
回复
你看看http://expert.csdn.net/TopicView.asp?id=3710
Firing_Sky 2000-07-19
  • 打赏
  • 举报
回复
这个问题论坛里已经有过解答了,建议你查询一下
sadpacific 2000-07-19
  • 打赏
  • 举报
回复
i care
eggbaby 2000-07-18
  • 打赏
  • 举报
回复
如果有样例源程再加分!!!

4,354

社区成员

发帖
与我相关
我的任务
社区描述
通信技术相关讨论
社区管理员
  • 网络通信
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧