Советы по Delphi
Рисование прямоугольника на изображении
Я хочу узнать как можно позволить пользователю нарисовать на изображении прямоугольник, чтобы в дальнейшем выбранную часть, к примеру, масштабировать. Я хотел бы достичь такого же эффекта, как в других программах, где с помощью мышки можно при нажатой левой кнопке мыши выделить какую-либо область изображения.
Создайте логическое поле ImageMouse, для рисования прямоугольника ImageRect используйте метод холста drawfocusrect. Следующий код работает одинаково для левой и правой кнопок мыши:
| procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);beginImageMouse := 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);VarNewRect : tRect;beginif ImageMouse thenIf (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 beginImageRect.Right := X;ImageRect.Bottom := Y;Image1.Canvas.DrawFocusRect(ImageRect);ImageMouse := False;Image1.Canvas.CopyRect(Image1.Canvas.ClipRect,Image1.Canvas,ImageRect)end;end; |
[000672]
