unit1.pas

来自「鼠标控制程序,用鼠标可以拖动无边框的体.能给大家一参考.」· PAS 代码 · 共 88 行

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

  private
    { Private declarations }
  public

    { Public declarations }
  end;

var
  Form1: TForm1;
    procedure kAppMessage(var Msg:TMsg;var Handled:Boolean);
implementation



{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  msg:tmsg;handled:boolean;
begin
{捕捉消息：将程序的收到消息事件与消息过滤过程
            关联起来}
//Application.OnMessage;// :=kAppMessage(msg,handled);
end;

procedure kAppMessage(var Msg:TMsg;var Handled:Boolean);
var
  Handle:hwnd ;
begin
//            　　｛如果鼠标左键按下的话｝
//if Msg.message=WM_LButtonDown then
  begin
//            　　｛判断光标是否在用户工作区内｝
//function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

//if DefWindowProc(Handle,WM_NCHitTest,0,GetMessagePos)=HTClient then
begin
//            　　｛发出鼠标在用户标题栏内被按下的消息｝
  SendMessage(Handle,WM_NCLButtonDown,HTCaption,GetMessagePos);
  Handled:=true;
//            ｛消息处理完毕，窗体不再接受M
//            ouseDown及Click事件，如果为false，程序的运行稍微有
//            些不正常。｝
end;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  msg:tmsg;handled:boolean;
begin
kAppMessage(msg,handled)
end;

procedure TForm1.Button2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  msg:tmsg;handled:boolean;
begin
kAppMessage(msg,handled)
end;

end.