|
При создании одной из своих
программ, мне потребовалось организовать возможность перемещения
элементов 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);
и при нажатии левой кнопки мыши, и при перемещении картинки, и
при отжатии кнопки, должны выполняться через один и тот же
таймер. Но не известно, к каким другим проблемам это может
привести. Если кто хочет, можете экспериментировать.
| 
