powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Перетаскивание панелей.
1 сообщений из 26, страница 2 из 2
Перетаскивание панелей.
    #39939937
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
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.



З.ы. В удаление панелей нет необходимости. Их можно скрывать\отображать, на них можно перезагружать картинки.
...
Рейтинг: 0 / 0
1 сообщений из 26, страница 2 из 2
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Перетаскивание панелей.
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]