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