
13.05.2013, 21:39
|
Местный
|
|
Регистрация: 09.11.2010
Сообщения: 499
Репутация: 10
|
|
Надо примерно так
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
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
MovedCanvas:TCanvas;
MovedPoint1,MovedPoint2:TPoint;
procedure DrawRectangle();
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DrawRectangle();
begin
if MovedCanvas = Nil then Exit;
with MovedCanvas do begin
Pen.Color:= clRed; // можно другой;
Pen.Mode := pmXor; // а вот это важно!;
MoveTo(MovedPoint1.X,MovedPoint1.Y);
LineTo(MovedPoint1.X,MovedPoint2.Y);
LineTo(MovedPoint2.X,MovedPoint2.Y);
LineTo(MovedPoint2.X,MovedPoint1.Y);
LineTo(MovedPoint1.X,MovedPoint1.Y);
end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not (ssLeft in Shift) then Exit;
MovedCanvas := Canvas;
MovedPoint1.X:=X;
MovedPoint1.Y:=Y;
MovedPoint2.X:=X;
MovedPoint2.Y:=Y;
DrawRectangle(true);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if MovedCanvas = Nil then Exit;
DrawRectangle(true);
MovedPoint2.X:=X;
MovedPoint2.Y:=Y;
DrawRectangle(true);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if MovedCanvas = Nil then Exit;
DrawRectangle(true);
MovedCanvas := nil;
// а вот тут можно что нибудь нарисовать
Canvas.Pen.Color := clBlack;
Canvas.Pen.Mode := pmCopy;
Canvas.Brush.Color:=clYellow;
//Canvas.FillRect(Canvas.ClipRect); вот это не нужно
Canvas.Rectangle(MovedPoint1.X,MovedPoint1.Y,MovedPoint2.X,MovedPoint2.Y);
end;
end.
|