При создании одной из своих программ, мне потребовалось организовать возможность
перемещения элементов 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 пишем:
Подпрограмма PaintFlagi выстраивает элементы Shape по периметру Image вне
зависимости от его расположения на форме и размеров. По ходу выполнения
программы будет необходимость делать Shape видимыми или невидимыми, и этим
займутся подпрограммы FlagNoVisible и FlagVisible.
Нам также понадобятся переменные. Опишем их:
{$R *.dfm}
Var
X0, Y0: integer;
Ramka: TRamka;
Как я уже писал, саму рамку мы будем рисовать на канве. Но для этого необходима
предварительная подготовка. В событие Activate нашей формы пишем код:
Первая строка делает невидимыми Shape. Вторая строка устанавливает такой режим
карандаша, что при первой прорисовки рамки она будет рисоваться, а при повторной
прорисовки рамка будет удаляться, восстанавливая первоначальную картинку. Третья
строка делает заливку рамки бесцветной. При желании сюда же можно прописать код
ширины рамки и ее цвета:
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,
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,
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;
Хотелось бы обратить внимание на две вещи: программа реагирует только на нажатие
левой кнопки мыши, и при нажатии левой кнопки мыши рамка появляется, а при
отжатии (без перемещения) исчезает. Весьма полезные свойства. Дело в том, что
вторым свойством не обладает ни один из четырёх примеров, которые я нашёл в
Интернете. А что касается первого свойства, то у одного примера есть такой
недостаток: перенесешь картинку из одного места в другое, нажмешь на картинку
правой кнопкой мыши или колёсиком, и картинка перемещается на своё старое место.
Весьма удручающая картина.
А теперь заставим картинку менять свои размеры. Так как этот код ну очень похож
на тот код, который я уже описал, я не буду его объяснять так же подробно.
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;
Что бы изменять ширину картинки левым флагом, мы проделываем тот же самый фокус.
И в заключении я хотел бы сказать про эффект, который я назвал "ломаная рамка".
Визуально это выглядит так. При нажатии кнопки на картинке, рамка вырисовывается
частично: в тех местах, где рамка пересекает флажки, линия рамки отсутствует. В
том примере, который я написал, данный эффект отсутствует вследствие того, что я
вынес флажки за пределы рамки. Но если флажки расставить так, что бы линия рамки
пересекала их по середине, как это реализовано в Delphi, то мы обязательно
столкнёмся с данным эффектом. А дело вот в чем. Посмотрим код, который
реализовывается при нажатии левой кнопки мыши на Image:
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 становятся невидимыми вместе с той
частью рамки, где линия рамки проходит через флаги. Почему происходит так, я
могу только догадываться. Этого эффекта можно избежать, если при помощи таймера
искусственно отстрочить выполнение команды:
на одну миллисекунду (минимальное значение таймера). Но тогда вылезет другая
проблема. Если слишком резко переместить картинку, то первой уже выполниться
команда, которая должна состирать рамку. Вот тот код:
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. Возможное решение данной проблемы: все команды,
которые рисуют рамку:
и при нажатии левой кнопки мыши, и при перемещении картинки, и при отжатии
кнопки, должны выполняться через один и тот же таймер. Но не известно, к каким
другим проблемам это может привести. Если кто хочет, можете экспериментировать.