unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDestroy(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormResize(Sender: TObject);
private
FStartX, FStartY:Integer;
FIsButtonDown:boolean;
FBuffer:TBitMap;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
//ControlStyle:=ControlStyle+[csOpaque];
//DoubleBuffered:=true;
FIsButtonDown:=false;
FBuffer:=TBitmap.Create;
FBuffer.Height:=Height;
FBuffer.Width:=Width;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FStartX:=X;
FStartY:=Y;
FIsButtonDown:=true;
BitBlt(FBuffer.Canvas.Handle,0,0,Width,Height,Canvas.Handle,0,0,SRCCOPY);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (FIsButtonDown) then
begin
BitBlt(Canvas.Handle,0,0,Width,Height,FBuffer.Canvas.Handle,0,0,SRCCOPY);
if (ssCtrl in Shift) then Canvas.Rectangle(FStartX, FStartY, X, Y)
else
with Canvas do
begin
MoveTo(FStartX, FStartY);
LineTo(X, Y);
end;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (FIsButtonDown) then
begin
FormMouseMove(Sender, Shift, X, Y);
BitBlt(FBuffer.Canvas.Handle,0,0,Width,Height,Canvas.Handle,0,0,SRCCOPY);
FIsButtonDown:=false;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FBuffer.Destroy;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
FBuffer.Height:=Height;
FBuffer.Width:=Width;
end;
end.