Советы по Delphi
Рисование прямоугольника на изображении
Я хочу узнать как можно позволить пользователю нарисовать на изображении прямоугольник, чтобы в дальнейшем выбранную часть, к примеру, масштабировать. Я хотел бы достичь такого же эффекта, как в других программах, где с помощью мышки можно при нажатой левой кнопке мыши выделить какую-либо область изображения.
Создайте логическое поле ImageMouse, для рисования прямоугольника ImageRect используйте метод холста drawfocusrect. Следующий код работает одинаково для левой и правой кнопок мыши:
|
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ImageMouse := True;
ImageRect.Left := X;
ImageRect.Top := Y;
ImageRect.Right := X;
ImageRect.Bottom := Y;
Image1.Canvas.DrawFocusRect(ImageRect);
end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Var NewRect : tRect; begin if ImageMouse then If (X > ImageRect.Left) AND (Y > ImageRect.Top) then begin {Восстанавливаем фон} Image1.Canvas.DrawFocusRect(ImageRect); {Меняем прямоугольник} ImageRect.Right := X; ImageRect.Bottom := Y; {Рисуем прямоугольник фокуса} Image1.Canvas.DrawFocusRect(ImageRect); end; end; procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin {Восстанавливаем фон} if ImageMouse then begin ImageRect.Right := X; ImageRect.Bottom := Y; Image1.Canvas.DrawFocusRect(ImageRect); ImageMouse := False; Image1.Canvas.CopyRect(Image1.Canvas.ClipRect, Image1.Canvas,ImageRect) end; end; |
[000672]
