Создание рамки для перемещения Image
При создании одной из своих программ, мне потребовалось организовать возможность
перемещения элементов Image внутри формы и возможность изменять их размеры. Сама
по себе задача не сложная, сложность заключалась в том, как все это делать при
помощи мышки, в лучших традициях фотошопа и еже с ним. Как и любой другой
начинающий программист, я полез в Интернет. Там я нашел, по меньшей мере, четыре
способа решения моей проблемы, но все они обладали различными недостатками, в
результате чего пришлось писать свой собственный код. Получился достаточно
длинный код, но зато сама рамка не хуже, чем у профессионалов.
Создадим новый проект. Название формы делаем MainForm. Кидаем на форму один
Image и восемь Shape. В раздел uses добавляем модуль jpeg. Это необходимо, что
бы наше приложение понимало данный формат. Загружаем в Image любую картинку.
Элементы Shape будут играть роль флажков, при помощи которых мы будем изменять
размер нашей картинки. Первоначально элемент Shape представляет собой белый
квадрат с черной рамкой. Лично я предпочитаю оставить данное сочетание цветов
как есть. А вот размеры всех Shape (свойства Width и Height) сделаем 8 на 8
пикселей.
Саму рамку мы будем рисовать на канве формы. Но, прежде всего, нам нужны
переменные, куда мы будем сохранять ее размеры. Для этой цели мы воспользуемся
записью (представление). В раздел type, перед строкой TMainForm = class(TForm)
записываем соответствующий код. Должно получиться вот так:
type TRamka = record Top: integer; Left: integer; Width: integer; Height: integer; end; TMainForm = class(TForm)
В данной программе нам не обойтись без своих собственных подпрограмм. Давайте
напишем их. В раздел private пишем:
private { Private declarations } Procedure PaintFlagi; Procedure FlagVisible; Procedure FlagNoVisible; Public
А вот и сами подпрограммы:
procedure TMainForm.PaintFlagi; begin Shape1.Top := Image1.Top - 8; Shape1.Left := Image1.Width div 2 - 4 + Image1.Left; Shape2.Top := Image1.Top - 8; Shape2.Left := Image1.Left + Image1.Width; Shape3.Top := Image1.Top + Image1.Height div 2 - 4; Shape3.Left := Image1.Left + Image1.Width; Shape4.Top := Image1.Top + Image1.Height; Shape4.Left := Image1.Left + Image1.Width; Shape5.Top := Image1.Top + Image1.Height; Shape5.Left := Image1.Left + Image1.Width div 2 - 4; Shape6.Top := Image1.Top + Image1.Height ; Shape6.Left := Image1.Left - 8; Shape7.Top := Image1.Top + Image1.Height div 2 - 4; Shape7.Left := Image1.Left - 8; Shape8.Top := Image1.Top - 8; Shape8.Left := Image1.Left - 8; end; procedure TMainForm.FlagNoVisible; begin Shape1.Visible := False; Shape2.Visible := False; Shape3.Visible := False; Shape4.Visible := False; Shape5.Visible := False; Shape6.Visible := False; Shape7.Visible := False; Shape8.Visible := False; end; procedure TMainForm.FlagVisible; begin Shape1.Visible := True; Shape2.Visible := True; Shape3.Visible := True; Shape4.Visible := True; Shape5.Visible := True; Shape6.Visible := True; Shape7.Visible := True; Shape8.Visible := True; end;
Подпрограмма PaintFlagi выстраивает элементы Shape по периметру Image вне
зависимости от его расположения на форме и размеров. По ходу выполнения
программы будет необходимость делать Shape видимыми или невидимыми, и этим
займутся подпрограммы FlagNoVisible и FlagVisible.
Нам также понадобятся переменные. Опишем их:
{$R *.dfm} Var X0, Y0: integer; Ramka: TRamka;
Как я уже писал, саму рамку мы будем рисовать на канве. Но для этого необходима
предварительная подготовка. В событие Activate нашей формы пишем код:
procedure TMainForm.FormActivate(Sender: TObject); begin FlagNoVisible; MainForm.Canvas.Pen.Mode := pmNotXor; MainForm.Canvas.Brush.Style := bsClear; end;
Первая строка делает невидимыми Shape. Вторая строка устанавливает такой режим
карандаша, что при первой прорисовки рамки она будет рисоваться, а при повторной
прорисовки рамка будет удаляться, восстанавливая первоначальную картинку. Третья
строка делает заливку рамки бесцветной. При желании сюда же можно прописать код
ширины рамки и ее цвета:
MainForm.Canvas.Pen.Color := цвет.
MainForm.Canvas.Pen.Width := ширина.
А теперь заставим Image перемещаться по форме. В событие MouseDown элемента
Image пишем такой код:
procedure TMainForm.Image1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // В начале мы проверяем, была ли нажата именно левая кнопка мыши IF button = mbLeft then begin // делаем невидимыми наши флажки FlagNoVisible; // передаём координаты и размеры картинки в элемент записи Ramka Ramka.Top := Image1.Top; Ramka.Left := Image1.Left; Ramka.Width := Image1.Width; Ramka.Height := Image1.Height; // запоминаем начальные координаты мыши X0 := X; Y0 := Y; // рисуем рамку Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height); end; end;
В событие MouseMove мы пишем:
procedure TMainForm.Image1MouseMove(Sender: TObject; Shift:
TShiftState; X,Y: Integer); begin // если нажата левая кнопка мыши IF ssLeft in Shift then begin // стираем рамку на старом месте Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height); // вычисляем новые координаты рамки Ramka.Left := Ramka.Left + X - X0; Ramka.Top := Ramka.Top + Y - Y0; // запоминаем новые координаты мыши X0 := x; Y0 := y; // рисуем рамку на новом месте Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height); end; end;
В событие MouseUp пишем:
procedure TMainForm.Image1MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // проверяем левую кнопку мыши if button = mbLeft then begin // определяем новые координаты Image Image1.Top := Ramka.Top; Image1.Left := Ramka.Left; // стираем рамку Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height); // ставим флаги на новое место PaintFlagi; // делаем флаги видимыми FlagVisible; end; end;
Хотелось бы обратить внимание на две вещи: программа реагирует только на нажатие
левой кнопки мыши, и при нажатии левой кнопки мыши рамка появляется, а при
отжатии (без перемещения) исчезает. Весьма полезные свойства. Дело в том, что
вторым свойством не обладает ни один из четырёх примеров, которые я нашёл в
Интернете. А что касается первого свойства, то у одного примера есть такой
недостаток: перенесешь картинку из одного места в другое, нажмешь на картинку
правой кнопкой мыши или колёсиком, и картинка перемещается на своё старое место.
Весьма удручающая картина.
А теперь заставим картинку менять свои размеры. Так как этот код ну очень похож
на тот код, который я уже описал, я не буду его объяснять так же подробно.
Верхний флаг:
procedure TMainForm.Shape1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF button = mbLeft then begin FlagNoVisible; Ramka.Top := Image1.Top; Ramka.Left := Image1.Left; Ramka.Width := Image1.Width; Ramka.Height := Image1.Height + Ramka.Top; Y0 := Y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Height); end; end; procedure TMainForm.Shape1MouseMove(Sender: TObject; Shift:
TShiftState; X, Y: Integer); begin IF ssLeft in Shift then begin Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Height); Ramka.Top := Ramka.Top + Y - Y0; Y0 := y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Height); end; end; procedure TMainForm.Shape1MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button = mbLeft then begin Image1.Top := Ramka.Top; Image1.Height := Ramka.Height - Ramka.Top; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Height); PaintFlagi; FlagVisible; end; end;
Здесь мы изменяем высоту Image по верхнему флажку. Но следует отметить, что у
прямоугольника, нарисованного на канве, в отличие от Image нет таких свойств как
высота и ширина. Есть ближние точки и дальние точки. И что бы иметь возможность
изменять координату ближней точки, не изменяя координаты дальней точки, мы
пользуемся кодом:
Ramka.Height := Image1.Height + Ramka.Top;
А что бы вычислить новую высоту картинки, мы используем код:
Image1.Height := Ramka.Height - Ramka.Top;
Что бы изменять ширину картинки левым флагом, мы проделываем тот же самый фокус.
Левый флаг:
procedure TMainForm.Shape7MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF button = mbLeft then begin FlagNoVisible; Ramka.Top := Image1.Top; Ramka.Left := Image1.Left; Ramka.Width := Image1.Width + Image1.Left; Ramka.Height := Image1.Height; X0 := X; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Top + Ramka.Height); end; end; procedure TMainForm.Shape7MouseMove(Sender: TObject; Shift:
TShiftState; X,Y: Integer); begin IF ssLeft in Shift then begin Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Top + Ramka.Height); Ramka.Left := Ramka.Left + X - X0; X0 := x; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Top + Ramka.Height); end; end; procedure TMainForm.Shape7MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button = mbLeft then begin Image1.Left := Ramka.Left; Image1.Width := Ramka.Width - Ramka.Left; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Top + Ramka.Height); PaintFlagi; FlagVisible; end; end;
Совмещаем код левого и верхнего флагов, и получаем код верхнего левого флага.
Верхний левый флаг:
procedure TMainForm.Shape8MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF button = mbLeft then begin FlagNoVisible; Ramka.Top := Image1.Top; Ramka.Left := Image1.Left; Ramka.Width := Image1.Width + Image1.Left; Ramka.Height := Image1.Height + Image1.Top; X0 := X; Y0 := Y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Height); end; end; procedure TMainForm.Shape8MouseMove(Sender: TObject;
Shift: TShiftState; X,Y: Integer); begin IF ssLeft in Shift then begin Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Height); Ramka.Left := Ramka.Left + X - X0; Ramka.Top := Ramka.Top + Y - Y0; X0 := x; Y0 := y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Height); end; end; procedure TMainForm.Shape8MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button = mbLeft then begin Image1.Top := Ramka.Top; Image1.Left := Ramka.Left; Image1.Width := Ramka.Width - Ramka.Left; Image1.Height := Ramka.Height - Ramka.Top; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Height); PaintFlagi; FlagVisible; end; end;
Для изменения ширины картинки правым флагом, необходимо просто изменять ширину.
Правый флаг:
procedure TMainForm.Shape3MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF button = mbLeft then begin FlagNoVisible; Ramka.Top := Image1.Top; Ramka.Left := Image1.Left; Ramka.Width := Image1.Width; Ramka.Height := Image1.Height; X0 := X; Canvas.Rectangle(Ramka.Left, Ramka.Top, Image1.Left + Ramka.Width,
Ramka.Top + Ramka.Height); end; end; procedure TMainForm.Shape3MouseMove(Sender: TObject;
Shift: TShiftState; X,Y: Integer); begin IF ssLeft in Shift then begin Canvas.Rectangle(Ramka.Left, Ramka.Top, Image1.Left + Ramka.Width,
Ramka.Top + Ramka.Height); Ramka.Width := Ramka.Width + X - X0; X0 := x; Canvas.Rectangle(Ramka.Left, Ramka.Top, Image1.Left + Ramka.Width,
Ramka.Top + Ramka.Height); end; end; procedure TMainForm.Shape3MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button = mbLeft then begin Image1.Width := Ramka.Width; Canvas.Rectangle(Ramka.Left, Ramka.Top, Image1.Left + Ramka.Width,
Ramka.Top + Ramka.Height); PaintFlagi; FlagVisible; end; end;
С остальными флагами, я думаю, вопросов не будет, по этому даю код без
объяснений.
Нижний флаг:
procedure TMainForm.Shape5MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF button = mbLeft then begin FlagNoVisible; Ramka.Top := Image1.Top; Ramka.Left := Image1.Left; Ramka.Width := Image1.Width; Ramka.Height := Image1.Height; Y0 := Y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height); end; end; procedure TMainForm.Shape5MouseMove(Sender: TObject;
Shift: TShiftState; X,Y: Integer); begin IF ssLeft in Shift then begin Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height); Ramka.Height := Ramka.Height + Y - Y0; Y0 := y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height); end; end; procedure TMainForm.Shape5MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button = mbLeft then begin Image1.Height := Ramka.Height; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height); PaintFlagi; FlagVisible; end; end;
Нижний правый флаг:
procedure TMainForm.Shape4MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF button = mbLeft then begin FlagNoVisible; Ramka.Top := Image1.Top; Ramka.Left := Image1.Left; Ramka.Width := Image1.Width; Ramka.Height := Image1.Height; X0 := X; Y0 := Y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Image1.Left + Ramka.Width,
Ramka.Top + Ramka.Height); end; end; procedure TMainForm.Shape4MouseMove(Sender: TObject;
Shift: TShiftState; X,Y: Integer); begin IF ssLeft in Shift then begin Canvas.Rectangle(Ramka.Left, Ramka.Top, Image1.Left + Ramka.Width,
Ramka.Top + Ramka.Height); Ramka.Width := Ramka.Width + X - X0; Ramka.Height := Ramka.Height + Y - Y0; X0 := x; Y0 := y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Image1.Left + Ramka.Width,
Ramka.Top + Ramka.Height); end; end; procedure TMainForm.Shape4MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button = mbLeft then begin Image1.Height := Ramka.Height; Image1.Width := Ramka.Width; Canvas.Rectangle(Ramka.Left, Ramka.Top, Image1.Left + Ramka.Width,
Ramka.Top + Ramka.Height); PaintFlagi; FlagVisible; end; end;
Верхний правый флаг:
procedure TMainForm.Shape2MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF button = mbLeft then begin FlagNoVisible; Ramka.Top := Image1.Top; Ramka.Left := Image1.Left; Ramka.Width := Image1.Width; Ramka.Height := Image1.Height + Ramka.Top; X0 := X; Y0 := Y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Height); end; end; procedure TMainForm.Shape2MouseMove(Sender: TObject;
Shift: TShiftState; X,Y: Integer); begin IF ssLeft in Shift then begin Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Height); Ramka.Width := Ramka.Width + X - X0; Ramka.Top := Ramka.Top + Y - Y0; X0 := x; Y0 := y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Height); end; end; procedure TMainForm.Shape2MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button = mbLeft then begin Image1.Top := Ramka.Top; Image1.Height := Ramka.Height - Ramka.Top; Image1.Width := Ramka.Width; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Height); PaintFlagi; FlagVisible; end; end;
Нижний левый флаг:
procedure TMainForm.Shape6MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF button = mbLeft then begin FlagNoVisible; Ramka.Top := Image1.Top; Ramka.Left := Image1.Left; Ramka.Width := Image1.Width + Image1.Left; Ramka.Height := Image1.Height; X0 := X; Y0 := Y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Top + Ramka.Height); end; end; procedure TMainForm.Shape6MouseMove(Sender: TObject;
Shift: TShiftState; X,Y: Integer); begin IF ssLeft in Shift then begin Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Top + Ramka.Height); Ramka.Left := Ramka.Left + X - X0; Ramka.Height := Ramka.Height + Y - Y0; X0 := x; Y0 := y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Top + Ramka.Height); end; end; procedure TMainForm.Shape6MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button = mbLeft then begin Image1.Left := Ramka.Left; Image1.Width := Ramka.Width - Ramka.Left; Image1.Height := Ramka.Height; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Width,
Ramka.Top + Ramka.Height); PaintFlagi; FlagVisible; end; end;
И в заключении я хотел бы сказать про эффект, который я назвал "ломаная рамка".
Визуально это выглядит так. При нажатии кнопки на картинке, рамка вырисовывается
частично: в тех местах, где рамка пересекает флажки, линия рамки отсутствует. В
том примере, который я написал, данный эффект отсутствует вследствие того, что я
вынес флажки за пределы рамки. Но если флажки расставить так, что бы линия рамки
пересекала их по середине, как это реализовано в Delphi, то мы обязательно
столкнёмся с данным эффектом. А дело вот в чем. Посмотрим код, который
реализовывается при нажатии левой кнопки мыши на Image:
procedure TMainForm.Image1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF button = mbLeft then begin FlagNoVisible; Ramka.Top := Image1.Top; Ramka.Left := Image1.Left; Ramka.Width := Image1.Width; Ramka.Height := Image1.Height; X0 := X; Y0 := Y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height); end; end;
Как видно из кода, команда, которая делает элементы Shape невидимыми,
выполняется раньше, чем команда, которая рисует рамку. Но в реальности в начале
рисуется рамка, а только потом элементы Shape становятся невидимыми вместе с той
частью рамки, где линия рамки проходит через флаги. Почему происходит так, я
могу только догадываться. Этого эффекта можно избежать, если при помощи таймера
искусственно отстрочить выполнение команды:
Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height);
на одну миллисекунду (минимальное значение таймера). Но тогда вылезет другая
проблема. Если слишком резко переместить картинку, то первой уже выполниться
команда, которая должна состирать рамку. Вот тот код:
procedure TMainForm.Image1MouseMove(Sender: TObject;
Shift: TShiftState; X,Y: Integer); begin IF ssLeft in Shift then begin Canvas.Rectangle(Ramka.Left, Ramka.Top,
Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height);
// рисуем рамку вместо того, что бы её стереть. Ramka.Left := Ramka.Left + X - X0; Ramka.Top := Ramka.Top + Y - Y0; X0 := x; Y0 := y; Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height); end; end;
Визуально это будет выглядеть так: рамка не будет стираться в том месте, откуда
началось перемещение Image. Возможное решение данной проблемы: все команды,
которые рисуют рамку:
Canvas.Rectangle(Ramka.Left, Ramka.Top, Ramka.Left + Ramka.Width,
Ramka.Top + Ramka.Height);
и при нажатии левой кнопки мыши, и при перемещении картинки, и при отжатии
кнопки, должны выполняться через один и тот же таймер. Но не известно, к каким
другим проблемам это может привести. Если кто хочет, можете экспериментировать.
Замечания и вопросы по статье отсылайте на
[email protected].
Оригинал статьи: image-frame.zip (19 Кб).
Дата: 06.06.2009,
Автор: