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

Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...

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

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