Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  125

•  TDictionary Custom Sort  3 312

•  Fast Watermark Sources  3 062

•  3D Designer  4 818

•  Sik Screen Capture  3 314

•  Patch Maker  3 528

•  Айболит (remote control)  3 628

•  ListBox Drag & Drop  2 992

•  Доска для игры Реверси  81 537

•  Графические эффекты  3 922

•  Рисование по маске  3 227

•  Перетаскивание изображений  2 608

•  Canvas Drawing  2 732

•  Рисование Луны  2 556

•  Поворот изображения  2 163

•  Рисование стержней  2 160

•  Paint on Shape  1 564

•  Генератор кроссвордов  2 223

•  Головоломка Paletto  1 764

•  Теорема Монжа об окружностях  2 211

 

 

Архив исходников

   
  Базы данных
  Графика & Мультимедиа
  Сети & Интернет
  Система
  Разное
   

Ссылки и Баннеры ...

 

Delphi Sources

Delphi Sources

СТАТЬИ

 

. : Создание рамки для перемещения 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);


и при нажатии левой кнопки мыши, и при перемещении картинки, и при отжатии кнопки, должны выполняться через один и тот же таймер. Но не известно, к каким другим проблемам это может привести. Если кто хочет, можете экспериментировать.

Замечания и вопросы по статье отсылайте на AlickL@mail.ru.
 

Оригинал статьи: image-frame.zip (19 Кб).

Дата: 06.06.2009, Автор: Александр Лобутев.



Назад

   

 





















































































































































































































































































































































































































































































































 

© 2004-2024 "DS"

Соглашение пользователя / Реклама / Карта сайта             Created by BrokenByte Software