unit custom_menu; //{$DEFINE DEBUG} {$DEFINE MYLIB} //{$DEFINE ICON} interface uses Windows, Messages, SysUtils, Graphics, Controls, Forms, ComCtrls, ExtCtrls, StdCtrls, Grids, ActnList, Menus, Classes, ImgList, ToolWin, CheckLst, Buttons, myIniFile; type T_MyMenuVisibles = class(TObject) private F_MenuVisibles: TStrings; F_Menu: TMenu; function F_GetCount: Integer; // function F_GetIndexVisible(iIndex: Integer): Boolean; function F_GetVisible(sName: String): Boolean; function F_GetName(iIndex: Integer): String; public constructor Create(AMenu: TMenu); destructor Destroy; override; property Count: Integer read F_GetCount; property Menu: TMenu read F_Menu; property Visible[sName: String]: Boolean read F_GetVisible; property Name[iIndex: Integer]: String read F_GetName; end; T_MyMenuVisibleList = class(TObject) private F_MenuVisibleList: TList; function F_GetCount: Integer; function F_GetMenu(iIndex: Integer): TMenu; public constructor Create; destructor Destroy; override; procedure AddMenu(AMenu: TMenu); function GetMyMenuList(AMenu: TMenu): T_MyMenuVisibles; property Count: Integer read F_GetCount; property Menu[iIndex: Integer]: TMenu read F_GetMenu; end; type T_MyMenuReset = procedure(AMenu: TMenu) of object; T_MyMenuItemVisibleChange = procedure(AMenuItem: TMenuItem; bVisible: Boolean) of object; T_MyGetMenuVisible = function(AMenuItem: TMenuItem): Boolean of object; TApp_CustomMenu = class(TForm) ActionList1: TActionList; actFile_Close: TAction; actMenu_Reset: TAction; actMenu_Test: TAction; actMenu_Popup: TAction; mnuMenu: TPopupMenu; mniMenu_Category: TMenuItem; mniMenu_Line1: TMenuItem; mniMenu_Test: TMenuItem; mniMenu_Reset: TMenuItem; mniMenu_Line2: TMenuItem; mniFile_Close: TMenuItem; shpLine1: TShape; Panel_Base: TPanel; pnlTitle: TPanel; shpTop: TShape; lblTitle: TLabel; lstSelMenu: TComboBox; Panel1: TPanel; lblMenu_Text: TLabel; lstMenu: TCheckListBox; pnlMenu_Test: TPanel; btnMenu_Test: TButton; pnlCmd: TPanel; btnClose: TButton; btnReset: TButton; GroupBox1: TGroupBox; Label_Hint: TLabel; procedure FormCreate (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure FormDestroy(Sender: TObject); procedure actFile_CloseExecute(Sender: TObject); procedure actMenu_ResetExecute(Sender: TObject); procedure actMenu_TestExecute (Sender: TObject); procedure actMenu_PopupExecute(Sender: TObject); procedure lstMenu_ClickCheck (Sender: TObject); procedure lstMenu_DrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure lstMenuKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure lstMenuKeyPress (Sender: TObject; var Key: Char); procedure lstSelMenuSelect (Sender: TObject); procedure lstMenuClick (Sender: TObject); private { Private 宣言 } F_InitMenuList: T_MyMenuVisibleList; F_OnMenuReset: T_MyMenuReset; F_GetMenuVisible: T_MyGetMenuVisible; F_OnMenuItemVisibleChange: T_MyMenuItemVisibleChange; procedure F_MenuGoToCategory(Sender: TObject); procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; public { Public 宣言 } procedure DockTo(AParent: TWinControl); procedure AddMenu(sTitle: String; AMenu: TMenu); function GetMenu: TMenu; // procedure ReadIniMenu (AIniFile: TMyIniFile; AMenus: array of TMenu); // procedure WriteIniMenu(AIniFile: TMyIniFile; AMenus: array of TMenu); procedure ReadIniMenu (AIniFile: TMyIniFile); procedure WriteIniMenu(AIniFile: TMyIniFile); property OnMenuReset: T_MyMenuReset read F_OnMenuReset write F_OnMenuReset; property OnMenuItemVisibleChange: T_MyMenuItemVisibleChange read F_OnMenuItemVisibleChange write F_OnMenuItemVisibleChange; property GetMenuVisible: T_MyGetMenuVisible read F_GetMenuVisible write F_GetMenuVisible; end; //------------------------------------------------------------------------------ procedure gpcCreateMenuForm; //procedure gpcReadIniMenu (AIniFile: TMyIniFile; AMenus: array of TMenu); procedure gpcWriteIniMenu(AIniFile: TMyIniFile); var App_CustomMenu: TApp_CustomMenu; G_MenuList: TList; //============================================================================== implementation uses {$IFDEF DEBUG} myDebug, {$ENDIF} myControl, myMenu, myNum, mySize, myWStrings, myMessageBox, custom_base, main; {$R *.dfm} const lciMARGIN = 2; //------------------------------------------------------------------------------ {T_MyMenuVisibles} constructor T_MyMenuVisibles.Create(AMenu: TMenu); procedure lpc_AddList(slList: TStrings; AMenuItem: TMenuItem); var i: Integer; l_MenuItem: TMenuItem; begin for i := 0 to AMenuItem.Count-1 do begin l_MenuItem := AMenuItem.Items[i]; slList.AddObject(UpperCase(l_MenuItem.Name), TObject(l_MenuItem.Visible)); if (l_MenuItem.Count > 0) then begin lpc_AddList(slList, l_MenuItem); end; end; end; begin inherited Create; F_Menu := AMenu; F_MenuVisibles := TStringList.Create; lpc_AddList(F_MenuVisibles, F_Menu.Items); end; destructor T_MyMenuVisibles.Destroy; begin F_MenuVisibles.Clear; F_MenuVisibles.Free; inherited; end; function T_MyMenuVisibles.F_GetCount: Integer; begin Result := F_MenuVisibles.Count; end; { function T_MyMenuVisibles.F_GetIndexVisible(iIndex: Integer): Boolean; begin Result := Boolean(F_MenuVisibles.Objects[iIndex]); end; } function T_MyMenuVisibles.F_GetVisible(sName: String): Boolean; var i: Integer; begin sName := UpperCase(sName); for i := 0 to F_GetCount-1 do begin if (F_MenuVisibles.Strings[i] = sName) then begin Result := Boolean(F_MenuVisibles.Objects[i]); Exit; end; end; Result := True; //デフォルトはTrue end; function T_MyMenuVisibles.F_GetName(iIndex: Integer): String; begin if (gfnbIsInsideRange(iIndex, 0, F_GetCount-1)) then begin Result := F_MenuVisibles.Strings[iIndex]; end else begin Result := ''; end; end; //------------------------------------------------------------------------------ {T_MyMenuVisibleList} constructor T_MyMenuVisibleList.Create; begin inherited Create; F_MenuVisibleList := TList.Create; end; destructor T_MyMenuVisibleList.Destroy; var i: Integer; begin for i := F_MenuVisibleList.Count-1 downto 0 do begin T_MyMenuVisibles(F_MenuVisibleList.Items[i]).Free; F_MenuVisibleList.Delete(i); end; F_MenuVisibleList.Free; { for i := Self.Count-1 downto 0 do begin T_MyMenuVisibles(Self.Items[i]).Free; Self.Delete(i); end; } inherited; end; procedure T_MyMenuVisibleList.AddMenu(AMenu: TMenu); begin F_MenuVisibleList.Add(T_MyMenuVisibles.Create(AMenu)); // Self.Add(T_MyMenuVisibles.Create(AMenu)); end; function T_MyMenuVisibleList.GetMyMenuList(AMenu: TMenu): T_MyMenuVisibles; var i: Integer; l_MyMenuVisibles: T_MyMenuVisibles; begin for i := 0 to F_GetCount-1 do begin l_MyMenuVisibles := T_MyMenuVisibles(F_MenuVisibleList.Items[i]); // for i := 0 to Self.Count-1 do begin // l_MyMenuVisibles := T_MyMenuVisibles(Self.Items[i]); if (l_MyMenuVisibles.Menu = AMenu) then begin Result := l_MyMenuVisibles; Exit; end; end; Result := nil; end; function T_MyMenuVisibleList.F_GetCount: Integer; begin Result := F_MenuVisibleList.Count; end; function T_MyMenuVisibleList.F_GetMenu(iIndex: Integer): TMenu; begin if (gfnbIsInsideRange(iIndex, 0, F_GetCount-1)) then begin Result := T_MyMenuVisibles(F_MenuVisibleList.Items[iIndex]).Menu; // if (gfnbIsInsideRange(iIndex, 0, Self.Count-1)) then begin // Result := T_MyMenuVisibles(Self.Items[iIndex]).Menu; end else begin Result := nil; end; end; //============================================================================== procedure gpcCreateMenuForm; var i: Integer; begin if (App_CustomMenu = nil) then begin App_CustomMenu := TApp_CustomMenu.Create(G_MainForm); end else begin for i := 0 to Screen.FormCount-1 do begin if (Screen.Forms[i] = App_CustomMenu) then begin Exit; end; end; App_CustomMenu := TApp_CustomMenu.Create(G_MainForm); end; end; const lcsSECT_MENU = 'MENU'; procedure TApp_CustomMenu.ReadIniMenu(AIniFile: TMyIniFile); {,2011-06-30: 2011-06-30:読み込むメニューを引数で指定せずに済むように変更。 } function lfn_FindMenuItem(sName: String; AMenuItem: TMenuItem): TMenuItem; var i: Integer; l_MenuItem: TMenuItem; begin Result := nil; sName := UpperCase(sName); if (sName = UpperCase(AMenuItem.Name)) then begin Result := AMenuItem; end else if (AMenuItem.Count > 0) then begin for i := 0 to AMenuItem.Count-1 do begin l_MenuItem := AMenuItem.Items[i]; if (sName = UpperCase(l_MenuItem.Name)) then begin Result := l_MenuItem; Exit; end else if (l_MenuItem.Count > 0) then begin Result := lfn_FindMenuItem(sName, l_MenuItem); if (Result <> nil) then begin Exit; end; end; end; end; end; var lsl_List: TMyWStrings; ls_Sect: WideString; i, k: Integer; l_Menu: TMenu; l_MenuItem: TMenuItem; begin lsl_List := TMyWStrings.Create; try for i := 0 to App_CustomMenu.F_InitMenuList.Count-1 do begin l_Menu := App_CustomMenu.F_InitMenuList.Menu[i]; ls_Sect := WideFormat('%s_%s.%s', [lcsSECT_MENU, gfnParentFormGet(l_Menu).Name, l_Menu.Name]); if (AIniFile.SectionExists(ls_Sect)) then begin AIniFile.ReadSectionText(ls_Sect, lsl_List); //非表示にするメニューのNameプロパティのみが列挙されている for k := 0 to lsl_List.Count -1 do begin l_MenuItem := lfn_FindMenuItem(lsl_List[k], l_Menu.Items); if (l_MenuItem <> nil) then begin if (@F_OnMenuItemVisibleChange <> nil) then begin F_OnMenuItemVisibleChange(l_MenuItem, False); end else begin l_MenuItem.Visible := False; end; end; end; end; lsl_List.Clear; end; finally lsl_List.Free; end; lstSelMenuSelect(nil); end; procedure gpcWriteIniMenu(AIniFile: TMyIniFile); procedure lpc_WriteMenu(AList: TMyWStrings; AMenuItem: TMenuItem); var i: Integer; l_MenuItem: TMenuItem; lb_Visible: Boolean; begin for i := 0 to AMenuItem.Count-1 do begin l_MenuItem := AMenuItem.Items[i]; if (Copy(l_MenuItem.Name, 1, 2) = '__') then begin Continue; end; if (@App_CustomMenu.F_GetMenuVisible <> nil) then begin lb_Visible := App_CustomMenu.F_GetMenuVisible(l_MenuItem); end else begin lb_Visible := l_MenuItem.Visible; end; if not(lb_Visible) then begin AList.Add(l_MenuItem.Name); end; if (l_MenuItem.Count > 0) then begin lpc_WriteMenu(AList, l_MenuItem); end; end; end; var lsl_List : TMyWStrings; ls_Sect : WideString; l_Menu : TMenu; i : Integer; begin lsl_List := TMyWStrings.Create; try for i := 0 to App_CustomMenu.F_InitMenuList.Count-1 do begin l_Menu := App_CustomMenu.F_InitMenuList.Menu[i]; ls_Sect := WideFormat('%s_%s.%s', [lcsSECT_MENU, gfnParentFormGet(l_Menu).Name, l_Menu.Name]); AIniFile.EraseSection(ls_Sect); if (App_CustomMenu <> nil) then begin lsl_List.Clear; lpc_WriteMenu(lsl_List, l_Menu.Items); AIniFile.WriteSectionText(ls_Sect, lsl_List); end; end; finally lsl_List.Free; end; end; //procedure TApp_CustomMenu.WriteIniMenu(AIniFile: TMyIniFile; AMenus: array of TMenu); procedure TApp_CustomMenu.WriteIniMenu(AIniFile: TMyIniFile); procedure _WriteMenu(AList: TMyWStrings; AMenuItem: TMenuItem); var i: Integer; l_MenuItem: TMenuItem; lb_Visible: Boolean; begin for i := 0 to AMenuItem.Count-1 do begin l_MenuItem := AMenuItem.Items[i]; if (Copy(l_MenuItem.Name, 1, 2) = '__') then begin Continue; end; if (@F_GetMenuVisible <> nil) then begin lb_Visible := F_GetMenuVisible(l_MenuItem); end else begin lb_Visible := l_MenuItem.Visible; end; if not(lb_Visible) then begin AList.Add(l_MenuItem.Name); end; if (l_MenuItem.Count > 0) then begin _WriteMenu(AList, l_MenuItem); end; end; end; var lsl_List : TMyWStrings; ls_Sect : WideString; l_Menu : TMenu; i : Integer; begin //[Menu] // if not(Assigned(App_CustomMenu)) then begin //Exit; // end; lsl_List := TMyWStrings.Create; try for i := 0 to F_InitMenuList.Count-1 do begin // l_Menu := AMenus[i]; l_Menu := F_InitMenuList.Menu[i]; ls_Sect := WideFormat('%s_%s.%s', [lcsSECT_MENU, gfnParentFormGet(l_Menu).Name, l_Menu.Name]); AIniFile.EraseSection(ls_Sect); lsl_List.Clear; _WriteMenu(lsl_List, l_Menu.Items); AIniFile.WriteSectionText(ls_Sect, lsl_List); end; finally lsl_List.Free; end; end; //============================================================================== procedure TApp_CustomMenu.WMSysCommand(var Msg: TWMSysCommand); begin case Msg.CmdType of 61587 :begin //システムアイコンクリック actMenu_PopupExecute(nil); end; else begin inherited; end; end; end; procedure TApp_CustomMenu.F_MenuGoToCategory(Sender: TObject); var l_MenuItem : TMenuItem; ls_Caption : String; i : Integer; begin lstMenu.SetFocus; l_MenuItem := TMenuItem(Sender); ls_Caption := Copy(l_MenuItem.Caption, 0, AnsiPos(' へ移動', l_MenuItem.Caption) -1); for i := 1 to lstMenu.Items.Count-1 do begin if (ls_Caption = lstMenu.Items[i]) then begin lstMenu.TopIndex := i; lstMenu.ItemIndex := i; Exit; end; end; end; procedure TApp_CustomMenu.FormCreate(Sender: TObject); var lh_Menu: HMENU; begin Self.Icon := Application.Icon; DockTo(G_CustomForm.tabMenu); Panel_Base.Align := alClient; Label_Hint.Caption := ''; //システムメニュー 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_InitMenuList := T_MyMenuVisibleList.Create; F_GetMenuVisible := nil; F_OnMenuReset := nil; F_OnMenuItemVisibleChange := nil; end; procedure TApp_CustomMenu.DockTo(AParent: TWinControl); begin gpcCreateCustomBaseForm(G_MainForm); Self.ManualDock(AParent); Self.Align := alClient; Self.Visible := True; end; procedure TApp_CustomMenu.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; procedure TApp_CustomMenu.FormDestroy(Sender: TObject); begin F_InitMenuList.Free; end; //閉じる procedure TApp_CustomMenu.actFile_CloseExecute(Sender: TObject); begin G_CustomForm.actFile_CloseExecute(nil); end; //------------------------------------------------------------------------------ //メニュー procedure TApp_CustomMenu.AddMenu(sTitle: String; AMenu: TMenu); begin F_InitMenuList.AddMenu(AMenu); //Stringsにタイトルを、Objectsにメニュー(のアドレス)を追加 lstSelMenu.AddItem(sTitle, AMenu); if (lstSelMenu.Items.Count = 1) then begin lstSelMenu.ItemIndex := 0; lstSelMenuSelect(nil); end else if (lstSelMenu.Items.Count > 1) then begin pnlTitle.Visible := True; end; end; procedure TApp_CustomMenu.lstMenu_DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure lpc_MenuDepthGet(AMenuItem: TMenuItem; var iDepth: Integer); begin if (AMenuItem.Parent.Name <> '') then begin Inc(iDepth); lpc_MenuDepthGet(AMenuItem.Parent, iDepth); end; end; const lci_Indent = 20; var l_MenuItem: TMenuItem; li_Depth: Integer; begin if (odSelected in State) then begin if (GetFocus = lstMenu.Handle) then begin lstMenu.Canvas.Brush.Color := clHighlight; lstMenu.Canvas.Font.Color := clHighlightText; end else begin lstMenu.Canvas.Brush.Color := clBtnFace; lstMenu.Canvas.Font.Color := clBtnText; end; end else begin lstMenu.Canvas.Brush.Color := lstMenu.Color; lstMenu.Canvas.Font.Color := lstMenu.Font.Color; end; lstMenu.Canvas.FillRect(Rect); l_MenuItem := TMenuItem(lstMenu.Items.Objects[Index]); if (l_MenuItem.Parent = l_MenuItem) then begin //第一階層のメニュー Inc(Rect.Left, lciMARGIN); end else begin //サブメニューならインデント li_Depth := 0; lpc_MenuDepthGet(l_MenuItem, li_Depth); Inc(Rect.Left, (lci_Indent * li_Depth) + lciMARGIN); end; if (l_MenuItem.Caption <> '-') then begin DrawText(lstMenu.Canvas.Handle, PChar(lstMenu.Items[Index]), -1, Rect, DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); end else begin lstMenu.Canvas.MoveTo(Rect.Left, Rect.Top + gfniRectHeight(Rect) div 2); lstMenu.Canvas.LineTo(Rect.Right, Rect.Top + gfniRectHeight(Rect) div 2); end; end; procedure TApp_CustomMenu.lstMenuClick(Sender: TObject); var l_MenuItem : TMenuItem; l_Action : TAction; begin l_MenuItem := TMenuItem(lstMenu.Items.Objects[lstMenu.ItemIndex]); l_Action := TAction(l_MenuItem.Action); if (l_Action = nil) then begin if (l_MenuItem.IsLine) then begin Label_Hint.Caption := '区切り'; end else begin Label_Hint.Caption := StripHotKey(l_MenuItem.Caption); if (l_MenuItem.Hint <> '') then begin Label_Hint.Caption := Format('%s (%s)', [Label_Hint.Caption, l_MenuItem.Hint]); end; end; end else begin Label_Hint.Caption := gfnsActionDescriptionGet(l_Action); if (l_Action.Hint <> '') then begin Label_Hint.Caption := Format('%s (%s)', [Label_Hint.Caption, l_Action.Hint]); end; end; end; //チェック procedure TApp_CustomMenu.lstMenu_ClickCheck(Sender: TObject); var l_MenuItem: TMenuItem; begin l_MenuItem := TMenuItem(lstMenu.Items.Objects[lstMenu.ItemIndex]); if (@F_OnMenuItemVisibleChange <> nil) then begin F_OnMenuItemVisibleChange(l_MenuItem, lstMenu.Checked[lstMenu.ItemIndex]); end else begin l_MenuItem.Visible := lstMenu.Checked[lstMenu.ItemIndex]; end; end; procedure TApp_CustomMenu.lstMenuKeyPress(Sender: TObject; var Key: Char); begin if (Key = ' ') then begin Key := #0; end; end; procedure TApp_CustomMenu.lstMenuKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin case Key of VK_F10: begin if not(ssAlt in Shift) and not(ssCtrl in Shift) then begin actMenu_PopupExecute(nil); Key := 0; end; end; end; end; //初期化 procedure TApp_CustomMenu.actMenu_ResetExecute(Sender: TObject); var i: Integer; l_Menu : TMenu; l_MenuItem : TMenuItem; l_MyMenuVisibles : T_MyMenuVisibles; begin if (gfniMessageBoxYesNo('メニューのカスタマイズをリセットします'#13'よろしいですか') = ID_YES) then begin Screen.Cursor := crHourGlass; Self.Enabled := False; lstMenu.Items.BeginUpdate; try l_Menu := GetMenu; l_MyMenuVisibles := F_InitMenuList.GetMyMenuList(l_Menu); for i := 0 to lstMenu.Count-1 do begin l_MenuItem := TMenuItem(lstMenu.Items.Objects[i]); if (@F_OnMenuItemVisibleChange <> nil) then begin F_OnMenuItemVisibleChange(l_MenuItem, l_MyMenuVisibles.Visible[l_MenuItem.Name]); end else begin l_MenuItem.Visible := l_MyMenuVisibles.Visible[l_MenuItem.Name]; end; lstMenu.Checked[i] := l_MenuItem.Visible; end; finally lstMenu.Items.EndUpdate; Self.Enabled := True; Screen.Cursor := crDefault; end; if (@F_OnMenuReset <> nil) then begin F_OnMenuReset(l_Menu); end; end; end; //テスト procedure TApp_CustomMenu.actMenu_TestExecute(Sender: TObject); var l_PopupMenu: TPopupMenu; lpt_Pos: TPoint; begin if not(actMenu_Test.Enabled) then begin Exit; end; l_PopupMenu := TPopupMenu(lstSelMenu.Items.Objects[lstSelMenu.ItemIndex]); lpt_Pos := pnlMenu_Test.ClientOrigin; Inc(lpt_Pos.X, 2); Inc(lpt_Pos.Y, 2); l_PopupMenu.Popup(lpt_Pos.X, lpt_Pos.Y); end; procedure TApp_CustomMenu.actMenu_PopupExecute(Sender: TObject); begin mnuMenu.Popup(Self.ClientOrigin.X, Self.ClientOrigin.Y); end; function TApp_CustomMenu.GetMenu: TMenu; begin Result := TMenu(lstSelMenu.Items.Objects[lstSelMenu.ItemIndex]); end; procedure TApp_CustomMenu.lstSelMenuSelect(Sender: TObject); procedure lpc_MenuListSet(AMenuItem: TMenuItem); var i: Integer; ls_Category, ls_Name: String; begin for i := 0 to AMenuItem.Count-1 do begin if (Copy(AMenuItem.Items[i].Name, 0, 2) = '__') then begin //Nameの頭が'__'で始まるメニュー項目はリストから除外 Continue; end; ls_Category := StripHotKey(AMenuItem.Items[i].Caption); //カテゴリ移動メニュー作成 if (AMenuItem.Parent = nil) then begin //第一階層のメニューをカテゴリ別にしている if (ls_Category = '-') then begin //ライン ls_Name := gfnsAvailableName('mniMenu_CategoryLine'); mniMenu_Category.Add( NewItem( '-', 0, False, True, nil, 0, ls_Name )); end else begin ls_Name := gfnsAvailableName('mniMenu_Category'); mniMenu_Category.Add( NewItem( Format('%s へ移動', [ls_Category]), 0, False, True, F_MenuGoToCategory, 0, ls_Name )); end; end; lstMenu.Items.AddObject(ls_Category, AMenuItem.Items[i]); if (@F_GetMenuVisible <> nil) then begin lstMenu.Checked[lstMenu.Count-1] := F_GetMenuVisible(AMenuItem.Items[i]); end else begin lstMenu.Checked[lstMenu.Count-1] := AMenuItem.Items[i].Visible; end; if (AMenuItem.Items[i].Count > 0) then begin //サブメニューあり lpc_MenuListSet(AMenuItem.Items[i]); end; end; end; var l_Menu: TMenu; begin l_Menu := GetMenu; actMenu_Test.Enabled := (l_Menu is TPopupMenu); gpcMenuItemFree(mniMenu_Category); lstMenu.Items.BeginUpdate; try lstMenu.Items.Clear; lpc_MenuListSet(l_Menu.Items); lstMenu.ItemIndex := 0; finally lstMenu.Items.EndUpdate; end; end; end.