Componentes.Terceros.SpTBXLib/internal/2.4.4/1/Source/SpTBXCustomizerForm.pas

unit SpTBXCustomizerForm;

{==============================================================================
Version 2.4.4

The contents of this file are subject to the SpTBXLib License; you may
not use or distribute this file except in compliance with the
SpTBXLib License.
A copy of the SpTBXLib License may be found in SpTBXLib-LICENSE.txt or at:
  http://www.silverpointdevelopment.com/sptbxlib/SpTBXLib-LICENSE.htm

Alternatively, the contents of this file may be used under the terms of the
Mozilla Public License Version 1.1 (the "MPL v1.1"), in which case the provisions
of the MPL v1.1 are applicable instead of those in the SpTBXLib License.
A copy of the MPL v1.1 may be found in MPL-LICENSE.txt or at:
  http://www.mozilla.org/MPL/

If you wish to allow use of your version of this file only under the terms of
the MPL v1.1 and not to allow others to use your version of this file under the
SpTBXLib License, indicate your decision by deleting the provisions
above and replace them with the notice and other provisions required by the
MPL v1.1. If you do not delete the provisions above, a recipient may use your
version of this file under either the SpTBXLib License or the MPL v1.1.

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The initial developer of this code is Robert Lee.

Requirements:
For Delphi/C++Builder 2009 or newer:
  - Jordan Russell's Toolbar 2000
    http://www.jrsoftware.org
For Delphi/C++Builder 7-2007:
  - Jordan Russell's Toolbar 2000
    http://www.jrsoftware.org
  - Troy Wolbrink's TNT Unicode Controls
    http://www.tntware.com/delphicontrols/unicode/

Development notes:
  - All the theme changes and adjustments are marked with '[Theme-Change]'.

History:
  -

==============================================================================}

interface

{$BOOLEVAL OFF} // Unit depends on short-circuit boolean evaluation

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, ImgList, CheckLst,
  {$IFNDEF UNICODE}
  TntClasses, TntStdCtrls, TntCheckLst,
  {$ENDIF}
  TB2Toolbar, TB2Item,
  SpTBXSkins, SpTBXItem, SpTBXControls, SpTBXEditors, SpTBXTabs, SpTBXCustomizer;

resourcestring
  SSpTBXCustomizerFormChangeShortcut = 'The shortcut is already being used by the "%s" command. Do you want to reassign it to the "%s" command?';
  SSpTBXCustomizerFormChangeShortcutTitle = 'Change Shortcut';
  SSpTBXCustomizerFormSeparator = '[ Separator ]';
  SSpTBXCustomizerFormBlankSeparator = '[ Blank Separator ]';

type
  TSpTBXCustomizeForm = class(TSpTBXCustomCustomizeForm)
    SpTBXTabControl1: TSpTBXTabControl;
    tabCommands: TSpTBXTabItem;
    SpTBXTabSheet1: TSpTBXTabSheet;
    tabToolbars: TSpTBXTabItem;
    SpTBXTabSheet2: TSpTBXTabSheet;
    tabShortcuts: TSpTBXTabItem;
    SpTBXTabSheet3: TSpTBXTabSheet;
    CloseButton: TSpTBXButton;
    SpTBXLabel3: TSpTBXLabel;
    HotKey1: THotKey;
    ChangeShortcut: TSpTBXButton;
    SpTBXPanel5: TSpTBXPanel;
    Panel1: TPanel;
    cbSkins: TSpTBXComboBox;
    cbIconLabel: TSpTBXLabel;
    cbText: TSpTBXComboBox;
    cbIcon: TSpTBXComboBox;
    cbTextLabel: TSpTBXLabel;
    SpTBXGroupBox1: TSpTBXGroupBox;
    ResetButton: TSpTBXButton;
    checkVisible: TSpTBXCheckBox;
    SpTBXGroupBox2: TSpTBXGroupBox;
    lbToolbars: TSpTBXCheckListBox;
    lbCommands: TSpTBXListBox;
    lbShortcuts: TSpTBXListBox;
    ClosePanel: TSpTBXPanel;
    procedure lbCommandsStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure lbCommandsDragOver(Sender, Source: TObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean);
    procedure lbCommandsDragDrop(Sender, Source: TObject; X,
      Y: Integer);
    procedure lbToolbarsClickCheck(Sender: TObject);
    procedure CloseButtonClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lbCommandsEndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure lbShortcutsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cbSkinsClick(Sender: TObject);
    procedure checkVisibleClick(Sender: TObject);
    procedure cbTextClick(Sender: TObject);
    procedure lbToolbarsClick(Sender: TObject);
    procedure ChangeShortcutClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ResetButtonClick(Sender: TObject);
    procedure lbCommandsDrawItem(Sender: TObject; ACanvas: TCanvas;
      var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
      const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
    procedure lbShortcutsDrawItem(Sender: TObject; ACanvas: TCanvas;
      var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
      const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
  protected
    procedure DoFillCommands(ToolbarList, ItemList, ShortcutsList: TTntStringList); override;
    procedure DoSkinChange; override;
  end;

implementation

uses
  ActnList;

{$R *.dfm}

//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ Helpers }

procedure SpDrawListboxItem(L: TSpTBXListBox; Index: Integer; ARect: TRect;
  State: TOwnerDrawState; DrawShortcut: Boolean; DefaultImageList: TCustomImageList);
var
  Item: TTBCustomItem;
  IL: TCustomImageList;
  WS: WideString;
  TextR, ILRect: TRect;
  Y: Integer;
  ACanvas: TCanvas;
begin
  if (Index < 0) or (Index > L.Count - 1) or not (L.Items.Objects[Index] is TTBCustomItem) then Exit;
  Item := L.Items.Objects[Index] as TTBCustomItem;
  ACanvas := L.Canvas;

  // Draw the icon image
  Inc(ARect.Left, 2);  // Apply margins
  if Item.ImageIndex > -1 then begin
    IL := Item.Images;
    if not Assigned(IL) then
      IL := DefaultImageList;
    if Assigned(IL) then begin
      ILRect := Bounds(ARect.Left, ARect.Top + ((L.ItemHeight - IL.Height) div 2), IL.Width, IL.Height);
      // Draw icon shadow
      if odSelected in State then begin
        OffsetRect(ILRect, 1, 1);
        SpDrawIconShadow(ACanvas, ILRect, IL, Item.ImageIndex);
        OffsetRect(ILRect, -2, -2);
      end;
      SpDrawImageList(ACanvas, ILRect, IL, Item.ImageIndex, True, True);
    end;
  end;

  // Draw the caption
  Inc(ARect.Left, L.ItemHeight); // Apply margins
  WS := L.Items[Index];
  TextR := ARect;
  Y := SpDrawXPText(ACanvas, WS, TextR, DT_CALCRECT);
  ARect.Top := ARect.Top + ((L.ItemHeight - Y) div 2);
  SpDrawXPText(ACanvas, WS, ARect, 0);

  // Draw the shortcut
  if DrawShortcut then begin
    WS := Item.GetShortCutText;
    if (WS <> '0') and (WS <> '') then begin
      ARect.Left := L.Width - 120;
      SpDrawXPText(ACanvas, WS, ARect, 0)
    end;
  end;
end;

//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXCustomizeForm }

procedure TSpTBXCustomizeForm.FormCreate(Sender: TObject);
var
  L: TStringList;
begin
  ClosePanel.Visible := not Embedded;

  // Setup the listboxes
  if Assigned(Customizer.Images) then begin
    lbCommands.ItemHeight := Customizer.Images.Height + 4;
    lbShortcuts.ItemHeight := Customizer.Images.Height + 4;
  end;
  // Hide the Icon Options combobox if necessary
  if not Assigned(Customizer.OnIconOptionsChange) then begin
    cbIconLabel.Visible := False;
    cbIcon.Visible := False;
  end;
  // Fill the Skins combobox
  L := TStringList.Create;
  try
    SkinManager.SkinsList.GetSkinNames(L);
    L.Sort;
    cbSkins.Items.Assign(L);
    cbSkins.ItemIndex := L.IndexOf(SkinManager.CurrentSkinName);
  finally
    L.Free;
  end;
end;

procedure TSpTBXCustomizeForm.FormShow(Sender: TObject);
begin
  SpTBXTabControl1.ActiveTabIndex := 0;
end;

procedure TSpTBXCustomizeForm.FormKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
var
  I: Integer;
begin
  // Allow to change the tab index using Ctrl+Tab and Shift+Ctrl+Tab
  if Key = VK_TAB then
    if Shift = [ssCtrl] then begin
      I := SpTBXTabControl1.ActiveTabIndex;
      if I + 1 < SpTBXTabControl1.PagesCount then
        SpTBXTabControl1.ActiveTabIndex := I + 1
      else
        SpTBXTabControl1.ActiveTabIndex := I - 1
    end
    else
      if Shift = [ssCtrl, ssShift] then begin
        I := SpTBXTabControl1.ActiveTabIndex;
        if I - 1 > -1 then
          SpTBXTabControl1.ActiveTabIndex := I - 1
        else
          SpTBXTabControl1.ActiveTabIndex := I + 1;
      end;
end;

procedure TSpTBXCustomizeForm.CloseButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TSpTBXCustomizeForm.DoFillCommands(ToolbarList, ItemList, ShortcutsList: TTntStringList);
var
  I: Integer;
  TB: TSpTBXToolbar;
begin
  lbToolbars.Items.Assign(ToolbarList);
  lbCommands.Items.Assign(ItemList);
  lbShortcuts.Items.Assign(ShortcutsList);
  // Setup the Toolbars check list
  for I := 0 to lbToolbars.Count - 1 do begin
    TB := lbToolbars.Items.Objects[I] as TSpTBXToolbar;
    if TB.Visible then
      lbToolbars.State[I] := cbChecked;
  end;
  if lbToolbars.Count > 0 then begin
    lbToolbars.ItemIndex := 0;
    lbToolbarsClick(nil);
  end;
end;

procedure TSpTBXCustomizeForm.DoSkinChange;
begin
  inherited;
  ClosePanel.Color := SkinManager.CurrentSkin.ColorBtnFace;
end;

//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ Toolbars tab }

procedure TSpTBXCustomizeForm.lbToolbarsClick(Sender: TObject);
var
  I: Integer;
  TB: TTBCustomToolbar;
begin
  I := lbToolbars.ItemIndex;
  if I > -1 then begin
    TB := lbToolbars.Items.Objects[I] as TTBCustomToolbar;
    checkVisible.Checked := TB.Visible;
    if TB is TSpTBXToolbar then
      cbText.ItemIndex := Ord(TSpTBXToolbar(TB).DisplayMode)
    else
      cbText.ItemIndex := -1;
  end;
end;

procedure TSpTBXCustomizeForm.lbToolbarsClickCheck(Sender: TObject);
var
  I: Integer;
  TB: TTBCustomToolbar;
begin
  I := lbToolbars.ItemIndex;
  if I > -1 then begin
    TB := lbToolbars.Items.Objects[I] as TTBCustomToolbar;
    TB.Visible := lbToolbars.Checked[I];
  end;
end;

procedure TSpTBXCustomizeForm.ResetButtonClick(Sender: TObject);
begin
  Customizer.Reset;
  FillCommands;
end;

procedure TSpTBXCustomizeForm.checkVisibleClick(Sender: TObject);
var
  I: Integer;
begin
  I := lbToolbars.ItemIndex;
  if I > -1 then begin
    lbToolbars.Checked[I] := checkVisible.Checked;
    lbToolbarsClickCheck(nil);
  end;
end;

procedure TSpTBXCustomizeForm.cbTextClick(Sender: TObject);
var
  I: Integer;
  TB: TSpTBXToolbar;
begin
  I := lbToolbars.ItemIndex;
  if (I > -1) and (cbText.ItemIndex > -1) then
    if lbToolbars.Items.Objects[I] is TSpTBXToolbar then begin
      TB := lbToolbars.Items.Objects[I] as TSpTBXToolbar;
      TB.DisplayMode := TSpTBXToolbarDisplayMode(cbText.ItemIndex);
    end;
end;

procedure TSpTBXCustomizeForm.cbSkinsClick(Sender: TObject);
begin
  if cbSkins.ItemIndex > -1 then
    SkinManager.SetSkin(cbSkins.Text);
end;

//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ Commands tab }

procedure TSpTBXCustomizeForm.lbCommandsStartDrag(Sender: TObject;
  var DragObject: TDragObject);
var
  L: TSpTBXListBox;
  I: Integer;
  Item: TTBCustomItem;
  Sep: TTBSeparatorItem;
begin
  L := Sender as TSpTBXListBox;
  I := L.ItemIndex;
  if I > -1 then begin
    if I = 0 then begin
      // When dragging the separator item use the first one available, or create one
      if FSeparatorList.Count = 0 then begin
        Sep := SpCreateUniqueSeparator(False);
        Customizer.Items.Add(Sep);
        FSeparatorList.AddObject(Sep.Name, Sep);
      end;
      Item := FSeparatorList.Objects[0] as TTBCustomItem;
      // SpOutputDebugString('Start ' + FSeparatorList[0]);
    end
    else
      if (I = 1) and Customizer.BlankSeparators then begin
        // When dragging the blank separator item use the first one available, or create one
        if FBlankSeparatorList.Count = 0 then begin
          Sep := SpCreateUniqueSeparator(True);
          Customizer.Items.Add(Sep);
          FBlankSeparatorList.AddObject(Sep.Name, Sep);
        end;
        Item := FBlankSeparatorList.Objects[0] as TTBCustomItem;
      end
      else
        Item := L.Items.Objects[I] as TTBCustomItem;
    DragObject := TSpTBXItemDragObject.Create(L, Item);
  end;
end;

procedure TSpTBXCustomizeForm.lbCommandsEndDrag(Sender,
  Target: TObject; X, Y: Integer);
var
  Accepted: Boolean;
  I: Integer;
begin
  // When dropping an item on a toolbar we must remove the item from the list
  Accepted := Assigned(Target) and (Target <> Sender);
  if Accepted then begin
    I := lbCommands.ItemIndex;
    if I > -1 then
      if I = 0 then begin
        // SpOutputDebugString('End ' + FSeparatorList[0]);
        FSeparatorList.Delete(0);
      end
      else
        if (I = 1) and Customizer.BlankSeparators then
          FBlankSeparatorList.Delete(0)
        else
          lbCommands.Items.Delete(I);
  end;
end;

procedure TSpTBXCustomizeForm.lbCommandsDragOver(Sender,
  Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := Assigned(Source) and (Source is TSpTBXItemDragObject);
end;

procedure TSpTBXCustomizeForm.lbCommandsDragDrop(Sender,
  Source: TObject; X, Y: Integer);
var
  OrigItem: TTBCustomItem;
  WS: WideString;
begin
  if Assigned(Source) and (Source is TSpTBXItemDragObject) and
    (TSpTBXItemDragObject(Source).SourceControl <> Sender) then
  begin
    OrigItem := TSpTBXItemDragObject(Source).SouceItem;
    // Remove the item from its parent
    OrigItem.Parent.Remove(OrigItem);
    // Add the item to the Customizer.Items property
    Customizer.Items.Add(OrigItem);
    WS := SpCustomizerGetWideCaption(OrigItem);
    // Add the item entry in the commands list
    if OrigItem is TTBSeparatorItem then begin
      if Customizer.BlankSeparators and TTBSeparatorItem(OrigItem).Blank then
        FBlankSeparatorList.InsertObject(0, WS, OrigItem) // Insert the blank separator in the first position
      else
        FSeparatorList.InsertObject(0, WS, OrigItem) // Insert the separator in the first position
    end
    else
      lbCommands.AddItem(WS, OrigItem);
    // SpOutputDebugString('Dropped ' + WS);
  end;
end;

procedure TSpTBXCustomizeForm.lbCommandsDrawItem(Sender: TObject;
  ACanvas: TCanvas; var ARect: TRect; Index: Integer;
  const State: TOwnerDrawState; const PaintStage: TSpTBXPaintStage;
  var PaintDefault: Boolean);
begin
  if PaintStage = pstPrePaint then begin
    PaintDefault := False;
    if Index = 0 then begin
      // Draw the separator
      SpDrawXPText(ACanvas, SSpTBXCustomizerFormSeparator, ARect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
    end
    else
      if (Index = 1) and Customizer.BlankSeparators then begin
        // Draw the blank separator
        SpDrawXPText(ACanvas, SSpTBXCustomizerFormBlankSeparator, ARect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
      end
      else
        SpDrawListboxItem(Sender as TSpTBXListBox, Index, ARect, State, False, Customizer.Images);
  end;
end;

//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ Shortcuts tab }

procedure TSpTBXCustomizeForm.lbShortcutsClick(Sender: TObject);
var
  Item: TTBCustomItem;
begin
  if lbShortcuts.ItemIndex > -1 then begin
    Item := lbShortcuts.Items.Objects[lbShortcuts.ItemIndex] as TTBCustomItem;
    HotKey1.HotKey := Item.ShortCut;
  end;
end;

procedure TSpTBXCustomizeForm.lbShortcutsDrawItem(Sender: TObject;
  ACanvas: TCanvas; var ARect: TRect; Index: Integer;
  const State: TOwnerDrawState; const PaintStage: TSpTBXPaintStage;
  var PaintDefault: Boolean);
begin
  if PaintStage = pstPrePaint then begin
    PaintDefault := False;
    SpDrawListboxItem(Sender as TSpTBXListBox, Index, ARect, State, True, Customizer.Images);
  end;
end;

procedure TSpTBXCustomizeForm.ChangeShortcutClick(Sender: TObject);
var
  Item, F: TTBCustomItem;
  WS, WS2: WideString;
  T: TShortCut;
  I: Integer;
  ChangeShortCut: Boolean;
begin
  if lbShortcuts.ItemIndex < 0 then Exit;
  T := HotKey1.HotKey;
  Item := lbShortcuts.Items.Objects[lbShortcuts.ItemIndex] as TTBCustomItem;

  ChangeShortCut := True;

  if T <> 0 then begin
    // Find if the shortcut is already being used
    for I := 0 to lbShortcuts.Count - 1 do begin
      F := lbShortcuts.Items.Objects[I] as TTBCustomItem;
      if F.ShortCut = T then begin
        WS := WideFormat(SSpTBXCustomizerFormChangeShortcut, [SpCustomizerGetWideCaption(F), SpCustomizerGetWideCaption(Item)]);
        WS2 := SSpTBXCustomizerFormChangeShortcutTitle;
        ChangeShortCut := MessageBoxW(Handle, PWideChar(WS), PWideChar(WS2), MB_APPLMODAL+MB_ICONWARNING+MB_OKCANCEL+MB_DEFBUTTON1) = IDOK;
        if ChangeShortCut then
          if Assigned(F.Action) and (F.Action is TAction) then
            TAction(F.Action).ShortCut := 0
          else
            F.ShortCut := 0;

        Break;
      end;
    end;
  end;

  if ChangeShortCut then begin
    if Assigned(Item.Action) and (Item.Action is TAction) then
      TAction(Item.Action).ShortCut := T
    else
      Item.ShortCut := T;
    lbShortcuts.Invalidate;
  end;
end;

end.