Delphi7从入门到精通及附书源码 Delphi7从入门到精通及附书源码

源代码在线查看: mousef.pas

软件大小: 25335 K
上传用户: ys0796
关键词: Delphi7 源码
下载地址: 免注册下载 普通下载 VIP

相关代码

				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.
				
							

相关资源