lazarus/designer/taborderdlg.pas

{
 /***************************************************************************
                             taborderdlg.pas
                             ---------------

 ***************************************************************************/

 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 *                                                                         *
 ***************************************************************************
}

unit TabOrderDlg;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, LCLProc, Forms, Controls, Graphics, Dialogs,
  Buttons, ComCtrls, StdCtrls, Arrow, LazarusIDEStrConsts;

type

  { TTabOrderDialog }

  TTabOrderDialog = class(TForm)
    ArrowUp: TArrow;
    ArrowDown: TArrow;
    CancelButton: TBitBtn;
    OkButton: TBitBtn;
    ShowOldValuesCheckbox: TCHECKBOX;
    ItemTreeview: TTREEVIEW;
    procedure DownSpeedbuttonCLICK(Sender: TObject);
    procedure OkButtonCLICK(Sender: TObject);
    procedure ShowOldValuesCheckboxCLICK(Sender: TObject);
    procedure TabOrderDialogCLOSE(Sender: TObject;
                                  var CloseAction: TCloseAction);
    procedure TabOrderDialogCREATE(Sender: TObject);
    procedure UpSpeedbuttonCLICK(Sender: TObject);
  private
    FLookupRoot: TComponent;
    procedure SetLookupRoot(const AValue: TComponent);
    procedure CommitNodes(ANode: TTreeNode; var TabChanged: boolean);
    procedure CreateNodes(ParentControl: TWinControl; ParentNode: TTreeNode);
  public
    procedure FillTree;
    procedure ClearTree;
  public
    property LookupRoot: TComponent read FLookupRoot write SetLookupRoot;
  end;

function ShowTabOrderDialog(LookupRoot: TComponent): TModalresult;

implementation

function ShowTabOrderDialog(LookupRoot: TComponent): TModalresult;
var
  TabOrderDialog: TTabOrderDialog;
begin
  TabOrderDialog:=TTabOrderDialog.Create(nil);
  TabOrderDialog.LookupRoot:=LookupRoot;
  Result:=TabOrderDialog.ShowModal;
  TabOrderDialog.Free;
end;

{ TTabOrderDialog }

procedure TTabOrderDialog.TabOrderDialogCREATE(Sender: TObject);
begin
  ShowOldValuesCheckbox.Caption:=lisShowOldTabOrder;
end;

procedure TTabOrderDialog.UpSpeedbuttonCLICK(Sender: TObject);
var
  CurItem: TTreeNode;
begin
  CurItem:=ItemTreeview.Selected;
  if (CurItem=nil) or (CurItem.GetPrevSibling=nil) then exit;
  CurItem.MoveTo(CurItem.GetPrevSibling,naInsert);
  ItemTreeview.Selected:=CurItem;
end;

procedure TTabOrderDialog.TabOrderDialogCLOSE(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  FLookupRoot:=nil;
end;

procedure TTabOrderDialog.ShowOldValuesCheckboxCLICK(Sender: TObject);
begin
  FillTree;
end;

procedure TTabOrderDialog.DownSpeedbuttonCLICK(Sender: TObject);
var
  CurItem: TTreeNode;
begin
  CurItem:=ItemTreeview.Selected;
  if (CurItem=nil) or (CurItem.GetNextSibling=nil) then exit;
  CurItem.MoveTo(CurItem.GetNextSibling,naInsertBehind);
  ItemTreeview.Selected:=CurItem;
end;

procedure TTabOrderDialog.OkButtonCLICK(Sender: TObject);
var
  TabChanged: Boolean;
begin
  TabChanged:=false;
  CommitNodes(ItemTreeview.Items.GetFirstNode,TabChanged);
  if TabChanged then
    ModalResult:=mrOk
  else
    ModalResult:=mrCancel;
end;

procedure TTabOrderDialog.SetLookupRoot(const AValue: TComponent);
begin
  if FLookupRoot=AValue then exit;
  FLookupRoot:=AValue;
  if FLookupRoot<>nil then begin
    Caption:=lisTabOrderOf + ' ' + FLookupRoot.Name;
  end;
  FillTree;
end;

procedure TTabOrderDialog.CommitNodes(ANode: TTreeNode;
  var TabChanged: boolean);
var
  AControl: TWinControl;
  CurTabOrder: Integer;
begin
  CurTabOrder:=0;
  while ANode<>nil do begin
    AControl:=TWinControl(ANode.Data);
    if AControl.TabStop then begin
      if AControl.TabOrder<>CurTabOrder then
        TabChanged:=true;
      AControl.TabOrder:=TTabOrder(CurTabOrder);
      DebugLn('TTabOrderDialog.CommitNodes A ',AControl.Name,' ',
        IntToStr(AControl.TabOrder),' ',IntToStr(CurTabOrder));
      inc(CurTabOrder);
    end;
    CommitNodes(ANode.GetFirstChild,TabChanged);
    ANode:=ANode.GetNextSibling;
  end;
end;

procedure TTabOrderDialog.FillTree;
var
  AControl: TWinControl;
begin
  ItemTreeview.BeginUpdate;
  try
    ClearTree;
    if (FLookupRoot=nil) or (not (FLookupRoot is TWinControl)) then exit;
    AControl:=TWinControl(FLookupRoot);
    CreateNodes(AControl,nil);
  finally
    ItemTreeview.EndUpdate;
  end;
end;

procedure TTabOrderDialog.ClearTree;
begin
  ItemTreeview.Items.Clear;
end;

procedure TTabOrderDialog.CreateNodes(ParentControl: TWinControl;
  ParentNode: TTreeNode);
var
  i: Integer;
  AControl: TControl;
  CurTab: Integer;
  FirstSibling: TTreeNode;
  NodeBehind: TTreeNode;
  NewNode: TTreeNode;
  NodeText: String;
  AWinControl: TWinControl;
begin
  ItemTreeview.BeginUpdate;
  if ParentNode=nil then
    FirstSibling:=nil
  else
    FirstSibling:=ParentNode.GetFirstChild;
  for i:=0 to ParentControl.ControlCount-1 do begin
    AControl:=ParentControl.Controls[i];
    if not (AControl is TWinControl) then continue;
    AWinControl:=TWinControl(AControl);
    CurTab:=AWinControl.TabOrder;
    NodeBehind:=FirstSibling;
    while (NodeBehind<>nil) and (TWinControl(NodeBehind.Data).TabOrder<=CurTab)
    do
      NodeBehind:=NodeBehind.GetNextSibling;
    NodeText:=AWinControl.Name;
    if ShowOldValuesCheckbox.Checked then
      NodeText:=NodeText+'   ('+IntToStr(AWinControl.TabOrder)+')';
    if NodeBehind<>nil then
      NewNode:=ItemTreeview.Items.InsertObject(NodeBehind,NodeText,AControl)
    else
      NewNode:=ItemTreeview.Items.AddChildObject(ParentNode,NodeText,AControl);
    if (FirstSibling=nil) or (NewNode.GetPrevSibling=nil) then
      FirstSibling:=NewNode;
    CreateNodes(AWinControl,NewNode);
    NewNode.Expanded:=true;
  end;
  ItemTreeview.EndUpdate;
end;

initialization
  {$I taborderdlg.lrs}

end.