显示一个鼠标选择框

type

 TForm1 = class(TForm)

   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

     Shift: TShiftState; X, Y: Integer);

   procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

     Y: Integer);

   procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

     Shift: TShiftState; X, Y: Integer);

 private

   { Private declarations }

   Capturing : bool;

   Captured : bool;

   StartPlace : TPoint;

   EndPlace : TPoint;

 public

   { Public declarations }

 end;

var

 Form1: TForm1;

implementation

{$R *.DFM}

function MakeRect(Pt1 : TPoint;

                 Pt2 : TPoint) : TRect;

begin

 if pt1.x < pt2.x then begin

   Result.Left := pt1.x;

   Result.Right := pt2.x;

 end else begin

   Result.Left := pt2.x;

   Result.Right := pt1.x;

 end;

 if pt1.y < pt2.y then begin

   Result.Top := pt1.y;

   Result.Bottom := pt2.y;

 end else begin

   Result.Top := pt2.y;

   Result.Bottom := pt1.y;

 end;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

 Shift: TShiftState; X, Y: Integer);

begin

 if Captured then

   DrawFocusRect(Form1.Canvas.Handle,

                 MakeRect(StartPlace,

                          EndPlace));

 StartPlace.x := X;

 StartPlace.y := Y;

 EndPlace.x := X;

 EndPlace.y := Y;

 DrawFocusRect(Form1.Canvas.Handle,

               MakeRect(StartPlace,

                        EndPlace));

 Capturing := true;

 Captured := true;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

 Y: Integer);

begin

 if Capturing then begin

   DrawFocusRect(Form1.Canvas.Handle,

                 MakeRect(StartPlace,

                          EndPlace));

   EndPlace.x := X;

   EndPlace.y := Y;

   DrawFocusRect(Form1.Canvas.Handle,

                 MakeRect(StartPlace,

                          EndPlace));

 end;

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

 Shift: TShiftState; X, Y: Integer);

begin

 Capturing := false;

end;