1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Abstract:
22 A drop-down list with all component tab names.
23 Allows selection of any tab, including the ones not visible in tab control.
24 This list is opened from a button at the right edge of component palette.
25
26 This file is originally part of CodeTyphon Studio (http://www.pilotlogic.com/).
27 They improved Lazarus GPL code with this feature, then it was copied
28 and backported to Lazarus. Later it was modified with a different button etc.
29 }
30 unit CompPagesPopup;
31
32 {$mode objfpc}{$H+}
33
34 interface
35
36 uses
37 Classes, SysUtils, math,
38 // LCL
39 LCLIntf, LCLType, LMessages, Forms, Controls, ComCtrls, ExtCtrls,
40 Graphics, Dialogs, Buttons,
41 // LazUtils
42 LazLoggerBase, LazUTF8,
43 // IdeIntf
44 IDEImagesIntf, MenuIntf,
45 // IDE
46 LazarusIDEStrConsts, ComponentPalette_Options, MainBase, MainBar;
47
48 type
49
50 { TDlgCompPagesPopup }
51
52 TDlgCompPagesPopup = class(TForm)
53 cBtnClose: TSpeedButton;
54 Panel1: TPanel;
55 Panel2: TPanel;
56 TreeView1: TTreeView;
57 procedure cBtnCloseClick(Sender: TObject);
58 procedure FormCreate(Sender: TObject);
59 procedure FormDeactivate(Sender: TObject);
60 procedure FormShow(Sender: TObject);
61 procedure TreeView1Click(Sender: TObject);
62 private
63 fViewAllNode, fOptionsNode: TTreeNode;
64 fGroups: TStringListUTF8Fast; // Objects have group TreeNodes
65 fLastCloseUp: QWord;
66 fLastCanShowCheck: Boolean;
67 procedure AppDeactivated(Sender: TObject);
68 procedure FindGroups;
69 procedure BuildTreeItem(aPageCapt: string);
70 procedure BuildList;
71 protected
72 procedure WMActivate(var Message : TLMActivate); message LM_ACTIVATE;
73
74 procedure DoCreate; override;
75 procedure DoClose(var CloseAction: TCloseAction); override;
76 public
77 PositionForControl: TControl;
78 destructor Destroy; override;
79 procedure FixBounds;
80 procedure CanShowCheck;
81 property LastCanShowCheck: Boolean read fLastCanShowCheck;
82 end;
83
84 var
85 DlgCompPagesPopup: TDlgCompPagesPopup;
86
87
88 implementation
89
90 {$R *.lfm}
91
FirstWordnull92 function FirstWord(aStr: string): string;
93 var
94 spPos: integer;
95 begin
96 spPos := Pos(' ', aStr);
97 if spPos > 0 then
98 Result := Copy(aStr, 1, spPos-1)
99 else
100 Result := '';
101 end;
102
103 { TDlgCompPagesPopup }
104
105 procedure TDlgCompPagesPopup.FormShow(Sender: TObject);
106 begin
107 BuildList;
108 Application.AddOnDeactivateHandler(@AppDeactivated);
109 end;
110
111 procedure TDlgCompPagesPopup.FormDeactivate(Sender: TObject);
112 begin
113 Close;
114 end;
115
116 procedure TDlgCompPagesPopup.cBtnCloseClick(Sender: TObject);
117 begin
118 Close;
119 end;
120
121 procedure TDlgCompPagesPopup.FormCreate(Sender: TObject);
122 begin
123 IDEImages.AssignImage(cBtnClose, 'menu_close');
124
125 TreeView1.Images := IDEImages.Images_16;
126 {TIDEImages.AddImageToImageList(ImageList1, 'item_package');
127 TIDEImages.AddImageToImageList(ImageList1, 'pkg_open');}
128 end;
129
130 procedure TDlgCompPagesPopup.DoClose(var CloseAction: TCloseAction);
131 begin
132 inherited DoClose(CloseAction);
133 Application.RemoveOnDeactivateHandler(@AppDeactivated);
134
135 if CloseAction = caHide then
136 fLastCloseUp := GetTickCount64;
137 end;
138
139 destructor TDlgCompPagesPopup.Destroy;
140 begin
141 Application.RemoveOnDeactivateHandler(@AppDeactivated);
142 inherited Destroy;
143 end;
144
145 procedure TDlgCompPagesPopup.DoCreate;
146 begin
147 inherited DoCreate;
148
149 fLastCanShowCheck := True;
150 end;
151
152 procedure TDlgCompPagesPopup.FixBounds;
153 var
154 Mon: TRect;
155 zPos: TPoint;
156 margin, y: Integer;
157 begin
158 zPos:=point(PositionForControl.Width div 2,PositionForControl.Height);
159 zPos:=PositionForControl.ClientToScreen(zPos);
160
161 Mon := Screen.MonitorFromPoint(zPos).WorkareaRect;
162 Self.Height := TreeView1.Items.GetLastSubNode.Top + TreeView1.Items.GetLastSubNode.Height + TreeView1.Top + 20;
163
164 Self.Left := zPos.x - Self.Width div 2;
165 Self.Top:= zPos.y;
166
167 if (self.Left) < Mon.Left then
168 Self.Left := Mon.Left;
169
170 if (self.Left+self.Width) > Mon.Left + Mon.Width then
171 Self.Left := Max(Mon.Left, Mon.Left + Mon.Width - Self.Width);
172
173 margin := Min(Scale96ToScreen(150), PositionForControl.Top + PositionForControl.Height);
174 if margin > Mon.Height div 4 then
175 margin := 0;
176 if (self.Height + margin) > Mon.Height then
177 self.Height := Mon.Height - margin;
178
179 if (self.Top+self.Height) > Mon.Top + Mon.Height then begin
180 y := zPos.y - PositionForControl.Height - Self.Height;
181 if y > Mon.Top then begin
182 Self.Top := y // show above button
183 end
184 else begin
185 // overlap button, try to go right or left of it
186 Self.Top := Mon.Top + Mon.Height - Self.Height;
187 if zPos.x + PositionForControl.Width div 2 <= Mon.Left + Mon.Width - Self.Width then
188 Self.Left := zPos.x + PositionForControl.Width div 2
189 else;
190 Self.Left := Max(Mon.Left, zPos.x - PositionForControl.Width div 2 - Self.Width);
191 end;
192 end;
193
194 end;
195
196 procedure TDlgCompPagesPopup.TreeView1Click(Sender: TObject);
197 var
198 i: integer;
199 SelNode: TTreeNode;
200 e: TIDEMenuItem;
201 begin
202 SelNode:=TreeView1.Selected;
203 if (SelNode=nil) or (SelNode.ImageIndex=1) then exit;
204 if (SelNode.Data <> nil) then begin
205 e := TIDEMenuItem(SelNode.Data);
206 Close;
207 e.DoOnClick;
208 exit;
209 end;
210
211 if SelNode=fViewAllNode then
212 MainIDE.DoShowComponentList
213 else if SelNode=fOptionsNode then
214 MainIDE.DoOpenIDEOptions(TCompPaletteOptionsFrame, '', [], [])
215 else with MainIDEBar do
216 if Assigned(ComponentPageControl) and (ComponentPageControl.PageCount>0) then
217 for i:=0 to ComponentPageControl.PageCount-1 do
218 if SameText(SelNode.Text, ComponentPageControl.Page[i].Caption) then
219 begin
220 ComponentPageControl.PageIndex:=i;
221 ComponentPageControl.OnChange(Self);
222 Break;
223 end;
224 Close;
225 end;
226
227 procedure TDlgCompPagesPopup.WMActivate(var Message: TLMActivate);
228 begin
229 {$IFDEF LCLWin32}
230 //activate the mainform to simulate a true popup-window (works only on Windows)
231 if Assigned(PopupParent) and PopupParent.HandleAllocated then
232 SendMessage(PopupParent.Handle, LM_NCACTIVATE, Ord(Message.Active <> WA_INACTIVE), 0);
233 {$ENDIF}
234
235 inherited WMActivate(Message);
236 end;
237
238 procedure TDlgCompPagesPopup.FindGroups;
239 // Find groups. Page names with many words are grouped by the first word.
240 var
241 i, grpIndex: integer;
242 Word1: string;
243 begin
244 for i:=0 to MainIDEBar.ComponentPageControl.PageCount-1 do
245 begin
246 Word1 := FirstWord(MainIDEBar.ComponentPageControl.Page[i].Caption);
247 if (Word1 <> '') and (Word1 <> 'Data') then // "Data" is an exception
248 begin
249 grpIndex := fGroups.IndexOf(Word1);
250 if grpIndex > -1 then // Found, mark as group. TreeNode will be created later.
251 fGroups.Objects[grpIndex] := nil
252 else // Will be a group only if other members are found.
253 fGroups.AddObject(Word1, Self); // <>nil means a single item now.
254 end;
255 end;
256 // Delete single items (marked with "1") from groups list.
257 for i := fGroups.Count-1 downto 0 do
258 if Assigned(fGroups.Objects[i]) then
259 fGroups.Delete(i);
260 end;
261
262 procedure TDlgCompPagesPopup.AppDeactivated(Sender: TObject);
263 begin
264 Close;
265 end;
266
267 procedure TDlgCompPagesPopup.BuildTreeItem(aPageCapt: string);
268 // Create items in tree, grouping as needed.
269 var
270 grInd: integer;
271 Word1: string;
272 GroupNode, ItemNode: TTreeNode;
273 begin
274 GroupNode := Nil;
275 Word1 := FirstWord(aPageCapt);
276 if Word1 <> '' then
277 begin
278 grInd := fGroups.IndexOf(Word1);
279 if grInd > -1 then // Group found
280 begin
281 if Assigned(fGroups.Objects[grInd]) then
282 GroupNode := TTreeNode(fGroups.Objects[grInd])
283 else begin
284 GroupNode := TreeView1.Items.AddChild(nil, Word1+' pages');
285 fGroups.Objects[grInd] := GroupNode;
286 end;
287 end;
288 end;
289 ItemNode:=TreeView1.Items.AddChild(GroupNode, aPageCapt);
290 ItemNode.ImageIndex:=IDEImages.GetImageIndex('item_package');
291 ItemNode.SelectedIndex:=0;
292 end;
293
294 procedure TDlgCompPagesPopup.CanShowCheck;
295 begin
296 fLastCanShowCheck := not Visible and (GetTickCount64 > fLastCloseUp + 100);
297 end;
298
299 procedure TDlgCompPagesPopup.BuildList;
300 var
301 i: integer;
302 e: TIDEMenuItem;
303 n: TTreeNode;
304 begin
305 TreeView1.BeginUpdate;
306 TreeView1.Items.Clear;
307 fViewAllNode:=nil;
308 fOptionsNode:=nil;
309 if MainIDEBar.ComponentPageControl=nil then
310 begin
311 TreeView1.Items.AddChild(nil,'Sorry, No Pages');
312 Exit;
313 end;
314 fGroups := TStringListUTF8Fast.Create;
315 try
316 FindGroups;
317 for i:=0 to MainIDEBar.ComponentPageControl.PageCount-1 do
318 BuildTreeItem(MainIDEBar.ComponentPageControl.Page[i].Caption);
319 finally
320 fGroups.Free;
321 end;
322
323 // add 'View all'
324 fViewAllNode:=TreeView1.Items.AddChild(nil, lisCompPalComponentList);
325 fViewAllNode.ImageIndex:=IDEImages.GetImageIndex('menu_view_components');
326 fViewAllNode.SelectedIndex:=fViewAllNode.ImageIndex;
327
328 for i := 0 to ComponentPalettePageDropDownExtraEntries.Count - 1 do begin
329 e := ComponentPalettePageDropDownExtraEntries.Items[i];
330 n := TreeView1.Items.AddChildObject(nil, e.Caption, Pointer(e));
331 n.ImageIndex := e.ImageIndex;
332 end;
333
334 // add 'Options'
335 fOptionsNode:=TreeView1.Items.AddChild(nil, lisMenuGeneralOptions);
336 fOptionsNode.ImageIndex:=IDEImages.LoadImage('menu_environment_options');
337 fOptionsNode.SelectedIndex:=fOptionsNode.ImageIndex;
338
339 TreeView1.EndUpdate;
340 TreeView1.FullExpand;
341 Panel2.Caption:=Format(lisTotalPages,
342 [IntToStr(MainIDEBar.ComponentPageControl.PageCount)]);
343
344 FixBounds;
345 end;
346
347 end.
348
349