1 {
2 /***************************************************************************
3 taborderdlg.pas
4 ---------------
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 * *
10 * This source is free software; you can redistribute it and/or modify *
11 * it under the terms of the GNU General Public License as published by *
12 * the Free Software Foundation; either version 2 of the License, or *
13 * (at your option) any later version. *
14 * *
15 * This code is distributed in the hope that it will be useful, but *
16 * WITHOUT ANY WARRANTY; without even the implied warranty of *
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
18 * General Public License for more details. *
19 * *
20 * A copy of the GNU General Public License is available on the World *
21 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
22 * obtain it by writing to the Free Software Foundation, *
23 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
24 * *
25 ***************************************************************************
26 }
27
28 unit TabOrderDlg;
29
30 {$mode objfpc}{$H+}
31
32 interface
33
34 uses
35 Classes, SysUtils, Laz_AVL_Tree,
36 // LCL
37 Forms, Controls, Dialogs, Buttons, ExtCtrls, StdCtrls, ComCtrls, LCLType,
38 // LazUtils
39 LazLoggerBase,
40 // IdeIntf
41 PropEdits, IDEDialogs, IDEImagesIntf,
42 //IDE
43 IDEOptionDefs, LazarusIDEStrConsts;
44
45 type
46
47 { TTabOrderDialog }
48
49 TTabOrderDialog = class(TForm)
50 ArrowDown: TSpeedButton;
51 ArrowUp: TSpeedButton;
52 CheckBoxSortRecursivly: TCheckBox;
53 PanelSortByPosition: TPanel;
54 ItemTreeview: TTreeView;
55 SortByPositionButton: TBitBtn;
56 procedure ItemTreeviewSelectionChanged(Sender: TObject);
57 procedure SortByPositionButtonClick(Sender: TObject);
58 procedure FormShow(Sender: TObject);
59 procedure TabOrderDialogCreate(Sender: TObject);
60 procedure UpSpeedbuttonClick(Sender: TObject);
61 procedure DownSpeedbuttonClick(Sender: TObject);
62 procedure ItemTreeviewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
63 private
64 FUpdating: Boolean;
65 procedure SwapNodes(ANode1, ANode2, NewSelected: TTreeNode);
66 procedure CheckButtonsEnabled;
67 procedure CreateCandidates(OwnerComponent: TComponent; Candidates: TAvlTree);
68 procedure CreateNodes(ParentControl: TWinControl; ParentNode: TTreeNode;
69 Candidates: TAvlTree);
70 procedure RefreshTree;
71 procedure SomethingChanged;
72 procedure PersistentAdded({%H-}APersistent: TPersistent; {%H-}Select: boolean);
73 procedure PersistentDeleting({%H-}APersistent: TPersistent);
74 procedure DeletePersistent(var {%H-}APersistent: TPersistent);
75 procedure SetSelection(const ASelection: TPersistentSelectionList);
76 end;
77
78 { TTabOrderPropEditor }
79
80 TTabOrderPropEditor = class(TIntegerPropertyEditor)
81 public
GetAttributesnull82 function GetAttributes: TPropertyAttributes; override;
83 procedure Edit; override;
84 end;
85
86 var
87 TabOrderDialog: TTabOrderDialog;
88 ShowTabOrderEditor: TNotifyEvent;
89
90 implementation
91
92 {$R *.lfm}
93
SortNodeByControlPosnull94 function SortNodeByControlPos(Item1, Item2: Pointer): Integer;
95 var
96 Node1: TTreeNode absolute Item1;
97 Node2: TTreeNode absolute Item2;
98 Control1, Control2: TControl;
99 HorzDiff, TopDiff: Integer;
100 begin
101 Control1 := TControl(Node1.Data);
102 Control2 := TControl(Node2.Data);
103 Assert(Control1.Parent = Control2.Parent);
104 HorzDiff := Control1.Left - Control2.Left;
105 if Control1.Parent.BiDiMode <> bdLeftToRight then
106 begin
107 Inc(HorzDiff, Control1.Width);
108 Dec(HorzDiff, Control2.Width);
109 HorzDiff := -HorzDiff;
110 end;
111 TopDiff := Control1.Top - Control2.Top;
112 if TopDiff = 0 then
113 Exit(HorzDiff);
114
115 // Control1/2 will now refer to upper and lower control.
116 if TopDiff > 0 then
117 begin
118 Control1 := TControl(Node2.Data);
119 Control2 := TControl(Node1.Data);
120 end;
121 // If a control is "almost completely" above the other, it takes precedence
122 //regardless of the horizontal positioning.
123 if (Control1.Top + Control1.Height div 2 < Control2.Top)
124 and (Control1.Top + Control1.Height < Control2.Top + Control2.Height)
125 then
126 Result := TopDiff
127 else
128 Result := HorzDiff;
129 end;
130
131 { TTabOrderDialog }
132
133 procedure TTabOrderDialog.TabOrderDialogCreate(Sender: TObject);
134 begin
135 Name := NonModalIDEWindowNames[nmiwTabOrderEditor];
136
137 GlobalDesignHook.AddHandlerChangeLookupRoot(@SomethingChanged);
138 GlobalDesignHook.AddHandlerRefreshPropertyValues(@SomethingChanged);
139 GlobalDesignHook.AddHandlerPersistentAdded(@PersistentAdded);
140 GlobalDesignHook.AddHandlerPersistentDeleting(@PersistentDeleting);
141 GlobalDesignHook.AddHandlerDeletePersistent(@DeletePersistent);
142 GlobalDesignHook.AddHandlerSetSelection(@SetSelection);
143
144 IDEImages.AssignImage(ArrowDown, 'arrow_down');
145 IDEImages.AssignImage(ArrowUp, 'arrow_up');
146 IDEImages.AssignImage(SortByPositionButton, 'menu_edit_sort');
147
148 ArrowDown.Hint:=lisTabOrderDownHint;
149 ArrowUp.Hint:=lisTabOrderUpHint;
150 SortByPositionButton.Hint:=lisTabOrderSortHint;
151 CheckBoxSortRecursivly.Caption := lisTabOrderRecursively;
152 CheckBoxSortRecursivly.Hint := lisTabOrderRecursionHint;
153 end;
154
155 procedure TTabOrderDialog.FormShow(Sender: TObject);
156 var
157 Sel: TPersistentSelectionList;
158 begin
159 RefreshTree;
160 Sel := TPersistentSelectionList.Create;
161 try
162 GlobalDesignHook.GetSelection(Sel);
163 SetSelection(Sel);
164 finally
165 Sel.Free;
166 end;
167 CheckButtonsEnabled;
168 end;
169
170 procedure TTabOrderDialog.SortByPositionButtonClick(Sender: TObject);
171
172 procedure SortControls(FirstItem: TTreeNode);
173 var
174 SortedNodes: TFPList;
175 I: Integer;
176 CurrItem: TTreeNode;
177 begin
178 if Assigned(FirstItem) then begin
179 SortedNodes := TFPList.Create;
180 try
181 CurrItem := FirstItem;
182 repeat
183 if CheckBoxSortRecursivly.Checked then
184 SortControls(CurrItem.GetFirstChild);
185
186 SortedNodes.Add(CurrItem);
187 CurrItem := CurrItem.GetNextSibling;
188 until CurrItem = nil;
189
190 SortedNodes.Sort(@SortNodeByControlPos);
191
192 for I := SortedNodes.Count - 1 downto 0 do
193 begin
194 CurrItem := TTreeNode(SortedNodes[I]);
195 CurrItem.MoveTo(FirstItem, naAddFirst);
196 TWinControl(CurrItem.Data).TabOrder := I;
197 CurrItem.Text := TWinControl(CurrItem.Data).Name + ' (' + IntToStr(I) + ')';
198 end;
199 finally
200 SortedNodes.Free;
201 end;
202 end;
203 end;
204
205 var
206 FirstItem: TTreeNode;
207 begin
208 if (ItemTreeview.Selected <> nil) and (ItemTreeview.Selected.Parent <> nil) then
209 FirstItem := ItemTreeview.Selected.Parent.GetFirstChild
210 else
211 FirstItem := ItemTreeview.Items.GetFirstNode;
212
213 if IDEMessageDialog('', Format(lisTabOrderConfirmSort, [TControl(FirstItem.Data).Parent.Name]),
214 mtConfirmation, mbOKCancel) <> mrOK then
215 begin
216 Exit;
217 end;
218
219 ItemTreeview.BeginUpdate;
220 try
221 SortControls(FirstItem);
222 finally
223 ItemTreeview.EndUpdate;
224 end;
225 GlobalDesignHook.Modified(Self);
226 GlobalDesignHook.RefreshPropertyValues;
227 CheckButtonsEnabled;
228 end;
229
230 procedure TTabOrderDialog.ItemTreeviewSelectionChanged(Sender: TObject);
231 var
232 Node: TTreeNode;
233 begin
234 if FUpdating then Exit;
235 Node := ItemTreeview.Selected;
236 if Assigned(Node) then begin
237 FUpdating := True;
238 GlobalDesignHook.SelectOnlyThis(TPersistent(Node.Data));
239 FUpdating := False;
240 CheckButtonsEnabled;
241 end;
242 end;
243
244 procedure TTabOrderDialog.UpSpeedbuttonClick(Sender: TObject);
245 var
246 CurItem, NewItem: TTreeNode;
247 begin
248 CurItem := ItemTreeview.Selected;
249 if (CurItem=nil) or (CurItem.GetPrevSibling=nil) then exit;
250 NewItem := CurItem.GetPrevSibling;
251 SwapNodes(NewItem, CurItem, CurItem);
252 end;
253
254 procedure TTabOrderDialog.DownSpeedbuttonClick(Sender: TObject);
255 var
256 CurItem, NewItem: TTreeNode;
257 begin
258 CurItem:=ItemTreeview.Selected;
259 if (CurItem=nil) or (CurItem.GetNextSibling=nil) then exit;
260 NewItem := CurItem.GetNextSibling;
261 SwapNodes(CurItem, NewItem, CurItem);
262 end;
263
264 procedure TTabOrderDialog.ItemTreeviewKeyDown(Sender: TObject; var Key: Word;
265 Shift: TShiftState);
266 begin
267 if Shift = [ssCtrl] then
268 begin
269 case Key of
270 VK_UP:
271 begin
272 ArrowUp.Click;
273 Key := 0;
274 end;
275 VK_DOWN:
276 begin
277 ArrowDown.Click;
278 Key := 0;
279 end;
280 end;
281 end;
282 end;
283
284 procedure TTabOrderDialog.SwapNodes(ANode1, ANode2, NewSelected: TTreeNode);
285 var
286 Ctrl1, Ctrl2: TWinControl;
287 TabOrd: TTabOrder;
288 begin
289 if IsVisible and not FUpdating then
290 begin
291 FUpdating := true;
292 ItemTreeview.BeginUpdate;
293 try
294 ANode2.MoveTo(ANode1,naInsert); // Move Node2 in front of Node1.
295 Ctrl1 := TWinControl(ANode1.Data);
296 Ctrl2 := TWinControl(ANode2.Data);
297 TabOrd := Ctrl1.TabOrder; // Swap TabOrder values.
298 Ctrl1.TabOrder := Ctrl2.TabOrder;
299 Ctrl2.TabOrder := TabOrd;
300 ANode1.Text := Ctrl1.Name + ' (' + IntToStr(Ctrl1.TabOrder) + ')';
301 ANode2.Text := Ctrl2.Name + ' (' + IntToStr(Ctrl2.TabOrder) + ')';
302 ItemTreeview.Selected := NewSelected;
303 GlobalDesignHook.Modified(Self);
304 GlobalDesignHook.RefreshPropertyValues;
305 CheckButtonsEnabled;
306 finally
307 ItemTreeview.EndUpdate;
308 FUpdating := false;
309 end;
310 end;
311 end;
312
313 procedure TTabOrderDialog.CheckButtonsEnabled;
314 var
315 CurItem: TTreeNode;
316 begin
317 CurItem := ItemTreeview.Selected;
318 ArrowUp.Enabled := Assigned(CurItem) and Assigned(CurItem.GetPrevSibling);
319 ArrowDown.Enabled := Assigned(CurItem) and Assigned(CurItem.GetNextSibling);
320 SortByPositionButton.Enabled := Assigned(ItemTreeview.Items.GetFirstNode);
321 end;
322
323 procedure TTabOrderDialog.CreateCandidates(OwnerComponent: TComponent;
324 Candidates: TAvlTree);
325 var
326 i: Integer;
327 AComponent: TComponent;
328 begin
329 if OwnerComponent = nil then Exit;
330 if csDestroying in OwnerComponent.ComponentState then exit;
331 for i := 0 to OwnerComponent.ComponentCount - 1 do
332 begin
333 AComponent := OwnerComponent.Components[i];
334 if csDestroying in AComponent.ComponentState then continue;
335 if Candidates.Find(AComponent)<>nil then
336 begin
337 DebugLn('WARNING: TTabOrderDialog.CreateCandidates doppelganger found ', AComponent.Name);
338 end
339 else
340 begin
341 Candidates.Add(AComponent);
342 if csInline in AComponent.ComponentState then
343 CreateCandidates(AComponent, Candidates);
344 end;
345 end;
346 end;
347
348 procedure TTabOrderDialog.CreateNodes(ParentControl: TWinControl; ParentNode: TTreeNode; Candidates: TAvlTree);
349 // Add all controls in Designer to ItemTreeview.
350 var
351 AControl: TControl;
352 i, CurTab: integer;
353 FirstSibling: TTreeNode;
354 NodeBehind: TTreeNode;
355 NewNode: TTreeNode;
356 NodeText: string;
357 AWinControl: TWinControl;
358 begin
359 ItemTreeview.BeginUpdate;
360 if ParentNode = nil then
361 FirstSibling := nil
362 else
363 FirstSibling := ParentNode.GetFirstChild;
364 for i := 0 to ParentControl.ControlCount - 1 do
365 begin
366 AControl := ParentControl.Controls[i];
367 // skip non TWinControls and invisible form designer controls
368 if not (AControl is TWinControl) or (csNoDesignVisible in AControl.ControlStyle) or
369 not Assigned(Candidates.Find(AControl))
370 then
371 continue;
372 AWinControl := TWinControl(AControl);
373 CurTab := AWinControl.TabOrder;
374 NodeBehind := FirstSibling;
375 while (NodeBehind <> nil) and (TWinControl(NodeBehind.Data).TabOrder <= CurTab) do
376 NodeBehind := NodeBehind.GetNextSibling;
377 NodeText := AWinControl.Name + ' (' + IntToStr(AWinControl.TabOrder) + ')';
378 if NodeBehind <> nil then
379 NewNode := ItemTreeview.Items.InsertObject(NodeBehind, NodeText, AControl)
380 else
381 NewNode := ItemTreeview.Items.AddChildObject(ParentNode, NodeText, AControl);
382 if (FirstSibling = nil) or (NewNode.GetPrevSibling = nil) then
383 FirstSibling := NewNode;
384 CreateNodes(AWinControl, NewNode, Candidates);
385 NewNode.Expanded := True;
386 end;
387 ItemTreeview.EndUpdate;
388 end;
389
390 procedure TTabOrderDialog.RefreshTree;
391 var
392 LookupRoot: TPersistent;
393 Candidates: TAvlTree;
394 begin
395 if not IsVisible then Exit;
396 ItemTreeview.BeginUpdate;
397 try
398 ItemTreeview.Items.Clear;
399 LookupRoot := GlobalDesignHook.LookupRoot;
400 if LookupRoot is TWinControl then begin
401 Candidates := TAvlTree.Create;
402 try
403 CreateCandidates(TComponent(LookupRoot), Candidates);
404 CreateNodes(TWinControl(LookupRoot), nil, Candidates);
405 finally
406 Candidates.Free;
407 end;
408 Caption := Format(lisTabOrderOf, [TWinControl(LookupRoot).Name]);
409 end else
410 Caption := lisMenuViewTabOrder;
411 finally
412 ItemTreeview.EndUpdate;
413 end;
414 end;
415
416 procedure TTabOrderDialog.SomethingChanged;
417 begin
418 if FUpdating then Exit;
419 FUpdating := true;
420 RefreshTree;
421 CheckButtonsEnabled;
422 FUpdating := false;
423 end;
424
425 procedure TTabOrderDialog.PersistentAdded(APersistent: TPersistent; Select: boolean);
426 begin
427 SomethingChanged;
428 end;
429
430 procedure TTabOrderDialog.PersistentDeleting(APersistent: TPersistent);
431 begin
432 SomethingChanged;
433 end;
434
435 procedure TTabOrderDialog.DeletePersistent(var APersistent: TPersistent);
436 begin
437 ShowMessage('TTabOrderDialog.OnDeletePersistent is never called for some reason!');
438 SomethingChanged;
439 end;
440
441 procedure TTabOrderDialog.SetSelection(const ASelection: TPersistentSelectionList);
442 // Select item also in TreeView when selection in Designer changes.
443
FindSelectionnull444 function FindSelection: TTreeNode;
445 var
446 Node: TTreeNode;
447 begin
448 Node := ItemTreeview.Items.GetFirstNode;
449 while Assigned(Node) do
450 begin
451 if Assigned(Node.Data)
452 and (ASelection.IndexOf(TPersistent(Node.Data)) >= 0) then
453 Exit(Node);
454 Node := Node.GetNext;
455 end;
456 Result := Nil;
457 end;
458
459 var
460 Node: TTreeNode;
461 begin
462 // ToDo: support also multiply selections.
463 if FUpdating then Exit;
464 FUpdating := True;
465 Node := FindSelection;
466 if Node = Nil then
467 begin // Changing TabSheet in a PageControl does not trigger handlers
468 RefreshTree; // thus selection is not found -> refresh tree and try again.
469 Node := FindSelection;
470 end;
471 if Assigned(Node) then
472 ItemTreeview.Selected := Node;
473 FUpdating := False;
474 CheckButtonsEnabled;
475 end;
476
477 { TTabOrderPropEditor }
478
GetAttributesnull479 function TTabOrderPropEditor.GetAttributes: TPropertyAttributes;
480 begin
481 Result:=(inherited GetAttributes)+[paDialog];
482 end;
483
484 procedure TTabOrderPropEditor.Edit;
485 begin
486 ShowTabOrderEditor(Self);
487 end;
488
489 initialization
490 RegisterPropertyEditor(TypeInfo(TTabOrder), TControl, 'TabOrder', TTabOrderPropEditor);
491
492 end.
493
494