Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
Топик располагается на нескольких страницах: Ctrl  назад   1 [2]      все
 Re: Перетаскивание панелей.  [new]
ВсеРазумный
Member

Откуда:
Сообщений: 101
+
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    function GetObject(Sender: TObject; x: TClass): TObject;
    procedure FormCreate(Sender: TObject);
    procedure PanelsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, Y: Integer);
    procedure PanelsOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    Panels: TArray<TPanel>;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.GetObject(Sender: TObject; x: TClass): TObject;
begin
  while not(Sender is x) do
  begin
    Sender := TWinControl(Sender).Parent;
    if Sender = nil then
      exit(nil);
  end;
  Result := Sender;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SetLength(Panels, 0); // Не нуждается в вызове free
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
  m: TImage;
begin
  SetLength(Panels, 10);

  for I := Low(Panels) to High(Panels) do
  begin
    Panels[I] := TPanel.Create(self); // (Form1.Components[i] is TPanel) as TPanel
    with Panels[I] do
    begin
      Parent := self; // Show to form

      OnMouseDown := PanelsMouseDown;
      OnMouseUp := PanelsOnMouseUp;

      m := TImage.Create(Panels[I]); // (Panels[I].Components[i] is TImage) as TImage
      with m do
      begin
        Parent := Panels[I]; // Show to panel
        Picture.LoadFromFile('Treetog-Junior-Camera.ico');
        AutoSize := true;

        OnMouseDown := PanelsMouseDown;
        OnMouseUp := PanelsOnMouseUp;
      end;

      Width := m.Width;
      Height := m.Height;

      Top := (m.Height * I);
    end;
  end;

  Height := High(Panels) * Panels[0].Height * 2;
end;

procedure TForm1.PanelsOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, Y: Integer);
begin
  Sender := GetObject(Sender, TPanel);
  if Sender = nil then
    exit;

  TWinControl(Sender).Visible := true;

  Caption := x.ToString + ' : ' + Y.ToString;
end;

procedure TForm1.PanelsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, Y: Integer);
var
  t: TPoint;
begin
  Sender := GetObject(Sender, TPanel);
  if Sender = nil then
    exit;

  with TWinControl(Sender) do
  begin
    Visible := false;

    ReleaseCapture;

    Perform(WM_SYSCOMMAND, $F012, 0);

    t := Parent.ScreenToClient(Mouse.CursorPos);

    Perform(WM_LBUTTONUP, MK_CONTROL, MakeLong(t.x, t.Y));
  end;
end;

end.


З.ы. В удаление панелей нет необходимости. Их можно скрывать\отображать, на них можно перезагружать картинки.

Сообщение было отредактировано: 21 мар 20, 20:02
21 мар 20, 19:53    [22103703]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: Ctrl  назад   1 [2]      все
Все форумы / Delphi Ответить