unit custom_help;
//{$DEFINE DEBUG}
//{$DEFINE ICON}

interface

uses
	Windows,
	Messages,
	SysUtils,
	Graphics,
	Controls,
	Forms,
	ExtCtrls,
	StdCtrls,
	ActnList,
	Menus,
	Classes,
	Buttons,
	ComCtrls;

type
	TApp_CustomVersionInfo = class(TForm)
		ActionList1:        TActionList;
		actFile_Close:      TAction;
		actScroll_Up:       TAction;
		actScroll_Down:     TAction;
		actHelp_OnlineHelp: TAction;
		actMenu_Popup:      TAction;
		actHelp_Update:     TAction;

		mnuHelp:            TPopupMenu;
		mniHelp_OnlineHelp: TMenuItem;
		mniHelp_Line1:      TMenuItem;
		mniFile_Close:      TMenuItem;

		pnlHelp:               TPanel;
			pnlHelp_Ver:         TPanel;
				imgHelp_Icon:      TImage;
				lblHelp_Text:      TLabel;
				lblHelp_Ver:       TLabel;
				shpHelp_Line1:     TShape;
			lstHelp_ShortCutKey: TListBox;
			shpHelp_Line2:       TShape;
		pnlHelp_URL:           TPanel;
			lblHelp_URL:         TLabel;
		pnlCmd:                TPanel;
			btnClose:            TButton;
		shpHelp_Line3:         TShape;

		procedure FormCreate    (Sender: TObject);
		procedure FormClose     (Sender: TObject; var Action: TCloseAction);
		procedure FormKeyUp     (Sender: TObject; var Key: Word; Shift: TShiftState);
		procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
		procedure actFile_CloseExecute       (Sender: TObject);
		procedure actScroll_UpExecute        (Sender: TObject);
		procedure actScroll_DownExecute      (Sender: TObject);
		procedure actMenu_PopupExecute       (Sender: TObject);
		procedure actHelp_OnlineHelpExecute  (Sender: TObject);
		procedure actHelp_UpdateExecute      (Sender: TObject);
		procedure lstHelp_ShortCutKeyDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
		procedure lblHelp_URLMouseEnter      (Sender: TObject);
		procedure lblHelp_URLMouseLeave      (Sender: TObject);
	private
		{ Private 宣言 }
		procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
	public
		{ Public 宣言 }
	end;

//------------------------------------------------------------------------------
procedure gpcCreateHelpForm;
procedure gpcSetHelpComment(sText: WideString);


var
	App_CustomVersionInfo: TApp_CustomVersionInfo;
	G_HelpForm:            TApp_CustomVersionInfo;
	G_sHelpURL: WideString;


implementation
uses
	{$IFDEF DEBUG}
	myDebug,
	{$ENDIF}
	myFile,
//	myMultiMonitor,
	myMonitor,
	myNum,
	mySize,
	myWindow,
//	common,
	main,
	custom_shortcut,
	custom_base;

{$R *.dfm}

const
	L_ciMARGIN = 2;


//==============================================================================
procedure gpcCreateHelpForm;
var
	i: Integer;
begin
	if (App_CustomVersionInfo = nil) then begin
		App_CustomVersionInfo := TApp_CustomVersionInfo.Create(G_MainForm);
	end else begin
		for i := 0 to Screen.FormCount-1 do begin
			if (Screen.Forms[i] = App_CustomVersionInfo) then begin
Exit;
			end;
		end;
		App_CustomVersionInfo := TApp_CustomVersionInfo.Create(G_MainForm);
	end;
end;

procedure gpcSetHelpComment(sText: WideString);
begin
	G_HelpForm.lblHelp_Text.Caption := sText;
end;


//==============================================================================
procedure TApp_CustomVersionInfo.WMSysCommand(var Msg: TWMSysCommand);
begin
	case Msg.CmdType of
		61587: begin
			//システムアイコンクリック
			actMenu_PopupExecute(nil);
		end;

		else begin
			inherited;
		end;
	end;
end;

procedure TApp_CustomVersionInfo.FormCreate(Sender: TObject);
var
	lh_Menu: HMENU;
begin
	G_HelpForm := Self;
	gpcCreateCustomBaseForm(G_MainForm);

	Self.ManualDock(G_CustomForm.tabHelp);
	Self.Align    := alClient;
	pnlHelp.Align := alClient;
	Self.Icon     := Application.Icon;
	Self.Visible  := True;
	if (G_sHelpURL <> '') then begin
		lblHelp_URL.Caption := G_sHelpURL;
	end;

	//システムメニュー
	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);

	//バージョン情報
	imgHelp_Icon.Picture.Assign(Application.Icon);
	lblHelp_Ver.Caption  := Format('%s:Ver %s', [gfnsProductNameGet, gfnsFileVersionGet]);
	lblHelp_Text.Caption := gfnsCommentGet;

	lstHelp_ShortCutKey.Align := alClient;

	actHelp_UpdateExecute(nil);
end;

procedure TApp_CustomVersionInfo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
	Action := caFree;
end;

//閉じる
procedure TApp_CustomVersionInfo.actFile_CloseExecute(Sender: TObject);
begin
	G_CustomForm.actFile_CloseExecute(nil);
end;

procedure TApp_CustomVersionInfo.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
//F10
begin
	if  (Key = VK_F10)
	and	not(ssAlt in Shift)
	and not(ssCtrl in Shift)
	then begin
		actMenu_PopupExecute(nil);
	end;
end;

procedure TApp_CustomVersionInfo.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
	if (WheelDelta > 0) then begin
		actScroll_UpExecute(nil);
	end else begin
		actScroll_DownExecute(nil);
	end;
end;

procedure TApp_CustomVersionInfo.actScroll_UpExecute(Sender: TObject);
begin
	SendMessage(lstHelp_ShortCutKey.Handle, WM_VSCROLL, SB_LINEUP, 0);
end;

procedure TApp_CustomVersionInfo.actScroll_DownExecute(Sender: TObject);
begin
	SendMessage(lstHelp_ShortCutKey.Handle, WM_VSCROLL, SB_LINEDOWN, 0);
end;

procedure TApp_CustomVersionInfo.lstHelp_ShortCutKeyDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
	ls_Text: String;
begin
	ls_Text := lstHelp_ShortCutKey.Items[Index];

	with lstHelp_ShortCutKey.Canvas do begin
		if (ls_Text[1] = #9) then begin
			Brush.Color := clBtnFace;
			Font.Color  := clBtnText;
			ls_Text     := Copy(ls_Text, 2, MaxInt);
		end else begin
			Brush.Color := lstHelp_ShortCutKey.Color;
			Font.Color  := lstHelp_ShortCutKey.Font.Color;
		end;
		FillRect(Rect);
		if (ls_Text <> '-') then begin
			Inc(Rect.Left, 8);
		end;

		if (ls_Text <> '') then begin
			Inc(Rect.Left,  L_ciMARGIN);
			Dec(Rect.Right, L_ciMARGIN);
			if (lstHelp_ShortCutKey.Items[Index] = '-') then begin
				MoveTo(Rect.Left,  Rect.Top + gfniRectHeight(Rect) div 2);
				LineTo(Rect.Right, Rect.Top + gfniRectHeight(Rect) div 2);
			end else begin
				DrawText(Handle, PChar(lstHelp_ShortCutKey.Items[Index]), -1, Rect, DT_VCENTER or DT_NOPREFIX or DT_SINGLELINE);
			end;
		end;
	end;
end;

procedure TApp_CustomVersionInfo.actHelp_UpdateExecute(Sender: TObject);
//ヘルプ作成
	procedure lpc_ShortCutKeyListUp(sKey: String);
	var
		i: Integer;
		li_Key: Word;
		l_Shift: TShiftState;
		l_Action: TAction;
	begin
		ShortCutToKey(gfniTextToShortCut(sKey), li_Key, l_Shift);
		for i := 0 to G_ShortCutList.Count-1 do begin
			if (T_ShortCutAction(G_ShortCutList.Items[i]).Key = li_Key) then begin
				l_Action := T_ShortCutAction(G_ShortCutList.Items[i]).Action;
				lstHelp_ShortCutKey.Items.Add(
						Format('%*s %s/%s', [
							G_iShortCutLength +2, //前後の[]で+2
							Format('[%s]', [sKey]),
							l_Action.Category,
							StripHotKey(l_Action.Caption)
						])
				);
				Break;
			end;
		end;
	end;

	procedure lpc_MouseGestureListUp(iIndex: Integer);
	var
		l_Action: TAction;
	begin
		case iIndex 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;

		if (l_Action <> nil) then begin
			lstHelp_ShortCutKey.Items.Add(
					Format('%*s %s/%s', [
						G_iShortCutLength +2, //前後の[]で+2
						Format('[%s]', [G_csGESTURESTRING[iIndex]]),
						l_Action.Category,
						StripHotKey(l_Action.Caption)
					])
			);
		end;
	end;

	function lfns_CommandShortCutKeyGet(AAction: TAction): String;
		procedure lpc_SetDispKey(var sKey: String; sAdd: String);
		begin
			sKey := Format('%s [%s]', [sKey, sAdd]);
		end;
	var
		i: Integer;
	begin
		Result := '';
		for i := 0 to G_ShortCutList.Count-1 do begin
			if (T_ShortCutAction(G_ShortCutList.Items[i]).Action = AAction) then begin
				lpc_SetDispKey(Result, gfnsShortCutToText(T_ShortCutAction(G_ShortCutList.Items[i]).Key));
			end;
		end;

		if (AAction = G_GestureUp)    then lpc_SetDispKey(Result, G_csGESTURESTRING[G_ciGESTUREUP]);
		if (AAction = G_GestureDown)  then lpc_SetDispKey(Result, G_csGESTURESTRING[G_ciGESTUREDOWN]);
		if (AAction = G_GestureLeft)  then lpc_SetDispKey(Result, G_csGESTURESTRING[G_ciGESTURELEFT]);
		if (AAction = G_GestureRight) then lpc_SetDispKey(Result, G_csGESTURESTRING[G_ciGESTURERIGHT]);
	end;
var
	i, li_Len: Integer;
	l_Action:  TAction;
	ls_Key:    String;
begin
	//ヘルプのキーリスト
	lstHelp_ShortCutKey.Items.Clear;
	lstHelp_ShortCutKey.Items.Add(#9'現在のショートカットキー一覧');
	for i := 0 to High(G_csSHORTCUTKEY) do begin
		lpc_ShortCutKeyListUp(G_csSHORTCUTKEY[i, G_ciSHORTCUTDISP]);
	end;

	lstHelp_ShortCutKey.Items.Add(#9'現在のマウスジェスチャ設定');
	lpc_MouseGestureListUp(G_ciGESTUREUP);
	lpc_MouseGestureListUp(G_ciGESTUREDOWN);
	lpc_MouseGestureListUp(G_ciGESTURELEFT);
	lpc_MouseGestureListUp(G_ciGESTURERIGHT);

	lstHelp_ShortCutKey.Items.Add('-');
	lstHelp_ShortCutKey.Items.Add(#9'現在のコマンド設定一覧');
	li_Len := 0;
	for i := 0 to G_ActionList.ActionCount-1 do begin
		l_Action := TAction(G_ActionList.Actions[i]);
		ls_Key   := lfns_CommandShortCutKeyGet(l_Action);
		if (ls_Key <> '') then begin
			li_Len := gfniMax([li_Len, Length(gfnsCommandDescriptGet(l_Action))]);
		end;
	end;
	for i := 0 to G_ActionList.ActionCount-1 do begin
		l_Action := TAction(G_ActionList.Actions[i]);
		ls_Key   := lfns_CommandShortCutKeyGet(l_Action);
		if (ls_Key <> '') then begin
			lstHelp_ShortCutKey.Items.Add(
					Format('%-*s %s', [
						li_Len,
						gfnsCommandDescriptGet(l_Action),
						ls_Key
					])
			);
		end;
	end;
end;

procedure TApp_CustomVersionInfo.actHelp_OnlineHelpExecute(Sender: TObject);
//オンラインヘルプ
begin
	gpcExecute(lblHelp_URL.Caption);
end;

procedure TApp_CustomVersionInfo.lblHelp_URLMouseEnter(Sender: TObject);
//アンダーラインを引く
begin
	if not(fsUnderline in lblHelp_URL.Font.Style) then lblHelp_URL.Font.Style := lblHelp_URL.Font.Style + [fsUnderline];
	Screen.Cursor := crHandPoint;
end;

procedure TApp_CustomVersionInfo.lblHelp_URLMouseLeave(Sender: TObject);
//アンダーラインを戻す
begin
	if (fsUnderline in lblHelp_URL.Font.Style) then lblHelp_URL.Font.Style := lblHelp_URL.Font.Style - [fsUnderline];
	Screen.Cursor := crDefault;
end;

procedure TApp_CustomVersionInfo.actMenu_PopupExecute(Sender: TObject);
begin
	mnuHelp.Popup(Self.ClientOrigin.X, Self.ClientOrigin.Y);
end;


end.