Рисование прямоугольника на изображении

Delphi , Компоненты и Классы , TImage и TImageList

Рисование прямоугольника на изображении

Билл Гейтс помер и попал на небеса, а там вместо апостола Петра машину с 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;

Статья Рисование прямоугольника на изображении раздела Компоненты и Классы TImage и TImageList может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.

:: Главная :: TImage и TImageList ::

Время компиляции файла: 2024-04-24 22:55:34
2024-04-26 13:43:45/0.0032031536102295/0