unit1.pas

delphi实现的类QQ的伸缩窗口。供DELPHI爱好者参考学习。

{ Reference: http://dev.csdn.net/article/58/58404.shtm }
{ Author: 刘童亮, cooniur, http://cooniur.blogchina.com }
{ E-mail: [e-mail] }

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls;

type
  TfrmMain = class(TForm)
    Timer1: TTimer;
    Timer2: TTimer;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
  private
    { Private declarations }
    function GetFormNameAt(const Pos: TPoint): string;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

function TfrmMain.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 TfrmMain.Timer1Timer(Sender: TObject);
var
  winPos: TPoint;
  t: integer;
  b: boolean;
begin
  b:= false;
  if (frmMain.Top <= 3) then
  begin
    b:= true;
    t:= 0;
  end
  else if frmMain.Left + frmMain.Width - Screen.Width >= 0 then
  begin
    b:= true;
    t:= frmMain.Top;
  end
  else
    t:= frmMain.Top;


  if b then
  begin
    //得到当前鼠标指针的在屏幕上的坐标
    GetCursorPos(winPos);
    //当鼠标指针下的窗体的Name等于frmMain.name时
    if frmMain.Name = GetFormNameAt(winPos) then
    {在此我们可以为frmMain取一个特别的名称，以防有别的窗体名称与它相同}
    begin
      //停用Timer2
      frmMain.timer2.Enabled:= false;
      //frmMain的Top与屏幕对齐
      frmMain.Top:= t;
      if t <> 0 then
        frmMain.Left:= Screen.Width - frmMain.Width;
    end
    else begin
      frmMain.Timer2.Enabled:= true;
    end;
  end;
end;

procedure TfrmMain.Timer2Timer(Sender: TObject);
begin
  // 当 top 距屏幕上侧 20 像素时,自动隐藏
  if frmMain.Top <= 20 then
  begin
    //将frmMain向上移，在屏幕上方露出3像素
    frmMain.Top:= -(frmMain.Height - 3);
    if (frmMain.Left + frmMain.Width > Screen.Width) then
      frmMain.Left:= Screen.Width - frmMain.Width;
  end
  // 当 left 距屏幕下侧 20 像素时,自动隐藏
  else if frmMain.Left + frmMain.Width - Screen.Width >= -20 then
    //将frmMain向右移，在屏幕右方露出4像素
    frmMain.Left:= Screen.Width - 4;   
end;

procedure TfrmMain.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  if NewWidth < 170 then
    NewWidth:= 170;
  if NewHeight < 420 then
    NewHeight:= 420;
end;

end.