Delphi7从入门到精通及附书源码 Delphi7从入门到精通及附书源码
源代码在线查看: mousef.pas
unit MouseF;
interface
uses Windows, Classes, Graphics,
Controls, Forms, SysUtils;
type
TMouseForm = 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);
procedure FormPaint(Sender: TObject);
private
fDragging: Boolean;
fRect: TRect;
dragStart: TPoint;
public
{ Public declarations }
end;
var
MouseForm: TMouseForm;
implementation
{$R *.DFM}
procedure TMouseForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
fDragging := True;
Mouse.Capture := Handle;
fRect.Left := X;
fRect.Top := Y;
fRect.BottomRight := fRect.TopLeft;
dragStart := fRect.TopLeft;
Canvas.DrawFocusRect (fRect);
end;
end;
procedure TMouseForm.FormMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
// display the position of the mouse in the caption
Caption := Format ('Mouse in x=%d, y=%d', [X, Y]);
if fDragging then
begin
// remove and redraw the dragging rectangle
Canvas.DrawFocusRect (fRect);
if X > dragStart.X then
fRect.Right := X
else
fRect.Left := X;
if Y > dragStart.Y then
fRect.Bottom := Y
else
fRect.Top := Y;
Canvas.DrawFocusRect (fRect);
end
else
if ssShift in Shift then
// mark points in yellow
Canvas.Pixels [X, Y] := clYellow;
end;
procedure TMouseForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if fDragging then
begin
Mouse.Capture := 0; // calls ReleaseCapture
fDragging := False;
Invalidate;
end;
end;
procedure TMouseForm.FormPaint(Sender: TObject);
begin
Canvas.Rectangle (fRect.Left, fRect.Top,
fRect.Right, fRect.Bottom);
end;
end.