自动隐藏

XiaoLaohu 2000-03-05 05:48:00
如何实现一个窗口的自动隐藏功能?
...全文
368 20 打赏 收藏 转发到动态 举报
写回复
用AI写文章
20 条回复
切换为时间正序
请发表友善的回复…
发表回复
jwchc 2000-07-19
  • 打赏
  • 举报
回复
全错也.
众所周知,WIN的桌面工具栏具有隐藏功能,OICQ就是根据这一技术实现的.
要实现需要使用shellAPI的SHAppBarMessage()函数.
具体用法可以参照深度历险中的例程. 我给你发一份过去请查收.
XiaoLaohu 2000-03-09
  • 打赏
  • 举报
回复
.. .
好像还是.. .
patpat,可以把代码发到我Email嘛?
IRC@MIDATECH.COM
patpat 2000-03-08
  • 打赏
  • 举报
回复
部分关键代码
var
fmFlatTool: TfmFlatTool;

implementation

uses HouseSetup;

{$R *.DFM}

procedure TfmFlattool.CMMouseLeave(var Message: TMessage);
var
p:TPoint;
begin
inherited;
if onThread then exit;
GetCursorPos(p);
p:=self.ScreenToClient(p);
if p.y<self.Height then
exit;
if FMouseInControl then begin
FMouseInControl := False;
HideThread.Resume;
end;
end;

procedure TfmFlattool.CMMouseEnter(var Message: TMessage);
var
p:Tpoint;
PControl:TControl;
begin
inherited;
{ Don't draw a border if DragMode <> dmAutomatic since this button is meant to
be used as a dock client. }
if onThread then exit;
GetCursorPos(p);
PConTrol:=FindDragTarget(P, True);
// if (PConTrol.Parent<>nil) and (PControl<>Image1)and(PConTrol.Parent=self) then exit;
if not FMouseInControl and (GetCapture = 0) then
begin
FMouseInControl := True;
ShowThread.Resume;
end;
end;

procedure THideThread.Execute;
var
i:integer;
begin
while 1=1 do begin
fmFlatTool.onThread:=True;
for i:=0 downto -23 do
// fmFlatTool.Top:=i*2;
// MoveWindow(fmFlattool.Handle,0,i*2,fmFlatTool.Width,fmFlatTool.Height,);
setWindowPos(fmFlattool.Handle,HWND_TOPMOST,0,i*2,
fmFlatTool.Width,fmFlatTool.Height,SWP_SHOWWINDOW);
fmFlatTool.Showing:=False;
fmFlatTool.onThread:=False;
fmFlatTool.HideThread.Suspend;
end;
end;


procedure TShowThread.Execute;
var
i:integer;
begin
while 1=1 do begin
fmFlatTool.onThread:=True;
fmFlatTool.Showing:=True;
for i:=-23 to 0 do
// fmFlatTool.Top:=i*2;
// MoveWindow(fmFlattool.Handle,0,i*2,fmFlatTool.Width,fmFlatTool.Height,True);
setWindowPos(fmFlattool.Handle,HWND_TOPMOST,0,i*2,
fmFlatTool.Width,fmFlatTool.Height,SWP_SHOWWINDOW);
// fmFlattool.CheckCursorThread.resume;
fmFlatTool.onThread:=False;
fmFlatTool.ShowThread.Suspend;
end;
end;

procedure TfmFlatTool.FormShow(Sender: TObject);
begin
Left:=0;
Width:=800;
Height:=55;
Top:=-46;
onThread:=False;
end;

procedure TfmFlatTool.FormCreate(Sender: TObject);
begin
ShowThread:=TShowThread.Create(True);
HideThread:=THideThread.Create(True);
FSFields:=TList.Create;
end;

procedure TfmFlatTool.FormDestroy(Sender: TObject);
begin
ShowThread.FreeOnTerminate:=True;
HideThread.FreeOnTerminate:=True;
ShowThread.Terminate;
HideThread.Terminate;
// FSFields.Clear;
end;

procedure TfmFlatTool.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ShowThread.suspend;
HideThread.suspend;
patpat 2000-03-08
  • 打赏
  • 举报
回复
XiaoLaoHu,

我昨天的E_mail被退出来了,现在,我再送一次
XiaoLaohu 2000-03-08
  • 打赏
  • 举报
回复
我搞不清楚了,我现在究竟应该怎么做呢?有谁可以帮忙做一下.. .
Firing_Sky 2000-03-08
  • 打赏
  • 举报
回复
patpat,应用程序失去焦点是也能响应吗?
patpat 2000-03-07
  • 打赏
  • 举报
回复
不好意思,这几天搞系统分析,很晚才回家,我马上E_mail.

agui 这两个消息是Delphi自定义的,无论其上是否有控件,都会接到消息,当然,从内部进入也会发生,这就需要自己处理了。

我建议看看TSpeedButton的源码,我就是从那里学的
alin 2000-03-07
  • 打赏
  • 举报
回复
做一个Mouse Hook不以行了吗,当Mouse 在窗体上时,用onMouseMove可以得到Mouse情况,但如果不在自己程序上,程序没法得到鼠标位置的,只能采用鼠标Hook技术,我的主页 http://alin.heha.net 源代码下载栏目 上有一个完整的鼠标Hook例子,可以下载,D5编译,我相信ICQ或OICQ都采用鼠标Hook,不会那么累地不停取得鼠标位置的。
XiaoLaohu 2000-03-07
  • 打赏
  • 举报
回复
是呀,我就是要做类似ICQ的.. .
LaoZheng 2000-03-07
  • 打赏
  • 举报
回复
做一类似ICQ自动隐藏shu 谁有给我一份?
zcm@csdn.net
XiaoLaohu 2000-03-07
  • 打赏
  • 举报
回复
哦,如果愿意的话,也希望能给我发一份。谢谢!



欢迎光临CSDN IRC.. .
光明山人 2000-03-07
  • 打赏
  • 举报
回复
patpat, 哪有WM_MOUSEENTER和WM_MOUSELEAVE消息?我在MSDN中找不见。
再说如果Form上有控件,Mouse消息是传给控件的,Form收不到。

Xiaolaohu: 我也有一个这样的程序,也是用线程定时判断的。既然与“着火的天空”差不多,我就不抢这个分了。:)
Firing_Sky 2000-03-06
  • 打赏
  • 举报
回复
patpat, 你的方法有一个问题,那就是当程序失去焦点的时候,就不能弹出了,你觉得呢?
XiaoLaohu 2000-03-06
  • 打赏
  • 举报
回复
最好能发一份,谢谢!
patpat 2000-03-05
  • 打赏
  • 举报
回复
刚才没说明白,因为代码在公司,所以不能马上E_mail
patpat 2000-03-05
  • 打赏
  • 举报
回复
Firing_sky,你的程序太复杂了,而且还要用线程来判断鼠标位置,其实可以这样做。

XiaoLaohu:

Delphi 有一个自定义消息:
当鼠标进入任何可视控件时,此控件会接到WM_MOUSEENTER消息,同样,当鼠标离开时,控件会接到WM_MOUSELEAVE消息。

所以,只要截获这两个消息就行了。不用一直判断鼠标位置,那样会大大大大的降低效率。

Xiaolaohu:如果你要,我可以把我的代码也给你.
XiaoLaohu 2000-03-05
  • 打赏
  • 举报
回复
是自动缩进,能否发源代码给我?(直接看太累)谢谢!
mailto:dongxue@childlib.online.sh.cn
XiaoLaohu 2000-03-05
  • 打赏
  • 举报
回复
是自动缩进,能否发源代码给我?(直接看太累)谢谢!
<a href="mailto:dongxue@childlib.online.sh.cn">dongxue@childlib.online.sh.cn</a>
Firing_Sky 2000-03-05
  • 打赏
  • 举报
回复
你指的是不是自动缩进?如果是的,请看这个我写的小时钟程序

program MyClock;

uses
Forms,
Main in 'Main.pas' {FrmClock},
TimeThread in 'TimeThread.pas';

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TFrmClock, FrmClock);
Application.Run;
end.



unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons, Menus, math, TimeThread;

type
TFrmClock = class(TForm)
PanelTime: TPanel;
SpdBtnSetting: TSpeedButton;
PopMenu: TPopupMenu;
MnuFont: TMenuItem;
MnuTime: TMenuItem;
MnuAbout: TMenuItem;
N1: TMenuItem;
MnuExit: TMenuItem;
MnuBigfont: TMenuItem;
MnuSmallfont: TMenuItem;
Mnu24Hour: TMenuItem;
Mnu12Hour: TMenuItem;
Timer: TTimer;
procedure SpdBtnSettingClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MnuBigfontClick(Sender: TObject);
procedure MnuSmallfontClick(Sender: TObject);
procedure MnuExitClick(Sender: TObject);
procedure Mnu24HourClick(Sender: TObject);
procedure Mnu12HourClick(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure PopMenuPopup(Sender: TObject);
private
BigFont:boolean;
Hour24:boolean;
procedure ThreadResume(Sender:TObject);
{ Private declarations }
public
{ Public declarations }
end;

var
FrmClock: TFrmClock;
MyThread:ThreadMouse;

implementation

{$R *.DFM}

procedure TFrmClock.SpdBtnSettingClick(Sender: TObject);
var
P:TPoint;
begin
P.x :=SpdBtnSetting.Left;
P.y :=SpdBtnSetting.Top + SpdBtnSetting.Height;
P:=ClientToScreen(P);
PopMenu.Popup(P.x , P.y );
end;

procedure TFrmClock.FormCreate(Sender: TObject);
begin
self.Left :=floor((Screen.Width -self.Width)/2);
self.Top :=2-self.Height ;
PanelTime.Caption :=formatDateTime('ampm hh:mm:ss',now);
MyThread:=ThreadMouse.Create(false);
Application.OnDeactivate :=ThreadResume;
end;

procedure TFrmClock.MnuBigfontClick(Sender: TObject);
begin
BigFont:=true;
PanelTime.Font.Size :=24;
MnuBigFont.Checked :=true;
MnuSmallFont.Checked :=false;
end;

procedure TFrmClock.MnuSmallfontClick(Sender: TObject);
begin
BigFont:=false;
PanelTime.Font.Size :=15;
MnuBigFont.Checked :=false;
MnuSmallFont.Checked :=true;
end;

procedure TFrmClock.MnuExitClick(Sender: TObject);
begin
close;
end;

procedure TFrmClock.Mnu24HourClick(Sender: TObject);
begin
Hour24:=true;
PanelTime.Caption :=formatDateTime('ampm hh:mm:ss',now);
Mnu24Hour.Checked :=true;
Mnu12Hour.Checked :=false;
end;

procedure TFrmClock.Mnu12HourClick(Sender: TObject);
begin
Hour24:=false;
PanelTime.Caption :=formatDateTime('hh:mm:ss',now);
Mnu24Hour.Checked :=false;
Mnu12Hour.Checked :=true;
end;

procedure TFrmClock.TimerTimer(Sender: TObject);
begin
if not Hour24 then
PanelTime.Caption :=formatDateTime('ampm hh:mm:ss',now)
else
PanelTime.Caption :=formatDateTime('hh:mm:ss',now);
end;

procedure TFrmClock.PopMenuPopup(Sender: TObject);
begin
if not MyThread.Suspended then
MyThread.Suspend;
end;

procedure TFrmClock.ThreadResume(Sender: TObject);
begin
if MyThread.Suspended then
MyThread.Resume;
end;

end.




unit TimeThread;

interface

uses
Classes, Controls, Windows;

type
ThreadMouse = class(TThread)
private
Px:integer;
Py:integer;
procedure WinPushIn;
procedure WinPushOut;
{ Private declarations }
protected
procedure Execute; override;
end;

implementation
uses
Main;

{ Important: Methods and properties of objects in VCL can only be used in a
method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure ThreadMouse.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }

{ ThreadMouse }

procedure ThreadMouse.Execute;
var
P:TPoint;
begin
while not Terminated do
begin
P:=mouse.CursorPos;
Px:=P.x;
Py:=P.y;
if (P.x > frmClock.Left) and (P.x < frmClock.Left + frmClock.Width) and (P.y <frmClock.Top + frmClock.Height) then
Synchronize(WinPushOut)
else
Synchronize(WinPushIn);
end;
end;

procedure ThreadMouse.WinPushIn;
var
i:integer;
j:integer;
begin
j:=frmClock.Top;
for i:=j downto 2-frmClock.Height do
frmClock.Top := i;
end;

procedure ThreadMouse.WinPushOut;
var
i:integer;
j:integer;
begin
j:=frmClock.Top;
for i:=j to 0 do
frmClock.Top := i;
end;

end.

Lin 2000-03-05
  • 打赏
  • 举报
回复
能否详细点?

5,379

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

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