unit custom_toolbar; //{$DEFINE DEBUG} {$DEFINE MYLIB} interface uses Windows, Messages, SysUtils, Graphics, Controls, Forms, ComCtrls, ExtCtrls, StdCtrls, ActnList, Menus, Classes, CheckLst, Buttons, myIniFile; type T_MyToolBarSetMenu = procedure(AToolButton: TToolButton; AAction: TAction) of object; T_MyToolBarGetAction = function (AAction: TAction): TComponent of object; T_MyToolControl = class(TObject) private F_iLeft: Integer; //F_InsertToolButtonで必要 F_iRight: Integer; //F_InsertToolButtonで必要 F_iWidth: Integer; //F_InsertToolButtonで必要 F_Control: TControl; //ツールバー上のコントロール。TToolButtonの場合はnilにする F_Action: TAction; F_sName: String; //アクションの名前かコントロールの名前 F_sCaption: String; F_Style: TToolButtonStyle; //ツールボタンのスタイル。TToolButtonでない場合はデフォルトのtbsButton F_PopupMenu: TPopupMenu; //ポップアップメニュー F_DropdownMenu: TPopupMenu; //ドロップダウンメニュー F_OnMouseDown: TMouseEvent; F_OnMouseUp: TMouseEvent; F_OnMouseMove: TMouseMoveEvent; F_bToolButton: Boolean; F_bSeparator: Boolean; //セパレータか F_bNeedFree: Boolean; //F_Init〜でFreeする必要のあるセパレータか function F_GetLeft: Integer; procedure F_SetLeft(iLeft: Integer); function F_GetRight: Integer; procedure F_SetRight(iRight: Integer); function F_GetWidth: Integer; function F_GetControl: TControl; public constructor Create(AControl: TControl); function IsVisible: Boolean; function IsSame(AControl: TControl): Boolean; overload; function IsSame(AToolControl: T_MyToolControl): Boolean; overload; procedure ToolButtonFree; property Action: TAction read F_Action; property Caption: String read F_sCaption; property Control: TControl read F_GetControl; property DropdownMenu: TPopupMenu read F_DropdownMenu; property IsSeparator: Boolean read F_bSeparator; property IsToolButton: Boolean read F_bToolButton; property Left: Integer read F_GetLeft; property Name: String read F_sName; property PopupMenu: TPopupMenu read F_PopupMenu; property Right: Integer read F_GetRight; property Style: TToolButtonStyle read F_Style; property Width: Integer read F_GetWidth; property OnMouseUp: TMouseEvent read F_OnMouseUp; property OnMouseDown: TMouseEvent read F_OnMouseDown; property OnMouseMove: TMouseMoveEvent read F_OnMouseMove; end; T_MyToolBar = class(TObject) private F_ToolBar: TToolBar; //ツールバー F_InitToolControls: TList; //デフォルトのツールバーの状態を保持するリスト F_ToolControls: TList; //ツールバーのコマンドリスト procedure F_SetToolBar(AToolBar: TToolBar); function F_GetInitToolControlCount: Integer; function F_GetInitToolControl(iIndex: Integer): T_MyToolControl; function F_GetToolControlCount: Integer; function F_GetToolControl(iIndex: Integer): T_MyToolControl; public constructor Create(AToolBar: TToolBar); destructor Destroy; override; property ToolBar: TToolBar read F_ToolBar; //ボタンのデフォルトのアクション property InitToolControlCount: Integer read F_GetInitToolControlCount; property InitToolControl[iIndex: Integer]: T_MyToolControl read F_GetInitToolControl; property ToolControlCount: Integer read F_GetToolControlCount; property ToolControl[iIndex: Integer]: T_MyToolControl read F_GetToolControl; end; type TApp_CustomToolBar = class(TForm) ActionList_ToolBar: TActionList; actFile_Close: TAction; actToolBar_Add: TAction; actToolBar_Insert: TAction; actToolBar_Delete: TAction; actToolBar_ResetAll: TAction; actToolBar_MoveUp: TAction; actToolBar_MoveDown: TAction; mnuCommandCategory: TPopupMenu; mnuCommandList: TPopupMenu; mniToolBar_Add: TMenuItem; mnuNowSetting: TPopupMenu; mniToolBar_Delete: TMenuItem; mniToolBar_NowSettingLine1: TMenuItem; mniToolBar_Reset: TMenuItem; pnlToolBar: TPanel; pnlTitle: TPanel; lblTitle: TLabel; lstSelToolBar: TComboBox; shpTop: TShape; pnlCmd: TPanel; btnClose: TButton; btnReset: TButton; Panel1: TPanel; pnlNowSetting: TPanel; lblNowSetting: TLabel; lstNowSetting: TCheckListBox; btnToolBar_Add: TButton; btnToolBar_Delete: TButton; btnToolBar_MoveUp: TButton; btnToolBar_MoveDown: TButton; pnlCommand: TPanel; lblCommand: TLabel; lstCommand: TCheckListBox; GroupBox1: TGroupBox; Label_Hint: TLabel; procedure actFile_CloseExecute (Sender: TObject); procedure actToolBar_AddExecute (Sender: TObject); procedure actToolBar_DeleteExecute (Sender: TObject); procedure actToolBar_ResetAllExecute(Sender: TObject); procedure actToolBar_MoveUpExecute (Sender: TObject); procedure actToolBar_InsertExecute (Sender: TObject); procedure FormCreate (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure FormDestroy(Sender: TObject); procedure FormResize (Sender: TObject); procedure mnuCommandListPopup(Sender: TObject); procedure mnuNowSettingPopup (Sender: TObject); procedure lstSelToolBarSelect (Sender: TObject); procedure lstCommandDragDrop (Sender, Source: TObject; X, Y: Integer); procedure lstCommandDragOver (Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure lstCommandDrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure lstCommandMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure lstCommandEnter (Sender: TObject); procedure lstCommandMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure lstCommandClickCheck (Sender: TObject); procedure lstNowSettingDragDrop (Sender, Source: TObject; X, Y: Integer); procedure lstNowSettingDragOver (Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure lstNowSettingDrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure lstNowSettingKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure lstNowSettingEnter (Sender: TObject); procedure lstNowSettingClickCheck(Sender: TObject); procedure lstCommandClick(Sender: TObject); procedure lstNowSettingClick(Sender: TObject); private { Private 宣言 } F_MyToolBarList: TList; F_NowSetting: TList; F_ToolBar: TToolBar; function F_GetDescription(AToolControl: T_MyToolControl): String; // procedure F_CmdGoToCategory(Sender: TObject); function F_GetToolControl(AControl: TControl): T_MyToolControl; overload; function F_GetToolControl(iIndex: Integer): T_MyToolControl; overload; function F_GetMyToolBar(AToolBar: TToolBar): T_MyToolBar; function F_GetListIndex(AToolControl: T_MyToolControl): Integer; // function F_GetNowIndex (AToolControl: T_MyToolControl): Integer; function F_AppendToolButton(sName: String): Boolean; overload; function F_AppendToolButton(AToolControl: T_MyToolControl): Boolean; overload; function F_InsertToolButton(iIndex: Integer; AToolControl: T_MyToolControl; bCreate: Boolean): Boolean; // function F_InsertToolButton(iIndex: Integer; AToolControl: T_MyToolControl): Boolean; function F_DeleteToolButton(iIndex: Integer): Boolean; procedure F_ClearToolBar; public { Public 宣言 } procedure AddToolBar(sTitle: String; AToolBar: TToolBar); overload; procedure ReadIniToolBar (AIniFile: TMyIniFile); //; AToolBars: array of TToolBar); procedure WriteIniToolBar(AIniFile: TMyIniFile); //; AToolBars: array of TToolBar); end; procedure gpcCreateToolBarForm(AOwner: TComponent); //procedure gpcWriteIniToolBar(AIniFile: TMyIniFile; AToolBars: array of TToolBar); var App_CustomToolBar: TApp_CustomToolBar; //============================================================================== implementation uses {$IFDEF DEBUG} myDebug, {$ENDIF} CommCtrl, myControl, myFile, myList, myMenu, myMessageBox, myNum, myWindow, myWStrings, custom_base, main; {$R *.dfm} const lciMARGIN = 2; const lcsTOOLBUTTON_SPC = '-'; //============================================================================== {T_MyToolControl} constructor T_MyToolControl.Create(AControl: TControl); var l_ToolButton: TToolButton; begin inherited Create; F_Control := AControl; F_iLeft := F_Control.Left; F_iRight := F_Control.BoundsRect.Right; F_iWidth := F_Control.Width; F_bNeedFree := False; F_bToolButton := (F_Control is TToolButton); if (F_bToolButton) then begin l_ToolButton := TToolButton(F_Control); F_OnMouseDown := l_ToolButton.OnMouseDown; F_OnMouseUp := l_ToolButton.OnMouseUp; F_OnMouseMove := l_ToolButton.OnMouseMove; F_Action := TAction(l_ToolButton.Action); if (F_Action <> nil) then begin F_sName := F_Action.Name; F_sCaption := F_Action.Caption; end else begin F_sName := l_ToolButton.Name; F_sCaption := l_ToolButton.Caption; end; F_Style := l_ToolButton.Style; //ツールボタンのスタイル。 F_bSeparator := (F_Style = tbsSeparator) or (F_Style = tbsDivider); if (F_bSeparator) then begin F_iWidth := 8; end; F_PopupMenu := l_ToolButton.PopupMenu; //ポップアップメニュー F_DropdownMenu := l_ToolButton.DropdownMenu; //ドロップダウンメニュー end else begin F_sName := F_Control.Name; if (AControl is TPanel) then begin //ツールバーにツールボタン以外のコントロールを置く場合はTPanelを親にする F_sCaption := TPanel(F_Control).Caption; end else if (AControl is TLabel) then begin F_sCaption := TLabel(F_Control).Caption; end else begin F_sCaption := ''; end; //以下のものはTToolButton以外には必要ないので適当でかまわない F_Action := nil; F_bSeparator := False; F_Style := tbsButton; //TToolButtonでない場合はデフォルトのtbsButtonにしておく F_PopupMenu := nil; F_DropdownMenu := nil; end; end; procedure T_MyToolControl.ToolButtonFree; begin if (F_bToolButton) then begin //セパレータも含むツールボタン if (F_Control <> nil) then begin TToolButton(F_Control).Free; F_Control := nil; end else if (F_bSeparator) then begin TToolButton(F_Control).Free; end; end else begin F_Control.Visible := False; end; end; function T_MyToolControl.IsVisible: Boolean; begin if (F_bToolButton) then begin if (F_Control <> nil) then begin Result := F_Control.Visible; end else begin //※要再考 Result := False; end; end else begin Result := F_Control.Visible; end; end; function T_MyToolControl.IsSame(AControl: TControl): Boolean; begin if (AControl is TToolButton) then begin Result := (F_Action = AControl.Action); end else begin Result := (F_Control = AControl); end; end; function T_MyToolControl.IsSame(AToolControl: T_MyToolControl): Boolean; begin // Result := IsSame(AToolControl.Control); NG! if (AToolControl.IsToolButton) then begin if (F_bToolButton) then begin Result := (F_Action = AToolControl.Action); end else begin Result := False; end; end else begin Result := (F_Control = AToolControl.Control); end; end; function T_MyToolControl.F_GetLeft: Integer; begin if (F_Control <> nil) then begin Result := F_Control.Left; end else begin Result := F_iLeft; end; end; procedure T_MyToolControl.F_SetLeft(iLeft: Integer); begin F_iLeft := iLeft; end; function T_MyToolControl.F_GetRight: Integer; begin if (F_Control <> nil) then begin Result := F_Control.BoundsRect.Right; end else begin Result := F_iRight; end; end; procedure T_MyToolControl.F_SetRight(iRight: Integer); begin F_iRight := iRight; end; function T_MyToolControl.F_GetWidth: Integer; begin if (F_Control <> nil) then begin Result := F_Control.Width; end else begin Result := F_iWidth; end; end; function T_MyToolControl.F_GetControl: TControl; begin Result := F_Control; { if (F_bToolButton) then begin Result := nil; end else begin Result := F_Control; end; } end; //------------------------------------------------------------------------------ {T_MyToolBar} constructor T_MyToolBar.Create(AToolBar: TToolBar); begin inherited Create; F_InitToolControls := TList.Create; //ツールバーのデフォルトのコントロール F_ToolControls := TList.Create; //ツールバーのコントロールのリスト F_SetToolBar(AToolBar); //並べ替えるツールバー end; destructor T_MyToolBar.Destroy; var i: Integer; l_ToolControl: T_MyToolControl; begin for i := F_InitToolControls.Count-1 downto 0 do begin l_ToolControl := T_MyToolControl(F_InitToolControls.Items[i]); if (l_ToolControl.F_bNeedFree) then begin //コマンドリストからは削除した区切りは↓ではFreeされないのでここでFreeする l_ToolControl.Free; end; F_InitToolControls.Delete(i); end; F_InitToolControls.Free; for i := F_ToolControls.Count-1 downto 0 do begin T_MyToolControl(F_ToolControls.Items[i]).Free; F_ToolControls.Delete(i); end; F_ToolControls.Free; inherited; end; procedure T_MyToolBar.F_SetToolBar(AToolBar: TToolBar); var i: Integer; l_ToolControl: T_MyToolControl; lb_Separator: Boolean; begin F_ToolBar := AToolBar; //コマンドリスト用データ //最初にすべてのツールボタンとコントロールがツールバー上に置かれているのでまず //それをリストにする。 for i := 0 to F_ToolBar.ButtonCount-1 do begin //F_ToolControlsのItemはT_MyToolControl //F_ToolBar.Buttons[i]はツールバー以外のコントロールも含む F_ToolControls.Add(T_MyToolControl.Create(F_ToolBar.Buttons[i])); end; lb_Separator := False; i := 0; repeat l_ToolControl := T_MyToolControl(F_ToolControls.Items[i]); //初期化用データ if (l_ToolControl.IsVisible) then begin F_InitToolControls.Add(l_ToolControl); end; if (l_ToolControl.IsSeparator) then begin //セパレータ if (lb_Separator = False) then begin lb_Separator := True; if (i > 0) then begin //最初に現れたセパレータをリストの先頭に持っていく F_ToolControls.Move(i, 0); end; Inc(i); end else begin //余計な区切りはコマンドリストからは削除 if (l_ToolControl.IsVisible) then begin //ここではFreeせずに後でFreeする必要があることを示すフラグを立てるだけ l_ToolControl.F_bNeedFree := True; F_ToolControls.Delete(i); end else begin //非表示なので取り除く l_ToolControl.Free; F_ToolControls.Delete(i); // Inc(i); end; end; end else begin Inc(i); end; until (i > F_ToolControls.Count-1); //VisibleがFalseのツールボタンをツールバーから取り除く for i := F_ToolControls.Count-1 downto 0 do begin l_ToolControl := T_MyToolControl(F_ToolControls.Items[i]); if (l_ToolControl.IsToolButton) then //ツールボタンか(セパレータもツールボタン) begin if not(l_ToolControl.IsVisible) then begin //ツールバー上から取り除く l_ToolControl.ToolButtonFree; end; end; end; end; function T_MyToolBar.F_GetInitToolControlCount: Integer; begin Result := F_InitToolControls.Count; end; function T_MyToolBar.F_GetInitToolControl(iIndex: Integer): T_MyToolControl; begin if (iIndex >= 0) and (iIndex < F_GetInitToolControlCount) then begin Result := T_MyToolControl(F_InitToolControls.Items[iIndex]); end else begin Result := nil; end; end; function T_MyToolBar.F_GetToolControlCount: Integer; begin Result := F_ToolControls.Count; end; function T_MyToolBar.F_GetToolControl(iIndex: Integer): T_MyToolControl; begin if (iIndex >= 0) and (iIndex < F_GetToolControlCount) then begin Result := T_MyToolControl(F_ToolControls.Items[iIndex]); end else begin Result := nil; end; end; //============================================================================== { procedure TApp_CustomToolBar.ToolBarButton_MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //押された状態のツールボタンを押したままボタン外にマウスを移動させると押された状 //態がキャンセルされてしまうことへ対処。 var l_Button: TToolButton; l_Action: TAction; begin if (Sender is TToolButton) then begin l_Button := TToolButton(Sender); l_Action := TAction(l_Button.Action); if (l_Action <> nil) and (l_Action.Checked) then begin //usesにCommCtrlを足す必要あり。 l_Button.Parent.Perform(TB_PRESSBUTTON, l_Button.Index, MakeLong(Ord(True), 0)); end; end; end; procedure TApp_CustomToolBar.ToolBarButton_MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure lpc_ButtonsDown(AToolBar: TToolBar); var i: Integer; begin for i := 0 to AToolBar.ButtonCount-1 do begin ToolBarButton_MouseUp(AToolBar.Buttons[i], mbLeft, [], 0, 0); //第一引数以外は適当でよい end; end; var l_Button: TToolButton; l_Action: TAction; begin if (Sender is TToolButton) then begin l_Button := TToolButton(Sender); l_Action := TAction(l_Button.Action); if (l_Action <> nil) and (l_Action.Checked) then begin ToolBarButton_MouseUp(TToolBar(Sender), mbLeft, [], 0, 0); //第一引数以外は適当でよい end else begin lpc_ButtonsDown(TToolBar(l_Button.Parent)); end; end else if (Sender is TToolBar) then begin lpc_ButtonsDown(TToolBar(Sender)); end; end; } //------------------------------------------------------------------------------ function TApp_CustomToolBar.F_DeleteToolButton(iIndex: Integer): Boolean; var l_MyToolControl: T_MyToolControl; begin Result := False; if (iIndex >= 0) and (iIndex < F_NowSetting.Count) then begin l_MyToolControl := T_MyToolControl(F_NowSetting.Items[iIndex]); l_MyToolControl.ToolButtonFree; l_MyToolControl.Free; F_NowSetting.Delete(iIndex); Result := True; end; end; procedure TApp_CustomToolBar.F_ClearToolBar; var i:Integer; l_Control: TControl; begin if (F_ToolBar = nil) then begin Exit; end; if (F_NowSetting.Count > 0) then begin for i := F_NowSetting.Count-1 downto 0 do begin T_MyToolControl(F_NowSetting.Items[i]).ToolButtonFree; // F_NowSetting.Delete(i); //メモリーリークする end; end else begin for i := F_ToolBar.ButtonCount-1 downto 0 do begin l_Control := F_ToolBar.Buttons[i]; if (l_Control is TToolButton) then begin TToolButton(l_Control).Free; end else begin l_Control.Visible := False; end; end; end; end; function TApp_CustomToolBar.F_InsertToolButton(iIndex: Integer; AToolControl: T_MyToolControl; bCreate: Boolean): Boolean; var li_Left: Integer; l_Insert, l_ToolControl: T_MyToolControl; l_ToolButton: TToolButton; l_Control: TControl; l_Action: TAction; begin // Result := False; // if (AToolControl = nil) then begin //Exit; // end; if (F_NowSetting.Count = 0) or (iIndex = 0) then begin li_Left := 0; end else begin iIndex := gfniNumLimit(iIndex, 1, F_NowSetting.Count); l_Insert := T_MyToolControl(F_NowSetting.Items[iIndex -1]); //一つ前のボタンから計算するため-1 li_Left := l_Insert.Left + l_Insert.Width; end; if (AToolControl = nil) then begin //セパレータとする l_ToolButton := TToolButton.Create(F_ToolBar); with l_ToolButton do begin Left := li_Left; //Nameの前でなければならない Name := gfnsAvailableName('ToolButton_Spc'); Parent := F_ToolBar; Style := tbsSeparator; Caption := lcsTOOLBUTTON_SPC; Width := 8; //OnMouseMove //OnMouseMove := ToolBarButton_MouseMove; end; l_Control := l_ToolButton; end else if not(AToolControl.IsToolButton) then begin //ツールボタンではないコントロール l_Control := AToolControl.Control; l_Control.Left := li_Left; l_Control.Visible := True; end else begin //ツールボタン l_Action := AToolControl.Action; l_ToolButton := TToolButton.Create(F_ToolBar); with l_ToolButton do begin Left := li_Left; //Nameの前でなければならない Name := gfnsAvailableName(AToolControl.Name); Parent := F_ToolBar; Action := l_Action; Style := AToolControl.Style; if (AToolControl.IsSeparator) then begin Width := 8; end else begin Width := AToolControl.Width; //Styleの後でなければならない end; PopupMenu := AToolControl.PopupMenu; DropdownMenu := AToolControl.DropdownMenu; //OnMouseDown if (@AToolControl.OnMouseDown <> nil) then begin OnMouseDown := AToolControl.OnMouseDown; end; //OnMouseUp if (@AToolControl.OnMouseUp <> nil) then begin OnMouseUp := AToolControl.OnMouseUp; end else begin if (l_Action <> nil) then begin if (l_Action.AutoCheck) or (l_Action.GroupIndex > 0) then begin //OnMouseUp := ToolBarButton_MouseUp; end; end; end; //OnMouseMove if (@AToolControl.OnMouseMove = nil) then begin //OnMouseMove := ToolBarButton_MouseMove; end else begin OnMouseMove := AToolControl.OnMouseMove; end; end; l_Control := l_ToolButton; end; if (bCreate) then begin l_ToolControl := T_MyToolControl.Create(l_Control); l_ToolControl.F_SetLeft(l_Control.Left); l_ToolControl.F_SetRight(l_Control.BoundsRect.Right); F_NowSetting.Insert(iIndex, l_ToolControl); end; Result := True; end; function TApp_CustomToolBar.F_AppendToolButton(AToolControl: T_MyToolControl): Boolean; begin Result := F_InsertToolButton(F_NowSetting.Count, AToolControl, True); end; function TApp_CustomToolBar.F_AppendToolButton(sName: String): Boolean; var i: Integer; l_MyToolBar: T_MyToolBar; l_ToolControl: T_MyToolControl; begin sName := UpperCase(sName); if (sName <> lcsTOOLBUTTON_SPC) then begin l_MyToolBar := F_GetMyToolBar(F_ToolBar); for i := 0 to l_MyToolBar.ToolControlCount-1 do begin l_ToolControl := l_MyToolBar.ToolControl[i]; if (UpperCase(l_ToolControl.Name) = sName) then begin Result := F_AppendToolButton(l_ToolControl); Exit; end; end; end; Result := F_AppendToolButton(nil); end; const lcsSECT_TOOLBAR = 'TOOLBAR'; procedure TApp_CustomToolBar.ReadIniToolBar(AIniFile: TMyIniFile); //; AToolBars: array of TToolBar); var l_List: TMyWStrings; ls_Sect: WideString; i, k: Integer; l_Form : TForm; l_ToolBar : TToolBar; // l_File : WideString; begin { for i := 0 to App_CustomToolBar.F_MyToolBarList.Count-1 do begin l_ToolBar := T_MyToolBar(F_MyToolBarList[i]).ToolBar; l_Form := gfnParentFormGet(l_ToolBar); l_File := WideFormat('%s%s_%s.res', [gfnsFilePathGet(gfnsExeNameGet), l_Form.Name, l_ToolBar.Name]); ReadComponentResFile(l_File, l_ToolBar); end; Exit; } l_ToolBar := F_ToolBar; l_List := TMyWStrings.Create; try for i := 0 to App_CustomToolBar.F_MyToolBarList.Count-1 do begin F_ToolBar := T_MyToolBar(F_MyToolBarList[i]).ToolBar; if (F_GetMyToolBar(F_ToolBar) = nil) then begin Continue; end; l_Form := gfnParentFormGet(F_ToolBar); ls_Sect := WideFormat('%s_%s.%s', [lcsSECT_TOOLBAR, l_Form.Name, F_ToolBar.Name]); if (AIniFile.SectionExists(ls_Sect)) then begin //初期設定をクリア F_ClearToolBar; AIniFile.ReadSectionText(ls_Sect, l_List); //Action.Nameを順番に列挙しているだけ for k := 0 to l_List.Count -1 do begin F_AppendToolButton(l_List[k]); end; end; l_List.Clear; for k := F_NowSetting.Count-1 downto 0 do begin T_MyToolControl(F_NowSetting.Items[k]).Free; F_NowSetting.Delete(k); end; end; finally l_List.Free; end; if (l_ToolBar <> nil) then begin F_ToolBar := l_ToolBar; end; lstSelToolBarSelect(nil); end; procedure TApp_CustomToolBar.WriteIniToolBar(AIniFile: TMyIniFile); //; AToolBars: array of TToolBar); var lsl_List : TMyWStrings; ls_Sect : WideString; i : Integer; k : Integer; l_Control : TControl; l_Action : TAction; l_ToolBar : TToolBar; l_Form : TForm; l_File : WideString; begin for i := 0 to App_CustomToolBar.F_MyToolBarList.Count-1 do begin l_ToolBar := T_MyToolBar(F_MyToolBarList[i]).ToolBar; l_Form := gfnParentFormGet(l_ToolBar); l_File := WideFormat('%s%s_%s.res', [gfnsFilePathGet(gfnsExeNameGet), l_Form.Name, l_ToolBar.Name]); //リソースに保存 WriteComponentResFile(l_File, l_ToolBar); end; Exit; // if not(Assigned(App_CustomToolBar)) then begin //Exit; // end; lsl_List := TMyWStrings.Create; try //[ToolButton] for i := 0 to F_MyToolBarList.Count-1 do begin l_ToolBar := T_MyToolBar(F_MyToolBarList[i]).ToolBar; ls_Sect := WideFormat('%s_%s.%s', [lcsSECT_TOOLBAR, gfnParentFormGet(l_ToolBar).Name, l_ToolBar.Name]); AIniFile.EraseSection(ls_Sect); if (Assigned(App_CustomToolBar)) then begin for k := 0 to l_ToolBar.ButtonCount-1 do begin l_Control := TControl(l_ToolBar.Buttons[k]); if (l_Control.Visible) then begin if (l_Control is TToolButton) then begin l_Action := TAction(TToolButton(l_Control).Action); if (l_Action <> nil) then begin lsl_List.Add(l_Action.Name); end else begin lsl_List.Add(lcsTOOLBUTTON_SPC); end; end else begin lsl_List.Add(l_Control.Name); end; end; end; AIniFile.WriteSectionText(ls_Sect, lsl_List); lsl_List.Clear; end; end; finally lsl_List.Free; end; end; //------------------------------------------------------------------------------ procedure gpcCreateToolBarForm(AOwner: TComponent); var i: Integer; begin if (App_CustomToolBar = nil) then begin App_CustomToolBar := TApp_CustomToolBar.Create(AOwner); end else begin for i := 0 to Screen.FormCount-1 do begin if (Screen.Forms[i] = App_CustomToolBar) then begin Exit; end; end; App_CustomToolBar := TApp_CustomToolBar.Create(AOwner); end; end; //============================================================================== { procedure TApp_CustomToolBar.F_CmdGoToCategory(Sender: TObject); var l_MenuItem: TMenuItem; i: Integer; ls_Caption: String; begin l_MenuItem := TMenuItem(Sender); ls_Caption := Copy(l_MenuItem.Caption, 0, AnsiPos(' へ移動', l_MenuItem.Caption) -1); for i := 1 to lstCommand.Items.Count-1 do begin if (ls_Caption = TAction(F_ActionList.Actions[i]).Category) then begin lstCommand.TopIndex := i; Exit; end; end; end; } function TApp_CustomToolBar.F_GetDescription(AToolControl: T_MyToolControl): String; var l_Action: TAction; begin if (AToolControl = nil) then begin Result := '区切り'; end else begin if (AToolControl.IsSeparator) then begin Result := '区切り'; end else if (AToolControl.IsToolButton) then begin l_Action := AToolControl.Action; if (l_Action = nil) then begin Result := StripHotKey(AToolControl.Caption); end else if (l_Action.Category = '区切り') then begin Result := '区切り'; end else begin Result := Format('%s/%s', [l_Action.Category, StripHotKey(l_Action.Caption)]); end; end else begin Result := AToolControl.Caption; end; end; end; procedure TApp_CustomToolBar.FormCreate(Sender: TObject); var lh_Menu: HMENU; begin {$IFDEF DEBUG} myDebug.gpcMessageModeSet(True); {$ENDIF} pnlToolBar.Align := alClient; pnlCommand.Align := alClient; Self.Icon := Application.Icon; Label_Hint.Caption := ''; gpcCreateCustomBaseForm(G_MainForm); Self.ManualDock(G_CustomForm.tabToolBar); Self.Align := alClient; Self.Visible := True; //システムメニュー lh_Menu := GetSystemMenu(Handle, False); DeleteMenu(lh_Menu, SC_RESTORE, MF_BYCOMMAND); //元のサイズに戻す DeleteMenu(lh_Menu, SC_MINIMIZE, MF_BYCOMMAND); //最小化 DeleteMenu(lh_Menu, SC_MAXIMIZE, MF_BYCOMMAND); //最大化 DrawMenuBar(lh_Menu); F_MyToolBarList := TList.Create; F_NowSetting := TList.Create; F_ToolBar := nil; end; procedure TApp_CustomToolBar.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; procedure TApp_CustomToolBar.FormDestroy(Sender: TObject); var i: Integer; begin for i := F_NowSetting.Count-1 downto 0 do begin T_MyToolControl(F_NowSetting.Items[i]).Free; F_NowSetting.Delete(i); end; F_NowSetting.Free; for i := F_MyToolBarList.Count-1 downto 0 do begin T_MyToolBar(F_MyToolBarList.Items[i]).Free; F_MyToolBarList.Delete(i); end; F_MyToolBarList.Free; end; procedure TApp_CustomToolBar.FormResize(Sender: TObject); var li_BtnWidth: Integer; begin li_BtnWidth := btnToolBar_Add.Width + (8 * 2); pnlNowSetting.Width := ((Self.ClientWidth - li_BtnWidth) div 2) + li_BtnWidth; end; //閉じる procedure TApp_CustomToolBar.actFile_CloseExecute(Sender: TObject); begin G_CustomForm.actFile_CloseExecute(nil); end; procedure TApp_CustomToolBar.AddToolBar(sTitle: String; AToolBar: TToolBar); begin F_MyToolBarList.Add(T_MyToolBar.Create(AToolBar)); lstSelToolBar.Items.Add(sTitle); if (lstSelToolBar.Items.Count = 1) then begin lstSelToolBar.ItemIndex := 0; lstSelToolBarSelect(nil); end else if (lstSelToolBar.Items.Count > 1) then begin pnlTitle.Visible := True; end; AToolBar.AutoSize := False; AToolBar.Wrapable := False; Application.ProcessMessages; AToolBar.AutoSize := True; end; //コマンドリスト //描画 procedure TApp_CustomToolBar.lstCommandDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var l_Action: TAction; l_ToolControl: T_MyToolControl; begin with lstCommand.Canvas do begin if (odSelected in State) then begin if (GetFocus = lstCommand.Handle) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end else begin Brush.Color := clBtnFace; Font.Color := clBtnText; end; end else begin Brush.Color := lstCommand.Color; Font.Color := lstCommand.Font.Color; end; // Font.Name := 'MS UI Gothic'; FillRect(Rect); l_ToolControl := F_GetMyToolBar(F_ToolBar).ToolControl[Index]; l_Action := l_ToolControl.Action; if (F_ToolBar.Images <> nil) then begin if (l_Action <> nil) and (l_Action.ImageIndex <> -1) then begin F_ToolBar.Images.Draw(lstCommand.Canvas, Rect.Left, Rect.Top, l_Action.ImageIndex); end; Inc(Rect.Left, F_ToolBar.Images.Width + lciMARGIN); end; DrawText(Handle, PChar(F_GetDescription(l_ToolControl)), -1, Rect, DT_SINGLELINE or DT_VCENTER); end; end; procedure TApp_CustomToolBar.lstNowSettingDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var l_ToolControl: T_MyToolControl; l_Action: TAction; begin with lstNowSetting.Canvas do begin if (odSelected in State) then begin if (GetFocus = lstNowSetting.Handle) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end else begin Brush.Color := clBtnFace; Font.Color := clBtnText; end; end else begin Brush.Color := lstNowSetting.Color; Font.Color := lstNowSetting.Font.Color; end; // Font.Name := 'MS UI Gothic'; FillRect(Rect); l_ToolControl := T_MyToolControl(F_NowSetting.Items[Index]); l_Action := l_ToolControl.Action; if (F_ToolBar.Images <> nil) then begin if (l_Action <> nil) and (l_Action.ImageIndex >= 0) then begin F_ToolBar.Images.Draw(lstNowSetting.Canvas, Rect.Left, Rect.Top, l_Action.ImageIndex); end; Inc(Rect.Left, F_ToolBar.Images.Width + lciMARGIN); end; DrawText(Handle, PChar(F_GetDescription(l_ToolControl)), -1, Rect, DT_SINGLELINE or DT_VCENTER); end; end; //ドラッグ procedure TApp_CustomToolBar.lstCommandMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //ドラッグ開始 //オートにすると不都合があるのでマニュアルドラッグ var l_Control: TControl; l_CheckListBox: TCheckListBox; li_Index: Integer; begin if not(Sender is TControl) then Exit; l_Control := TControl(Sender); if (Button = mbLeft) then begin l_Control.BeginDrag(False, GetSystemMetrics(SM_CXDOUBLECLK)); end else if (Button = mbRight) then begin if not(Sender is TCheckListBox) then Exit; l_CheckListBox := TCheckListBox(Sender); if (l_CheckListBox.CanFocus) then begin l_CheckListBox.SetFocus; end; li_Index := l_CheckListBox.ItemAtPos(Point(X, Y), True); if (li_Index >= 0) then begin l_CheckListBox.Selected[li_Index] := True; end; end; end; procedure TApp_CustomToolBar.lstCommandMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var l_CheckListBox: TCheckListBox; begin if not(Sender is TCheckListBox) then Exit; if (Button <> mbRight) then begin l_CheckListBox := TCheckListBox(Sender); l_CheckListBox.PopupMenu.OnPopup(nil); end; end; procedure TApp_CustomToolBar.lstCommandDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); //ドラッグ中のマウスカーソルをドラッグ状態にするために必要。 begin Accept := (Source = lstNowSetting); end; procedure TApp_CustomToolBar.lstCommandDragDrop(Sender, Source: TObject; X, Y: Integer); //現在の設定からコマンドリストへドロップ begin if not(Source = lstNowSetting) then Exit; //コマンドリストへドロップ = 削除 actToolBar_DeleteExecute(nil); end; procedure TApp_CustomToolBar.lstNowSettingDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); //ドラッグ中のマウスカーソルをドラッグ状態にするために必要。 begin Accept := (Source = lstCommand) and (actToolBar_Add.Enabled); end; procedure TApp_CustomToolBar.lstNowSettingDragDrop(Sender, Source: TObject; X, Y: Integer); //コマンドリストから現在の設定へドロップ begin if not(Source = lstCommand) then Exit; //現在の設定へドロップ = ドロップ位置へ挿入 actToolBar_InsertExecute(nil); end; procedure TApp_CustomToolBar.lstNowSettingKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var l_CheckListBox: TCheckListBox; begin if not(Sender is TCheckListBox) then Exit; l_CheckListBox := TCheckListBox(Sender); case Key of VK_F10: begin if (ssShift in Shift) then begin l_CheckListBox.PopupMenu.Popup(l_CheckListBox.ClientOrigin.X, l_CheckListBox.ClientOrigin.Y); end; Key := 0; end; VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_HOME, VK_END: begin l_CheckListBox.PopupMenu.OnPopup(nil); end; end; end; procedure TApp_CustomToolBar.mnuNowSettingPopup(Sender: TObject); //現在の設定メニューをポップアップ var l_ToolControl: T_MyToolControl; begin lstNowSettingEnter(nil); if (actToolBar_Delete.Enabled) then begin l_ToolControl := F_NowSetting.Items[lstNowSetting.ItemIndex]; mniToolBar_Delete.Caption := Format('[%s] をツールバーから削除(&R)', [F_GetDescription(l_ToolControl)]); end else begin mniToolBar_Delete.Caption := '削除(&R)'; end; end; procedure TApp_CustomToolBar.mnuCommandListPopup(Sender: TObject); //コマンドリストメニューをポップアップ begin lstCommandEnter(nil); if (actToolBar_Add.Enabled) then begin mniToolBar_Add.Caption := Format('[%s] をツールバーに追加(&A)', [F_GetDescription(F_GetMyToolBar(F_ToolBar).ToolControl[lstCommand.ItemIndex])]); end else begin mniToolBar_Add.Caption := '追加(&A)'; end; end; procedure TApp_CustomToolBar.lstCommandClick(Sender: TObject); var l_Action: TAction; begin if (lstCommand.ItemIndex >= 0) then begin l_Action := TAction(G_ActionList.Actions[lstCommand.ItemIndex]); Label_Hint.Caption := gfnsActionHintGet(l_Action); end else begin Label_Hint.Caption := ''; end; end; procedure TApp_CustomToolBar.lstCommandClickCheck(Sender: TObject); var l_MyToolControl, l_MyBtnControl: T_MyToolControl; i: Integer; begin l_MyToolControl := F_GetMyToolBar(F_ToolBar).ToolControl[lstCommand.ItemIndex]; if (lstCommand.Checked[lstCommand.ItemIndex]) then begin //チェック⇒ツールバーに追加 actToolBar_AddExecute(nil); if (l_MyToolControl.IsSeparator) then begin //区切りは複数追加可能とするため常にチェック状態にはしない lstCommand.Checked[F_GetListIndex(l_MyToolControl)] := False; end; end else begin //チェックをはずした⇒現在のツールバーから取り除く //区切りは除外 if not(l_MyToolControl.IsSeparator) then begin for i := F_NowSetting.Count-1 downto 0 do begin l_MyBtnControl := T_MyToolControl(F_NowSetting.Items[i]); if (l_MyToolControl.IsSame(l_MyBtnControl)) then begin l_MyBtnControl.ToolButtonFree; l_MyBtnControl.Free; //T_MyToolControlをFree F_NowSetting.Delete(i); //リストのアイテムを削除 lstNowSetting.Items.Delete(i); //表示されているリストのアイテムを削除 Break; end; end; end; end; end; procedure TApp_CustomToolBar.lstNowSettingClick(Sender: TObject); var l_ToolButton : TToolButton; l_Action : TAction; begin if (lstNowSetting.ItemIndex >= 0) then begin l_ToolButton := F_ToolBar.Buttons[lstNowSetting.ItemIndex]; l_Action := TAction(l_ToolButton.Action); if (l_Action = nil) then begin if (l_ToolButton.Style = tbsSeparator) or (l_ToolButton.Style = tbsDivider) then begin Label_Hint.Caption := '区切り'; end else begin Label_Hint.Caption := StripHotKey(l_ToolButton.Caption); end; end else begin Label_Hint.Caption := gfnsActionHintGet(l_Action); end; end else begin Label_Hint.Caption := ''; end; end; procedure TApp_CustomToolBar.lstNowSettingClickCheck(Sender: TObject); //現在の設定 begin actToolBar_DeleteExecute(nil); end; //------------------------------------------------------------------------------ procedure TApp_CustomToolBar.actToolBar_AddExecute(Sender: TObject); var li_Index: Integer; l_ToolControl: T_MyToolControl; begin if (lstCommand.ItemIndex < 0) then Exit; li_Index := lstCommand.ItemIndex; l_ToolControl := F_GetMyToolBar(F_ToolBar).ToolControl[li_Index]; if (F_AppendToolButton(l_ToolControl)) then begin lstNowSetting.Items.Add(''); lstNowSetting.Checked[lstNowSetting.Count-1] := True; lstCommandEnter(nil); lstCommand.Checked[li_Index] := True; end; end; procedure TApp_CustomToolBar.actToolBar_InsertExecute(Sender: TObject); var li_Index, li_Insert: Integer; l_ToolControl: T_MyToolControl; lpt_Pos: TPoint; begin if (lstCommand.ItemIndex < 0) then Exit; li_Index := lstCommand.ItemIndex; l_ToolControl := F_GetMyToolBar(F_ToolBar).ToolControl[li_Index]; lpt_Pos := gfnptMousePosGet; li_Insert := lstNowSetting.ItemAtPos(lstNowSetting.ScreenToClient(lpt_Pos), False); if (li_Insert > -1) then begin if (F_InsertToolButton(li_Insert, l_ToolControl, True)) then begin lstNowSetting.Items.Insert(li_Insert, ''); lstNowSetting.Checked[li_Insert] := True; lstNowSettingEnter(nil); lstCommand.Checked[lstCommand.ItemIndex] := True; end; end; end; procedure TApp_CustomToolBar.actToolBar_DeleteExecute(Sender: TObject); var li_Index, li_CmdCheck: Integer; l_MyToolControl: T_MyToolControl; begin if (lstNowSetting.ItemIndex < 0) then begin Exit; end; li_Index := lstNowSetting.ItemIndex; l_MyToolControl := T_MyToolControl(F_NowSetting[li_Index]); li_CmdCheck := F_GetListIndex(l_MyToolControl); if (li_CmdCheck >= 0) then begin lstCommand.Checked[li_CmdCheck] := False; end; F_DeleteToolButton(li_Index); lstNowSetting.Items.Delete(li_Index); lstNowSettingEnter(nil); end; procedure TApp_CustomToolBar.actToolBar_ResetAllExecute(Sender: TObject); var i, li_Index: Integer; l_MyToolBar: T_MyToolBar; l_MyToolControl: T_MyToolControl; begin if (Sender = nil) or (gfniMessageBoxYesNo('ツールバーの設定をリセットします'#13'よろしいですか') = ID_YES) then begin lstNowSetting.Items.BeginUpdate; try for i := F_NowSetting.Count-1 downto 0 do begin F_DeleteToolButton(i); //F_NowSetting.Delete(i); NG F_DeleteToolButtonの中でやっている end; lstNowSetting.Items.Clear; for i := 0 to lstCommand.Items.Count-1 do begin lstCommand.Checked[i] := False; end; l_MyToolBar := T_MyToolBar(F_MyToolBarList.Items[lstSelToolBar.ItemIndex]); for i := 0 to l_MyToolBar.InitToolControlCount-1 do begin l_MyToolControl := l_MyToolBar.InitToolControl[i]; if (F_AppendToolButton(l_MyToolControl)) then begin lstNowSetting.Items.Add(''); lstNowSetting.Checked[lstNowSetting.Count-1] := True; li_Index := F_GetListIndex(l_MyToolControl); if (li_Index > 0) then begin lstCommand.Checked[li_Index] := True; end; end; end; lstNowSettingEnter(nil); finally lstNowSetting.Items.EndUpdate; end; end; end; function TApp_CustomToolBar.F_GetToolControl(AControl: TControl): T_MyToolControl; var i: Integer; l_MyToolBar: T_MyToolBar; l_ToolControl: T_MyToolControl; begin Result := nil; if (AControl = nil) then begin Exit; end; l_MyToolBar := F_GetMyToolBar(F_ToolBar); for i := 0 to l_MyToolBar.ToolControlCount-1 do begin l_ToolControl := l_MyToolBar.ToolControl[i]; if (l_ToolControl.IsSame(AControl)) then begin Result := l_ToolControl; Exit; end; end; end; function TApp_CustomToolBar.F_GetToolControl(iIndex: Integer): T_MyToolControl; begin if (iIndex >= 0) and (iIndex < F_NowSetting.Count) then begin Result := T_MyToolControl(F_NowSetting.Items[iIndex]); end else begin Result := nil; end; end; function TApp_CustomToolBar.F_GetMyToolBar(AToolBar: TToolBar): T_MyToolBar; var l_MyToolBar: T_MyToolBar; i: Integer; begin Result := nil; for i := 0 to F_MyToolBarList.Count-1 do begin l_MyToolBar := T_MyToolBar(F_MyToolBarList.Items[i]); if (l_MyToolBar.ToolBar = AToolBar) then begin Result := l_MyToolBar; Exit; end; end; end; function TApp_CustomToolBar.F_GetListIndex(AToolControl: T_MyToolControl): Integer; //ツールボタンの候補一覧リストでのインデックスを返す var i: Integer; l_MyToolControl: T_MyToolControl; l_MyToolBar: T_MyToolBar; begin if (F_ToolBar = nil) then begin Result := -1; Exit; end; l_MyToolBar := F_GetMyToolBar(F_ToolBar); for i := 0 to l_MyToolBar.ToolControlCount-1 do begin l_MyToolControl := T_MyToolControl(l_MyToolBar.ToolControl[i]); if (AToolControl.IsSame(l_MyToolControl)) then begin Result := i; Exit; end; end; Result := -1; end; { function TApp_CustomToolBar.F_GetNowIndex (AToolControl: T_MyToolControl): Integer; //現在のツールボタンのインデックスを返す var i: Integer; l_MyToolControl: T_MyToolControl; begin if (F_ToolBar = nil) then begin Result := -1; Exit; end; for i := 0 to F_NowSetting.Count-1 do begin l_MyToolControl := T_MyToolControl(F_NowSetting.Items[i]); if (AToolControl.IsSame(l_MyToolControl)) then begin Result := i; Exit; end; end; Result := -1; end; } procedure TApp_CustomToolBar.actToolBar_MoveUpExecute(Sender: TObject); //ツールボタン移動 var li_FromIndex, li_ToIndex, li_DelIndex, li_ItemIndex, li_Move: Integer; l_FromToolControl: T_MyToolControl; begin if (lstNowSetting.ItemIndex < 0) then begin Exit; end; li_FromIndex := lstNowSetting.ItemIndex; if (Sender = actToolBar_MoveUp) then begin //上に移動 if (lstNowSetting.ItemIndex <= 0) then begin Exit; end; li_ToIndex := li_FromIndex -1; li_DelIndex := li_FromIndex +1; li_ItemIndex := li_ToIndex; li_Move := -1; end else if (Sender = actToolBar_MoveDown) then begin //下に移動 if (lstNowSetting.ItemIndex >= lstNowSetting.Count-1) then begin Exit; end; li_ToIndex := li_FromIndex +2; li_DelIndex := li_FromIndex; li_ItemIndex := li_FromIndex +1; li_Move := 1; end else begin Exit; end; lstNowSetting.Items.BeginUpdate; try l_FromToolControl := F_GetToolControl(li_FromIndex); if (l_FromToolControl.IsToolButton) then begin F_InsertToolButton(li_ToIndex, l_FromToolControl, True); F_DeleteToolButton(li_DelIndex); end else begin F_InsertToolButton(li_ToIndex, l_FromToolControl, False); F_NowSetting.Exchange(li_FromIndex, li_FromIndex + li_Move); end; lstNowSetting.ItemIndex := li_ItemIndex; lstNowSetting.Repaint; finally lstNowSetting.Items.EndUpdate; end; lstNowSettingEnter(nil); end; procedure TApp_CustomToolBar.lstCommandEnter(Sender: TObject); begin //区切りはいつでもTrue actToolBar_Add.Enabled := (lstCommand.ItemIndex = 0) or ((lstCommand.ItemIndex > 0) and (lstCommand.Checked[lstCommand.ItemIndex] = False)); actToolBar_Delete.Enabled := False; actToolBar_MoveUp.Enabled := False; actToolBar_MoveDown.Enabled := False; end; procedure TApp_CustomToolBar.lstNowSettingEnter(Sender: TObject); begin actToolBar_Add.Enabled := False; actToolBar_Delete.Enabled := (lstNowSetting.ItemIndex >= 0); actToolBar_MoveUp.Enabled := (lstNowSetting.ItemIndex >= 1); actToolBar_MoveDown.Enabled := (lstNowSetting.ItemIndex >= 0) and (lstNowSetting.ItemIndex < lstNowSetting.Count-1); end; procedure TApp_CustomToolBar.lstSelToolBarSelect(Sender: TObject); var l_MyToolBar: T_MyToolBar; l_ListToolControl, l_NowToolControl: T_MyToolControl; i, k: Integer; // ls_Category: String; begin if (lstSelToolBar.ItemIndex < 0) then begin Exit; end; l_MyToolBar := T_MyToolBar(F_MyToolBarList.Items[lstSelToolBar.ItemIndex]); F_ToolBar := l_MyToolBar.ToolBar; //ツールバーのボタン削除ではなく現在のツールバーのリストのクリア // F_ClearToolBar; NG! for i := F_NowSetting.Count-1 downto 0 do begin T_MyToolControl(F_NowSetting.Items[i]).Free; end; F_NowSetting.Clear; for i := 0 to F_ToolBar.ButtonCount-1 do begin if (F_ToolBar.Buttons[i].Visible) then begin F_NowSetting.Add(T_MyToolControl.Create(F_ToolBar.Buttons[i])); end; end; //コマンドリスト lstCommand.Items.BeginUpdate; try lstCommand.Clear; for i := 0 to l_MyToolBar.ToolControlCount-1 do begin lstCommand.Items.Add(''); l_ListToolControl := l_MyToolBar.ToolControl[i]; for k := 0 to F_NowSetting.Count-1 do begin l_NowToolControl := T_MyToolControl(F_NowSetting.Items[k]); if (l_ListToolControl.IsSame(l_NowToolControl)) then begin if not(l_ListToolControl.IsSeparator) then begin lstCommand.Checked[i] := True; end; Break; end; end; end; lstCommand.ItemIndex := 0; finally lstCommand.Items.EndUpdate; end; { //カテゴリメニュー構築 gpcMenuShortCutDel(mnuCommandCategory); ls_Category := ''; for i := 0 to F_ActionList.ActionCount-1 do begin l_Action := TAction(F_ActionList.Actions[i]); if (l_Action.Category <> ls_Category) then begin //メニューに追加 ls_Category := l_Action.Category; mnuCommandCategory.Items.Add( NewItem( Format('%s へ移動', [ls_Category]), 0, False, True, F_CmdGoToCategory, 0, Format('mniPShortCut_Category_%d', [i]) ) ); end; end; } //現在の設定 lstNowSetting.Items.BeginUpdate; try lstNowSetting.Clear; for i := 0 to F_NowSetting.Count-1 do begin lstNowSetting.Items.Add(''); lstNowSetting.Checked[i] := True; end; if (lstNowSetting.Items.Count > 0) then begin lstNowSetting.ItemIndex := 0; end; finally lstNowSetting.Items.EndUpdate; end; end; end.