Показать сообщение отдельно
  #5  
Старый 13.05.2013, 21:39
icWasya icWasya вне форума
Местный
 
Регистрация: 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.
Ответить с цитированием