自动隐藏

Question

你指的是不是自动缩进？如果是的，请看这个我写的小时钟程序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;interfaceuses
  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;interfaceuses
  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.

Answer 1

是自动缩进，能否发源代码给我？（直接看太累）谢谢！
<a href="mailto:[email protected]">[email protected]</a>

Answer 2

是自动缩进，能否发源代码给我？（直接看太累）谢谢！
mailto:[email protected]

Answer 3

Firing_sky,你的程序太复杂了，而且还要用线程来判断鼠标位置，其实可以这样做。XiaoLaohu:Delphi 有一个自定义消息：
  当鼠标进入任何可视控件时，此控件会接到WM_MOUSEENTER消息，同样，当鼠标离开时，控件会接到WM_MOUSELEAVE消息。所以，只要截获这两个消息就行了。不用一直判断鼠标位置，那样会大大大大的降低效率。Xiaolaohu:如果你要，我可以把我的代码也给你.

Answer 4

刚才没说明白，因为代码在公司，所以不能马上E_mail

Answer 5

patpat,  你的方法有一个问题，那就是当程序失去焦点的时候，就不能弹出了，你觉得呢？

Answer 6

patpat, 哪有WM_MOUSEENTER和WM_MOUSELEAVE消息？我在MSDN中找不见。
再说如果Form上有控件，Mouse消息是传给控件的，Form收不到。Xiaolaohu: 我也有一个这样的程序，也是用线程定时判断的。既然与“着火的天空”差不多，我就不抢这个分了。:)

Answer 7

哦，如果愿意的话，也希望能给我发一份。谢谢！欢迎光临CSDN IRC.. .

Answer 8

做一类似ICQ自动隐藏shu 谁有给我一份?
[email protected]

Answer 9

是呀，我就是要做类似ICQ的.. .

Answer 10

做一个Mouse Hook不以行了吗，当Mouse 在窗体上时，用onMouseMove可以得到Mouse情况，但如果不在自己程序上，程序没法得到鼠标位置的，只能采用鼠标Hook技术，我的主页 http://alin.heha.net 源代码下载栏目 上有一个完整的鼠标Hook例子，可以下载，D5编译，我相信ICQ或OICQ都采用鼠标Hook,不会那么累地不停取得鼠标位置的。

Answer 11

不好意思，这几天搞系统分析，很晚才回家，我马上E_mail.agui 这两个消息是Delphi自定义的，无论其上是否有控件，都会接到消息，当然，从内部进入也会发生，这就需要自己处理了。我建议看看TSpeedButton的源码，我就是从那里学的

Answer 12

patpat，应用程序失去焦点是也能响应吗？

Answer 13

XiaoLaoHu,我昨天的E_mail被退出来了，现在，我再送一次

Answer 14

部分关键代码
var
  fmFlatTool: TfmFlatTool;implementationuses 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;

Answer 15

.. .
好像还是.. .
patpat,可以把代码发到我Email嘛？
[email protected]

Answer 16

全错也.
  众所周知,WIN的桌面工具栏具有隐藏功能,OICQ就是根据这一技术实现的.
  要实现需要使用shellAPI的SHAppBarMessage()函数.
  具体用法可以参照深度历险中的例程. 我给你发一份过去请查收.