|
Перетаскивание панелей.
#39939937
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
|
|
|
|
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.
З.ы. В удаление панелей нет необходимости. Их можно скрывать\отображать, на них можно перезагружать картинки.
|
|
|