unit1.~pas

delphi制作QQ伸缩窗体 实例演示

 //实现这个效果的关键在于如何判断当前鼠标指针下面的窗体是不是我们的程序窗体。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  ExtCtrls, ComCtrls, StdCtrls;  //第1步，加ExtCtrls, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Timer2: TTimer;

    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);

  private
    { Private declarations }
  //第2步 自定义函数GetFormNameAt, 它可获得当前鼠标指针下面的窗体的名称
  function GetFormNameAt(const Pos: TPoint): string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
 //*****************************************************************************
 //以下是程序代码
 function Tform1.GetFormNameAt(const Pos: TPoint): string;
var
  w: TWinControl;
begin
  //得到鼠标指针下的VCL可视组件
  w:= FindVclWindow(Pos);
  if (w <> nil) then
  begin
    //当W的上级Parent不为空时就继续往上找
    while w.Parent <> nil do
      w:= w.Parent;
    //最后返回窗体的名称Name
    Result:= w.Name;
  end
  else
    Result:= '';
end;
//******************************************************************************
procedure TForm1.Timer1Timer(Sender: TObject);
var
  winPos: TPoint;
  t: integer;
  b: boolean;
begin
  b:= false;
  if (form1.Top <= 3) then
  begin
    b:= true;
    t:= 0;
  end
  else if form1.Left + form1.Width - Screen.Width >= 0 then
  begin
    b:= true;
    t:= form1.Top;
  end
  else
    t:= form1.Top;
if b then
  begin
    //得到当前鼠标指针的在屏幕上的坐标
    GetCursorPos(winPos);
    //当鼠标指针下的窗体的Name等于form1.name时
    if form1.Name = GetFormNameAt(winPos) then
    {在此我们可以为form1取一个特别的名称，以防有别的窗体名称与它相同}
    begin
      //停用Timer2
      form1.timer2.Enabled:= false;
      //form1的Top与屏幕对齐
      form1.Top:= t;
      if t <> 0 then
        form1.Left:= Screen.Width - form1.Width;
    end
    else begin
      form1.Timer2.Enabled:= true;
    end;
  end;
end;
//******************************************************************************
procedure TForm1.Timer2Timer(Sender: TObject);
// 当 top 距屏幕上侧 20 像素时,自动隐藏
begin
if form1.Top <= 20 then
  begin
    //将form1向上移，在屏幕上方露出3像素
    form1.Top:= -(form1.Height - 3);
    if (form1.Left + form1.Width > Screen.Width) then
      form1.Left:= Screen.Width - form1.Width;
  end
  // 当 left 距屏幕下侧 20 像素时,自动隐藏
  else if form1.Left + form1.Width - Screen.Width >= -20 then
    //将form1向右移，在屏幕右方露出4像素
    form1.Left:= Screen.Width - 4;
end;
end.