|
Рисование прямоугольника на изображении
|
Билл Гейтс помер и попал на небеса, а там вместо апостола Петра машину с Windows поставили. И, значит, в окне на мониторе надпись: "Уважаемый Билл, за Ваши заслуги перед человечеством мы разрешаем Вам самому выбрать, куда Вы попадете - в ад или в рай Выбирайте - в ад или в рай?". И ниже три кнопки с вариантами ответов: "Yes, No,Cancel"...
|
Я хочу узнать как можно позволить пользователю нарисовать на
изображении прямоугольник, чтобы в дальнейшем выбранную часть, к примеру,
масштабировать. Я хотел бы достичь такого же эффекта, как в других программах,
где с помощью мышки можно при нажатой левой кнопке мыши выделить какую-либо
область изображения.
Создайте логическое поле 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;
|
|
