unit custom_shortcut; //{$DEFINE DEBUG} {$DEFINE MYLIB} //{$DEFINE ICON} interface uses Windows, Messages, SysUtils, Graphics, Controls, Forms, ComCtrls, ExtCtrls, StdCtrls, Grids, ActnList, Menus, Classes, Buttons, myIniFile; const G_ciKEYNUMFIRST = 0; G_ciKEYNUMEND = 9; G_ciKEYCHARFIRST = 10; G_ciKEYCHAREND = 36; G_ciKEYFUNCFIRST = 37; G_ciKEYFUNCEND = 48; G_ciKEYEXTFIRST = 49; G_ciKEYEXTEND = 61; G_ciSHORTCUTTEXT = 0; G_ciSHORTCUTDISP = 1; //ショートカットキー G_csSHORTCUTKEY: array[0..61, G_ciSHORTCUTTEXT..G_ciSHORTCUTDISP] of String = ( ('0', '0'), ('1', '1'), ('2', '2'), ('3', '3'), ('4', '4'), ('5', '5'), ('6', '6'), ('7', '7'), ('8', '8'), ('9', '9'), ('Space', 'スペース'), ('A', 'A'), ('B', 'B'), ('C', 'C'), ('D', 'D'), ('E', 'E'), ('F', 'F'), ('G', 'G'), ('H', 'H'), ('I', 'I'), ('J', 'J'), ('K', 'K'), ('L', 'L'), ('M', 'M'), ('N', 'N'), ('O', 'O'), ('P', 'P'), ('Q', 'Q'), ('R', 'R'), ('S', 'S'), ('T', 'T'), ('U', 'U'), ('V', 'V'), ('W', 'W'), ('X', 'X'), ('Y', 'Y'), ('Z', 'Z'), ('F1', 'F1'), ('F2', 'F2'), ('F3', 'F3'), ('F4', 'F4'), ('F5', 'F5'), ('F6', 'F6'), ('F7', 'F7'), ('F8', 'F8'), ('F9', 'F9'), ('F10', 'F10'), ('F11', 'F11'), ('F12', 'F12'), ('Enter', 'Enter'), ('BkSp', 'BS(後退)'), ('Del', 'Del'), ('Ins', 'Ins'), ('Esc', 'Esc'), ('PgUp', 'PgUp'), ('PgDn', 'PgDn'), ('Home', 'Home'), ('End', 'End'), ('Left', '←'), ('Right', '→'), ('Up', '↑'), ('Down', '↓') ); const //マウスジェスチャ G_ciGESTUREUP = 0; G_ciGESTUREDOWN = 1; G_ciGESTURELEFT = 2; G_ciGESTURERIGHT = 3; G_csGESTURESTRING: array[G_ciGESTUREUP..G_ciGESTURERIGHT]of String = ( 'ジェスチャ ↑', 'ジェスチャ ↓', 'ジェスチャ ←', 'ジェスチャ →' ); type T_GestureAction = record //マウスジェスチャ GestureUp, GestureDown, GestureLeft, GestureRight: TAction; end; T_ShortCutAction = class(TObject) private F_iKey: Word; F_Action: TAction; public constructor Create(iKey: Word; AAction: TAction); property Key: Word read F_iKey; property Action: TAction read F_Action; end; type TApp_CustomShortCut = class(TForm) ActionList1: TActionList; actFile_Close: TAction; actCommand_KeyAdd: TAction; actCommand_KeyDelete: TAction; actCommand_KeyResetAll: TAction; actShortCutKey_ResetAll: TAction; actShortCutKey_Set: TAction; actShortCutKey_Delete: TAction; actGesture_Set: TAction; actGesture_Delete: TAction; actGesture_ResetAll: TAction; actMenu_Popup: TAction; mnuCustomShortCut: TPopupMenu; mniMenu_Reset: TMenuItem; mniMenu_Line2: TMenuItem; mniFile_Close: TMenuItem; mnuCommand: TPopupMenu; mniCommand_KeyNumAdd: TMenuItem; mniCommand_KeyCharAdd: TMenuItem; mniCommand_KeyFuncAdd: TMenuItem; mniCommand_KeyExtAdd: TMenuItem; mniCommand_KeyGestureAdd: TMenuItem; mniCommand_KeyLine1: TMenuItem; mniCommand_KeyAdd: TMenuItem; mniCommand_KeyDelete: TMenuItem; mniCommand_KeyLine2: TMenuItem; mniCommand_KeyReset: TMenuItem; mnuCommand_Category: TPopupMenu; mnuShortCutKey: TPopupMenu; mniShortCutKey_Line1: TMenuItem; mniShortCutKey_Set: TMenuItem; mniShortCutKey_Delete: TMenuItem; mniShortCutKey_Line2: TMenuItem; mniShortCutKey_ResetAll: TMenuItem; mnuGesture: TPopupMenu; mniGesture_Line1: TMenuItem; mniGesture_Set: TMenuItem; mniGesture_Delete: TMenuItem; mniGesture_Line2: TMenuItem; mniGesture_ResetAll: TMenuItem; pnlCustomShortCut: TPanel; pnlCommand: TPanel; lblCommand: TLabel; celCommand: TStringGrid; btnCommand_KeyAdd: TButton; btnCommand_KeyDelete: TButton; btnCommand_KeyReset: TButton; Splitter1: TSplitter; pnlShortCut: TPanel; pagShortCut: TPageControl; tabShortCutKey: TTabSheet; celShortCutKey: TStringGrid; btnShortCutKey_Set: TButton; btnShortCutKey_Delete: TButton; btnShortCutKey_ResetAll: TButton; tabGesture: TTabSheet; celGesture: TStringGrid; btnGesture_Set: TButton; btnGesture_Delete: TButton; btnGesture_ResetAll: TButton; pnlCmd: TPanel; btnClose: TButton; GroupBox1: TGroupBox; Label_Hint: TLabel; procedure FormCreate (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure FormDestroy(Sender: TObject); procedure FormResize (Sender: TObject); procedure FormKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure actFile_CloseExecute(Sender: TObject); procedure actMenu_PopupExecute(Sender: TObject); procedure mnuShortCutKeyPopup (Sender: TObject); procedure mnuGesturePopup (Sender: TObject); procedure mnuCommandPopup (Sender: TObject); //ショートカット procedure pagShortCutChange(Sender: TObject); procedure actCommand_KeyResetAllExecute(Sender: TObject); //ショートカットキー procedure actShortCutKey_SetExecute (Sender: TObject); procedure actShortCutKey_DeleteExecute (Sender: TObject); procedure actShortCutKey_ResetAllExecute(Sender: TObject); procedure celShortCutKeyDragDrop (Sender, Source: TObject; X, Y: Integer); procedure celShortCutKeyDragOver (Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure celShortCutKeyDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure celShortCutKeyMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure celShortCutKeyMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure celShortCutKeyKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure actGesture_ResetAllExecute (Sender: TObject); procedure actGesture_SetExecute (Sender: TObject); procedure actGesture_DeleteExecute (Sender: TObject); procedure actMouseGesture_ResetExecute(Sender: TObject); procedure actCommand_KeyAddExecute (Sender: TObject); procedure actCommand_KeyDeleteExecute(Sender: TObject); procedure celCommandDragDrop (Sender, Source: TObject; X, Y: Integer); procedure celCommandDragOver (Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure celCommandDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure celCommandMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure celCommandMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure celCommandSelectCell (Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); procedure celShortCutKeySelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); procedure celGestureSelectCell (Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); private { Private 宣言 } // F_slUndoBuff: TList; //キーカスタマイズのアンドゥバッファ F_Drag: TObject; function F_GetCmdHint(AAction: TAction): String; function F_GetShortCut(iIndex: Integer): TShortCut; procedure F_DispCommandKey(AAction: TAction); procedure F_DispShortCutKey; function F_GetKeyAction(iRow: Integer): TAction; procedure F_SetKeyAction(iRow: Integer; AAction: TAction); procedure F_SetAction (iRow: Integer; AAction: TAction); overload; procedure F_SetAction (iRow, iActionIndex: Integer); overload; procedure F_DelAction (iRow: Integer); function F_GetGestureAction(iRow: Integer): TAction; procedure F_SetGestureAction(iRow: Integer; AAction: TAction); procedure F_DelGestureAction(iRow: Integer); procedure F_ChangeSetting; //Help更新のため procedure F_CommandPopup (iIndex: Integer); procedure F_ShortCutPopup (iIndex: Integer); procedure F_MouseGesturePopup(iIndex: Integer); procedure F_SetCommand (Sender: TObject); procedure F_CmdGoToCategory (Sender: TObject); procedure F_CmdAddKey (Sender: TObject); procedure F_CmdAddGesture (Sender: TObject); procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; public { Public 宣言 } end; //------------------------------------------------------------------------------ procedure gpcCreateShortCutForm; procedure gpcSetInitShortCut (AActionList: TActionList); procedure gpcSetInitMouseGesture(GestureUp, GestureDown, GestureLeft, GestureRight: TAction); procedure gpcReadIniShortCut (AIniFile: TMyIniFile; AActionList: TActionList); procedure gpcWriteIniShortCut(AIniFile: TMyIniFile); function gfniTextToShortCut(Text: string): TShortCut; function gfnsShortCutToText(ShortCut: TShortCut): string; function gfnsCommandDescriptGet(AAction: TAction): String; var G_iKeyLength, G_iGestureLength, G_iShortCutLength: Integer; G_InitShortCutList, G_ShortCutList: TList; G_InitGestureUp, G_InitGestureDown, G_InitGestureLeft, G_InitGestureRight: TAction; G_GestureUp, G_GestureDown, G_GestureLeft, G_GestureRight: TAction; var App_CustomShortCut: TApp_CustomShortCut; implementation uses {$IFDEF DEBUG} myDebug, {$ENDIF} myControl, myGrid, myMenu, myMessageBox, // myMultiMonitor, myMonitor, myNum, myWindow, myWStrings, custom_base, custom_help, main; {$R *.dfm} const lciMARGIN = 2; //============================================================================== procedure gpcCreateShortCutForm; var i: Integer; begin if (App_CustomShortCut = nil) then begin App_CustomShortCut := TApp_CustomShortCut.Create(G_MainForm); end else begin for i := 0 to Screen.FormCount-1 do begin if (Screen.Forms[i] = App_CustomShortCut) then begin Exit; end; end; App_CustomShortCut := TApp_CustomShortCut.Create(G_MainForm); end; end; procedure gpcSetInitShortCut(AActionList: TActionList); //ショートカットの初期値をセット var i, k: Integer; li_Old, li_Key: Word; l_Shift: TShiftState; l_Action: TAction; begin for i := 0 to AActionList.ActionCount-1 do begin l_Action := TAction(AActionList.Actions[i]); if (l_Action.SecondaryShortCuts.Count > 0) then begin li_Old := 0; for k := 0 to l_Action.SecondaryShortCuts.Count-1 do begin ShortCutToKey(l_Action.SecondaryShortCuts.ShortCuts[k], li_Key, l_Shift); if (li_Key <> li_Old) then begin //キーとそれに割り当てられているTActionをリストに追加する G_InitShortCutList.Add(T_ShortCutAction.Create(li_Key, l_Action)); G_ShortCutList.Add (T_ShortCutAction.Create(li_Key, l_Action)); li_Old := li_Key; end; end; l_Action.SecondaryShortCuts.Clear; end; end; end; procedure gpcSetInitMouseGesture(GestureUp, GestureDown, GestureLeft, GestureRight: TAction); //マウスジェスチャの初期値をセット begin G_InitGestureUp := GestureUp; G_InitGestureDown := GestureDown; G_InitGestureLeft := GestureLeft; G_InitGestureRight := GestureRight; G_GestureUp := G_InitGestureUp; G_GestureDown := G_InitGestureDown; G_GestureLeft := G_InitGestureLeft; G_GestureRight := G_InitGestureRight; end; const lcsSECT_SHORTCUT = 'SHORTCUT'; lcsSECT_MOUSEGESTURE = 'MOUSEGESTURE'; procedure gpcReadIniShortCut(AIniFile: TMyIniFile; AActionList: TActionList); function lfns_GetActionName(AAction: TAction): String; begin if (AAction = nil) then begin Result := ''; end else begin Result := AAction.Name; end; end; function lfn_FindAction(sName: String; AActionList: TActionList): TAction; var i: Integer; ls_Name: String; l_Action: TAction; begin ls_Name := UpperCase(sName); Result := nil; for i := 0 to AActionList.ActionCount-1 do begin l_Action := TAction(AActionList.Actions[i]); if (ls_Name = UpperCase(l_Action.Name)) then begin Result := l_Action; Exit; end; end; end; var lsl_List: TMyWStrings; i: Integer; li_ShortCut, li_Gesture: Integer; l_Action: TAction; li_Key: Word; l_Shift: TShiftState; begin lsl_List := TMyWStrings.Create; try //[ShortCut] if (AIniFile.SectionExists(lcsSECT_SHORTCUT)) then begin //初期設定をクリア for i := G_ShortCutList.Count-1 downto 0 do begin T_ShortCutAction(G_ShortCutList.Items[i]).Free; G_ShortCutList.Delete(i); end; AIniFile.ReadSection(lcsSECT_SHORTCUT, lsl_List); //アクションがセットされている仮想キーコードすべてが列挙されている //仮想キーコード=Action.Name for i := 0 to lsl_List.Count -1 do begin li_ShortCut := gfniStrToInt(lsl_List[i]); if (li_ShortCut > 0) and (li_ShortCut <= High(TShortCut)) then begin l_Action := lfn_FindAction(AIniFile.ReadString(lcsSECT_SHORTCUT, lsl_List[i], 'actNop'), AActionList); if (l_Action <> nil) then begin ShortCutToKey(li_ShortCut, li_Key, l_Shift); G_ShortCutList.Add(T_ShortCutAction.Create(li_Key, l_Action)); end; end; end; end; //[MouseGesture] if (AIniFile.SectionExists(lcsSECT_MOUSEGESTURE)) then begin AIniFile.ReadSection(lcsSECT_MOUSEGESTURE, lsl_List); //仮のジェスチャーコード=Action.Name for i := 0 to lsl_List.Count -1 do begin li_Gesture := gfniStrToInt(lsl_List[i]); case li_Gesture of G_ciGESTUREUP: begin G_GestureUp := lfn_FindAction(AIniFile.ReadString(lcsSECT_MOUSEGESTURE, lsl_List[i], lfns_GetActionName(G_GestureUp)), AActionList); end; G_ciGESTUREDOWN: begin G_GestureDown := lfn_FindAction(AIniFile.ReadString(lcsSECT_MOUSEGESTURE, lsl_List[i], lfns_GetActionName(G_GestureDown)), AActionList); end; G_ciGESTURELEFT: begin G_GestureLeft := lfn_FindAction(AIniFile.ReadString(lcsSECT_MOUSEGESTURE, lsl_List[i], lfns_GetActionName(G_GestureLeft)), AActionList); end; G_ciGESTURERIGHT: begin G_GestureRight := lfn_FindAction(AIniFile.ReadString(lcsSECT_MOUSEGESTURE, lsl_List[i], lfns_GetActionName(G_GestureRight)), AActionList); end; else begin Continue; end; end; end; end; finally lsl_List.Free; end; end; procedure gpcWriteIniShortCut(AIniFile: TMyIniFile); function lfns_GetActionName(AAction: TAction): String; begin if (AAction = nil) then begin Result := ''; end else begin Result := AAction.Name; end; end; var i: Integer; begin // if not(Assigned(App_CustomShortCut)) then begin //Exit; // end; //[ShortCut] AIniFile.EraseSection(lcsSECT_SHORTCUT); if (Assigned(App_CustomShortCut)) then begin for i := 0 to G_ShortCutList.Count-1 do begin AIniFile.WriteString(lcsSECT_SHORTCUT, IntToStr(T_ShortCutAction(G_ShortCutList.Items[i]).Key), T_ShortCutAction(G_ShortCutList.Items[i]).Action.Name); end; AIniFile.WriteSection(lcsSECT_SHORTCUT); end; //[MouseGesture] //デフォルトと同じでも必ず書き出す AIniFile.EraseSection(lcsSECT_MOUSEGESTURE); if (Assigned(App_CustomShortCut)) then begin AIniFile.WriteString(lcsSECT_MOUSEGESTURE, IntToStr(G_ciGESTUREUP), lfns_GetActionName(G_GestureUp)); AIniFile.WriteString(lcsSECT_MOUSEGESTURE, IntToStr(G_ciGESTUREDOWN), lfns_GetActionName(G_GestureDown)); AIniFile.WriteString(lcsSECT_MOUSEGESTURE, IntToStr(G_ciGESTURELEFT), lfns_GetActionName(G_GestureLeft)); AIniFile.WriteString(lcsSECT_MOUSEGESTURE, IntToStr(G_ciGESTURERIGHT), lfns_GetActionName(G_GestureRight)); end; end; constructor T_ShortCutAction.Create(iKey: Word; AAction: TAction); begin inherited Create; F_iKey := iKey; F_Action := AAction; end; const lciCOL_KEYDISP = 0; //キー lciCOL_KEYCMDHINT = 1; //ヒント const lciCOL_CMDCATEGORY = 0; lciCOL_CMDHINT = 1; lciCOL_CMDKEY = 2; //------------------------------------------------------------------------------ function gfniTextToShortCut(Text: string): TShortCut; //表示用のテキストからショートカット値を返す。 var i: Integer; begin for i := 0 to High(G_csSHORTCUTKEY) do begin if (Text = G_csSHORTCUTKEY[i, G_ciSHORTCUTDISP]) then begin Result := Menus.TextToShortCut(G_csSHORTCUTKEY[i, G_ciSHORTCUTTEXT]); Exit; end; end; Result := 0; end; function gfnsShortCutToText(ShortCut: TShortCut): string; var i: Integer; begin Result := Menus.ShortCutToText(ShortCut); for i := 0 to High(G_csSHORTCUTKEY) do begin if (Result = G_csSHORTCUTKEY[i, G_ciSHORTCUTTEXT]) then begin Result := G_csSHORTCUTKEY[i, G_ciSHORTCUTDISP]; Exit; end; end; end; function gfnsCommandDescriptGet(AAction: TAction): String; begin if (AAction = nil) then begin Result := ''; end else if (AAction.Category = '区切り') then begin Result := '区切り'; end else begin Result := Format('%s/%s', [AAction.Category, StripHotKey(AAction.Caption)]); end; end; //------------------------------------------------------------------------------ procedure TApp_CustomShortCut.WMSysCommand(var Msg: TWMSysCommand); begin case Msg.CmdType of 61587: begin //システムアイコンクリック actMenu_PopupExecute(nil); end; else begin inherited; end; end; end; procedure TApp_CustomShortCut.FormCreate(Sender: TObject); procedure lpc_AddKeyMenu(AMenuItem: TMenuItem; iIndex: Integer); var l_MenuItem: TMenuItem; begin AMenuItem.Add( NewItem( Format('[%s] を追加', [G_csSHORTCUTKEY[iIndex, G_ciSHORTCUTDISP]]), //Caption 0, //ShortCut False, //Checked True, //Enabled F_CmdAddKey, //OnClickイベント 0, //HelpContext Format('%s_%d', [AMenuItem.Name, AMenuItem.Count]) //Name ) ); l_MenuItem := AMenuItem.Items[AMenuItem.Count-1]; l_MenuItem.Tag := iIndex; end; procedure lpc_AddGestureMenu(AMenuItem: TMenuItem; iIndex: Integer); var l_MenuItem: TMenuItem; begin AMenuItem.Add( NewItem( Format('[%s] を追加', [G_csGESTURESTRING[iIndex]]), //Caption 0, //ShortCut False, //Checked True, //Enabled F_CmdAddGesture, //OnClickイベント 0, //HelpContext Format('%s_%d', [AMenuItem.Name, AMenuItem.Count]) //Name ) ); l_MenuItem := AMenuItem.Items[AMenuItem.Count-1]; l_MenuItem.Tag := iIndex; end; var i, li_Count, li_Index, li_HeaderCount, li_Width: Integer; lh_Menu: HMENU; l_Action: TAction; ls_Category, ls_Name: String; l_ShortCutMenuItem, l_GestureMenuItem{, l_MenuItem}: TMenuItem; begin gpcCreateCustomBaseForm(G_MainForm); Self.ManualDock(G_CustomForm.tabShortCut); Self.Align := alClient; pnlCommand.Align := alClient; Self.Icon := Application.Icon; Self.Visible := True; 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); pnlCustomShortCut.Align := alClient; //ショートカット // F_slUndoBuff := TList.Create; pagShortCut.ActivePageIndex := 0; //キーリストの初期設定 with celShortCutKey do begin ColWidths[lciCOL_KEYDISP] := (gfniGridCanvasTextWidth(celShortCutKey, 'A') * G_iKeyLength) + (lciMARGIN * 2); //左右のマージンでlciMARGIN * 2 RowCount := Length(G_csSHORTCUTKEY) + celShortCutKey.FixedRows; //ヘッダーの分をプラス Cells[lciCOL_KEYDISP, 0] := 'キー'; Cells[lciCOL_KEYCMDHINT, 0] := 'コマンド'; for i := 0 to High(G_csSHORTCUTKEY) do begin li_Index := i + celShortCutKey.FixedRows; //ヘッダーの分をプラス celShortCutKey.Cells[lciCOL_KEYDISP, li_Index] := G_csSHORTCUTKEY[i, G_ciSHORTCUTDISP]; F_SetAction(li_Index, nil); if (i >= G_ciKEYNUMFIRST) and (i <= G_ciKEYNUMEND) then begin lpc_AddKeyMenu(mniCommand_KeyNumAdd, i); end else if (i >= G_ciKEYCHARFIRST) and (i <= G_ciKEYCHAREND) then begin lpc_AddKeyMenu(mniCommand_KeyCharAdd, i); end else if (i >= G_ciKEYFUNCFIRST) and (i <= G_ciKEYFUNCEND) then begin lpc_AddKeyMenu(mniCommand_KeyFuncAdd, i); end else if (i >= G_ciKEYEXTFIRST) and (i <= G_ciKEYEXTEND) then begin lpc_AddKeyMenu(mniCommand_KeyExtAdd, i); end; end; end; //マウスジェスチャ for i := 0 to High(G_csGESTURESTRING) do begin lpc_AddGestureMenu(mniCommand_KeyGestureAdd, i); end; with celGesture do begin ColWidths[lciCOL_KEYDISP] := (gfniGridCanvasTextWidth(celShortCutKey, 'A') * G_iGestureLength) + (lciMARGIN * 2); //左右のマージンでlciMARGIN * 2 Cells[lciCOL_KEYDISP, 0] := 'ジェスチャ'; Cells[lciCOL_KEYCMDHINT, 0] := 'コマンド'; for i := 0 to High(G_csGESTURESTRING) do begin Cells[lciCOL_KEYDISP, i + FixedRows] := G_csGESTURESTRING[i]; case i of G_ciGESTUREUP: l_Action := G_GestureUp; G_ciGESTUREDOWN: l_Action := G_GestureDown; G_ciGESTURELEFT: l_Action := G_GestureLeft; G_ciGESTURERIGHT: l_Action := G_GestureRight; else l_Action := nil; end; Cells[lciCOL_CMDHINT, i + FixedRows] := F_GetCmdHint(l_Action); end; end; //コマンドリスト初期設定 celCommand.RowCount := G_ActionList.ActionCount + (celCommand.FixedRows -1); //ヘッダー分をプラス&区切り分をマイナス celCommand.Cells[lciCOL_CMDCATEGORY, 0] := 'カテゴリ'; celCommand.Cells[lciCOL_CMDHINT, 0] := 'コマンド'; celCommand.Cells[lciCOL_CMDKEY, 0] := 'キー'; li_HeaderCount := celCommand.FixedRows -1; //ヘッダー分を足す&区切り分を引く //区切りは除外するので0からではなく1からスタート for i := 1 to G_ActionList.ActionCount-1 do begin l_Action := TAction(G_ActionList.Actions[i]); if (celCommand.Cells[lciCOL_CMDHINT, i + li_HeaderCount] = '') then begin celCommand.Cells[lciCOL_CMDCATEGORY, i + li_HeaderCount] := l_Action.Category; celCommand.Cells[lciCOL_CMDHINT, i + li_HeaderCount] := Trim(StripHotKey(l_Action.Caption)); end; end; //カテゴリメニュー構築 li_Width := 0; ls_Category := ''; li_Count := 0; l_ShortCutMenuItem := nil; l_GestureMenuItem := nil; //区切りは除外するので0からではなく1からスタート for i := 1 to G_ActionList.ActionCount-1 do begin l_Action := TAction(G_ActionList.Actions[i]); if (l_Action.Category <> ls_Category) then begin //メニューに追加 ls_Category := l_Action.Category; //固定ピッチフォントではないので逐一幅を計算する li_Width := gfniMax([li_Width, gfniGridCanvasTextWidth(celCommand, ls_Category)]); ls_Name := gfnsAvailableName('mniPShortCut_Category'); mnuCommand_Category.Items.Add( NewItem( Format('%s へ移動', [ls_Category]), //Caption 0, //ShortCut False, //Checked True, //Enabled F_CmdGoToCategory, //OnClickイベント 0, //HelpContext ls_Name //Name )); ls_Name := gfnsAvailableName('mniShortCutKey'); mnuShortCutKey.Items.Insert(li_Count, NewItem( Format('%sコマンドをセット', [ls_Category]), //Caption 0, //ShortCut False, //Checked True, //Enabled nil, //OnClickイベント 0, //HelpContext ls_Name //Name )); l_ShortCutMenuItem := mnuShortCutKey.Items[li_Count]; ls_Name := gfnsAvailableName('mniGesture'); mnuGesture.Items.Insert(li_Count, NewItem( Format('%sコマンドをセット', [ls_Category]), //Caption 0, //ShortCut False, //Checked True, //Enabled nil, //OnClickイベント 0, //HelpContext ls_Name //Name )); l_GestureMenuItem := mnuGesture.Items[li_Count]; Inc(li_Count); end; if (l_ShortCutMenuItem <> nil) then begin ls_Name := gfnsAvailableName(Format('%s___mniShortCut', [l_Action.Name])); l_ShortCutMenuItem.Add( NewItem( StripHotKey(l_Action.Caption), 0, //ShortCut False, //Checked True, //Enabled F_SetCommand, //OnClickイベント 0, //HelpContext ls_Name //Name )); end; if (l_GestureMenuItem <> nil) then begin ls_Name := gfnsAvailableName(Format('%s___mniGesture', [l_Action.Name])); l_GestureMenuItem.Add( NewItem( StripHotKey(l_Action.Caption), 0, //ShortCut False, //Checked True, //Enabled F_SetCommand, //OnClickイベント 0, //HelpContext ls_Name //Name )); end; end; celCommand.ColWidths[lciCOL_CMDCATEGORY] := li_Width + (lciMARGIN * 2); Tag := 1; //ショートカット表示 F_DispShortCutKey; mnuShortCutKeyPopup(nil); mnuGesturePopup(nil); mnuCommandPopup(nil); FormResize(nil); end; procedure TApp_CustomShortCut.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; //破棄 procedure TApp_CustomShortCut.FormDestroy(Sender: TObject); begin // F_slUndoBuff.Free; end; procedure TApp_CustomShortCut.FormResize(Sender: TObject); begin with celCommand do begin ColWidths[lciCOL_CMDHINT] := ClientWidth - ColWidths[lciCOL_CMDCATEGORY] - ColWidths[lciCOL_CMDKEY] - (GridLineWidth * (ColCount +1)); end; with celShortCutKey do begin ColWidths[lciCOL_KEYCMDHINT] := ClientWidth - ColWidths[lciCOL_KEYDISP] - (GridLineWidth * (ColCount +1)); end; with celGesture do begin ColWidths[lciCOL_KEYCMDHINT] := ClientWidth - ColWidths[lciCOL_KEYDISP] - (GridLineWidth * (ColCount)); end; end; //閉じる procedure TApp_CustomShortCut.actFile_CloseExecute(Sender: TObject); begin G_CustomForm.actFile_CloseExecute(nil); end; //------------------------------------------------------------------------------ procedure TApp_CustomShortCut.F_SetCommand(Sender: TObject); var ls_Name: String; l_MenuItem: TMenuItem; l_Action: TAction; i: Integer; begin if not(Sender is TMenuItem) then begin Exit; end; l_MenuItem := TMenuItem(Sender); ls_Name := Copy(l_MenuItem.Name, 1, Pos('___', l_MenuItem.Name) -1); l_Action := nil; for i := 0 to G_ActionList.ActionCount-1 do begin if (G_ActionList.Actions[i].Name = ls_Name) then begin l_Action := TAction(G_ActionList.Actions[i]); Break; end; end; if (l_Action <> nil) then begin if (pagShortCut.ActivePage = tabShortCutKey) then begin F_SetKeyAction(celShortCutKey.Row, l_Action); end else if (pagShortCut.ActivePage = tabGesture) then begin F_SetGestureAction(celGesture.Row, l_Action); end; end; end; procedure TApp_CustomShortCut.F_CmdGoToCategory(Sender: TObject); //カテゴリジャンプ var l_MenuItem: TMenuItem; i: Integer; l_Select: TGridRect; ls_Caption: String; begin l_MenuItem := TMenuItem(Sender); ls_Caption := Copy(l_MenuItem.Caption, 0, AnsiPos(' へ移動', l_MenuItem.Caption) -1); for i := 1 to celCommand.RowCount-1 do begin if (ls_Caption = celCommand.Cells[lciCOL_CMDCATEGORY, i]) then begin celCommand.TopRow := i; l_Select.Left := 0; l_Select.Top := i; l_Select.Right := celCommand.ColCount-1; l_Select.Bottom := i; celCommand.Selection := l_Select; Exit; end; end; end; procedure TApp_CustomShortCut.F_CmdAddKey(Sender: TObject); //コマンドにキーを追加 var l_MenuItem: TMenuItem; li_Ret, li_KeyRow, li_CmdIndex: Integer; l_NowAction, l_Action: TAction; begin l_MenuItem := TMenuItem(Sender); li_KeyRow := l_MenuItem.Tag + celShortCutKey.FixedRows; l_NowAction := F_GetKeyAction(li_KeyRow); li_CmdIndex := celCommand.Row - (celCommand.FixedRows -1); //区切り分で-1 l_Action := TAction(G_ActionList.Actions[li_CmdIndex]); if (l_NowAction = l_Action) then begin Exit end; li_Ret := ID_YES; if (l_NowAction <> nil) then begin li_Ret := gfniMessageBoxYesNo(Format('[%s] には %s がセットされています'#13'置き換えますか', [G_csSHORTCUTKEY[l_MenuItem.Tag, G_ciSHORTCUTDISP], F_GetCmdHint(l_NowAction)])); end; if (li_Ret = ID_YES) then begin F_SetKeyAction(li_KeyRow, l_Action); end; end; procedure TApp_CustomShortCut.F_CmdAddGesture(Sender: TObject); //コマンドにジェスチャを追加 var l_MenuItem: TMenuItem; li_Ret, li_GestureRow, li_CmdIndex: Integer; l_NowAction, l_Action: TAction; begin l_MenuItem := TMenuItem(Sender); li_GestureRow := l_MenuItem.Tag + celGesture.FixedRows; l_NowAction := F_GetGestureAction(li_GestureRow); li_CmdIndex := celCommand.Row - (celCommand.FixedRows -1); //区切り分で-1 l_Action := TAction(G_ActionList.Actions[li_CmdIndex]); if (l_NowAction = l_Action) then begin Exit end; li_Ret := ID_YES; if (l_NowAction <> nil) then begin li_Ret := gfniMessageBoxYesNo(Format('[%s] には %s がセットされています'#13'置き換えますか', [G_csGESTURESTRING[l_MenuItem.Tag], F_GetCmdHint(l_NowAction)])); end; if (li_Ret = ID_YES) then begin F_SetGestureAction(li_GestureRow, l_Action); end; end; function TApp_CustomShortCut.F_GetCmdHint(AAction: TAction): String; begin if (AAction = nil) then begin Result := ''; end else begin Result := Format('%s/%s', [AAction.Category, StripHotKey(AAction.Caption)]); end; end; //ショートカット procedure TApp_CustomShortCut.pagShortCutChange(Sender: TObject); var ls_List, ls_Add: String; begin if (pagShortCut.ActivePage = tabGesture) then begin ls_List := 'マウスジェスチャ'; ls_Add := 'ジェスチャ'; end else begin ls_List := 'キーリスト'; ls_Add := 'キー'; end; celCommand.Hint := Format('左の%sからドラッグし、ドロップしてコマンドに%sを追加', [ls_List, ls_Add]); end; procedure TApp_CustomShortCut.F_DispCommandKey(AAction: TAction); //コマンドリストのAActionに設定されているキーを表示用にセットする procedure lpc_SetDispKey(var sKey: String; sAdd: String); begin sKey := Format('%s [%s]', [sKey, sAdd]); end; var i, li_CmdListRow: Integer; ls_Key: String; begin if (AAction = nil) then begin Exit; end; li_CmdListRow := AAction.Index + (celCommand.FixedRows -1); //ヘッダー分を足す //キーリスト ls_Key := ''; for i := 0 to G_ShortCutList.Count-1 do begin if (T_ShortCutAction(G_ShortCutList.Items[i]).Action = AAction) then begin lpc_SetDispKey(ls_Key, gfnsShortCutToText(T_ShortCutAction(G_ShortCutList.Items[i]).Key)); end; end; //マウスジェスチャ //キーリストと違ってApp_BugsEyeのF_GestureAction構造体にそれぞれのActionを保持している if (AAction = G_GestureUp) then begin lpc_SetDispKey(ls_Key, celGesture.Cells[lciCOL_KEYDISP, G_ciGESTUREUP + celGesture.FixedRows]); end; if (AAction = G_GestureDown) then begin lpc_SetDispKey(ls_Key, celGesture.Cells[lciCOL_KEYDISP, G_ciGESTUREDOWN + celGesture.FixedRows]); end; if (AAction = G_GestureLeft) then begin lpc_SetDispKey(ls_Key, celGesture.Cells[lciCOL_KEYDISP, G_ciGESTURELEFT + celGesture.FixedRows]); end; if (AAction = G_GestureRight) then begin lpc_SetDispKey(ls_Key, celGesture.Cells[lciCOL_KEYDISP, G_ciGESTURERIGHT + celGesture.FixedRows]); end; celCommand.Cells[lciCOL_CMDKEY, li_CmdListRow] := Trim(ls_Key); end; procedure TApp_CustomShortCut.F_DispShortCutKey; var i, k: Integer; li_Key: Word; l_Shift: TShiftState; l_Action: TAction; begin //キーにセットされているコマンドを表示 for i := 1 to celShortCutKey.RowCount-1 do begin l_Action := nil; ShortCutToKey(gfniTextToShortCut(celShortCutKey.Cells[lciCOL_KEYDISP, i]), li_Key, l_Shift); for k := 0 to G_ShortCutList.Count-1 do begin if (T_ShortCutAction(G_ShortCutList.Items[k]).Key = li_Key) then begin l_Action := T_ShortCutAction(G_ShortCutList.Items[k]).Action; F_SetAction(i, l_Action); Break; end; end; F_SetAction(i, l_Action); end; //コマンドにセットされているキーを表示 for i := 0 to G_ActionList.ActionCount-1 do begin l_Action := TAction(G_ActionList.Actions[i]); F_DispCommandKey(l_Action); end; end; //コマンドリスト //描画 procedure TApp_CustomShortCut.celCommandDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); {$IFDEF ICON} var l_Action: TAction; {$ENDIF} begin with celCommand.Canvas do begin if (gdFixed in State) then begin Brush.Color := celCommand.FixedColor; Font.Color := celCommand.Font.Color; end else begin if (gdSelected in State) then begin if (GetFocus = celCommand.Handle) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end else begin Brush.Color := clBtnFace; Font.Color := clBtnText; end; end else begin Brush.Color := celCommand.Color; Font.Color := celCommand.Font.Color; end; end; Font.Name := 'MS UI Gothic'; FillRect(Rect); if (ARow = 0) then begin DrawText(Handle, PChar(celCommand.Cells[ACol, ARow]), -1, Rect, DT_SINGLELINE or DT_NOPREFIX or DT_CENTER or DT_VCENTER); end else begin Inc(Rect.Left, lciMARGIN); DrawText(Handle, PChar(celCommand.Cells[ACol, ARow]), -1, Rect, DT_SINGLELINE or DT_VCENTER); end; end; end; //ドラッグ procedure TApp_CustomShortCut.celCommandMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //ドラッグ開始 //オートにすると不都合があるのでマニュアルドラッグ var li_Col, li_Row: Integer; l_Rect: TGridRect; begin F_Drag := Sender; with celCommand do begin MouseToCell(X, Y, li_Col, li_Row); if (li_Row > 0) then begin if (Button = mbLeft) then begin BeginDrag(False, GetSystemMetrics(SM_CXDOUBLECLK)); end else if (Button = mbRight) then begin if (Row <> li_Row) then begin l_Rect.Left := 0; l_Rect.Top := li_Row; l_Rect.Right := ColCount-1; l_Rect.Bottom := li_Row; Selection := l_Rect; end; end; end; end; end; procedure TApp_CustomShortCut.celCommandMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var lpt_Pos: TPoint; li_Col, li_Row: Integer; begin lpt_Pos := gfnptMousePosGet; celCommand.MouseToCell(X, Y, li_Col, li_Row); if (F_Drag = celCommand) and (li_Row = 0) then begin if (li_Col = lciCOL_CMDCATEGORY) or (Button = mbRight) then begin mnuCommand_Category.Popup(lpt_Pos.X, lpt_Pos.Y); end; end else if (Button = mbRight) then begin mnuCommand.Popup(lpt_Pos.X, lpt_Pos.Y); end else begin // mnuCommandPopup(nil); end; end; procedure TApp_CustomShortCut.celCommandSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); begin F_CommandPopup(ARow); end; procedure TApp_CustomShortCut.celShortCutKeySelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); begin F_ShortCutPopup(ARow); end; procedure TApp_CustomShortCut.celGestureSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); begin F_MouseGesturePopup(ARow); end; procedure TApp_CustomShortCut.celShortCutKeyMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var li_Col, li_Row: Integer; l_Rect: TGridRect; l_Grid: TStringGrid; begin if not(Sender is TStringGrid) then Exit; l_Grid := TStringGrid(Sender); F_Drag := Sender; if (Button = mbLeft) then begin l_Grid.BeginDrag(False, GetSystemMetrics(SM_CXDOUBLECLK)); end else if (Button = mbRight) then begin with l_Grid do begin MouseToCell(X, Y, li_Col, li_Row); if (li_Row > 0) and (li_Row <> Row) then begin l_Rect.Left := 0; l_Rect.Top := li_Row; l_Rect.Right := ColCount-1; l_Rect.Bottom := li_Row; Selection := l_Rect; end; end; end; end; procedure TApp_CustomShortCut.celShortCutKeyMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var lpt_Pos: TPoint; li_Col, li_Row: Integer; l_Grid: TStringGrid; begin if not(Sender is TStringGrid) then Exit; l_Grid := TStringGrid(Sender); l_Grid.MouseToCell(X, Y, li_Col, li_Row); if ((F_Drag = celShortCutKey) or (F_Drag = celGesture)) and (li_Row > 0) and (Button = mbRight) then begin lpt_Pos := gfnptMousePosGet; l_Grid.PopupMenu.Popup(lpt_Pos.X, lpt_Pos.Y); end else begin l_Grid.PopupMenu.OnPopup(nil); end; end; procedure TApp_CustomShortCut.celShortCutKeyKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var l_Grid: TStringGrid; begin if not(Sender is TStringGrid) then Exit; l_Grid := TStringGrid(Sender); case Key of VK_F10: begin if (ssShift in Shift) then begin l_Grid.PopupMenu.Popup(l_Grid.ClientOrigin.X, l_Grid.ClientOrigin.Y); end; Key := 0; end; VK_APPS: begin l_Grid.PopupMenu.Popup(l_Grid.ClientOrigin.X, l_Grid.ClientOrigin.Y); Key := 0; end; VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_HOME, VK_END: begin // l_Grid.PopupMenu.OnPopup(nil); end; end; end; procedure TApp_CustomShortCut.celCommandDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); //ドラッグ中のcelCommandListのマウスカーソルをドラッグ状態にするために必要。 var li_Col, li_Row: Integer; begin if (F_Drag = celShortCutKey) or (F_Drag = celGesture) then begin //X,Yはグリッドのクライアント座標 with celCommand do begin MouseToCell(X, Y, li_Col, li_Row); Accept := {(li_Col = lciCOL_CMDHINT) and} (li_Row > 0); end; end else begin Accept := False; Exit; end; end; procedure TApp_CustomShortCut.celCommandDragDrop(Sender, Source: TObject; X, Y: Integer); //キー&マウスジェスチャのリストからコマンドリストへドロップ var li_Col, li_Row: Integer; lr_GridRect: TGridRect; begin if (F_Drag = celShortCutKey) or (F_Drag = celGesture) then begin with celCommand do begin MouseToCell(X, Y, li_Col, li_Row); with lr_GridRect do begin Left := 0; Top := li_Row; Right := ColCount -1; Bottom := li_Row; end; Selection := lr_GridRect; end; if (F_Drag = celShortCutKey) then begin //コマンドリストへキーを追加 actShortCutKey_SetExecute(nil); end else if (F_Drag = celGesture) then begin //コマンドリストへマウスジェスチャを追加 actGesture_SetExecute(nil); end; end; end; procedure TApp_CustomShortCut.celShortCutKeyDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); //ドラッグ中のマウスカーソルをドラッグ状態にするために必要。 var li_Col, li_Row: Integer; l_Grid: TStringGrid; begin if (F_Drag <> celCommand) or not(Sender is TStringGrid) then begin Accept := False; Exit; end; l_Grid := TStringGrid(Sender); //X,Yはグリッドのクライアント座標 with l_Grid do begin MouseToCell(X, Y, li_Col, li_Row); Accept := {(li_Col = lciCOL_KEYCMDHINT) and} (li_Row > 0); end; end; procedure TApp_CustomShortCut.celShortCutKeyDragDrop(Sender, Source: TObject; X, Y: Integer); //コマンドリストからキー&マウスジェスチャのリストへドロップ var li_Col, li_Row: Integer; lr_GridRect: TGridRect; l_Grid: TStringGrid; begin if not(Sender is TStringGrid) then Exit; if (F_Drag <> celCommand) then begin Exit; end; l_Grid := TStringGrid(Sender); with l_Grid do begin MouseToCell(X, Y, li_Col, li_Row); with lr_GridRect do begin Left := 0; Top := li_Row; Right := ColCount -1; Bottom := li_Row; end; Selection := lr_GridRect; end; if (Sender = celShortCutKey) then begin //キーリスト actShortCutKey_SetExecute(nil); end else if (Sender = celGesture) then begin //マウスジェスチャリスト actGesture_SetExecute(nil); end; end; procedure TApp_CustomShortCut.F_ShortCutPopup(iIndex: Integer); var ls_Key, ls_KeyCmdHint, ls_CmdHint: String; begin ls_Key := celShortCutKey.Cells[lciCOL_KEYDISP, iIndex]; //対象となるキー ls_KeyCmdHint := celShortCutKey.Cells[lciCOL_KEYCMDHINT, iIndex]; //キーに設定済みのコマンドの説明 ls_CmdHint := F_GetCmdHint(TAction(G_ActionList.Actions[celCommand.Row - (celCommand.FixedRows -1)])); //設定しようとしているコマンドの説明 Label_Hint.Caption := gfnsActionHintGet(F_GetKeyAction(iIndex)); actShortCutKey_Set.Enabled := (ls_KeyCmdHint <> ls_CmdHint); actShortCutKey_Set.Caption := Format('[%s] に %s をセット(&S)', [ ls_Key, ls_CmdHint, '' ] ); actShortCutKey_Delete.Enabled := (ls_KeyCmdHint <> ''); if (actShortCutKey_Delete.Enabled) then begin actShortCutKey_Delete.Caption := Format('[%s] のコマンドを削除(&R)', [ ls_Key, '' ] ); end else begin actShortCutKey_Delete.Caption := 'キーのコマンドを削除(&R)'; end; end; procedure TApp_CustomShortCut.mnuShortCutKeyPopup(Sender: TObject); //キーリストメニューをポップアップ begin F_ShortCutPopup(celShortCutKey.Row); end; procedure TApp_CustomShortCut.F_MouseGesturePopup(iIndex: Integer); var ls_Gesture, ls_GestureCmdHint, ls_CmdHint: String; begin ls_Gesture := celGesture.Cells[lciCOL_KEYDISP, iIndex]; //対象となるジェスチャ ls_GestureCmdHint := celGesture.Cells[lciCOL_KEYCMDHINT, iIndex]; //ジェスチャに設定済みのコマンドの説明 ls_CmdHint := F_GetCmdHint(TAction(G_ActionList.Actions[celCommand.Row - (celCommand.FixedRows -1)])); //設定しようとしているコマンドの説明 Label_Hint.Caption := gfnsActionHintGet(F_GetGestureAction(iIndex)); actGesture_Set.Caption := Format('[%s] に %s をセット(&S)', [ ls_Gesture, ls_CmdHint, '' ] ); actGesture_Delete.Enabled := (ls_GestureCmdHint <> ''); //マウスジェスチャのコマンドが空でなければTrue if (actGesture_Delete.Enabled) then begin actGesture_Delete.Caption := Format('[%s] のコマンドを削除(&R)', [ ls_Gesture, '' ] ); end else begin actGesture_Delete.Caption := 'ジェスチャのコマンドを削除(&R)'; end; end; procedure TApp_CustomShortCut.mnuGesturePopup(Sender: TObject); //マウスジェスチャメニューをポップアップ begin F_MouseGesturePopup(celGesture.Row); end; procedure TApp_CustomShortCut.F_CommandPopup(iIndex: Integer); var l_StringGrid: TStringGrid; li_ActionIndex: Integer; l_Action: TAction; ls_CmdHint: String; begin if (pagShortCut.ActivePage = tabShortCutKey) then begin l_StringGrid := celShortCutKey; end else if (pagShortCut.ActivePage = tabGesture) then begin l_StringGrid := celGesture; end else begin actCommand_KeyAdd.Caption := 'コマンドにキーを追加(&A)'; //例外 Exit; end; li_ActionIndex := iIndex - (celCommand.FixedRows -1); l_Action := TAction(G_ActionList.Actions[li_ActionIndex]); ls_CmdHint := F_GetCmdHint(l_Action); //対象となるコマンドの説明 Label_Hint.Caption := gfnsActionHintGet(l_Action); actCommand_KeyAdd.Enabled := F_GetKeyAction(l_StringGrid.Row) <> G_ActionList.Actions[li_ActionIndex]; actCommand_KeyAdd.Caption := Format('%s のキーに [%s] を追加(&A)', [ ls_CmdHint, //コマンドの説明 l_StringGrid.Cells[lciCOL_KEYDISP, l_StringGrid.Row], '' ] ); actCommand_KeyDelete.Enabled := (celCommand.Cells[lciCOL_CMDKEY, iIndex] <> ''); //コマンドのキー欄が空でなければTrue if (actCommand_KeyDelete.Enabled) then begin actCommand_KeyDelete.Caption := Format('%s のキーとジェスチャを削除(&R)', [ ls_CmdHint, '' ] ); end else begin actCommand_KeyDelete.Caption := 'コマンドのキーとジェスチャを削除(&R)'; end; end; procedure TApp_CustomShortCut.mnuCommandPopup(Sender: TObject); //コマンドリストメニューをポップアップ begin F_CommandPopup(celCommand.Row); end; procedure TApp_CustomShortCut.F_ChangeSetting; var i: Integer; begin mnuCommandPopup(nil); mnuShortCutKeyPopup(nil); mnuGesturePopup(nil); //ヘルプのショートカットリストを更新 for i := 0 to Screen.FormCount-1 do begin if (Screen.Forms[i] = G_HelpForm) then begin G_HelpForm.actHelp_UpdateExecute(nil); Break; end; end; end; //------------------------------------------------------------------------------ //コマンドキー procedure TApp_CustomShortCut.actCommand_KeyAddExecute(Sender: TObject); //コマンドにショートカットキーもしくはマウスジェスチャを追加 begin if (pagShortCut.ActivePage = tabShortCutKey) then begin actShortCutKey_SetExecute(actShortCutKey_Set); end else if (pagShortCut.ActivePage = tabGesture) then begin actGesture_SetExecute(actGesture_Set); end; end; procedure TApp_CustomShortCut.actCommand_KeyDeleteExecute(Sender: TObject); var i: Integer; l_Action: TAction; lb_Update: Boolean; begin //余計な更新をキャンセルするため lb_Update := False; l_Action := TAction(G_ActionList.Actions[celCommand.Row - (celCommand.FixedRows -1)]); if (celCommand.Cells[lciCOL_CMDKEY, celCommand.Row] <> '') then begin for i := celShortCutKey.FixedRows to celShortCutKey.RowCount-1 do begin if (F_GetKeyAction(i) = l_Action) then begin F_DelAction(i); F_SetAction(i, nil); lb_Update := True; end; end; end; if (G_GestureUp = l_Action) then begin; F_DelGestureAction(G_ciGESTUREUP + celGesture.FixedRows); lb_Update := True; end; if (G_GestureDown = l_Action) then begin; F_DelGestureAction(G_ciGESTUREDOWN + celGesture.FixedRows); lb_Update := True; end; if (G_GestureLeft = l_Action) then begin; F_DelGestureAction(G_ciGESTURELEFT + celGesture.FixedRows); lb_Update := True; end; if (G_GestureRight = l_Action) then begin; F_DelGestureAction(G_ciGESTURERIGHT + celGesture.FixedRows); lb_Update := True; end; if (lb_Update) then begin //ヘルプのショートカットリストも更新 F_ChangeSetting; end; end; //------------------------------------------------------------------------------ //ショートカットキー function TApp_CustomShortCut.F_GetShortCut(iIndex: Integer): TShortCut; //Objectsに格納されているShortCut値を返す begin Result := gfniTextToShortCut(celShortCutKey.Cells[lciCOL_KEYDISP, iIndex]); end; procedure TApp_CustomShortCut.F_SetAction(iRow: Integer; AAction: TAction); //キーリストのキーにセットするコマンドのカテゴリ/キャプションとコマンドのインデックスをセット var i: Integer; li_CellKey, li_Key: Word; begin //アクションのインデックスはコマンド列にセット if (AAction <> nil) then begin celShortCutKey.Cells[lciCOL_KEYCMDHINT, iRow] := F_GetCmdHint(AAction); celShortCutKey.Cols[lciCOL_KEYCMDHINT].Objects[iRow] := TObject(AAction.Index); li_CellKey := F_GetShortCut(iRow); for i := 0 to G_ShortCutList.Count-1 do begin li_Key := T_ShortCutAction(G_ShortCutList.Items[i]).Key; if (li_Key = li_CellKey) then begin Exit; end; end; G_ShortCutList.Add(T_ShortCutAction.Create(li_CellKey, AAction)); end else begin // F_DelAction(iIndex); NG; // //↑と順序を入れ替えてはいけない celShortCutKey.Cells[lciCOL_KEYCMDHINT, iRow] := ''; celShortCutKey.Cols[lciCOL_KEYCMDHINT].Objects[iRow] := TObject(-1); end; end; procedure TApp_CustomShortCut.F_SetAction(iRow, iActionIndex: Integer); var l_Action: TAction; begin if (iActionIndex >= 0) then begin l_Action := TAction(G_ActionList.Actions[iActionIndex]); F_SetAction(iRow, l_Action); end else begin F_SetAction(iRow, nil); end; end; function TApp_CustomShortCut.F_GetKeyAction(iRow: Integer): TAction; //キーにセットされているアクションを返す var li_Index: Integer; begin //コマンドのインデックスを取得 li_Index := Integer(celShortCutKey.Cols[lciCOL_KEYCMDHINT].Objects[iRow]); if (li_Index >= 0) then begin //0以上ならアクション Result := TAction(G_ActionList.Actions[li_Index]); end else begin Result := nil; end; end; procedure TApp_CustomShortCut.F_SetKeyAction(iRow: Integer; AAction: TAction); //キーにコマンドをセット var l_NowAction: TAction; begin l_NowAction := F_GetKeyAction(iRow); //コマンドリストの選択行 = コマンド if (l_NowAction <> nil) and (l_NowAction = AAction) then begin //現在の設定と同じなら新たな処理は必要ないので抜ける Exit; end; F_DelAction(iRow); F_SetAction(iRow, AAction); F_DispCommandKey(AAction); //ヘルプのショートカットリストも更新 F_ChangeSetting; end; procedure TApp_CustomShortCut.F_DelAction(iRow: Integer); //キーリストのiRow行のキーにセットされているコマンドを削除する var i, li_ActionIndex: Integer; li_Key: WORD; l_Action: TAction; begin //セットされているアクションのインデックス li_ActionIndex := Integer(celShortCutKey.Cols[lciCOL_KEYCMDHINT].Objects[iRow]); if (li_ActionIndex >= 0) then begin l_Action := TAction(G_ActionList.Actions[li_ActionIndex]); //セットされているショートカット値 li_Key := F_GetShortCut(iRow); for i := G_ShortCutList.Count-1 downto 0 do begin if (T_ShortCutAction(G_ShortCutList.Items[i]).Key = li_Key) then begin T_ShortCutAction(G_ShortCutList.Items[i]).Free; G_ShortCutList.Delete(i); end; end; F_DispCommandKey(l_Action); end; end; procedure TApp_CustomShortCut.actShortCutKey_SetExecute(Sender: TObject); //キーにコマンドをセット var li_KeyRow, li_CmdIndex: Integer; begin //キーリストの選択行 = キー li_KeyRow := celShortCutKey.Row; //コマンドリストの選択行 = コマンド li_CmdIndex := celCommand.Row - (celCommand.FixedRows -1); //ヘッダ分を引く&区切り分を足す F_SetKeyAction(li_KeyRow, TAction(G_ActionList.Actions[li_CmdIndex])); end; procedure TApp_CustomShortCut.actShortCutKey_DeleteExecute(Sender: TObject); //キーにセットされているコマンドを削除する var li_Row: Integer; l_Action: TAction; begin li_Row := celShortCutKey.Row; if (li_Row > 0) then begin l_Action := F_GetKeyAction(li_Row); F_DelAction(li_Row); F_SetAction(li_Row, -1); F_DispCommandKey(l_Action); //ヘルプのショートカットリストも更新 F_ChangeSetting; end; end; procedure TApp_CustomShortCut.actShortCutKey_ResetAllExecute(Sender: TObject); //ショートカット設定のリセット var i: Integer; begin //ショートカットキーの初期化 if (Sender = nil) or (gfniMessageBoxYesNo('すべてのショートカットキーの設定をリセットします'#13'よろしいですか') = ID_YES) then begin for i := G_ShortCutList.Count-1 downto 0 do begin T_ShortCutAction(G_ShortCutList.Items[i]).Free; G_ShortCutList.Delete(i); end; for i := 0 to G_InitShortCutList.Count-1 do begin G_ShortCutList.Add(T_ShortCutAction.Create( T_ShortCutAction(G_InitShortCutList.Items[i]).Key, T_ShortCutAction(G_InitShortCutList.Items[i]).Action )); end; if (Sender <> nil) then begin F_DispShortCutKey; end; //ヘルプのショートカットリストも更新 F_ChangeSetting; end; end; //------------------------------------------------------------------------------ //マウスジェスチャ function TApp_CustomShortCut.F_GetGestureAction(iRow: Integer): TAction; //ジェスチャにセットされているアクションを返す begin case iRow - celGesture.FixedRows of G_ciGESTUREUP: Result := G_GestureUp; G_ciGESTUREDOWN: Result := G_GestureDown; G_ciGESTURELEFT: Result := G_GestureLeft; G_ciGESTURERIGHT: Result := G_GestureRight; else Result := nil; end; end; procedure TApp_CustomShortCut.F_SetGestureAction(iRow: Integer; AAction: TAction); //マウスジェスチャにコマンドをセット。 begin F_DelGestureAction(iRow); case iRow - celGesture.FixedRows of G_ciGESTUREUP: G_GestureUp := AAction; G_ciGESTUREDOWN: G_GestureDown := AAction; G_ciGESTURELEFT: G_GestureLeft := AAction; G_ciGESTURERIGHT: G_GestureRight := AAction; else begin //後の処理を飛ばす Exit; end; end; celGesture.Cells[lciCOL_KEYCMDHINT, iRow] := F_GetCmdHint(AAction); F_DispCommandKey(AAction); //ヘルプのショートカットリストも更新 F_ChangeSetting; end; procedure TApp_CustomShortCut.F_DelGestureAction(iRow: Integer); //ジェスチャにセットされているコマンドを削除する var l_Action: TAction; begin l_Action := F_GetGestureAction(iRow); case iRow - celGesture.FixedRows of G_ciGESTUREUP: G_GestureUp := nil; G_ciGESTUREDOWN: G_GestureDown := nil; G_ciGESTURELEFT: G_GestureLeft := nil; G_ciGESTURERIGHT: G_GestureRight := nil; else begin //後の処理を飛ばす Exit; end; end; celGesture.Cells[lciCOL_CMDHINT, iRow] := ''; F_DispCommandKey(l_Action); end; procedure TApp_CustomShortCut.actGesture_SetExecute(Sender: TObject); //マウスジェスチャにコマンドをセット。 var li_CmdIndex, li_GestureRow: Integer; l_Action: TAction; begin li_CmdIndex := celCommand.Row - (celCommand.FixedRows -1); //ヘッダー分をマイナス l_Action := TAction(G_ActionList.Actions[li_CmdIndex]); li_GestureRow := celGesture.Row; F_SetGestureAction(li_GestureRow, l_Action); end; procedure TApp_CustomShortCut.actGesture_DeleteExecute(Sender: TObject); //マウスジェスチャにセットされているコマンドを削除する begin F_DelGestureAction(celGesture.Row); //ヘルプのショートカットリストも更新 F_ChangeSetting; end; procedure TApp_CustomShortCut.actMouseGesture_ResetExecute(Sender: TObject); var li_GestureRow: Integer; l_Action: TAction; begin li_GestureRow := celGesture.Row; case li_GestureRow - celGesture.FixedRows of G_ciGESTUREUP: begin G_GestureUp := G_InitGestureUp; l_Action := G_GestureUp; end; G_ciGESTUREDOWN: begin G_GestureDown := G_InitGestureDown; l_Action := G_GestureDown; end; G_ciGESTURELEFT: begin G_GestureLeft := G_InitGestureLeft; l_Action := G_GestureLeft; end; G_ciGESTURERIGHT: begin G_GestureRight := G_InitGestureRight; l_Action := G_GestureRight; end; else begin //後の処理を飛ばす Exit; end; end; celGesture.Cells[lciCOL_KEYCMDHINT, li_GestureRow] := F_GetCmdHint(l_Action); F_DispShortCutKey; //ヘルプのショートカットリストも更新 F_ChangeSetting; end; procedure TApp_CustomShortCut.actGesture_ResetAllExecute(Sender: TObject); //マウスジェスチャの初期化 begin if (Sender = nil) or (gfniMessageBoxYesNo('すべてのマウスジェスチャの設定をリセットします'#13'よろしいですか') = ID_YES) then begin G_GestureUp := G_InitGestureUp; G_GestureDown := G_InitGestureDown; G_GestureLeft := G_InitGestureLeft; G_GestureRight := G_InitGestureRight; celGesture.Cells[lciCOL_CMDHINT, G_ciGESTUREUP + celGesture.FixedRows] := F_GetCmdHint(G_GestureUp); celGesture.Cells[lciCOL_CMDHINT, G_ciGESTUREDOWN + celGesture.FixedRows] := F_GetCmdHint(G_GestureDown); celGesture.Cells[lciCOL_CMDHINT, G_ciGESTURELEFT + celGesture.FixedRows] := F_GetCmdHint(G_GestureLeft); celGesture.Cells[lciCOL_CMDHINT, G_ciGESTURERIGHT + celGesture.FixedRows] := F_GetCmdHint(G_GestureRight); if (Sender <> nil) then begin F_DispShortCutKey; end; //ヘルプのショートカットリストも更新 F_ChangeSetting; end; end; procedure TApp_CustomShortCut.actCommand_KeyResetAllExecute(Sender: TObject); begin if (gfniMessageBoxYesNo('すべてのショートカットキーとマウスジェスチャの設定をリセットします'#13'よろしいですか') = ID_YES) then begin actShortCutKey_ResetAllExecute(nil); actGesture_ResetAllExecute(nil); F_DispShortCutKey; //ヘルプのショートカットリストも更新 F_ChangeSetting; end; end; procedure TApp_CustomShortCut.celShortCutKeyDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var // l_Action: TAction; l_Grid: TStringGrid; begin if not(Sender is TStringGrid) then Exit; l_Grid := TStringGrid(Sender); with l_Grid.Canvas do begin if (gdFixed in State) then begin Brush.Color := l_Grid.FixedColor; Font.Color := l_Grid.Font.Color; end else begin if (gdSelected in State) then begin if (GetFocus = l_Grid.Handle) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end else begin Brush.Color := clBtnFace; Font.Color := clBtnText; end; end else begin Brush.Color := l_Grid.Color; Font.Color := l_Grid.Font.Color; end; end; FillRect(Rect); if (ARow = 0) then begin Font.Name := 'MS UI Gothic'; DrawText(Handle, PChar(l_Grid.Cells[ACol, ARow]), -1, Rect, DT_SINGLELINE or DT_NOPREFIX or DT_CENTER or DT_VCENTER); end else if (ACol = lciCOL_KEYDISP) then begin Font.Name := 'MS ゴシック'; Inc(Rect.Left, lciMARGIN); Dec(Rect.Right, lciMARGIN); if (l_Grid = celShortCutKey) then begin //キーは右寄せ DrawText(Handle, PChar(l_Grid.Cells[ACol, ARow]), -1, Rect, DT_SINGLELINE or DT_NOPREFIX or DT_RIGHT or DT_VCENTER); end else begin //マウスジェスチャは左寄せ DrawText(Handle, PChar(l_Grid.Cells[ACol, ARow]), -1, Rect, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER); end; end else if (ACol = lciCOL_KEYCMDHINT) then begin Font.Name := 'MS UI Gothic'; if (l_Grid.Cells[ACol, ARow] <> '') then begin Inc(Rect.Left, lciMARGIN); DrawText(Handle, PChar(l_Grid.Cells[ACol, ARow]), -1, Rect, DT_SINGLELINE or DT_VCENTER); end; end; end; end; procedure TApp_CustomShortCut.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var l_Grid: TStringGrid; begin case Key of VK_F10: begin if (ssShift in Shift) then begin if (celCommand.Focused) then begin l_Grid := celCommand; end else if (celShortCutKey.Focused) then begin l_Grid := celShortCutKey; end else if (celGesture.Focused) then begin l_Grid := celGesture; end else begin l_Grid := nil; end; if (l_Grid <> nil) then begin l_Grid.PopupMenu.Popup(l_Grid.ClientOrigin.X, l_Grid.ClientOrigin.Y); end; Key := 0; end else if not(ssAlt in Shift) and not(ssCtrl in Shift) // and not(ssShift in Shift) then begin actMenu_PopupExecute(nil); Key := 0; end; end; VK_APPS: begin if not(celCommand.Focused) and not(celShortCutKey.Focused) and not(celGesture.Focused) then begin actMenu_PopupExecute(nil); Key := 0; end; end; end; end; procedure TApp_CustomShortCut.actMenu_PopupExecute(Sender: TObject); begin mnuCustomShortCut.Popup(Self.ClientOrigin.X, Self.ClientOrigin.Y); // mnuCustomShortCut.Popup(Self.ClientOrigin.X, Self.ClientOrigin.Y); end; //============================================================================== procedure lpcMaxLengthSet; var i: Integer; begin G_iKeyLength := 1; G_iGestureLength := 1; G_iShortCutLength := 1; for i := 0 to High(G_csSHORTCUTKEY) do begin G_iKeyLength := gfniMax([G_iKeyLength, Length(G_csSHORTCUTKEY[i, G_ciSHORTCUTDISP])]); end; for i := 0 to High(G_csGESTURESTRING) do begin G_iGestureLength := gfniMax([G_iGestureLength, Length(G_csGESTURESTRING[i])]); end; G_iShortCutLength := gfniMax([G_iKeyLength, G_iGestureLength]); end; procedure lpcListFree(AList: TList); var i: Integer; begin for i := AList.Count-1 downto 0 do begin T_ShortCutAction(AList.Items[i]).Free; AList.Delete(i); end; AList.Free; end; initialization lpcMaxLengthSet; //ショートカットリスト G_InitShortCutList := TList.Create; G_ShortCutList := TList.Create; //マウスジェスチャ G_InitGestureUp := nil; G_InitGestureDown := nil; G_InitGestureLeft := nil; G_InitGestureRight := nil; G_GestureUp := nil; G_GestureDown := nil; G_GestureLeft := nil; G_GestureRight := nil; finalization lpcListFree(G_InitShortCutList); lpcListFree(G_ShortCutList); end.