|
|
|
|
Delphi 1
Рисование прямоугольника на изображении
Я хочу узнать как можно позволить пользователю нарисовать на изображении прямоугольник,
чтобы в дальнейшем выбранную часть, к примеру, масштабировать.
Я хотел бы достичь такого же эффекта, как в других программах, где
с помощью мышки можно при нажатой левой кнопке мыши выделить какую-либо область изображения.
Создайте логическое поле 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]
|
|
|
|
|