unit _myHelpVersionInfo;
//{$DEFINE _DEBUG}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
	Dialogs, ExtCtrls, StdCtrls,
	ComCtrls;

type
	THelp_VersionInfo = class(TForm)
    Panel_Ver:               TPanel;
    Image_Icon: TImage;
      Lable_HelpVer:         TLabel;
      Label_HelpDescription: TLabel;
		Panel_Memo:              TPanel;
			Shape3:                TShape;
    Panel_Cmd:               TPanel;
	    Label_URL:             TLabel;
	    Button_Close:          TButton;
    Label_Memo: TLabel;
    Shape2: TShape;

		procedure FormCreate(Sender: TObject);
    procedure FormClose (Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
		procedure Label_URLMouseEnter(Sender: TObject);
		procedure Label_URLMouseLeave(Sender: TObject);
		procedure Label_URLClick(Sender: TObject);
    procedure Button_CloseClick(Sender: TObject);
	private
		{ Private 宣言 }
		function  FGetMemo: String;
		procedure FSetMemo(sText: String);
	public
		{ Public 宣言 }
		procedure SetTitle(sTitle: String);
		property  Memo: String read FGetMemo write FSetMemo;
	end;

procedure gpcVersionInfoCreate; overload;
procedure gpcVersionInfoCreate(sTitle: String); overload;
procedure gpcVersionInfoShow;
procedure gpcVersionInfoShowModal;
procedure gpcVersionInfoRelease;
procedure gpcVersionInfoTitleSet(sTitle: String);
procedure gpcVersionInfoDescriptionSet(sDescription: String);
procedure gpcVersionInfoURLSet(sURL: String);
function  gfnsVersionInfoMemoGet: String;
procedure gpcVersionInfoMemoSet(sText: String);
procedure gpcVersionInfoMemoWrapSet(bWrap: Boolean);
procedure gpcVersionInfoMemoFixedFontSet(bFixed : Boolean);

var
	Help_VersionInfo: THelp_VersionInfo;

implementation
uses
{$IFDEF _DEBUG}
	_myDebug;
{$ENDIF}
	PsAPI,
	ShellApi,
	System.UITypes,
	general;
//	myApp,
//	myMonitor,
//	myMultiMonitor,
//	mySize,
//	myString,
//	myWindow,
//	myFile;

{$R *.dfm}

(*
// myApp.pas -------------------------------------------------------------------
function gfnbFormExists(AForm: TForm): Boolean;
var
	i: Integer;
begin
	Result := False;

	if (AForm <> nil)
	then begin
		for i := 0 to Screen.FormCount -1
		do begin
			if (Screen.Forms[i] = AForm)
			then begin
				Result := True;
Exit;
			end;
		end;
	end;
end;

// mySize.pas ------------------------------------------------------------------
function gfniRectWidth(rtRect: TRect): Integer;
//rtRectの幅を返す。
begin
	with rtRect do begin
		Result := Right - Left;
	end;
end;
function gfniRectHeight(rtRect: TRect): Integer;
//rtRectの高さを返す。
begin
	with rtRect do begin
		Result := Bottom - Top;
	end;
end;


// myString.pas ----------------------------------------------------------------
function gfnsStrEndFit(sSrc, sEnd: WideString): WideString;
//sSrcの末尾がsEndでなければsEndを足して返す。
begin
	if (Copy(sSrc, Length(sSrc) - Length(sEnd) +1, Length(sEnd)) <> sEnd)
	then begin
		Result := sSrc + sEnd;
	end
	else
	begin
		Result := sSrc;
	end;
end;


//myWindow.pas -----------------------------------------------------------------
function gfnptMousePosGet: TPoint;
//マウスカーソルの位置をスクリーン座標で返す。
begin
	Result := Point(0, 0);
	GetCursorPos(Result);
end;

function gfnsSystem32DirGet: WideString;
var
	li_Size: UINT;
	lp_Buff: PWideChar;
begin
	Result := '';
	li_Size := GetSystemDirectoryW(nil, 0);
	if (li_Size > 0)
	then begin
		lp_Buff := AllocMem(li_Size * SizeOf(WideChar));
		try
			li_Size := GetSystemDirectoryW(lp_Buff, li_Size);
			if (li_Size > 0)
			then begin
				Result := gfnsStrEndFit(WideString(lp_Buff), '\');
			end;
		finally
			FreeMem(lp_Buff);
		end;
	end;
end;

//myMonitor.pas ----------------------------------------------------------------
procedure gpcMonitorInfoUpdate;
{
モニター情報が変わってもTScreenは感知しないのでTCustomForm.Monitorを呼ぶことでモ
ニター情報を再作成させる。
}
begin
	if (Application.MainForm <> nil)
	then begin
		Application.MainForm.Monitor;
	end;
end;
function gfniMonitorIndexGet(APoint: TPoint): Integer;
{
モニターのインデックスを取得。
APointはスクリーン座標であること。
}
var
	i : Integer;
begin
	//念のためモニター情報が変わっていたらモニター情報を再作成しておく
	gpcMonitorInfoUpdate;

	Result := -1;
	for i := 0 to Screen.MonitorCount -1
	do begin
		if (PtInRect(Screen.Monitors[i].BoundsRect, APoint))
		then begin
			Result := i;
Exit;
		end;
	end;
end;
procedure gpcMonitorCenterPosSet(AWinControl: TWinControl);
//ウィンドウをモニターの中心に配置
var
	l_Monitor : TMonitor;
begin
	//念のためモニター情報が変わっていたらモニター情報を再作成しておく
	gpcMonitorInfoUpdate;

	l_Monitor := Screen.Monitors[gfniMonitorIndexGet(gfnptMousePosGet)];
//	AWinControl.SetBounds((gfniRectWidth(l_Monitor.WorkareaRect) - AWinControl.Width) div 2, (gfniRectHeight(l_Monitor.WorkareaRect) - AWinControl.Height) div 2, AWinControl.Width, AWinControl.Height);
	SetWindowPos(AWinControl.Handle, HWND_TOP, (gfniRectWidth(l_Monitor.WorkareaRect) - AWinControl.Width) div 2, (gfniRectHeight(l_Monitor.WorkareaRect) - AWinControl.Height) div 2, AWinControl.Width, AWinControl.Height, 0);
end;

//myFile.pas -------------------------------------------------------------------
function gfnsFileMainGet(sFile: WideString): WideString;
{
ファイル名のうちパスと拡張子を除いた部分を返す。
メインファイル名の拡張子のないもの。
\ と . はつかない。
}
var
	i : Integer;
	lb_Ext : Boolean; //2007-10-26
begin
	Result := '';
	lb_Ext := True;
	for i := Length(sFile) downto 1
	do begin
		if (sFile[i] = '\')
		or (sFile[i] = '/')
    or (sFile[i] = ':')
		then     begin
			//\と/と:が出てきた時点でファイル名の終了なのでループを抜ける。
	Break;
		end
		else
    if  (sFile[i] = '.')
		and (lb_Ext)
    then begin;	//2007-10-26
			//拡張子であったので今までのをチャラにする。
			Result := '';
			lb_Ext := False;
		end
		else
		begin
			Result := sFile[i] + Result;
		end;
	end;
end;

function gfnsExeNameGet(sStr: WideString): WideString; overload;
{,2015-04-18:

2015-04-18:CommandLineToArgvWを使っていたものから自作関数で分割するようにに変更。
}
const
	lcs_QUOT  = WideChar('"');
	lcs_SPACE = WideChar(' ');
	lcs_TAB   = WideChar(#$9);
	lcs_CR    = WideChar(#$D);
	lcs_LF    = WideChar(#$A);
var
	i: Integer;
	li_Len   : Integer;
	ls_Param : WideString;
	ls_Char  : WideChar;
	lb_Quot  : Boolean;
	lb_Skip  : Boolean;
begin
	li_Len   := Length(sStr);
	lb_Quot  := False;
	lb_Skip  := False;
	ls_Param := '';

	for i := 1 to li_Len
	do begin
		ls_Char := sStr[i];
		case ls_Char of
			lcs_QUOT
			:begin
				//最初にみつかった引用符は区切り。
				if not(lb_Quot)
				then begin
					//最初にみつかった引用符は区切り。
					lb_Quot := True;
					if (ls_Param <> '')
					then begin
						//パラメータがあったのでそれが実行ファイル名。
						Result := ls_Param;
Exit;
					end;
				end
				else
				if (lb_Skip)
				then begin
					//引用符内引用符。
					lb_Skip  := False;
					ls_Param := ls_Param + ls_Char;
				end
				else
				if  (i < li_Len)
				and (sStr[i +1] = lcs_QUOT)
				then begin
					//この引用符のすぐ後にも引用符があるので引用符内引用符であるので引数の取り出しにはならない。
					//ex) "引用符を含めるには""とする"
					lb_Skip := True;
				end
				else
				if (lb_Quot)
				then begin
					//引用符の閉じ⇒ここまでが実行ファイル名。
					Result := ls_Param;
Exit;
				end;
			end;
			lcs_SPACE, //半角スペース。
			lcs_TAB,   //タブ。
			lcs_CR,    //改行。
			lcs_LF     //改行。
			:begin
				//引数の区切り。
				if (lb_Quot)
				then begin
					//引用符つき引数であるので引数の区切りではない⇒引数の文字列に加える。
					ls_Param := ls_Param + ls_Char;
				end
				else
				begin
					//引用符つき引数ではないので引数の区切り⇒ここまでが実行ファイル名。
					if (ls_Param <> '')
					then begin
						Result := ls_Param;
Exit;
					end;
				end;
			end;
			else
			begin
				ls_Param := ls_Param + ls_Char;
			end;
		end;
	end;

	if (ls_Param <> '')
	then begin
		Result := ls_Param;
	end;
end;

type
	TGetProcessImageFileName = function(hProcess: THandle; lpImageFileName: LPWSTR; nSize: DWORD): DWORD; stdcall;
//function GetProcessImageFileNameW(hProcess: THandle; lpImageFileName: LPWSTR; nSize: DWORD): DWORD; stdcall; external 'Psapi.dll';
function gfnsExeNameGet(hHandle: HWND): WideString; overload;
{
ウィンドウハンドルからexeファイル名を返す
http://m--takahashi.com/bbs/pastlog/02500/02414.html
http://www.geocities.jp/fjtkt/problems/2003_0004.html
http://www2.big.or.jp/~osamu/Delphi/tips.cgi?index=0182.txt
http://homepage1.nifty.com/MADIA/delphi/Win32API/Process.htm

http://rarara.cafe.coocan.jp/cgi-bin/lng/vc/vclng.cgi?print+201010/10100011.txt
http://www14.big.or.jp/~ken1/tech/tech11.html
}
	function _ProcessIDGet(hHandle: HWND): DWORD;
	begin
		GetWindowThreadProcessId(hHandle, @Result);
	end;
var
	lh_Process : THandle;
//	lh_Module  : THandle;
//	li_Num     : DWORD;
	lp_Buff    : PWideChar;
//	l_Info     : MODULEINFO;

	i : Integer;
	li_Drives : DWORD;
	li_Flag   : Integer;
	ls_Device : WideString;
	lp_Device : PWideChar;
	ls_Drv    : WideString;

	ls_Path   : WideString;
	lh_Module : HMODULE;
	l_GetProcessImageFileName : TGetProcessImageFileName;
begin
	Result := '';
	lh_Process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, _ProcessIDGet(hHandle));
	try
		lp_Buff := AllocMem((MAX_PATH +1) * SizeOf(WideChar));
		try
			//プロセスハンドルを渡すだけで実行ファイル名を得られた。インスタンスハンドルはいらないようだ。
			if (GetModuleFileNameExW(lh_Process, 0, lp_Buff, MAX_PATH) <> 0)
			then begin
				Result := WideString(lp_Buff);
			end
			else
			begin
{
				//EnumProcessModulesは32bitプロセスから64bitプロセスのモジュールハンドルを取得できない。
				if (EnumProcessModules(lh_Process, @lh_Module, SizeOf(HMODULE), li_Num))
				then begin
					FillChar(l_Info, SizeOf(l_Info), 0);
					if (GetModuleInformation(lh_Process, lh_Module, @l_Info, SizeOf(l_Info)))
					then begin
						if (GetMappedFileNameW(lh_Process, l_Info.EntryPoint, lp_Buff, MAX_PATH) <> 0)
						then begin
							Result := WideString(lp_Buff);
						end;
					end;
				end;
}
				//GetModuleFileNameExWは32bitプロセスから64bitプロセスの実行ファイル名を取得できない。
				//システムディレクトリを取得
				ls_Path := gfnsSystem32DirGet;

				//完全修飾パスを指定してPsapi.dllをロード
				lh_Module := LoadLibraryW(PWideChar(ls_Path + 'Psapi.dll'));
				if (lh_Module <> 0)
				then begin
					try
						//GetProcessImageFileNameの関数ポインタを取得
						@l_GetProcessImageFileName := GetProcAddress(lh_Module, 'GetProcessImageFileNameW');
						if (@l_GetProcessImageFileName <> nil)
						then begin
							l_GetProcessImageFileName(lh_Process, lp_Buff, MAX_PATH);
							Result := WideString(lp_Buff);
						end;
					finally
						FreeLibrary(lh_Module);
					end;

					if (Result <> '')
					then begin
						li_Drives := GetLogicalDrives;
						li_Flag   := 1;
						for i := Ord('A') to Ord('Z')
						do begin
							if ((li_Drives and li_Flag) <> 0)
							then begin
		//_myDebug.gpcDebug(WideChr(i));
								lp_Device := nil;
								try
									lp_Device := AllocMem((MAX_PATH +1) * SizeOf(WideChar));
									ls_Drv    := WideString(Char(i)) + ':';
									QueryDosDeviceW(PWideChar(ls_Drv), lp_Device, MAX_PATH);
									ls_Device := WideString(lp_Device);
		//_myDebug.gpcDebug(ls_Device);
									if (Pos(ls_Device + '\', Result) = 1)
									then begin
										Result := ls_Drv + Copy(Result, Length(ls_Device) +1, MaxInt);
						Break;
									end;
								finally
									FreeMem(lp_Device);
								end;
							end;
							li_Flag := li_Flag shl 1;
						end;
					end;
				end;
			end;
		finally
			FreeMem(lp_Buff);
		end;
	finally
		CloseHandle(lh_Process);
	end;
end;

function gfnsExeNameGet: WideString; overload;
{2007-09-24,2009-09-23:
WideString対応の実行プログラム名を返す。

2009-09-23:
　コマンドラインを分解して取得するのではなくApplicationのウィンドウハンドルから
　取得するように変更。
　コマンドプロンプトから実行させるとパスがつかないことがあることへの対処。
}
var
	lh_Handle: HWND;
begin
	lh_Handle := Application.Handle;
	if (lh_Handle <> 0)
	then begin
		Result := general.gfnsExeNameGet(lh_Handle);
	end;

	if (Result = '')
	then begin
		Result := gfnsExeNameGet(GetCommandLineW);
	end;
end;

//ファイルバージョン
type
	TMyFileVersionInfo = record
		Comments,                 // コメント
		CompanyName,              // 会社名
		FileDescription,          // 説明
		FileVersion,              // ファイルバージョン
		InternalName,             // 内部名
		LegalCopyright,           // 著作権
		LegalTrademarks,          // 商標
		OriginalFilename,         // 正式ファイル名
		PrivateBuild,             // プライベートビルド情報
		ProductName,              // 製品名
		ProductVersion,           // 製品バージョン
		SpecialBuild: WideString; // スペシャルビルド情報
	end;

function gfnrFileVersionInfoGet(sFile: WideString): TMyFileVersionInfo;
{2007-06-09:
ファイルのバージョン情報を返す

http://www2.big.or.jp/~osamu/Delphi/Tips/key.cgi?key=13#0226.txt
}
type
	 TLangAndCodePage = record
		 iLanguage: WORD;
		 iCodePage: WORD;
	 end;
   PLangAndCodePage = ^TLangAndCodePage;
var
	li_Size,
	li_Reserved,
	li_Len      : DWORD;
	lp_Buff,
//	lp_Locale,
	lp_Dat      : Pointer;
//	li_Hi,
//	li_Lo       : Integer;
	lp_LangPage : PLangAndCodePage;
	ls_FileInfo : WideString;
begin
	// 必要なバッファのサイズを取得
	li_Size := GetFileVersionInfoSizeW(PWideChar(sFile), li_Reserved);
	if (li_Size > 0) then begin
		//メモリ確保
		lp_Buff := AllocMem((li_Size +1) * 2);
		try
			if (GetFileVersionInfoW(PWideChar(sFile), 0, li_Size, lp_Buff)) then begin
				//変数情報ブロック内の変換テーブルを指定
//				if (VerQueryValueW(lp_Buff, '\VarFileInfo\Translation', lp_Locale, li_Len) and (li_Len > 0)) then begin
//					gpcInt32ToHiLo(Integer(lp_Locale^), li_Hi, li_Lo);
//					ls_FileInfo := WideFormat('\StringFileInfo\%.4x%.4x\', [li_Lo, li_Hi]);
				if (VerQueryValueW(lp_Buff, '\VarFileInfo\Translation', Pointer(lp_LangPage), li_Len) and (li_Len > 0)) then begin
					ls_FileInfo := WideString(Format('\StringFileInfo\%.4x%.4x\', [lp_LangPage^.iLanguage, lp_LangPage^.iCodePage]));

					//コメント
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'Comments'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.Comments := WideString(PWideChar(lp_Dat));
					end;
					//会社名
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'CompanyName'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.CompanyName := WideString(PWideChar(lp_Dat));
					end;
					//説明
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'FileDescription'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.FileDescription := WideString(PWideChar(lp_Dat));
					end;
					//ファイルバージョン
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'FileVersion'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.FileVersion := WideString(PWideChar(lp_Dat));
					end;
					//内部名
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'InternalName'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.InternalName := WideString(PWideChar(lp_Dat));
					end;
					//著作権
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'LegalCopyright'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.LegalCopyright := WideString(PWideChar(lp_Dat));
					end;
					//商標
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'LegalTrademarks'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.LegalTrademarks := WideString(PWideChar(lp_Dat));
					end;
					//正式ファイル名
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'OriginalFilename'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.OriginalFilename := WideString(PWideChar(lp_Dat));
					end;
					//プライベートビルド情報
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'PrivateBuild'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.PrivateBuild := WideString(PWideChar(lp_Dat));
					end;
					//製品名
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'ProductName'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.ProductName := WideString(PWideChar(lp_Dat));
					end;
					//製品バージョン
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'ProductVersion'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.ProductVersion := WideString(PWideChar(lp_Dat));
					end;
					//スペシャルビルド情報
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'SpecialBuild'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result.SpecialBuild := WideString(PWideChar(lp_Dat));
					end;
				end;
			end;
		finally
			// 解放
			FreeMem(lp_Buff);
		end;
	end;
end;

function gfnsProductNameGet: WideString;
//自アプリの製品名。
var
	lr_Info: TMyFileVersionInfo;
begin
	lr_Info := gfnrFileVersionInfoGet(gfnsExeNameGet);
	Result  := lr_Info.ProductName;
	if (Result = '')
	then begin
		//製品名が指定されていなければ主ファイル名を返す。
		Result := gfnsFileMainGet(gfnsExeNameGet);
	end;
end;

function gfnsCommentGet: WideString;
//自アプリの説明。
//タスクマネージャやエクスプローラのプロパティには出ない
var
	lr_Info: TMyFileVersionInfo;
begin
	lr_Info := gfnrFileVersionInfoGet(Application.ExeName);
	Result  := lr_Info.Comments;
end;

function gfnsFileVersionGet: WideString;
//自アプリのファイルバージョン。
var
	lr_Info: TMyFileVersionInfo;
begin
	lr_Info := gfnrFileVersionInfoGet(Application.ExeName);
	Result  := lr_Info.FileVersion;
end;

function gfnhExecute(sFile: WideString; sCmdLine: WideString = ''): THandle;
{
sFileを引数(sCmdLine)で実行してプロセスのハンドルを返す。
呼び出し側で戻り値をCloseHandleする必要あり。
}
var
	l_Info : TShellExecuteInfoW;
begin
	FillChar(l_Info, SizeOf(l_Info), 0);
	l_Info.cbSize := SizeOf(l_Info);
	l_Info.fMask :=
			 SEE_MASK_UNICODE
		or SEE_MASK_NOCLOSEPROCESS
		or SEE_MASK_CONNECTNETDRV  //ネットワーク上のファイルの UNC（Universal Naming Convention）パス名であることを表します。
//		or SEE_MASK_FLAG_DDEWAIT   //DDE 対話が開始される場合には、それが終了するまで再開されません。
	;

	if (sFile <> '')
	then begin
		l_Info.lpFile := PWideChar(sFile);
	end;

	if (sCmdLine <> '')
	then begin
		l_Info.lpParameters := PWideChar(sCmdLine);
	end;

	l_Info.nShow := SW_SHOWNORMAL;

	if (ShellExecuteExW(@l_Info))
	then begin
		Result := l_Info.hProcess;
	end
	else
	begin
		Result := 0;
	end;
end;

procedure gpcExecute(sFile: WideString);
//sFileを実行する。
begin
//general.gfnhExecute(sFile);

//Exit;
	ShellExecuteW(Application.Handle, nil, PWideChar(sFile), nil, nil, SW_SHOWNORMAL)
end;
*)

//==============================================================================
procedure THelp_VersionInfo.FormCreate(Sender: TObject);
var
	ls_Title : WideString;
begin
	gpcMonitorCenterPosSet(Self);

	Image_Icon.Picture.Assign(Application.Icon);
	Panel_Memo.Align := alClient;
	Label_Memo.Align := alClient;
//	Label_Memo.Align := alNone;
//	Label_Memo.Anchors := [akLeft, akTop, akRight];
	Caption := 'バージョン情報';
{
	if (gfnsFileDescriptionGet <> '') then begin
		ls_Title := gfnsFileDescriptionGet;
	end else
}
	if (gfnsProductNameGet <> '')
	then begin
		ls_Title := gfnsProductNameGet;
	end else
	if (Application.Title <> '')
	then begin
		ls_Title := Application.Title;
	end else
	begin
		ls_Title := ExtractFileName(Application.ExeName);
	end;

	SetTitle(ls_Title);
	Label_HelpDescription.Caption := gfnsCommentGet;
//	Label_HelpDescription.Caption := gfnsFileDescriptionGet;
	FSetMemo('');
	Label_URL.Caption := '';

	if ((GetWindowLong(Application.MainForm.Handle, GWL_EXSTYLE) and WS_EX_TOPMOST) = WS_EX_TOPMOST)
	then begin
		Windows.SetWindowPos(Self.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
	end;
end;

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

procedure THelp_VersionInfo.Label_URLMouseEnter(Sender: TObject);
begin
	if not(fsUnderline in Label_URL.Font.Style) then Label_URL.Font.Style := Label_URL.Font.Style + [fsUnderline];
	Screen.Cursor := crHandPoint;
end;

procedure THelp_VersionInfo.Label_URLMouseLeave(Sender: TObject);
begin
	if (fsUnderline in Label_URL.Font.Style) then Label_URL.Font.Style := Label_URL.Font.Style - [fsUnderline];
	Screen.Cursor := crDefault;
end;

procedure THelp_VersionInfo.Label_URLClick(Sender: TObject);
begin
	gfnhExecute(Label_URL.Caption);
end;

procedure THelp_VersionInfo.Button_CloseClick(Sender: TObject);
begin
	Close;
end;

procedure THelp_VersionInfo.SetTitle(sTitle: String);
begin
	if (sTitle <> '') then begin
		sTitle := gfnsStrEndFit(sTitle, ':');
	end;
	Lable_HelpVer.Caption := Format('%sVer %s', [sTitle, gfnsFileVersionGet]);
end;

function THelp_VersionInfo.FGetMemo: String;
begin
	Result := Label_Memo.Caption;
end;
procedure THelp_VersionInfo.FSetMemo(sText: String);
const
	lci_MEMOHEIGHT = 60;
begin
	Label_Memo.Caption := sText;

	if (sText <> '')
	then begin
		ClientHeight := Panel_Ver.Height + lci_MEMOHEIGHT + Panel_Cmd.Height;
//		Panel_Memo.Height  := lci_MEMOHEIGHT; //Label_Memo.Height;
		Panel_Memo.Visible := True;
	end
	else
	begin
		//値のセットがなければ非表示で高さを狭める
		Panel_Memo.Visible := False;
		ClientHeight := Panel_Ver.Height + Panel_Cmd.Height;
	end;
end;

//==============================================================================
procedure lpcCreate;
var
	i: Integer;
begin
	if not(gfnbFormExists(Help_VersionInfo)) then begin
		Help_VersionInfo := THelp_VersionInfo.Create(Application);
	end else begin
		for i := 0 to Screen.CustomFormCount-1 do begin
			if (Screen.CustomForms[i].ClassName = THelp_VersionInfo.ClassName) then Exit;
		end;
		Help_VersionInfo := THelp_VersionInfo.Create(Application);
	end;
end;

procedure gpcVersionInfoCreate;
begin
	lpcCreate;
end;

procedure gpcVersionInfoCreate(sTitle: String);
begin
	gpcVersionInfoTitleSet(sTitle);
end;

procedure gpcVersionInfoShow;
begin
	gpcVersionInfoURLSet (Help_VersionInfo.Label_URL.Caption);
	gpcVersionInfoMemoSet(Help_VersionInfo.Label_Memo.Caption);
	Help_VersionInfo.Show;
end;

procedure gpcVersionInfoShowModal;
begin
	gpcVersionInfoURLSet (Help_VersionInfo.Label_URL.Caption);
	gpcVersionInfoMemoSet(Help_VersionInfo.Label_Memo.Caption);
	Help_VersionInfo.ShowModal;
end;

procedure gpcVersionInfoRelease;
begin
	lpcCreate;	//AIU
	Help_VersionInfo.Release;
	Help_VersionInfo := nil;
end;

procedure gpcVersionInfoTitleSet(sTitle: String);
begin
	lpcCreate;
	Help_VersionInfo.SetTitle(sTitle);
end;

procedure gpcVersionInfoDescriptionSet(sDescription: String);
begin
	lpcCreate;
	Help_VersionInfo.Label_HelpDescription.Caption := sDescription;
end;

procedure gpcVersionInfoURLSet(sURL: String);
var
	li_Width: Integer;
begin
	lpcCreate;
	with Help_VersionInfo do begin
		Label_URL.Caption := sURL;
		if (sURL <> '') then begin
			li_Width := Label_URL.Width + (Label_URL.Left * 2);
			if (ClientWidth < li_Width) then ClientWidth := li_Width;
			if not(Label_URL.Visible) then begin
				ClientHeight     := ClientHeight     + Label_URL.Height;
				Panel_Cmd.Height := Panel_Cmd.Height + Label_URL.Height;
			end;
			Label_URL.Visible := True;
		end else begin
			//値のセットがなければ非表示で高さを狭める
			if (Label_URL.Visible) then begin
				ClientHeight     := ClientHeight     - Label_URL.Height;
				Panel_Cmd.Height := Panel_Cmd.Height - Label_URL.Height;
			end;
			Label_URL.Visible := False;
		end;
	end;
end;

function gfnsVersionInfoMemoGet: String;
begin
	lpcCreate;
	Result := Help_VersionInfo.Memo;
end;

procedure gpcVersionInfoMemoSet(sText: String);
begin
	lpcCreate;
	Help_VersionInfo.Memo := sText;
end;

//折り返すか
procedure gpcVersionInfoMemoWrapSet(bWrap: Boolean);
begin
	lpcCreate;
	with Help_VersionInfo
	do begin
		Label_Memo.WordWrap := bWrap;
	end;
end;

procedure gpcVersionInfoMemoFixedFontSet(bFixed : Boolean);
begin
	lpcCreate;
	with Help_VersionInfo
	do begin
		if (bFixed)
		then begin
			//固定ピッチフォント
			Label_Memo.Font.Name := 'ＭＳ ゴシック';
		end
		else
		begin
			Label_Memo.Font.Name := 'MS UI Gothic';
		end;
	end;
end;

procedure THelp_VersionInfo.FormShow(Sender: TObject);
begin
	if (Self.Tag = 0)
	then begin
		Self.Tag := 1;
//		Self.Constraints.MinWidth  := Self.Width;
//		Self.Constraints.MinHeight := Self.Height;
		Self.Constraints.MinHeight := (Self.Height - Self.ClientHeight) + Panel_Ver.Height + Panel_Cmd.Height;
	end;
end;

end.