Перетащите растровое изображение на форму

Question

Я рисую onformpaint Событие, то же самое растровое изображение в разных местах формы, что я хотел бы сделать, это добавить функцию перетаскивания в эти растровые изображения, чтобы позволить пользователю размещать их по своему усмотрению.форма. У меня есть идея, но она кажется довольно элементарной, и я не хочу прилагать бесполезные усилия. Я был бы признателен за некоторые идеи реализации от вас, ребята.

Спасибо.

PS Я бы хотелнравится реализовывать событие OnClick поверх этих растровых изображений

Answer 1

Если у вас нет особых причин для этого, я бы не рисовал растровые изображения в обработчике OnFormPaint, поскольку это сильно усложняет то, чего вы хотите достичь.Вместо этого вы можете использовать Timages в своей форме, и ваше второе требование иметь обработчики OnClick будет выполнено.Перетаскивание TIamges также не должно быть слишком сложным при работе с компонентами TImage.

Редактирование: Вдохновленный ответом Брюса, я создал рабочий образец, используя приемы из его упомянутого примера.Я создал подкласс TPanel и TImage для достижения желаемого эффекта.Важно, что TImage является родителем в TPanel.Обратите внимание, что это просто быстрый и грязный пример, никаких проверок (например, если родитель Timahe действительно TParent).Чтобы пример работал, поместите TPanel на форму и Timage на TPanel.

unit Unit66;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg;

const
  sizeBorder = 2;
  sc_SizeLeft = $F001; { these are the variations }
  sc_SizeRight = $F002; { on the SC_SIZE value }
  sc_SizeTop = $F003;
  sc_SizeTopLeft = $F004;
  sc_SizeTopRight = $F005;
  sc_SizeBottom = $F006;
  sc_SizeBottomRight = $F008;
  sc_SizeBottomLeft = $F007;
  sc_DragMove = $F012;

type
  TPanel = class(ExtCtrls.TPanel)
  public
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
  end;

  TImage = class(ExtCtrls.TImage)
  public
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;

  end;

  TForm66 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    procedure Image1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form66: TForm66;

implementation

{$R *.dfm}
{ TImage }

procedure TPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    if (X >= Width - sizeBorder) And NOT((Y <= sizeBorder) or (Y >= Height - sizeBorder)) then
      Self.Perform(WM_SysCommand, sc_SizeRight, 0)
    else if Not((X <= sizeBorder) or (X >= Width - sizeBorder)) And (Y <= sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeTop, 0)
    else if (X <= sizeBorder) And (Y <= sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeTopLeft, 0)
    else if (X >= Width - sizeBorder) and (Y <= sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeTopRight, 0)
    else if Not((X <= sizeBorder) or (X >= Width - sizeBorder)) And (Y >= Height - sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeBottom, 0)
    else if (Y >= Height - sizeBorder) And (X <= sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeBottomLeft, 0)
    else if (Y >= Height - sizeBorder) and (X >= Width - sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeBottomRight, 0)
    else if Not((Y <= sizeBorder) or (Y >= Height - sizeBorder)) And (X <= sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeLeft, 0)
    else
    begin
      Self.Perform(WM_SysCommand, sc_DragMove, 0);
    end;
  end;

end;

procedure TPanel.MouseMove(Shift: TShiftState; X, Y: integer);
begin
  if (X <= sizeBorder) or (X >= Width - sizeBorder) then
  begin
    if (Y >= Height - sizeBorder) then
    begin
      if (X >= Width - sizeBorder) then
        Cursor := crSizeNWSE
      else
        Cursor := crSizeNESW;
    end
    else if (Y <= sizeBorder) then
    begin
      if (X >= Width - sizeBorder) then
        Cursor := crSizeNESW
      else
        Cursor := crSizeNWSE;
    end
    else
      Cursor := crSizeWE;
  end
  else if (Y <= sizeBorder) or (Y >= Height - sizeBorder) then
  begin
    Cursor := crSizeNS;
  end
  else
    Cursor := crDefault;
end;

procedure TForm66.Image1Click(Sender: TObject);
begin
  ShowMessage('Image clicked');
end;

{ TImage }

type
  TWinControlHack = class(TWinControl);

procedure TImage.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
  if ssCtrl in Shift then
    TWinControlHack(Parent).MouseDown(Button, Shift, X, Y);
end;

procedure TImage.MouseMove(Shift: TShiftState; X, Y: integer);
begin
  TWinControlHack(Parent).MouseMove(Shift, X, Y);
end;

end.

Answer 2

Вот полезный пример , который позволит вам перемещать или изменять размеры потомков TCustomControl во время выполнения.

Я думаю, что ваш лучший вариант - использовать TImage вместо пользовательского чертежа.Как указывает iamjoosy, приведенный выше пример не будет работать с TGraphicControls.Есть несколько бесплатных компонентов, которые могут быть более полезными здесь и здесь .