unit general;
//{$DEFINE _DEBUG}

interface
uses
	ActnList,
	Classes,
	Clipbrd,
	Controls,
	Dialogs,
	Forms,
	Grids,
	Menus,
	Messages,
	Windows,
	Graphics, //Windowsの後にしないとだめ
	SysUtils;


const
	G_WM_APP_INFO_WINDOWHANDLE = WM_APP +1;

//myWindow.pas
const
	//ウィンドウテキストを取得する最大文字数。
	//D6ではあまり大きいとハングアップする。
	//XE2では大きくても大丈夫なようだ。
	G_ciMAXTEXTLEN = 255;

function gfnrcPhysicalWindowRectGet(hHandle: HWND): TRect;
//function PhysicalToLogicalPoint(hWindow: HWND; var lpPoint: TPoint): Boolean;
function LogicalToPhysicalPoint(hWindow: HWND; var lpPoint: TPoint): Boolean;
//function SetProcessDPIAware: Boolean;


function GetLayeredWindowAttributes(hHandle: HWND; var crKey: COLORREF; var bAlpha: BYTE; var dwFlags: DWORD): Boolean;

function gfnptMousePosGet: TPoint;
function gfnptPhysicalCursorPosGet: TPoint;
function gfnptClientMousePosGet(hHandle: HWND): TPoint;
function gfnptPhysicalToLogicalPoint(hHandle: HWND; ptPos: TPoint): TPoint;
function gfnbKeyState(iKey: Integer): Boolean;
function gfnbKeyStateAnd(iKeys: array of Integer): Boolean;
function gfnsClassNameGet(hHandle: HWND): WideString;
function gfnsWindowTextGet(hHandle: HWND): WideString;
//function gfnhWindowGet(APoint: TPoint): HWND;// overload;
function gfnhParentWindowGet(hHandle: HWND): HWND;
function gfnhToplevelWindowGet(hHandle: HWND): HWND; overload;
function gfnsExeNameGet(hHandle: HWND): WideString; overload;
function gfnrcDwmWindowRectGet(hHandle: HWND): TRect;
function gfnrcWindowRectGet(hHandle: HWND): TRect;
function gfnrcLogicalWindowRectGet(hHandle: HWND): TRect;
function gfnrcClientRectGet(hHandle: HWND): TRect;
function gfnptScreenToClient(hHandle: HWND; ptPos: TPoint): TPoint;
function gfnrcRectMove(rcRect: TRect; iX, iY: Integer): TRect; overload;
function gfnrcRectMove(rcRect: TRect; ptPos: TPoint): TRect;   overload;
function gfnrcOriginRect(AControl: TControl): TRect;
function gfniThreadIDGet(hHandle: HWND): DWORD;

function gfnsSystem32DirGet: WideString;
//function gfnsOsNameGet: WideString;
function gfnbAeroThemeEnableSet(bEnable: Boolean): Boolean;
function gfnbIsAeroThemeEnabled: Boolean;
function gfnbIsAeroThemeReady: Boolean;
function gfnbIsAlphaBlendReady: Boolean;

function gfnsLanguageGet(iLanguage: WORD): WideString;
function gfnsCodePageGet(iLanguage, iCodePage: WORD): WideString;

//myNum.pas
function gfniStrToInt(sNum: WideString): Int64;
function gfniRound(fNum: Extended): Int64;
function gfniRoundUp(fNum: Extended): Int64;
function gfniNumLimit(iNum: Integer; iMin, iMax: Integer): Integer;
function gfniNumLoop(iNum: Integer; iMin, iMax: Integer): Integer;
function gfniMax(iNum: array of Integer): Integer;
function gfniMin(iNum: array of Integer): Integer;
function gfnbIsInsideRange(iNum, iMin, iMax: Integer): Boolean;

//mySize.pas
function gfniRectWidth (rtRect: TRect): Integer;
function gfniRectHeight(rtRect: TRect): Integer;
function gfnrcRectCenter(rcParent, rcChild: TRect): TRect;
function gfnrcRectShift (rcRect: TRect; ptShift: TPoint): TRect; overload;
function gfnbCompleteRectInRect(rcCheck, rcRect: TRect): Boolean;
function gfnbRectInRect(rcCheck, rcRect: TRect): Boolean;
function gfnsCompasGet(ptStart, ptPos: TPoint): String;
procedure gpcSetMonitorBounds(AForm: TCustomForm; ARect: TRect);

//myFile.pas
function gfnsFilePathGet(sFile: WideString): WideString;
function gfnsFileNameGet(sFile: WideString): WideString;
function gfnsFileExtGet (sFile: WideString): WideString;
function gfnsFileExtChange(sFile, sExt: WideString): WideString;
function gfnsExeNameGet: WideString; overload;
function gfnbFileExists(sFile: WideString): Boolean;
function gfniFileSizeGet(hHandle: THandle): Int64;
function gfnsFileVersionGet(sFile: WideString): WideString; overload;
function gfnsProductNameGet(sFile: WideString): WideString; overload;
function gfnsFileVersionGet: WideString; overload;
function gfnsProductNameGet: WideString; overload;
function gfnhExecute(sFile: WideString): HWND;

//myGraphic.pas
const
	CAPTUREBLT = $40000000; //レイヤーウィンドウも含めたキャプチャを行うフラグ

type
	TZoomFlip = (fpNone, fpFlipHorizontal, fpFlipVertical, fpFlipBoth, fpRotate90, fpRotate180, fpRotate270);
		//fpFlipBothとfpRotate180は同じ

type
	TMyBitmap = class(TBitmap)
	public
		procedure SaveToFile(const Filename: WideString); reintroduce;
	end;

function gfnclColorRevers(clColor: TColor): TColor;
procedure gpcColorRGBToHLS(iRed, iGreen, iBlue: BYTE; var iHue, iLuminance, iSaturation: WORD; iMaxHue, iMaxLuminance, iMaxSaturation: WORD); overload;
procedure gpcColorRGBToHLS(iRed, iGreen, iBlue: BYTE; var iHue, iLuminance, iSaturation: WORD); overload;
procedure gpcColorRGBToHSV(iRed, iGreen, iBlue: BYTE; var iHue, iValue, iSaturation: WORD; iMaxHue, iMaxValue, iMaxSaturation: WORD);
procedure gpcImageRotate(hImage: HDC; iLeft, iTop, iWidth, iHeight: Integer; fpRotate: TZoomFlip);

//myControl.pas
//function gfnrcClientOriginRect(Control: TControl): TRect;
function gfnsAvailableName(sPrefix: String): String;
function gfnsFindComponentNameGet(sPrefix, sName: String): String;

//myGrid.pas
//procedure gpcGridDataClear(AGrid: TStringGrid);
//procedure gpcGridColDataClear(AGrid: TStringGrid; iCol: Integer);

//myApp.pas
//function gfnbFormExists(sName: String): Boolean; overload;
function gfnbFormExists(AForm: TForm): Boolean;  overload;
procedure gpcBoundsSet(AControl: TControl; ARect: TRect);
procedure gpcBringToFront(AWinControl: TWinControl);

//myClipbrd.pas
procedure gpcStrToClipboard(sStr: WideString);
function  gfnsStrFromClipboard: WideString;

//myList.pas
function gfnbIsIncludeList(sValue: String; slList: TStrings): Boolean; overload;
function gfnbIsIncludeList(sValue: String; slList: array of String): Boolean; overload;
procedure gpcDifferenceListGet(AGetList: TStrings; ASrcList, ADiffList: TStrings);

//myMessageBox
//function  gfniMessageBoxYesNo(const sMsg, sTitle: String): Integer;
function  gfniMessageBoxYesNo(sMsg: String; sTitle: String = ''; DefaultButton: TMsgDlgBtn = mbYes): Word;
procedure gpcShowMessage(sMsg: String; sTitle: String = '');

//myString.pas
//var
//	G_Debug : Boolean = False;

function gfnsStrReplace(sSrc, sOld, sNew: WideString): WideString; overload;
function gfnsStrReplace(sSrc, sOld, sNew: WideString; const bCaseSensitive: Boolean): WideString; overload;
function gfnsWideFormat(const sFormat: WideString; const Args: array of const): WideString;
function gfnbIsUnicode(sSrc: WideString): Boolean;
function gfnsWideToAnsi(sSrc: WideString): AnsiString;
function gfnsWideToUtf8(sSrc: WideString): AnsiString;
function gfnsUtf8ToWide(sSrc: AnsiString): WideString;
//AnsiStringとWideStringとの可逆変換関数。
const
	l_csDEFAULT_CHAR = #1;
	l_csPREFIX_CHAR  = '$';
const
	WC_NO_BEST_FIT_CHARS = $00000400;

function gfnsWideToAnsiEx(sSrc: WideString): AnsiString;
function gfnsAnsiToWideEx(sSrc: AnsiString): WideString;

function gfniCanvasTextWidthGet (AFont: TFont; sText: WideString; iCharExtra: Integer = 0): Integer;
function gfniCanvasTextHeightGet(AFont: TFont; sText: WideString; iCharExtra: Integer = 0): Integer;

//myType.pas
function gfnsBoolToStr(const bBool: Boolean): WideString;

//スタイル
function gfnbFlagCheck(iStyle: Longint; iCheck: Longint): Boolean;

//Menu
function gfnbIsMenuVisible(AMenuItem: TMenuItem): Boolean;
function gfniCheckRadioMenuIndexGet(AMenuItem: TMenuItem): Integer;
procedure gpcMenuStripHotKey(AMenuItem: TMenuItem);

//ファイルダイアログ
function gfnbOpenFileDialog(var sFileName: WideString; sDir: WideString; hHandle: HWND): Boolean;


//==============================================================================
implementation
uses
{$IFDEF _DEBUG}
	myDebug,
{$ENDIF}
	ActiveX,
	CommDlg,
	GraphUtil,
	PsAPI,
	RTLConsts,
	TlHelp32,
	ShellAPI,
	StdCtrls,
	MultiMon;


//myWindow.pas -----------------------------------------------------------------
var
	//Dwmapi.dll
	F_hDWMapidllModule : HMODULE;
	F_DwmEnableComposition    : function(uCompositionAction: UINT): HRESULT; stdcall;
	F_DwmIsCompositionEnabled : function(var bBool: BOOL): HResult stdcall;
	F_DwmGetWindowAttribute   : function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall;

	//user32.dll
	F_hUser32dllModule : HMODULE;
	F_LogicalToPhysicalPoint : function(hWindow: HWND; var lpPoint: TPoint): BOOL; stdcall;
	F_PhysicalToLogicalPoint : function(hWindow: HWND; var lpPoint: TPoint): BOOL; stdcall;
	F_GetPhysicalCursorPos   : function(var lpPoint: TPoint): BOOL; stdcall;
	F_SetProcessDPIAware     : function: BOOL; stdcall;

	F_GetLayeredWindowAttributes : function(hwnd: HWND; var crKey: COLORREF; var bAlpha: BYTE; var dwFlags: DWORD): BOOL; stdcall;
	F_SetLayeredWindowAttributes : function(Hwnd: THandle; crKey: COLORREF; bAlpha: Byte; dwFlags: DWORD): Boolean; stdcall;

	//Psapi.dll
	F_hPsapidllModule : HMODULE;
	F_GetProcessImageFileName : function(hProcess: THandle; lpImageFileName: LPWSTR; nSize: DWORD): DWORD; stdcall;

//http://www.delphipraxis.net/159936-form-mit-bssingle-unter-aero-zu-gross.html
const
	DWMWA_EXTENDED_FRAME_BOUNDS = 9;
const
	DWM_EC_DISABLECOMPOSITION = 0;
	DWM_EC_ENABLECOMPOSITION  = 1;

function DwmEnableComposition(uCompositionAction: UINT): HRESULT;
begin
	Result := E_NOTIMPL; //未実装

	if (@F_DwmEnableComposition <> nil)
	then begin
		Result := F_DwmEnableComposition(uCompositionAction);
	end;
end;

function gfnbAeroThemeEnableSet(bEnable: Boolean): Boolean;
//http://www.delphipraxis.net/137018-vista-aero-effekt-deaktiveren.html
//http://msdn.microsoft.com/en-us/library/windows/desktop/aa969510(v=vs.85).aspx
var
	li_Ret  : HResult;
	lb_Aero : Boolean;
begin
	lb_Aero := gfnbIsAeroThemeEnabled;
	if (lb_Aero = bEnable)
	then begin
		Result := True;
Exit;
	end;

	if (bEnable)
	then begin
		li_Ret := DwmEnableComposition(DWM_EC_ENABLECOMPOSITION);
	end
	else
	begin
		li_Ret := DwmEnableComposition(DWM_EC_DISABLECOMPOSITION);
	end;

	Result :=
				(li_Ret = S_OK)
		and gfnbIsAeroThemeEnabled = bEnable;
	;
end;

//function DwmIsCompositionEnabled(var bBool : BOOL) : HResult; stdcall external 'Dwmapi.dll';
function gfnbIsAeroThemeEnabled: Boolean;
var
	lb_Bool : BOOL;
begin
	Result := False;

	if (F_hDwmapidllModule <> 0)
	then begin
		if (@F_DwmIsCompositionEnabled <> nil)
		then begin
			F_DwmIsCompositionEnabled(lb_Bool);
			Result := lb_Bool;
		end;
	end;
end;

function gfnbIsAeroThemeReady: Boolean;
//http://www.delphipraxis.net/137018-vista-aero-effekt-deaktiveren.html
//http://msdn.microsoft.com/en-us/library/windows/desktop/aa969510(v=vs.85).aspx
begin
	Result := (@F_DwmEnableComposition <> nil);
end;

function gfnbIsAlphaBlendReady: Boolean;
begin
	Result := (@F_SetLayeredWindowAttributes <> nil);
end;

//http://www.delphipraxis.net/142052-getlayeredwindowattributes-funktioniert-nicht-noch-resize.html
//function GetLayeredWindowAttributes(hwnd: HWND; var crKey: COLORREF; var bAlpha: BYTE; var dwFlags: DWORD): BOOL; stdcall; external user32 name 'GetLayeredWindowAttributes';
function GetLayeredWindowAttributes(hHandle: HWND; var crKey: COLORREF; var bAlpha: BYTE; var dwFlags: DWORD): Boolean;
{2015-03-10:
}
begin
	Result := False;

	if (@F_GetLayeredWindowAttributes <> nil)
	then begin
		Result := F_GetLayeredWindowAttributes(hHandle, crKey, bAlpha, dwFlags);
	end;
end;

function gfniThreadIDGet(hHandle: HWND): DWORD;
var
	li_PID : DWORD;
begin
	Result := GetWindowThreadProcessId(hHandle, @li_PID);
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 := WideString(lp_Buff) + '\';
			end;
		finally
			FreeMem(lp_Buff);
		end;
	end;
end;


function gfniMonitorIndexGet(APoint: TPoint): Integer;
{2011-09-02:
モニターのインデックスを取得。
APointはスクリーン座標であること。
}
var
	i : Integer;
begin
	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;

function gfnMonitorGet(APoint: TPoint): TMonitor;
{2011-09-02:
APointのあるモニターを取得
}
var
	li_Index : Integer;
begin
	li_Index := gfniNumLimit(gfniMonitorIndexGet(APoint), 0, Screen.MonitorCount -1);
	Result   := Screen.Monitors[li_Index];
end;

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

function GetPhysicalCursorPos(var lpPoint: TPoint): BOOL;
begin
	if (@F_GetPhysicalCursorPos = nil)
	then begin
		Result := GetCursorPos(lpPoint);
	end
	else
	begin
		Result := F_GetPhysicalCursorPos(lpPoint);
	end;
end;

function gfnptPhysicalCursorPosGet: TPoint;
begin
	Result := Point(0, 0);
	GetPhysicalCursorPos(Result);
end;

function gfnptClientMousePosGet(hHandle: HWND): TPoint;
{2008-12-04:
現在のマウスカーソルの位置をウィンドウのクライアント座標で返す。
}
begin
	Result := gfnptMousePosGet;
	Windows.ScreenToClient(hHandle, Result);
end;

function gfnbKeyState(iKey: Integer): Boolean;
var
	li_Check: SHORT;
begin
	//左右ボタンを入れ替えている場合に対処
	if (GetSystemMetrics(SM_SWAPBUTTON) <> 0)
	then begin
		if (iKey = VK_LBUTTON)
		then begin
			iKey := VK_RBUTTON;
		end
		else
		if (iKey = VK_RBUTTON)
		then begin
			//2009-02-04:VK_RUBTTONとしたままだったのを修正。
			iKey := VK_LBUTTON;
		end;
	end;

	li_Check := GetAsyncKeyState(iKey);
	//Result := BOOL(Hi(li_Check)) and (BOOL(Lo(li_Check)));
	Result := BOOL(Hi(li_Check));
end;

function gfnbKeyStateAnd(iKeys: array of Integer): Boolean;
var
	i :integer;
begin
	Result := False;
	for i := 0 to High(iKeys)
	do begin
		if not(gfnbKeyState(iKeys[i]))
		then begin
Exit;
		end;
	end;
	Result := True;
end;

function gfnsClassNameGet(hHandle: HWND): WideString;
//ウィンドウハンドルhHandleのクラス名を返す
const
	lci_LEN = 256;
var
	lp_Buff: PWideChar;
begin
	Result := '';
	lp_Buff:= AllocMem((lci_LEN +1) * SizeOf(WideChar));
	try
		GetClassNameW(hHandle, lp_Buff, lci_LEN -1);
		Result := WideString(lp_Buff);
	finally
		FreeMem(lp_Buff);
	end;
end;

function gfnsWindowTextGetW(hHandle: HWND): WideString;
var
	li_Len   : DWORD;
	lp_Buff  : PWideChar;
//	ls_Text  : WideString;
	li_Index : DWORD;
	li_Style : Longint;
	li_Ret   : DWORD;
begin
	Result := '';
	li_Ret := 0;

	li_Len := GetWindowTextLengthW(hHandle);

	if (li_Len > 0)
	then begin
		Inc(li_Len);
		lp_Buff := AllocMem((li_Len) * SizeOf(WideChar));
		try
			li_Ret := GetWindowTextW(hHandle, lp_Buff, li_Len);
			Result := WideString(lp_Buff);
		finally
			FreeMem(lp_Buff);
		end;

		if (li_Ret > 0)
		then begin
Exit;
		end;
	end;

	//リストボックスがオーナードローでスタイルにLBS_HASSTRINGSがないと文字列は取得できない(文字化けすることがある)
	li_Style := GetWindowLong(hHandle, GWL_STYLE);

	if (gfnbFlagCheck(li_Style, LBS_OWNERDRAWFIXED))
	or (gfnbFlagCheck(li_Style, LBS_OWNERDRAWVARIABLE))
	then begin
		if not(gfnbFlagCheck(li_Style, LBS_HASSTRINGS))
		then begin
Exit;
		end;
	end;

//他のアプリケーションのエディットボックス用。
	if (SendMessageTimeoutW(hHandle, WM_GETTEXTLENGTH, 0, 0, SMTO_ABORTIFHUNG, 500, li_Len) <> 0)
	then begin
		if (li_Len > 0)
		then begin
			Inc(li_Len);
			lp_Buff := AllocMem(li_Len * SizeOf(WideChar));
			try
				if (SendMessageTimeoutW(hHandle, WM_GETTEXT, WPARAM(li_Len), LPARAM(lp_Buff), SMTO_ABORTIFHUNG, 500, li_Ret) <> 0)
				then begin
					Result := WideString(lp_Buff);
				end;
			finally
				FreeMem(lp_Buff);
			end;

			if (li_Ret > 0)
			then begin
Exit;
			end;
		end;
	end;

//リストボックス用。
	//現在の選択行を取得。
	if (SendMessageTimeoutW(hHandle, LB_GETCURSEL, 0, 0, SMTO_ABORTIFHUNG, 500, li_Index) <> 0)
	then begin
		if (li_Index = DWORD(LB_ERR))
		then begin
			li_Index := 0;
		end;
	end
	else
	begin
		li_Index := 0;
	end;

	if (SendMessageTimeoutW(hHandle, LB_GETTEXTLEN, li_Index, 0, SMTO_ABORTIFHUNG, 500, li_Len) <> 0)
	then begin
		//エラーでなく文字数が0より大きければ(1以上なら)処理に入る
		if  (li_Len <> DWORD(LB_ERR))
		and (li_Len > 0)
		then begin
			Inc(li_Len);
			lp_Buff := AllocMem((li_Len +1) * SizeOf(WideChar));
			try
				if (SendMessageTimeoutW(hHandle, LB_GETTEXT, WPARAM(li_Index), LPARAM(lp_Buff), SMTO_ABORTIFHUNG, 500, li_Ret) <> 0)
				then begin
					Result := WideString(lp_Buff);
				end;
			finally
				FreeMem(lp_Buff);
			end;

			if (li_Ret > 0)
			then begin
Exit;
			end;
		end;
	end;

//コンボボックス用
	if ((li_Style and CBS_OWNERDRAWFIXED)    = LBS_OWNERDRAWFIXED)
	or ((li_Style and CBS_OWNERDRAWVARIABLE) = LBS_OWNERDRAWVARIABLE)
	then begin
		if not((li_Style and CBS_HASSTRINGS) = CBS_HASSTRINGS)
		then begin
Exit;
		end;
	end;

	if (SendMessageTimeoutW(hHandle, CB_GETCURSEL, 0, 0, SMTO_ABORTIFHUNG, 500, li_Index) <> 0)
	then begin
		if (li_Index = DWORD(CB_ERR))
		then begin
			li_Index := 0;
		end;
	end;

	if (SendMessageTimeoutW(hHandle, CB_GETLBTEXTLEN, li_Index, 0, SMTO_ABORTIFHUNG, 500, li_Len) <> 0)
	then begin
		if  (li_Len <> DWORD(CB_ERR))
		and (li_Len > 0)
		then begin
			Inc(li_Len);
			lp_Buff := AllocMem(li_Len * SizeOf(WideChar));
			try
				if (SendMessageTimeoutW(hHandle, CB_GETLBTEXT, WPARAM(li_Index), LPARAM(lp_Buff), SMTO_ABORTIFHUNG, 500, li_Ret) <> 0)
				then begin
					Result := WideString(lp_Buff);
				end;
			finally
				FreeMem(lp_Buff);
			end;

			if (li_Ret > 0)
			then begin
Exit;
			end;
		end;
	end;
end;
function gfnsWindowTextGet(hHandle: HWND): WideString;
//ウィンドウハンドルhHandleのテキスト(キャプション)を返す
begin
	Result := gfnsWindowTextGetW(hHandle);

//4000文字を超えるあたりからWideFormatで深刻なエラーになる。
//	Result := Copy(Result, 1, G_ciMAXTEXTLEN);
end;

function gfnptScreenToClient(hHandle: HWND; ptPos: TPoint): TPoint;
{2009-03-08:
ptPosをhHandleのウィンドウのクライアント座標で返す。
}
//var
//	l_Rect : TRect;
begin
	Result := ptPos;
	if (IsWindow(hHandle))
	then begin
		Windows.ScreenToClient(hHandle, Result);
	end;
{
//何故↑でなくこんなやり方にしたのか分からない…
	if (IsWindow(hHandle))
	then begin
		l_Rect := gfnrcWindowRectGet(hHandle);
		Result.X := ptPos.X - l_Rect.Left;
		Result.Y := ptPos.Y - l_Rect.Top;
	end
	else
	begin
		Result.X := ptPos.X;
		Result.Y := ptPos.Y;
	end;
}
end;


//function DwmGetWindowAttribute(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall; external 'Dwmapi.dll';
function gfnrcDwmWindowRectGet(hHandle: HWND): TRect;
{2013-11-17:
}
var
	li_Ret : HRESULT;
begin
	li_Ret := E_NOTIMPL;
	Result := Rect(0, 0, 0, 0);

	if (@F_DwmGetWindowAttribute <> nil)
	then begin
		li_Ret := F_DwmGetWindowAttribute(
			hHandle,
			DWMWA_EXTENDED_FRAME_BOUNDS,
			@Result,
			SizeOf(TRect)
		);
	end;

	//DwmGetWindowAttribute APIはトップレベルウィンドウ以外では失敗する。
	if (li_Ret <> S_OK)
	then begin
		GetWindowRect(hHandle, Result);
	end;
end;

function gfnrcWindowRectGet(hHandle: HWND): TRect;
{2008-12-31:
ウィンドウのRectを返す。
}
begin
	Result := Rect(0, 0, 0, 0);

	if (gfnbIsAeroThemeEnabled)
	then begin
		Result := gfnrcDwmWindowRectGet(hHandle);
	end
	else
	begin
		GetWindowRect(hHandle, Result);
	end;
end;

// LogicalToPhysicalPoint ------------------------------------------------------
function LogicalToPhysicalPoint(hWindow: HWND; var lpPoint: TPoint): Boolean;
begin
	Result := False;

	if (@F_LogicalToPhysicalPoint <> nil)
	then begin
		Result := F_LogicalToPhysicalPoint(hWindow, lpPoint);
	end;
end;

// PhysicalToLogicalPoint ------------------------------------------------------
function PhysicalToLogicalPoint(hWindow: HWND; var lpPoint: TPoint): Boolean;
begin
	Result := False;

	if (@F_PhysicalToLogicalPoint <> nil)
	then begin
		Result := F_PhysicalToLogicalPoint(hWindow, lpPoint);
	end;
end;

function gfnptPhysicalToLogicalPoint(hHandle: HWND; ptPos: TPoint): TPoint;
begin
	Result := ptPos;
	PhysicalToLogicalPoint(hHandle, Result);
end;

function gfnrcPhysicalWindowRectGet(hHandle: HWND): TRect;
begin
	Result := gfnrcWindowRectGet(hHandle);

	if (LogicalToPhysicalPoint(hHandle, Result.TopLeft))
	then begin
		LogicalToPhysicalPoint(hHandle, Result.BottomRight);
	end;
end;

function gfnrcLogicalWindowRectGet(hHandle: HWND): TRect;
begin
	Result := gfnrcWindowRectGet(hHandle); //物理座標

	if (PhysicalToLogicalPoint(hHandle, Result.TopLeft))
	then begin
		PhysicalToLogicalPoint(hHandle, Result.BottomRight);
	end;
end;

function SetProcessDPIAware: Boolean;
begin
	if (@F_SetProcessDPIAware <> nil)
	then begin
		Result := F_SetProcessDPIAware;
	end
	else
	begin
		Result := False;
	end;
end;

function gfnrcClientRectGet(hHandle: HWND): TRect;
begin
	if not(GetClientRect(hHandle, Result)) then begin
		FillChar(Result, SizeOf(Result), 0);
	end;
end;

function gfnrcRectMove(rcRect: TRect; iX, iY: Integer): TRect;
{2009-09-09:
rcRectのLeftをiXに、TopをiYにしたRectを返す。
gfnrcRectShiftとの違いはiX,iYの分移動するのではなく、iX,iYへ移動すること。
}
begin
	with rcRect do begin
		Result := Rect(iX, iY, Right - (Left - iX), Bottom - (Top - iY));
	end;
end;
function gfnrcRectMove(rcRect: TRect; ptPos: TPoint): TRect;
begin
	Result := gfnrcRectMove(rcRect, ptPos.X, ptPos.Y);
end;
function gfnrcOriginRect(AControl: TControl): TRect;
{2008-06-02:
コントロールのBoundsRectをスクリーン座標で返す
}
begin
	Result := gfnrcRectMove(AControl.ClientRect, AControl.ClientOrigin);
end;

function gfnhParentWindowGet(hHandle: HWND): HWND;
//親ウィンドウのウィンドウハンドルを返す
begin
	Result := GetAncestor(hHandle, GA_PARENT);  //親ウィンドウ。hHandleがトップレベルウィンドウの場合GetDesktopWindowの値が返る
//	Result := GetParent(hHandle);
end;

function gfnhToplevelWindowGet(hHandle: HWND): HWND;
{2007-06-12:
トップレベルウィンドウを返す。
}
begin
	Result := GetAncestor(hHandle, GA_ROOT);
end;

function gfniProcessIDGet(hHandle: HWND): DWORD;
begin
	GetWindowThreadProcessId(hHandle, @Result);
end;


//function GetProcessImageFileNameW(hProcess: THandle; lpImageFileName: LPWSTR; nSize: DWORD): DWORD; stdcall; external 'Psapi.dll';
function gfnsExeNameGet(hHandle: HWND): WideString;
{2007-12-11:
ウィンドウハンドルから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
}
var
	lh_Process : THandle;
	lp_Buff    : PWideChar;

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

//	lh_Module : HMODULE;
//	l_GetProcessImageFileName : TGetProcessImageFileName;
begin
	Result := '-';

	lh_Process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, gfniProcessIDGet(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
				if (@F_GetProcessImageFileName <> nil)
				then begin
					F_GetProcessImageFileName(lh_Process, lp_Buff, MAX_PATH);
					Result := WideString(lp_Buff);

					li_Drives := GetLogicalDrives;
					li_Flag   := 1;
					for i := Ord('A') to Ord('Z')
					do begin
						if ((li_Drives and li_Flag) <> 0)
						then begin
							lp_Device := AllocMem((MAX_PATH +1) * SizeOf(WideChar));
							try
								ls_Drv    := Char(i) + ':';
								QueryDosDeviceW(PWideChar(ls_Drv), lp_Device, MAX_PATH);
								ls_Device := WideString(lp_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;
		finally
			FreeMem(lp_Buff);
		end;
	finally
		CloseHandle(lh_Process);
	end;
end;


//myNum.pas --------------------------------------------------------------------
procedure gpcVal(S: WideString; var V: Int64; var Code: Integer); overload;
var
	ls_Num : WideString;
	li_Pos : Integer;
begin
	Val(S, V, Code);
	if (Code > 0) then
	begin
		ls_Num := Copy(S, 1, Code -1);
		Val(ls_Num, V, li_Pos);
	end;
end;
procedure gpcVal(S: WideString; var V: Integer; var Code: Integer); overload;
var
	ls_Num : WideString;
	li_Pos : Integer;
begin
	Val(S, V, Code);
	if (Code > 0) then
	begin
		ls_Num := Copy(S, 1, Code -1);
		Val(ls_Num, V, li_Pos);
	end;
end;

function gfniStrToInt(sNum: WideString): Int64;
{2007-10-18,2008-02-13,2009-01-16:
sNumを整数にして返す。

2009-01-19:戻り値をInt64に変更。この時StrToInt64の'x'の扱いがStrToIntと違うことへ対処。
2008-02-13:16進に対応。
}
var
	li_Pos, i: Integer;
	ls_Tmp: AnsiString;
	li_Err: Integer;
begin
	sNum := WideUpperCase(Trim(sNum));

	gpcVal(sNum, Result, li_Err);
	if (li_Err = 0)
	then begin
Exit;
	end;

	ls_Tmp := '';
	for i := 1 to Length(sNum)
	do begin
		li_Pos := Pos(sNum[i], '$X-+, 0123456789ABCDEF');
		if (li_Pos >= 17)
		then begin
			//'A..F'
			if  (ls_Tmp <> '')
			and (ls_Tmp[1] = '$')
			then begin
				ls_Tmp := ls_Tmp + sNum[i];
			end
			else
			begin
				//頭に'$'を付け加えて変換できるようにする
				//頭に$がないと16進表記はエラーになるのでそれへの対処
				ls_Tmp := '$' + ls_Tmp + sNum[i];
			end;
		end
		else
		if (li_Pos >= 7)
		then begin
			//'0..9'
			ls_Tmp := ls_Tmp + sNum[i];
		end
		else
		if ((li_Pos = 1) or (li_Pos = 2)) and (ls_Tmp = '')
		then begin
			//'$', 'X'
			//16進表記
			ls_Tmp := '$';	//'x'や'X'ではだめ
		end
		else
		if  ((li_Pos = 3) or (li_Pos = 4))
		and (ls_Tmp = '')
		then begin	//and (i = 1) でもよい
			//'-', '+'
			//sNum[i]は'-+'のどちらか
			ls_Tmp := sNum[i];
		end
		else
		if (li_Pos = 5)
		then begin
			//','は無視。
		end
		else
		if (li_Pos = 6)
		then begin
			//' 'は行頭なら無視、途中ならそこまで
			if (ls_Tmp <> '')
			then begin
	Break;
			end;
		end
		else
		begin
	Break;
		end;
	end;

	if (ls_Tmp = '')
	then begin
		Result := 0;
	end;
end;

function gfniRound(fNum: Extended): Int64;
{2007-06-09:
fNumを四捨五入して返す
Delphiのヘルプからコピー
}
begin
	if (fNum >= 0) then begin
		Result := Trunc(fNum + 0.5);
	end else begin
		Result := Trunc(fNum - 0.5);
	end;
end;

function lfniCeil(X: Extended): Int64;
begin
	Result := Trunc(X);
	if Frac(X) > 0 then
		Inc(Result);
end;

function lfniFloor(X: Extended): Int64;
begin
	Result := Trunc(X);
	if Frac(X) < 0 then
		Dec(Result);
end;

function gfniRoundUp(fNum: Extended): Int64;
{2007-06-09:
fNumを切り上げて返す
}
begin
	if (fNum >= 0) then begin
		Result := lfniCeil(fNum);
	end else begin
		Result := lfniFloor(fNum);
	end;
end;

function gfniNumLimit(iNum: Integer; iMin, iMax: Integer): Integer;
begin
	if (iMin = iMax) then begin
		Result := iMin;
	end else begin
		if (iNum < iMin) then begin
			Result := iMin;
		end else if (iNum > iMax) then begin
			Result := iMax;
		end else begin
			Result := iNum;
		end;
	end;
end;

function gfniNumLoop(iNum: Integer; iMin, iMax: Integer): Integer;
{2007-10-05,28:
iNum := gfniNumLoop(5, 2, 5); //⇒5
iNum := gfniNumLoop(6, 2, 5); //⇒2
iNum := gfniNumLoop(7, 2, 5); //⇒3
２→３→４→５
↑←←←←←↓
2007-10-28:間違っていたので書き直し
}
var
	li_Diff, li_Interval: Integer;
begin
	if (iMin = iMax) then begin
		Result := iMin;
	end else begin
		li_Interval := iMax - iMin +1;	//間隔
		if (iNum < iMin) then begin
			li_Diff := Abs(iNum - iMin);
			Result  := iMax - (li_Diff mod li_Interval) +1;
		end else if (iNum > iMax) then begin
			li_Diff := iNum - iMax;
			Result  := iMin + (li_Diff mod li_Interval) -1;
		end else begin
			Result := iNum;
		end;
	end;
end;

function gfniMax(iNum: array of Integer): Integer;
{2007-08-27:
引数の中の最大値を返す
}
var
	i: Integer;
begin
	Result := iNum[0];
	for i := 1 to High(iNum) do begin
		if (iNum[i] > Result) then Result := iNum[i];
	end;
end;

function gfniMin(iNum: array of Integer): Integer;
{2007-12-16:
引数の中の最小値を返す
}
var
	i: Integer;
begin
	Result := iNum[0];
	for i := 1 to High(iNum) do begin
		if (iNum[i] < Result) then Result := iNum[i];
	end;
end;

function gfnbIsInsideRange(iNum, iMin, iMax: Integer): Boolean;
{2010-07-13:
}
begin
	Result := (iNum >= iMin) and (iNum <= iMax);
end;


//mySize.pas -------------------------------------------------------------------
function gfniRectWidth (rtRect: TRect): Integer;
{2007-06-09:
rtRectの幅を返す
}
begin
	with rtRect do begin
		Result := Right - Left;
	end;
end;

function gfniRectHeight(rtRect: TRect): Integer;
{2007-06-09:
rtRectの高さを返す
}
begin
	with rtRect do begin
		Result := Bottom - Top;
	end;
end;

function gfnrcRectCenter(rcParent, rcChild: TRect): TRect;
{2007-09-26:
rcChildがrcParentの真ん中にくるようなRectを返す
}
var
	li_Left, li_Top, li_Width, li_Height: Integer;
begin
	li_Width  := gfniRectWidth (rcChild);
	li_Height := gfniRectHeight(rcChild);
	li_Left   := rcParent.Left + (gfniRectWidth (rcParent) - li_Width)  div 2;
	li_Top    := rcParent.Top  + (gfniRectHeight(rcParent) - li_Height) div 2;

	Result := Rect(li_Left, li_Top, li_Left + li_Width, li_Top + li_Height);
end;

function gfnrcRectShift(rcRect: TRect; ptShift: TPoint): TRect;
{2007-09-27:
rcRectをptPoint移動した値を返す
}
begin
	with rcRect do begin
		Result := Rect(Left + ptShift.X, Top + ptShift.Y, Right + ptShift.X, Bottom + ptShift.Y);
	end;
end;

function gfnbCompleteRectInRect(rcCheck, rcRect: TRect): Boolean;
//rcCheckが完全にrcRect内にあればTrueを返す
begin
	if  (rcCheck.Left   >= rcRect.Left)
	and (rcCheck.Right  <= rcRect.Right)
	and (rcCheck.Top    >= rcRect.Top)
	and (rcCheck.Bottom <= rcRect.Bottom)
	then begin
		Result := True;
	end else begin
		Result := False;
	end;
end;

function gfnrcMinRect(rcRect: array of TRect): TRect;
//rcRectの重なる部分の一番狭い領域を返す。
var
	i: Integer;
begin
	Result := rcRect[0];
	for i := 1 to High(rcRect) do begin
		Result.Left   := gfniMax([Result.Left,   rcRect[i].Left]);
		Result.Top    := gfniMax([Result.Top,    rcRect[i].Top]);
		Result.Right  := gfniMin([Result.Right,  rcRect[i].Right]);
		Result.Bottom := gfniMin([Result.Bottom, rcRect[i].Bottom]);
	end;
	if (Result.Right  < Result.Left) then Result.Right  := Result.Left;
	if (Result.Bottom < Result.Top)  then Result.Bottom := Result.Top;
end;


function gfnbRectInRect(rcCheck, rcRect: TRect): Boolean;
{2010-02-11:
rcRect1とrcRect2が重なっていればTrue
}
var
	lrc_Rect: TRect;
begin
	Result := False;

	lrc_Rect := gfnrcMinRect([rcCheck, rcRect]);
	if (gfniRectWidth (lrc_Rect) = 0)
	or (gfniRectHeight(lrc_Rect) = 0)
	then begin
Exit;
	end;

	Result := True;
{
	if (rcCheck.Left   >= rcRect.Left)
	or (rcCheck.Right  <= rcRect.Right)
	or (rcCheck.Top    >= rcRect.Top)
	or (rcCheck.Bottom <= rcRect.Bottom)
	then begin
		Result := True;
	end else begin
		Result := False;
	end;
}
end;


function gfniAngleGet(ptStart, ptPos: TPoint): Integer;
{
ptStartを原点してptPosがどの方向（角度）にあるかを返す
ptPosがptStartからダブルクリックで許容される範囲(の三倍)内にあれば-1を返す。
それ以外は0〜359の角度を返す。
http://nkiso.u-tokai.ac.jp/phys/matsuura/lecture/dyna/contents/triangle/triangle.asp
}
const
	lci_NOMOVE = 3;	//マウスジェスチャーとして認識しない範囲
var
	li_X, li_Y: Integer;
begin
	li_X := ptPos.X   - ptStart.X;
	li_Y := ptStart.Y - ptPos.Y;  //数学の座標とはY軸が逆なので反対にしている

	//ダブルクリックの範囲のlci_NOMOVE倍内であれば動いていないとみなす
	if (Abs(li_X) <= (GetSystemMetrics(SM_CXDOUBLECLK) * lci_NOMOVE)) then li_X := 0;
	if (Abs(li_Y) <= (GetSystemMetrics(SM_CYDOUBLECLK) * lci_NOMOVE)) then li_Y := 0;

	if (li_X = 0) then begin
		if (li_Y = 0) then begin
			Result := -1;
		end else if (li_Y > 0) then begin
			Result := 90;
		end else begin
			Result := 270;
		end;
	end else if (li_Y = 0) then begin
		if (li_X > 0) then begin
			Result := 0;
		end else begin
			Result := 180;
		end;
	end else begin
		Result := gfniRound(Arctan(li_Y / li_X) * (360 / (2 * Pi)));	//Arctanはラジアン単位なので度に直す
		if (li_X > 0) and (li_Y > 0) then begin
			//第一象限
			//そのまま
		end else if (li_X < 0) and (li_Y > 0) then begin
			//第二象限
			Inc(Result, 180);	//第四象限と同じ値が出るのでプラス180度
		end else if (li_X < 0) and (li_Y < 0) then begin
			//第三象限
			Inc(Result, 180);	//第一象限と同じ値が出るのでプラス180度
		end else {if (li_X < 0) and (li_Y > 0) then }begin
			//第四象限
			Inc(Result, 360);	//マイナスの角度が出るのでぐるっと360度足しこむ
		end;
	end;
end;

function gfnsCompasGet(ptStart, ptPos: TPoint): String;
//上下左右を返す。
var
	li_Angle: Integer;
begin
	li_Angle := gfniAngleGet(ptStart, ptPos);
	case li_Angle of
		 -1:      Result := '';
			0.. 45: Result := 'Right';
		 46..135: Result := 'Up';
		136..225: Result := 'Left';
		226..315: Result := 'Down';
		316..359: Result := 'Right';
		else      Result := '';	//保険
	end;
end;

// myMonitor.pas ---------------------------------------------------------------
function gfnhMonitorFromRect(rcRect: TRect): HMONITOR;
//rcRectの領域があるモニターのモニターハンドルを返す。
begin
	Result := MultiMon.MonitorFromRect(@rcRect, MONITOR_DEFAULTTONEAREST);
end;
function gfnrcMonitorWorkAreaRectGet(hHandle: HMONITOR): TRect; overload;
//モニターのワークエリアを返す。
var
	lr_Info: TMonitorInfo;
begin
	lr_Info.cbSize := SizeOf(lr_Info);
	GetMonitorInfo(hHandle, @lr_Info);
	Result := lr_Info.rcWork;
end;
function gfnrcMonitorWorkAreaRectGet(rcRect: TRect): TRect; overload;
//rcRectの領域のあるモニターのワークエリアを返す。
begin
	Result := gfnrcMonitorWorkAreaRectGet(gfnhMonitorFromRect(rcRect));
end;

procedure gpcSetMonitorBounds(AForm: TCustomForm; ARect: TRect);
var
	lrc_WorkAreaRect  : TRect;
	li_Left           : Integer;
	li_Top            : Integer;
	li_FormWidth      : Integer;
	li_FormHeight     : Integer;
	li_WorkAreaWidth  : Integer;
	li_WorkAreaHeight : Integer;
begin
	li_FormWidth  := gfniRectWidth(ARect);
	li_FormHeight := gfniRectHeight(ARect);

	lrc_WorkAreaRect  := gfnrcMonitorWorkAreaRectGet(ARect);
	li_WorkAreaWidth  := gfniRectWidth(lrc_WorkAreaRect);
	li_WorkAreaHeight := gfniRectHeight(lrc_WorkAreaRect);

	if (li_FormWidth >= li_WorkAreaWidth)
	then begin
		li_Left := lrc_WorkAreaRect.Left;
	end
	else
	begin
		li_Left := gfniNumLimit(ARect.Left, lrc_WorkAreaRect.Left, lrc_WorkAreaRect.Left + li_WorkAreaWidth - li_FormWidth);
	end;

	if (li_FormHeight >= li_WorkAreaHeight)
	then begin
		li_Top := lrc_WorkAreaRect.Top;
	end
	else
	begin
		li_Top := gfniNumLimit(ARect.Top, lrc_WorkAreaRect.Top, lrc_WorkAreaRect.Top + li_WorkAreaHeight - li_FormHeight);
	end;

	AForm.BoundsRect := Rect(li_Left, li_Top, li_Left + li_FormWidth, li_Top + li_FormHeight);
end;


//myFile.pas -------------------------------------------------------------------
function gfnsFilePathGet(sFile: WideString): WideString;
//Unicode対応ExtractFilePath。
var
	i: Integer;
begin
//末尾の'\'がつくかつかないの法則が揺れると困るので処理を分けず独自関数のみにする
//	if (G_bIsNTOS) then begin
		Result := '';
		if (sFile <> '') then begin
			for i := Length(sFile) downto 1 do begin
				if (sFile[i] = '\') or (sFile[i] = '/') then begin
					Result := Copy(sFile, 1, i);
					Break;
				end else if (sFile[i] = ':') then begin
					Result := Copy(sFile, 1, i) + '\';
					Break;
				end;
			end;
		end;
//	end else begin
//		Result := ExtractFilePath(sFile);
//	end;
end;

(*
function gfnsShortFileNameGet(sFile: WideString): WideString;
{
Unicode対応の短いファイル名を返す。
戻り値がStringでないことに注意。
Unicode非対応のコンポーネントにファイルを渡すときの（完全ではないけれど）逃げ道。
}
var
	lp_Buff: PWideChar;
begin
	Result := sFile;

	lp_Buff := AllocMem((MAX_PATH + 1) * 2);
	try
		if (GetShortPathNameW(PWideChar(sFile), lp_Buff, (MAX_PATH + 1) * 2) > 0) then begin
			Result := WideString(lp_Buff);
		end;
	finally
		FreeMem(lp_Buff);
	end;
end;

function gfnsWorkFileNameGet(sExt : WideString): WideString;
//テンポラリファイル名として自身のファイル名の拡張子をsExtに変更して返す。
//主ファイル名にUnicodeな文字が入っていたらAnsiStringに変換し'?'を'_'に変更する。
//Unicode対応でない他のアプリへの対処
var
	ls_FullPath : WideString; //ファイル名も含めたフルパス
	ls_Path     : WideString;
	ls_Main     : WideString; //主ファイル名
	li_Len      : Integer;
begin
	if (sExt[1] <> '.')
	then begin
		sExt := '.' + sExt;
	end;

	ls_FullPath := gfnsExeNameGet;
	ls_Path     := gfnsFilePathGet(ls_FullPath);
	ls_Main     := gfnsFileExtChange(gfnsFileNameGet(ls_FullPath), '');
	if (gfnbIsUnicode(ls_FullPath))
	then begin
//			ls_Main := gfnsStrReplace(ls_Main, '?', '_');
//			if (gfnbIsUnicode(ls_Path))
//			then begin
			li_Len := Length(ls_Main);
			if (li_Len <= 8)
			then begin
				ls_Main := ls_Main + StringOfChar('_', 8 - li_Len +1);
			end;
//			end;
		Result := ls_Path + ls_Main + sExt;
	end
	else
	begin
		Result := gfnsFileExtChange(ls_FullPath, sExt);
	end;
end;
*)

function gfnsFileNameGet(sFile: WideString): WideString;
var
	i, li_Len, li_Pos: Integer;
begin
	Result := '';
	if (sFile <> '') then begin
		li_Len := Length(sFile);
		li_Pos := li_Len + 1;	//sFileの最後が'\'であった場合への対策
		for i := li_Len downto 1 do begin
			if (sFile[i] = '\') or (sFile[i] = '/') or(sFile[i] = ':') then begin
				Break;
			end;
			li_Pos := i;
		end;
		Result := Copy(sFile, li_Pos, MaxInt);
	end;
end;

function gfnsFileExtGet(sFile: WideString): WideString;
{2007-08-05,2008-12-27:
Unicode対応ExtractFileExt。
'.'は返る

2008-12-27:'.'のないファイル名のみの場合sFileすべてを返してしまう間違いを修正。
}
var
	i: Integer;
begin
	Result := '';
	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] = '.')
		then begin
			//拡張子あり
			Result := Copy(sFile, i, MaxInt);
	Break;
		end;
	end;
end;

function gfnsFileExtChange(sFile, sExt: WideString): WideString;
var
	i: Integer;
begin
	Result := '';

	if (sExt <> '') and (sExt[1] <> '.') then begin
		//sExtが''だった時は拡張子削除。
		//それ以外はピリオドがなければつけたす。
		sExt := '.' + sExt;
	end;

	for i := Length(sFile) downto 1 do begin
		if (sFile[i] = '\') or (sFile[i] = ':') then begin
			//拡張子なし
	Break;
		end else if (sFile[i] = '.') then begin;
			//拡張子あり
			if (i > 1) then begin
				Result := Copy(sFile, 1, i -1) + sExt;
			end else begin
				Result := sExt;
			end;
Exit;
		end;
	end;

	//sFileに拡張子があればここにはこない(↑でExitしている)
	Result := sFile + sExt;
end;

function gfnsExeNameGet: WideString;
//WideString対応の自身の実行プログラム名を返す。
begin
	Result := gfnsExeNameGet(Application.Handle);
end;

function gfnbFileExists(sFile: WideString): Boolean;
var
	li_Attr: DWORD;
begin
	Result := False;
	if (sFile = '') then begin
Exit;
	end;

	li_Attr := GetFileAttributesW(PWideChar(sFile));
	Result  := (li_Attr <> $FFFFFFFF) and ((li_Attr and FILE_ATTRIBUTE_DIRECTORY) = 0);
end;

function gfniFileSizeGet(hHandle: THandle): Int64;
{2008-03-11:
hHandleのファイルハンドルを持つファイルのサイズをByte単位で返す
}
var
	li_High, li_Low: DWORD;
begin
	if (hHandle <> INVALID_HANDLE_VALUE) then begin
		li_Low := GetFileSize(hHandle, @li_High);
		Result := li_High * (Int64(MAXDWORD) +1) + li_Low;
	end else begin
		Result := 0;
	end;
end;


var
	lhPIDToWindowHandle: HWND;
function gfnhPIDToWindow(iProcessID: DWORD): HWND;
{2010-07-29:
PIDからトップレベルウィンドウのウィンドウハンドルを返す。
}
	function l_fnbEnumWindowProc(hHandle: HWND; iParam: LPARAM): BOOL; stdcall;
	//戻り値はBooleanではなくBOOLである必要あり
	begin
		if (gfniProcessIDGet(hHandle) = DWORD(iParam)) then begin
			lhPIDToWindowHandle := hHandle;
			Result := False;
		end else begin
			Result := True;
		end;
	end;
begin
	lhPIDToWindowHandle := 0;
	EnumWindows(@l_fnbEnumWindowProc, iProcessID);
	Result := lhPIDToWindowHandle;
end;

function gfnhProcessToWindow(hProcess : THandle) : HWND;
{2010-04-03:
プロセスのハンドルからプロセスのトップレベルウィンドウのハンドルを取得して返す。
トップレベルウィンドウが複数ある場合は一番手前にあるウィンドウのハンドルが返る。
実行ファイルのウィンドウハンドルを取得する場合は実行後WaitForInputIdleで初期化処
理を終了するまで待ってからでないと取得に失敗する。
}
var
	lh_Handle  : THandle;
	lh_SelfPID : DWORD;
	l_Info     : TProcessEntry32;
begin
	Result := 0;

	FillChar(l_Info, SizeOf(l_Info), 0);
	l_Info.dwSize := Sizeof(l_Info);

	lh_Handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, hProcess);
	try
		if (Process32First(lh_Handle, l_Info)) then begin
			lh_SelfPID := gfniProcessIDGet(Application.Handle);
			repeat
//myDebug.gpcDebug([WideString(l_Info.szExeFile), l_Info.th32ParentProcessID, gfniProcessIDGet(Self.Handle)]);
				if (l_Info.th32ParentProcessID = lh_SelfPID) then begin
					Result := gfnhPIDToWindow(l_Info.th32ProcessID);
				end;
			until not(Process32Next(lh_Handle, l_Info));
		end;
	finally
		CloseHandle(lh_Handle);
	end;
end;

function gfnhExecute(sFile: WideString): HWND;
{2007-10-04,2011-06-23:
sFileを実行して実行されたプログラムを前面に表示させる
}
var
	l_InfoW : TShellExecuteInfoW;
	lh_Process : THandle;
//	lh_Window  : HWND;
begin
	Result := 0;

	FillChar(l_InfoW, SizeOf(l_InfoW), 0);
	l_InfoW.cbSize := SizeOf(l_InfoW);
	l_InfoW.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_InfoW.lpFile := PWideChar(sFile);
	end;
	l_InfoW.nShow := SW_SHOWNORMAL;

	if (ShellExecuteExW(@l_InfoW))
	then begin
		lh_Process := l_InfoW.hProcess;
	end
	else
	begin
		lh_Process := 0;
	end;
//		ShellExecuteW(Application.Handle, nil, PWideChar(sFile), nil, nil, SW_SHOWNORMAL);

	if (lh_Process <> 0)
	then begin
		try
			WaitForInputIdle(lh_Process, 3000);
			Result := gfnhProcessToWindow(lh_Process);
			if (IsWindow(Result))
			then begin
				SetForegroundWindow(Result);
			end;
		finally
			CloseHandle(lh_Process);
		end;
	end;
end;


type
	TLangAndCodePage = record
		iLanguage: WORD;
		iCodePage: WORD;
	end;
	PLangAndCodePage = ^TLangAndCodePage;

function gfnsFileVersionGet(sFile: WideString): WideString;
//ファイルのバージョン情報を返す
//http://www2.big.or.jp/~osamu/Delphi/Tips/key.cgi?key=13#0226.txt
var
	li_Size, li_Reserved, li_Len: DWORD;
	lp_Buff, lp_Dat: Pointer;
	lp_LangPage: PLangAndCodePage;
	ls_FileInfo: WideString;
begin
	Result := '';

	// 必要なバッファのサイズを取得
	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', Pointer(lp_LangPage), li_Len) and (li_Len > 0)) then begin
					ls_FileInfo := Format('\StringFileInfo\%.4x%.4x\', [lp_LangPage^.iLanguage, lp_LangPage^.iCodePage]);

					//ファイルバージョン
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'FileVersion'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result := WideString(PWideChar(lp_Dat));
					end;
				end;
			end;
		finally
			// 解放
			FreeMem(lp_Buff);
		end;
	end;
end;
function gfnsFileVersionGet: WideString;
//自アプリのファイルバージョン。
begin
	Result := gfnsFileVersionGet(gfnsExeNameGet);
end;

function gfnsProductNameGet(sFile: WideString): WideString;
//自アプリの製品名。
var
	li_Size, li_Reserved, li_Len: DWORD;
	lp_Buff, lp_Dat: Pointer;
	lp_LangPage: PLangAndCodePage;
	ls_FileInfo: WideString;
begin
	Result := '';

	// 必要なバッファのサイズを取得
	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', Pointer(lp_LangPage), li_Len) and (li_Len > 0)) then begin
					ls_FileInfo := Format('\StringFileInfo\%.4x%.4x\', [lp_LangPage^.iLanguage, lp_LangPage^.iCodePage]);

					//製品名
					if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'ProductName'), lp_Dat, li_Len) and (li_Len > 0)) then begin
						Result := WideString(PWideChar(lp_Dat));
					end;
				end;
			end;
		finally
			// 解放
			FreeMem(lp_Buff);
		end;
	end;
end;
function gfnsProductNameGet: WideString;
begin
	Result := gfnsProductNameGet(gfnsExeNameGet);
end;

//myGraphic.pas ----------------------------------------------------------------
type
	TFileStreamW = class(THandleStream)
	public
		constructor Create(const FileName: WideString; Mode: Word); overload;
		destructor Destroy; override;
	end;

constructor TFileStreamW.Create(const FileName: WideString; Mode: Word);
//TFileStreamのUnicode版　
var
	li_AccessMode, li_ShareMode: DWORD;
begin
	if (Mode = fmCreate) then begin
		inherited Create(CreateFileW(
				PWideChar(FileName),           //ファイル名
				GENERIC_READ or GENERIC_WRITE, //アクセスモード
				0,                             //共有モード
				nil,                           //セキュリティ
				OPEN_ALWAYS,                   //作成方法
				FILE_ATTRIBUTE_NORMAL,	       //ファイル属性
				0                              //テンプレート
		));
	end else begin
		//アクセスモード
		li_AccessMode := GENERIC_READ;
		if ((Mode and fmOpenWrite) <> 0) then begin
			li_AccessMode := li_AccessMode or GENERIC_WRITE;
		end;

		{$WARN SYMBOL_PLATFORM OFF}
		//共有モード
		li_ShareMode := 0;
		if (Mode >= fmShareExclusive) then begin
			Dec(Mode, $10);
		end;
		if ((Mode and (fmShareDenyRead - $10)) <> 0) then begin
			//読み込みは禁止=書き込みはOK
			li_ShareMode := FILE_SHARE_WRITE;
		end;
		if ((Mode and (fmShareDenyWrite - $10)) <> 0) then begin
			//書き込みは禁止=読み込みはOK
			li_ShareMode := li_ShareMode or FILE_SHARE_READ;
		end;
		{$WARN SYMBOL_PLATFORM ON}

		inherited Create(CreateFileW(
				PWideChar(FileName),
				li_AccessMode,
				li_ShareMode,
				nil,
				OPEN_EXISTING,
				FILE_ATTRIBUTE_NORMAL,
				0
		));
	end;
	if (FHandle = Integer(INVALID_HANDLE_VALUE)) then begin
		//エラーメッセージはUnicode対応ではない。
		raise EFCreateError.CreateResFmt(@SFCreateError, [FileName]);
	end;
end;

destructor TFileStreamW.Destroy;
begin
	if (FHandle >= 0) then CloseHandle(FHandle);
	inherited Destroy;
end;

//------------------------------------------------------------------------------
procedure TMyBitmap.SaveToFile(const Filename: WideString);
var
	l_Stream: TStream;
begin
	l_Stream := TFileStreamW.Create(Filename, fmCreate);
	try
		SaveToStream(l_Stream);
	finally
		l_Stream.Free;
	end;
end;


function gfnclColorRevers(clColor: TColor): TColor;
{2007-06-18:
clColorの反転色を返す
}
var
	li_Color: Longint;
	li_Red, li_Green, li_Blue: Integer;
begin
	li_Color := ColorToRGB(clColor);
	li_Red   := (li_Color and $0000FF);
	li_Green := (li_Color and $00FF00) div $000100;
	li_Blue  := (li_Color and $FF0000) div $010000;
	Result   := (($FF - li_Blue) * $010000) + (($FF - li_Green) * $000100) + ($FF - li_Red);
end;

procedure gpcColorRGBToHLS(iRed, iGreen, iBlue: BYTE; var iHue, iLuminance, iSaturation: WORD; iMaxHue, iMaxLuminance, iMaxSaturation: WORD);
{2009-09-13:
RGBをHLSに変換。
APIのColorRGBToHLSがH,L,Sの範囲が0〜240で直観的でないので自作。

http://www.pannoki.com/tips/
index.php?RGB%20to%20HLS
http://inugashira.exblog.jp/9551741/
http://support.microsoft.com/kb/29240/ja
}
const
	lci_MAXRGB = High(BYTE); //R,G,Bの取れる値の範囲(256)
var
	li_Max, li_Min: WORD;
	li_Hue, li_Saturation: Integer;
	lf_RDelta, lf_GDelta, lf_BDelta: Extended;
begin
	if (iRed = iGreen) and (iGreen = iBlue) then begin
		//全部同じということは無彩色(黒か白かグレー)であるので色彩(Hue)と彩度(Saturation)は無意味
		iSaturation := 0;
		iHue        := 0;
		iLuminance  := gfniRound(iRed / lci_MAXRGB * iMaxLuminance);
	end else begin
		li_Max := gfniMax([iRed, iGreen, iBlue]);
		li_Min := gfniMin([iRed, iGreen, iBlue]);

		//明度
		iLuminance := WORD(gfniRound((li_Max + li_Min) / 2 / lci_MAXRGB * iMaxLuminance));

		//彩度
		if (iLuminance <= (iMaxLuminance div 2)) then begin
			li_Saturation := gfniRound((((li_Max - li_Min) * iMaxSaturation) + ((li_Max + li_Min) / 2)) / (li_Max + li_Min));
		end else begin
			li_Saturation := gfniRound((((li_Max - li_Min) * iMaxSaturation) + ((2 * lci_MAXRGB - li_Max - li_Min) / 2)) / (2 * lci_MAXRGB - li_Max - li_Min));
		end;
		iSaturation := WORD(gfniNumLimit(li_Saturation, 0, iMaxSaturation));

		//Hue
		lf_RDelta := ( ((li_Max - iRed)   * (iMaxHue / 6)) + ((li_Max - li_Min) / 2) ) / (li_Max - li_Min);
		lf_GDelta := ( ((li_Max - iGreen) * (iMaxHue / 6)) + ((li_Max - li_Min) / 2) ) / (li_Max - li_Min);
		lf_BDelta := ( ((li_Max - iBlue)  * (iMaxHue / 6)) + ((li_Max - li_Min) / 2) ) / (li_Max - li_Min);

		if (iRed = li_Max) then begin
			li_Hue := gfniRound(lf_BDelta - lf_GDelta);
		end else if (iGreen = li_Max) then begin
			li_Hue := gfniRound((iMaxHue / 3) + lf_RDelta - lf_BDelta);
		end else {if (iBlue = li_Max) then} begin
			li_Hue := gfniRound(((2 * iMaxHue) / 3) + lf_GDelta - lf_RDelta);
		end;
		iHue := WORD(gfniNumLoop(li_Hue, 0, iMaxHue -1));
	end;
end;

procedure gpcColorRGBToHLS(iRed, iGreen, iBlue: BYTE; var iHue, iLuminance, iSaturation: WORD);
//Hは0〜360
//LとSは0〜100
const
	lci_MAXHUE        = 360;
	lci_MAXLUMINANCE  = 100;
	lci_MAXSATURATION = 100;
begin
	gpcColorRGBToHLS(iRed, iGreen, iBlue, iHue, iLuminance, iSaturation, lci_MAXHUE, lci_MAXLUMINANCE, lci_MAXSATURATION);
end;

procedure gpcColorRGBToHSV(iRed, iGreen, iBlue: BYTE; var iHue, iValue, iSaturation: WORD; iMaxHue, iMaxValue, iMaxSaturation: WORD);
const
	lci_MAXRGB = High(BYTE) +1; //R,G,Bの取れる値の範囲(256)
var
	li_Max, li_Min: WORD;
	li_Hue: Integer;
	lf_RDelta, lf_GDelta, lf_BDelta: Extended;
begin
	if (iRed = iGreen) and (iGreen = iBlue) then begin
		iHue        := 0;
		iSaturation := 0;
		iValue      := gfniRound(iRed / lci_MAXRGB * iMaxValue);
	end else begin
		li_Max := gfniMax([iRed, iGreen, iBlue]);
		li_Min := gfniMin([iRed, iGreen, iBlue]);
		iSaturation := WORD(gfniNumLimit(gfniRound((li_Max - li_Min) / li_Max * iMaxSaturation), 0, iMaxSaturation));
		iValue      := WORD(gfniNumLimit(gfniRound(li_Max / lci_MAXRGB * iMaxValue), 0, iMaxValue));

		//Hue
		lf_RDelta := ( ((li_Max - iRed)   * (iMaxHue / 6)) + ((li_Max - li_Min) / 2) ) / (li_Max - li_Min);
		lf_GDelta := ( ((li_Max - iGreen) * (iMaxHue / 6)) + ((li_Max - li_Min) / 2) ) / (li_Max - li_Min);
		lf_BDelta := ( ((li_Max - iBlue)  * (iMaxHue / 6)) + ((li_Max - li_Min) / 2) ) / (li_Max - li_Min);

		if (iRed = li_Max) then begin
			li_Hue := gfniRound(lf_BDelta - lf_GDelta);
		end else if (iGreen = li_Max) then begin
			li_Hue := gfniRound((iMaxHue / 3) + lf_RDelta - lf_BDelta);
		end else {if (iBlue = li_Max) then} begin
			li_Hue := gfniRound(((2 * iMaxHue) / 3) + lf_GDelta - lf_RDelta);
		end;
		iHue := WORD(gfniNumLoop(li_Hue, 0, iMaxHue -1));
	end;
end;

procedure gpcImageRotate(hImage: HDC; iLeft, iTop, iWidth, iHeight: Integer; fpRotate: TZoomFlip);
{2017-01-25:画像の反転・回転を行う。
画像の回転は同じ画像内で行う(画像内に上書きされる)
とりあえず変形は正方形を想定しているため、反転は問題ないが回転は幅と高さが違うとおかしなことになる。
	 1     2
	 +-----+
	 |     |
	 |     |
	 +-----+
	 3     4
}
var
	lpt_Point  : array[0..2] of TPoint;
	lpt_Pos1, //Left,         Top
	lpt_Pos2, //Left + Width, Top
	lpt_Pos3, //Left,         Top + Height
	lpt_Pos4  //Left + Width, Top + Height
	: TPoint;
begin
	lpt_Pos1 := Point(iLeft,          iTop);
	lpt_Pos2 := Point(iLeft + iWidth, iTop);
	lpt_Pos3 := Point(iLeft,          iTop + iHeight);
	lpt_Pos4 := Point(iLeft + iWidth, iTop + iHeight);

	case fpRotate of
		fpFlipHorizontal
		:begin
{
//これだと右に1ピクセルずれる
			lpt_Point[0] := lpt_Pos2;
			lpt_Point[1] := lpt_Pos1;
			lpt_Point[2] := lpt_Pos4;
}
			lpt_Point[0].X := lpt_Pos2.X -1;
			lpt_Point[0].Y := lpt_Pos2.Y;
			lpt_Point[1].X := lpt_Pos1.X -1;
			lpt_Point[1].Y := lpt_Pos1.Y;
			lpt_Point[2].X := lpt_Pos4.X -1;
			lpt_Point[2].Y := lpt_Pos4.Y;
		end;
		fpFlipVertical
		:begin
{
//これだと下に1ピクセルずれる
			lpt_Point[0] := lpt_Pos3;
			lpt_Point[1] := lpt_Pos4;
			lpt_Point[2] := lpt_Pos1;
}
			lpt_Point[0].X := lpt_Pos3.X;
			lpt_Point[0].Y := lpt_Pos3.Y -1;
			lpt_Point[1].X := lpt_Pos4.X;
			lpt_Point[1].Y := lpt_Pos4.Y -1;
			lpt_Point[2].X := lpt_Pos1.X;
			lpt_Point[2].Y := lpt_Pos1.Y -1;
		end;
		fpFlipBoth, fpRotate180
		:begin
{
//これだと右と下に1ピクセルずれる
			lpt_Point[0] := lpt_Pos4;
			lpt_Point[1] := lpt_Pos3;
			lpt_Point[2] := lpt_Pos2;
}
			lpt_Point[0].X := lpt_Pos4.X -1;
			lpt_Point[0].Y := lpt_Pos4.Y -1;
			lpt_Point[1].X := lpt_Pos3.X -1;
			lpt_Point[1].Y := lpt_Pos3.Y -1;
			lpt_Point[2].X := lpt_Pos2.X -1;
			lpt_Point[2].Y := lpt_Pos2.Y -1;
		end;
		fpRotate90
		:begin
			lpt_Point[0] := lpt_Pos2;
			lpt_Point[1] := lpt_Pos4;
			lpt_Point[2] := lpt_Pos1;
		end;
		fpRotate270
		:begin
			lpt_Point[0] := lpt_Pos3;
			lpt_Point[1] := lpt_Pos1;
			lpt_Point[2] := lpt_Pos4;
		end;
		else
		begin
Exit;
		end;
	end;

//PlgBltは同じデバイスコンテキストでないと失敗する。
	PlgBlt(hImage, lpt_Point, hImage, iLeft, iTop, iWidth, iHeight, 0, 0, 0);
end;

//myList.pas -------------------------------------------------------------------
function gfnbIsIncludeList(sValue: String; slList: TStrings): Boolean;
{2007-10-17:
slList中にsValueがあればTrueを返す
大文字小文字の違いは無視
}
var
	i: Integer;
begin
	Result := False;
	for i := 0 to slList.Count -1 do begin
		if (AnsiCompareText(sValue, slList[i]) = 0) then begin
			Result := True;
			Break;
		end;
	end;
end;

function gfnbIsIncludeList(sValue: String; slList: array of String): Boolean;
//slList中にsValueがあればTrueを返す
//大文字小文字の違いは無視
var
	i: Integer;
begin
	Result := False;
	for i := Low(slList) to High(slList) do begin
		if (AnsiCompareText(sValue, slList[i]) = 0) then begin
			Result := True;
			Break;
		end;
	end;
end;

procedure gpcDifferenceListGet(AGetList: TStrings; ASrcList, ADiffList: TStrings);
{2015-10-05:
リストASrcListからリストADiffListの要素を取り除いたものをAGetListにセットする。
AGetListはASrcListおよびADiffListと同じであってはならない。
}
	function _IsElementExist(sElement: String; AList: TStrings): Boolean;
	var
		i: Integer;
	begin
		Result := False;
		for i := 0 to AList.Count -1
		do begin
			if (sElement = AList[i])
			then begin
				Result := True;
	Exit;
			end;
		end;
	end;
var
	i: Integer;
	l_List: TStrings;
begin
	//AGetListの前のvarがないと呼び出し側でエラーになる。
	if (AGetList = nil)
	then begin
		AGetList := TStringList.Create;
	end;

	if (ASrcList = nil)
	or (ASrcList.Count = 0)
	then begin
		if  (ADiffList <> nil)
		and (ADiffList.Count > 0)
		then begin
			AGetList.Assign(ADiffList);
		end
		else
		begin
			AGetList.Clear;
		end;
Exit;
	end;


	if (ADiffList = nil)
	then begin
		AGetList.Assign(ASrcList);
Exit;
	end;

	l_List := nil;
	try
		l_List := TStringList.Create;
		for i := 0 to ASrcList.Count -1
		do begin
			if not(_IsElementExist(ASrcList[i], ADiffList))
			then begin
				l_List.AddObject(ASrcList[i], ASrcList.Objects[i]);
			end;
		end;
		AGetList.Assign(l_List);
	finally
		l_List.Free;
	end;

//myDebug.gpcDebug(AGetList);

end;


//------------------------------------------------------------------------------
//myMessageDlg
type
	TMyMessageDlgEvent = class(TObject)
	public
		procedure DoFormShow(Sender: TObject);
	end;
var
	F_MessageDlgEvent : TMyMessageDlgEvent;

const
	F_ciDEFAULT_MB_YES = 0;  //mbYes:      ls_Caption := '??(Y)';
	F_ciDEFAULT_MB_NO  = 1;  //mbNo:       ls_Caption := '???(N)';
	F_ciDEFAULT_MB_OK = 2;       //mbOK:       ls_Caption := 'OK';
	F_ciDEFAULT_MB_CANCEL = 3;   //mbCancel:   ls_Caption := 'Cancel';
	F_ciDEFAULT_MB_ABORT = 4;    //mbAbort:    ls_Caption := '??(A) ';
	F_ciDEFAULT_MB_RETRY = 5;    //mbRetry:    ls_Caption := '???(R)';
	F_ciDEFAULT_MB_IGNORE = 6;   //mbIgnore:   ls_Caption := '??(I)';
	F_ciDEFAULT_MB_ALL = 7;      //mbAll:      ls_Caption := '???';
	F_ciDEFAULT_MB_NOTOALL = 8;  //mbNoToAll:  ls_Caption := '???????';
	F_ciDEFAULT_MB_YESTOALL = 9; //mbYesToAll: ls_Caption := '??????';
	F_ciDEFAULT_MB_HELP = 10;     //mbHelp:     ls_Caption := '???(H)';
	F_ciDEFAULT_MB_CLOSE = 11;    //mbClose:    ls_Caption := '???(C)';


procedure TMyMessageDlgEvent.DoFormShow(Sender: TObject);
var
	l_Pos : TPoint;
	l_Monitor : TMonitor;
	l_Form    : TForm;
//	l_Rect    : TRect;
	ls_Caption : String;
	i : Integer;
	l_Control  : TControl;
	lb_Bool    : LongBool;
	l_Cursor   : TRect;
begin
	if not(Sender is TForm)
	then begin
Exit;
	end;

	l_Form := TForm(Sender);
	//
	l_Pos := gfnptMousePosGet;
	l_Monitor := gfnMonitorGet(l_Pos);

	SetWindowPos(
		l_Form.Handle,
		0,
		l_Monitor.Left + ((l_Monitor.Width  - l_Form.Width)  div 2),
		l_Monitor.Top  + ((l_Monitor.Height - l_Form.Height) div 2),
		0,
		0,
		SWP_NOSIZE or SWP_NOZORDER
	);

	ls_Caption := '';
	case l_Form.Tag of
		F_ciDEFAULT_MB_YES:      ls_Caption := 'はい(&Y)';
		F_ciDEFAULT_MB_NO:       ls_Caption := 'いいえ(&N)';
		F_ciDEFAULT_MB_OK:       ls_Caption := 'OK';
		F_ciDEFAULT_MB_CANCEL:   ls_Caption := 'Cancel';
		F_ciDEFAULT_MB_ABORT:    ls_Caption := '中止(&A) ';
		F_ciDEFAULT_MB_RETRY:    ls_Caption := '再試行(&R)';
		F_ciDEFAULT_MB_IGNORE:   ls_Caption := '無視(&I)';
		F_ciDEFAULT_MB_ALL:      ls_Caption := 'すべて';
		F_ciDEFAULT_MB_NOTOALL:  ls_Caption := 'すべてにいいえ';
		F_ciDEFAULT_MB_YESTOALL: ls_Caption := 'すべてにはい';
		F_ciDEFAULT_MB_HELP:     ls_Caption := 'ヘルプ(&H)';
	end;

	if (ls_Caption <> '')
	then begin
		//カーソルをOKボタンの上へ
		SystemParametersInfo(SPI_GETSNAPTODEFBUTTON, 0, @lb_Bool, 0);
		if (lb_Bool)
		then begin
			for i := 0 to l_Form.ControlCount-1
			do begin
				l_Control := l_Form.Controls[i];
				if  (l_Control is TButton)
				and (TButton(l_Control).Caption = ls_Caption)
				then begin
					GetWindowRect(TWinControl(l_Control).Handle, l_Cursor);
					l_Cursor := gfnrcRectCenter(l_Cursor, Rect(0,0,0,0));
					SetCursorPos(l_Cursor.Left, l_Cursor.Top);
				end;
			end;
		end;
	end;
end;

function gfniMessageDlg(sMsg, sTitle: String; Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): Word;
var
	l_MsgForm  : TForm;
	l_FormShow : TMyMessageDlgEvent;
begin
	l_MsgForm := nil;
	try
		l_MsgForm := CreateMessageDialog(sMsg, mtCustom, Buttons); //, DefaultButton);

		if (sTitle = '')
		then begin
//			sTitle := gfnsExeNameGet;
			sTitle := gfnsProductNameGet;
		end;
		l_MsgForm.Caption := sTitle;
//		SetWindowTextW(l_MsgForm.Handle, PWideChar(sTitle));

		case DefaultButton of
			mbYes:      l_MsgForm.Tag := F_ciDEFAULT_MB_YES;
			mbNo:       l_MsgForm.Tag := F_ciDEFAULT_MB_NO;
			mbOK:       l_MsgForm.Tag := F_ciDEFAULT_MB_OK;
			mbCancel:   l_MsgForm.Tag := F_ciDEFAULT_MB_CANCEL;
			mbAbort:    l_MsgForm.Tag := F_ciDEFAULT_MB_ABORT;
			mbRetry:    l_MsgForm.Tag := F_ciDEFAULT_MB_RETRY;
			mbIgnore:   l_MsgForm.Tag := F_ciDEFAULT_MB_IGNORE;
			mbAll:      l_MsgForm.Tag := F_ciDEFAULT_MB_ALL;
			mbNoToAll:  l_MsgForm.Tag := F_ciDEFAULT_MB_NOTOALL;
			mbYesToAll: l_MsgForm.Tag := F_ciDEFAULT_MB_YESTOALL;
			mbHelp:     l_MsgForm.Tag := F_ciDEFAULT_MB_HELP;
		end;

		Beep;
		l_FormShow := nil;
		try
			l_FormShow       := TMyMessageDlgEvent.Create;
			l_MsgForm.OnShow := l_FormShow.DoFormShow;
			Result := l_MsgForm.ShowModal;
		finally
			FreeAndNil(l_FormShow);
		end;
	finally
		l_MsgForm.Release;
	end;
end;

procedure gpcShowMessage(sMsg: String; sTitle: String = '');
begin
	gfniMessageDlg(sMsg, sTitle, [mbOk], mbOk);
end;

function gfniMessageBoxYesNo(sMsg: String; sTitle: String = ''; DefaultButton: TMsgDlgBtn = mbYes): Word;
begin
	Result := gfniMessageDlg(sMsg, sTitle, [mbYes, mbNo], DefaultButton);
end;


//------------------------------------------------------------------------------
//myString.pas
//StringReplace のUnicode対応版的。
function gfnsStrReplace(sSrc, sOld, sNew: WideString; const bCaseSensitive: Boolean): WideString;
{2008-12-07,2011-11-21:
StringReplaceのUnicode対応の高速改良版。
bCaseSensitiveは大文字小文字の区別をするかしないか。
Trueで区別する。

2011-11-21:SetLengthとsOldの位置を配列で持つことで2〜3倍高速化。
　配列無しでやると30%程度の高速化。
}
var
	li_Pos      : Integer;
	li_SrcIndex : Integer;
	li_ResIndex : Integer;
	ls_CmpSrc   : WideString;
	ls_CmpOld   : WideString;
	lp_Src      : PWideChar;
	lp_CmpSrc   : PWideChar;
	li_SrcLen   : Integer;
	li_OldLen   : Integer;
	li_NewLen   : Integer;
	li_Count    : Integer;
	li_Indexs   : array of Integer;
	li_Len      : Integer;
	i : Integer;
begin
	if (sSrc = '')
	or (sOld = '')
	then begin
		Result := sSrc;
Exit;
	end;

	if not(bCaseSensitive) then
	begin
		ls_CmpOld := WideUpperCase(sOld);
		ls_CmpSrc := WideUpperCase(sSrc);
	end else
	begin
		ls_CmpOld := sOld;
		ls_CmpSrc := sSrc;
	end;

	li_SrcLen   := Length(sSrc);
	li_OldLen   := Length(sOld);
	SetLength(li_Indexs, li_SrcLen +1); //最大
	li_Indexs[0] := 0;
	li_Count     := 0;
	li_SrcIndex  := 0;
	repeat
		lp_CmpSrc := @PWideChar(ls_CmpSrc)[li_SrcIndex];
		li_Pos := Pos(ls_CmpOld, WideString(lp_CmpSrc));
		if (li_Pos > 0) then
		begin
			//置換対象文字列があった。
			li_Indexs[li_Count +1] := li_SrcIndex + li_Pos -1;
			Inc(li_Count);
			li_SrcIndex := li_SrcIndex + li_Pos + li_OldLen -1;
		end;
//		Application.ProcessMessages;
	until (li_Pos = 0);

	if (li_Count <= 0) then
	begin
		Result := sSrc;
	end else
	begin
		li_NewLen := Length(sNew);
		li_Len    := Length(sSrc) + (li_NewLen - li_OldLen) * li_Count;
		if (li_Len <= 0) then
		begin
			Result := '';
Exit;
		end;
		SetLength(Result, li_Len);
		li_ResIndex := 1; //ResultはWideStringなので0ではなく1
		lp_Src := @PWideChar(sSrc)[0];
		for i := 1 to li_Count do
		begin
			li_Len := li_Indexs[i] - li_Indexs[i-1];
			if (i = 1) then
			begin
				Inc(li_Len);
			end;
			lstrcpynW(PWideChar(@Result[li_ResIndex]), lp_Src, li_Len);
			Inc(li_ResIndex, li_Len -1);
			if (li_NewLen > 0) then
			begin
				lstrcpynW(PWideChar(@Result[li_ResIndex]), PWideChar(sNew), li_NewLen +1);
				Inc(li_ResIndex, li_NewLen);
			end;
			lp_Src := @PWideChar(sSrc)[li_Indexs[i] +1];
//			Application.ProcessMessages;
		end;
		//残りをコピー
		lstrcpynW(PWideChar(@Result[li_ResIndex]), lp_Src, li_SrcLen - li_Indexs[li_Count]);
		//実装が正しければ必要のない処理。
//		Result := WideString(PWideChar(Result));
	end;
end;
function gfnsStrReplace(sSrc, sOld, sNew: WideString): WideString;
{2008-12-07:
StringReplaceのUnicode対応版。
大文字小文字の区別あり。
}
begin
	Result := gfnsStrReplace(sSrc, sOld, sNew, True);
end;

function gfnbIsUnicode(sSrc: WideString): Boolean;
{2007-11-05,2009-02-12:
sSrcにウムラウトのようなUnicode文字があればTrueを返す
http://yokohama.cool.ne.jp/chokuto/urawaza/api/WideCharToMultiByte.html
0x00000400 (WC_NO_BEST_FIT_CHARS)
Windows 2000/XP：直接マルチバイト文字に変換できない文字をデフォルトキャラクタに置きかえます。

2009-02-12:
	ResultをWideChartoMultiByteに直接渡すのでなくlb_Boolを介するように変更。
	BooleanとLongBoolで型が違うため実行時エラーになってしまうことがあるため。
}
var
	lb_Bool: LongBool;
begin
	WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, PWideChar(sSrc), -1, nil, 0, nil, @lb_Bool);
	Result := lb_Bool;
end;

//UTF-16LE⇔UTF-8
function gfnsWideToUTF8(sSrc: WideString): AnsiString;
//WideStringをUTF-8にエンコードして返す。
var
	li_Len:  Integer;
	lp_Buff: PAnsiChar;
begin
	li_Len  := WideCharToMultiByte(CP_UTF8, 0, PWideChar(sSrc), -1, nil, 0, nil, nil);
	lp_Buff := AllocMem(li_Len + 1);
	try
		WideCharToMultiByte(CP_UTF8, 0, PWideChar(sSrc), -1, lp_Buff, li_Len +1, nil, nil);
		Result := UTF8String(lp_Buff);
	finally
		FreeMem(lp_Buff);
	end;
end;

function gfnsUTF8ToWide(sSrc: AnsiString): WideString;
//UTF-8でエンコードされている文字列をWideStringにして返す。
var
	li_Len:  Integer;
	lp_Buff: PWideChar;
begin
	li_Len  := MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(sSrc), -1, nil, 0);
	lp_Buff := AllocMem((li_Len + 1) * 2);
	try
		MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len);
		Result := WideString(lp_Buff);
	finally
		FreeMem(lp_Buff);
	end;
end;


function gfnsWideToAnsi(sSrc: WideString): AnsiString;
{2008-06-03,12-28,2009-02-12:
合成文字をきちんとあつかってAnsiStringに変換。
例)「か゛」→「が」みたいな感じで。

2009-02-12:合成文字のみの場合にきちんと変換されていなかった不具合の修正。
2008-12-28:gfnsWideToStr→gfnsWideToAnsi
}
var
	li_Len:  Integer;
	lp_Buff: PAnsiChar;
begin
	//WC_COMPOSITECHECKが肝
	li_Len := WideCharToMultiByte(CP_ACP, WC_COMPOSITECHECK{ or WC_SEPCHARS}, PWideChar(sSrc), -1, nil, 0, nil, nil);
	Inc(li_Len);
	lp_Buff := AllocMem(li_Len);
	try
		WideCharToMultiByte(CP_ACP, WC_COMPOSITECHECK{ or WC_SEPCHARS}, PWideChar(sSrc), -1, lp_Buff, li_Len, nil, nil);
		Result := AnsiString(lp_Buff);
	finally
		FreeMem(lp_Buff);
	end;
end;


function gfnbIsComponentNameUsed(sName: String): Boolean;
{2009-07-19:
sNameがコンポーネントのNameプロパティとしてすでに使われていればTrueを返す。
}
	function _IsNameUsed(Component: TComponent; sName: String): Boolean;
	var
		i: Integer;
	begin
		Result := False;
		for i := 0 to Component.ComponentCount -1
		do begin
			if (Component.Components[i].Name = sName)
			then begin
				Result := True;
			end
			else
			begin
				Result := _IsNameUsed(Component.Components[i], sName);
			end;

			if (Result)
			then begin
		Break;
			end;
		end;
	end;
begin
	Result := _IsNameUsed(Application, sName);
end;

procedure gpcAvaiableNameGet(sPrefix: String; var sName: String; var iIndex: Integer);
{2009-07-19:
コントロールにセットすることができるNameプロパティの値とインデックスをセットする。
フォーマットは sPrefix_n
}
begin
	iIndex := 0;
	repeat
		sName := Format('%s_%d', [sPrefix, iIndex]);
		Inc(iIndex);
	until not(gfnbIsComponentNameUsed(sName));
end;

function gfnsAvailableName(sPrefix: String): String;
{2009-07-19:
コントロールにセットすることができるNameプロパティを返す。
フォーマットは sPrefix_n
}
var
	li_Index: Integer;
begin
	gpcAvaiableNameGet(sPrefix, Result, li_Index);
end;

function gfnsFindComponentNameGet(sPrefix, sName: String): String;
begin
	Result := Format('%s_%s', [sPrefix, Copy(sName, Pos('_', sName) +1, MAXINT)]);
end;

//myGrid.pas -------------------------------------------------------------------
procedure gpcGridDataClear(AGrid: TStringGrid);
//固定セル以外をクリア
var
	i, k: Integer;
begin
	with AGrid
	do begin
		for i := FixedRows to RowCount-1
		do begin
			for k := FixedCols to ColCount-1
			do begin
				Cells[k, i] := '';
			end;
		end;
	end;
end;

procedure gpcGridColDataClear(AGrid: TStringGrid; iCol: Integer);
//固定セル以外の列をクリア
var
	i: Integer;
begin
	with AGrid
	do begin
		for i := FixedRows to RowCount-1
		do begin
			Cells[iCol, i] := '';
		end;
	end;
end;

//myApp.pas --------------------------------------------------------------------
(*
function gfnbFormExists(sName: String): Boolean;
{2010-07-11:
}
var
	i: Integer;
begin
	Result := False;

	for i := 0 to Screen.FormCount -1
	do begin
		if (Screen.Forms[i].Name = sName)
		then begin
			Result := True;
Exit;
		end;
	end;
end;
*)
function gfnbFormExists(AForm: TForm): Boolean;
{2010-07-11:
}
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;

procedure gpcBoundsSet(AControl: TControl; ARect: TRect);
begin
	AControl.SetBounds(ARect.Left, ARect.Top, gfniRectWidth(ARect), gfniRectHeight(ARect));
end;

procedure gpcBringToFront(AWinControl: TWinControl);
{2011-11-05:
}
begin
	SetWindowPos(AWinControl.Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW or SWP_NOACTIVATE);
end;

//myClipbrd.pas ----------------------------------------------------------------
procedure gpcStrToClipboard(sStr: WideString);
var
	li_WLen  : Integer;
	li_Len   : Integer;
	ls_WText : WideString;
	ls_Text  :  AnsiString;
	lh_Mem   :   THandle;
	lp_Data  :  Pointer;
begin
	ls_WText := sStr;
	li_WLen  := (Length(ls_WText) + 1) * 2;
	ls_Text  := gfnsWideToAnsi(ls_WText);
	li_Len   := Length(ls_Text) + 1;
	if (ls_WText <> '')
	then begin
		if (OpenClipboard(Application.Handle))
		then begin
			try
				EmptyClipboard;
				//CF_UNICODETEXT
				lh_Mem  := GlobalAlloc(GHND or GMEM_SHARE, li_WLen);
				lp_Data := GlobalLock(lh_Mem);
				lstrcpyW(lp_Data, PWideChar(ls_WText));
				GlobalUnlock(lh_Mem);
				SetClipboardData(CF_UNICODETEXT, lh_Mem);
				//CF_TEXT
				lh_Mem  := GlobalAlloc(GHND or GMEM_SHARE, li_Len);
				lp_Data := GlobalLock(lh_Mem);
				lstrcpyA(lp_Data, PAnsiChar(ls_Text));
				GlobalUnlock(lh_Mem);
				SetClipboardData(CF_TEXT, lh_Mem);
			finally
				CloseClipboard;
			end;
		end;
	end;
end;

function gfnsStrFromClipboard: WideString;
{2007-08-05,10-12,2013-10-11:
クリップボードの文字列を取得して返す

2013-10-11:
　D6エディターからのコピーで文字化けしてしまうのでShift_JISを優先して返すオプショ
ンを追加。
2007-10-12:APIバイブルにそった書き方に変更
}
var
	li_Format : array[0..1] of Integer;
	li_Text: Integer;
	lh_Clip, lh_Data: THandle;
	lp_Clip, lp_Data: Pointer;
begin
	Result := '';

	//Unicodeを優先
	li_Format[0] := CF_UNICODETEXT;
	li_Format[1] := CF_TEXT;

	li_Text := GetPriorityClipboardFormat(li_Format, 2);

	if (li_Text > 0)
	then begin
//		if (OpenClipboard(Application.Handle)) then begin
		if (OpenClipboard(0))
		then begin
			lh_Clip := GetClipboardData(li_Text);
			if (lh_Clip <> 0)
			then begin
				lh_Data := 0;
				if (GlobalFlags(lh_Clip) <> GMEM_INVALID_HANDLE)
				then begin
					try
						if (li_Text = CF_TEXT)
						then begin
							lh_Data := GlobalAlloc(GHND or GMEM_SHARE, GlobalSize(lh_Clip));
							lp_Clip := GlobalLock(lh_Clip);
							lp_Data := GlobalLock(lh_Data);
							lstrcpy(lp_Data, lp_Clip);
							Result := WideString(AnsiString(PAnsiChar(lp_Data)));
							GlobalUnlock(lh_Data);
							GlobalFree(lh_Data);
							GlobalUnlock(lh_Clip);	//GlobalFreeはしてはいけない
						end
						else
						if (li_Text = CF_UNICODETEXT)
						then begin
							lh_Data := GlobalAlloc(GHND or GMEM_SHARE, GlobalSize(lh_Clip));
							lp_Clip := GlobalLock(lh_Clip);
							lp_Data := GlobalLock(lh_Data);
							lstrcpyW(lp_Data, lp_Clip);
							Result := WideString(PWideChar(lp_Data));
							GlobalUnlock(lh_Data);
							GlobalFree(lh_Data);
							GlobalUnlock(lh_Clip);	//GlobalFreeはしてはいけない
						end;
					finally
						if (lh_Data <> 0)
						then begin
							GlobalUnlock(lh_Data);
						end;
						CloseClipboard;
					end;
				end;
			end;
		end;
	end;
end;


//myType.pas -------------------------------------------------------------------
function gfnsBoolToStr(const bBool: Boolean): WideString;
//bBoolがTrueなら'True'を、Falseなら'False'という文字列を返す。
begin
	if (bBool)
	then begin
		Result := 'True';
	end
	else
	begin
		Result := 'False';
	end;
end;


//------------------------------------------------------------------------------
//スタイル
function gfnbFlagCheck(iStyle: Longint; iCheck: Longint): Boolean;
begin
	Result := ((iStyle and iCheck) = iCheck);
end;


//------------------------------------------------------------------------------
//Menu
function gfnbIsMenuVisible(AMenuItem: TMenuItem): Boolean;
begin
	if (AMenuItem.Name = '')
	then begin
		Result := AMenuItem.Visible;
	end
	else
	begin
		Result := AMenuItem.Visible;
		if (Result)
		then begin
			if (AMenuItem.Parent.Name = '')
			then begin
				//トップメニューだった
Exit;
			end
			else
			begin
				Result := gfnbIsMenuVisible(AMenuItem.Parent);
			end;
		end
		else
		begin
Exit;
		end;
	end;
end;

function gfniCheckRadioMenuIndexGet(AMenuItem: TMenuItem): Integer;
{AMenuItemのサブメニューでチェック状態にあるメニューアイテムのインデックスを返す
}
var
	i : Integer;
	l_MenuItem : TMenuItem;
begin
	Result := -1;
	if (AMenuItem = nil)
	or (AMenuItem.Count <= 0)
	then begin
Exit;
	end;

	for i := 0 to AMenuItem.Count -1
	do begin
		l_MenuItem := AMenuItem.Items[i];
		if (l_MenuItem.RadioItem)
		then begin
			if (l_MenuItem.Checked)
			then begin
				Result := i;
Exit;
			end;
		end;
	end;
end;

procedure gpcMenuStripHotKey(AMenuItem: TMenuItem);
//メニュー内の全てのアクセラレータを取り除く
var
	i: Integer;
begin
	AMenuItem.Caption := StripHotKey(AMenuItem.Caption);
	for i := 0 to AMenuItem.Count -1
	do begin
		gpcMenuStripHotKey(AMenuItem.Items[i]);
	end;
end;

// sub_api.pas ---------------------------------------------------------------------
//AnsiStringとWideStringとの可逆変換関数。
function gfnsWideToAnsiEx(sSrc: WideString): AnsiString;
{2007-07-27,08-28,10-22,11-05,12-05,12-18,2008-02-12,19,03-07,04-13,06-02,2011-03-31,8-28:
ウムラウトなどのUnicodeな文字だけを$+16進に変換して返す。

http://yokohama.cool.ne.jp/chokuto/urawaza/api/WideCharToMultiByte.html
0x00000400 (WC_NO_BEST_FIT_CHARS)
Windows 2000/XP:直接マルチバイト文字に変換できない文字をデフォルトキャラクタに置きかえます。

2011-08-28:IsDBCSLeadByteの判定をif判定のelseの中に入れた。またApplication.ProcessMessagesを遅くなるのでコメントアウト
2011-03-31:SetLengthであらかじめ必要なバイト数を確保して書き込んでゆくやり方に変えた。10倍速くなった。それでもUTF-7利用の方が2倍速い。
2010-06-06:プリフィクスを%から$に変更。
2008-04-13:WC_COMPOSITECHECKをコメントアウトUnicodeの3099（「゛」のような文字）があるとおかしなことになってしまうことが判明したので。
2008-03-07:%を%%ではなく%0025に変換するように変更。
2008-02-19:%は2バイト文字の第一バイトにも第二バイトにも現れないのでAnsiPosでなくPosに変更。
2008-02-12:ウムラウトのようなUnicode文字かプリフィクスがあるか判定し、なければ変換ぜずsSrcをそのまま返すように変更。
2007-12-18:WideCharToMultiByteは終わりの#0も含めた必要なバッファ数を返すことから終わりの#0まで返していた不具合を修正。
2007-12-05:repeatを使ったものに書き換え。
2007-11-05:プリフィクスの扱いの間違いを修正。
2007-10-22:1バイトのウムラウトのような文字だけでなく2バイトの(中国語のような)文字にも対応できるように変更。
2007-08-28:プリフィクス文字がsSrc中にあった場合の処理を追加。
}
var
	i        : Integer;
	li_Pos   : Integer;
	li_Len   : Integer;
	li_Count : Integer;
	li_Index : Integer;
	ls_Char  : AnsiChar;
	lb_Bool  : LongBool;
	lp_Buff  : PAnsiChar;
begin
	Result := '';
	if (sSrc <> '')
	then begin
		//WC_COMPOSITECHECKは指定してはいけない。
		li_Len := WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, PWideChar(sSrc), -1, nil, 0, l_csDEFAULT_CHAR, @lb_Bool);
		if  (lb_Bool = False)
		and (Pos(l_csPREFIX_CHAR, sSrc) = 0)
		then begin
			//ウムラウトのようなUnicode文字がなくプリフィクス文字($)もない場合は変換する必要なし。
			//'$'は2バイト文字の第一バイトにも第二バイトにも現れないのでPosでよい。
			Result := AnsiString(sSrc);
		end
		else
		begin
			lp_Buff := AllocMem(li_Len + 1);
			try
				li_Len := WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, PWideChar(sSrc), -1, lp_Buff, li_Len, l_csDEFAULT_CHAR, @lb_Bool);
				if (li_Len > 0)
				then begin
					//まず必要なバイト数を求める
					li_Count := li_Len; //必要なバイト数
					i := 0;
					Dec(li_Len);
					//forで回すよりこっちの方が速い。
					repeat
						ls_Char := lp_Buff[i];
						if (ls_Char = l_csDEFAULT_CHAR)
						or (ls_Char = l_csPREFIX_CHAR)
						then begin
							//#1→'$xxxx' xxxx は元の文字の4桁の16進値
							//$→ '$0024'
							Inc(li_Count, 4);
						end;
						Inc(i);
					until (i >= li_Len);  //untilは条件がTrueで終了。
					SetLength(Result, li_Count);

					i        := 0; //lp_Buffのインデックス
					li_Pos   := 1; //sSrc   のインデックス
					li_Index := 1; //Result のインデックス
					repeat
						ls_Char := lp_Buff[i];
						if (ls_Char = l_csDEFAULT_CHAR)
						or (ls_Char = l_csPREFIX_CHAR)
						then begin
							//#1→'$xxxx' xxxx は元の文字の4桁の16進値
							//$→ '$0024'
							Result[li_Index] := l_csPREFIX_CHAR;
							Inc(li_Index);
							StrFmt(@Result[li_Index], '%0.4x', [Ord(sSrc[li_Pos])]);
							Inc(li_Index, 4);
						end
						else
						begin
							Result[li_Index] := ls_Char;
							Inc(li_Index);
							//2011-08-28:位置を変更
							//この判定はないといけない。
//							if (IsDBCSLeadByte(Byte(ls_Char))) then begin
							//こっちの方が10%程度速い
							case ls_Char of
								#$81..#$9F,
								#$E0..#$EF
								:begin
									//2バイト文字の先頭バイトなのでもう1バイトスキップ。
									Inc(i);
									Result[li_Index] := lp_Buff[i];
									Inc(li_Index);
								end;
							end;
						end;

						Inc(i);
						Inc(li_Pos);
						//2011-08-28:遅くなるのでコメントアウト
//						Application.ProcessMessages; 遅くなる
					until (i >= li_Len);  //untilは条件がTrueで終了。
					SetLength(Result, li_Index -1);
				end;
			finally
				FreeMem(lp_Buff);
			end;
		end;
	end;
end;

function gfnsAnsiToWideEx(sSrc: AnsiString): WideString;
{2007-07-27,10-22,11-05,12-05,2008-02-12,19,03-07,16,05-30,2010-06-02,2011-03-31:
gfnsWideToStrExの逆。

2011-03-31:Resultに逐次上書きしてゆき最後にSetLengthする方式に変更。30倍ほど速くなった。それでもUTF-7利用のほうが30%程度高速。
2010-06-06:プリフィクスを%から$に変更。
2008-05-30:速度向上のため書き換え。200倍くらいの差が出た…。
2008-03-16:プリフィクスに続く四文字が数値変換できない場合はプリフクスも含めてそのままにするよう変更。
2008-03-07:%を%%ではなく%0025に変換するようにgfnsWideToStrExを変えたのでそれに対応。
2008-02-19:%は2バイト文字の第一バイトにも第二バイトにも現れないのでAnsiPosでなくPosに変更。
2008-02-12:プリフィクスがあるか判定し、なければ変換ぜずsSrcをそのまま返すように変更。
2007-12-05:repeatを使ったものに書き換え。
2007-11-05:プリフィクスの扱いの間違いを修正。
2007-10-22:1バイトのウムラウトのような文字だけでなく2バイトの(中国語のような)文字にも対応。
}
var
	ls_Code  : array[0..4] of WideChar;
	ls_Char  : WideChar;
	li_Read  : Integer;
	li_Write : Integer;
	li_Pos   : Integer;
	li_Len   : Integer;
begin
	Result := '';
	if (sSrc <> '') then
	begin
		Result := WideString(sSrc);

		li_Pos := Pos(l_csPREFIX_CHAR, Result);
		//プリフィクス文字($)がなければ独自変換する必要はない。
		if (li_Pos > 0) then
		begin
			ls_Code[0] := '$';
			li_Len     := Length(Result);
			li_Read    := li_Pos;         //読み込む位置
			li_Write   := li_Read;        //書き込む位置
			repeat
				if (Result[li_Read] = l_csPREFIX_CHAR) then
				begin
					try
						//'$'に続く(はずの)4文字の数値をUnicode文字に変換。
						Move(Result[li_Read +1], ls_Code[1], 4 * SizeOf(WideChar));
						ls_Char          := WideChar(StrToInt(ls_Code));
						Result[li_Write] := ls_Char;
						Inc(li_Read, 5);
						Inc(li_Write);
					except
						//イレギュラー
						//イレギュラー時はそのままにする。
						Result[li_Write] := Result[li_Read];
						Inc(li_Read);
						Inc(li_Write);
					end;
				end else
				begin
					Result[li_Write] := Result[li_Read];
					Inc(li_Read);
					Inc(li_Write);
				end;
				//Application.ProcessMessages;
			until (li_Read > li_Len);	//untilは条件がTrueで終了。
			SetLength(Result, li_Write -1);
		end;
	end;
end;

function gfniCanvasTextWidthGet(AFont: TFont; sText: WideString; iCharExtra: Integer = 0): Integer;
{2009-10-28, 2011-03-01:
2011-03-01:行間指定に対応。
}
var
	l_Bitmap : TBitmap;
begin
	l_Bitmap:= TBitmap.Create;
	try
		l_Bitmap.Canvas.Font.Assign(AFont);
		SetTextCharacterExtra(l_Bitmap.Canvas.Handle, iCharExtra);
		Result := l_Bitmap.Canvas.TextWidth(sText);
	finally
		l_Bitmap.Free;
	end;
end;
function gfniCanvasTextHeightGet(AFont: TFont; sText: WideString; iCharExtra: Integer = 0): Integer;
{2009-10-28, 2011-03-01:
2011-03-01:行間指定に対応。
}
var
	l_Bitmap : TBitmap;
begin
	l_Bitmap:= TBitmap.Create;
	try
		l_Bitmap.Canvas.Font.Assign(AFont);
		SetTextCharacterExtra(l_Bitmap.Canvas.Handle, iCharExtra);
		Result := l_Bitmap.Canvas.TextHeight(sText);
	finally
		l_Bitmap.Free;
	end;
end;


function gfnsWideFormat(const sFormat: WideString; const Args: array of const): WideString;
{
D6のWideFormatのバグへの対処。
's'は引数インデックスまで対応。
}
type
	T_MyType = record
		sType   : WideString; //形式指定子
		sChar   : WideChar;   //変換型文字
		iIndex  : Integer;    //引数インデックス指定子 [index ":"］
		bLeft   : Boolean;    //左揃えインジケータ ["-"]
		iWidth  : Integer;    //幅指定子 [width]
		iPrec   : Integer;    //精度指定子 ["." prec]
		iLength : Integer;    //形式指定子の長さ(*があって2桁以上の数値と置き換えられた場合長さが変わってしまうために必要)
	end;

	function _GetStr(const AType: T_MyType): WideString;
		function _FillChar(sChar: WideChar; iCount: Integer): WideString;
		{2007-09-16,2015-09-16:
		FillCharのWideString版のようなもの
		}
		var
			i: Integer;
		begin
			if (iCount > 0)
			then begin
				SetLength(Result, iCount);
				for i := 1 to iCount do begin
		//			Result := Result + sStr;
					Result[i] := sChar;
				end;
			end else
			begin
				Result := '';
			end;
		end;
	var
		li_Len  : Integer;
		li_Count:Integer;
	begin
		if not(gfnbIsInsideRange(AType.iIndex, 0, High(Args)))
		then begin
			Result := '';
		end else
		begin
			case Args[AType.iIndex].VType of
				vtChar       : Result := Args[AType.iIndex].VChar;
				vtString     : Result := Args[AType.iIndex].VString^;
				vtWideChar   : Result := Args[AType.iIndex].VWideChar;
				vtPWideChar  : Result := Args[AType.iIndex].VPWideChar;
				vtAnsiString : Result := WideString(AnsiString(Args[AType.iIndex].VAnsiString));
				vtWideString : Result := WideString(Args[AType.iIndex].VWideString);
				vtPChar      : Result := Args[AType.iIndex].VPChar;
				else           Result := '';
			end;

			if (AType.iPrec >= 0)
			then begin
				//最大の幅の指定
				if (Length(Result) > AType.iPrec)
				then begin
					SetLength(Result, AType.iPrec);
				end;
			end;

			if (AType.iWidth >= 0)
			then begin
				li_Len := Length(Result);
				if (li_Len < AType.iWidth)
				then begin
					li_Count := AType.iWidth - li_Len;
					if (AType.bLeft)
					then begin
						//左詰
						Result := Result + _FillChar(' ', li_Count);
					end
					else
					begin
						//右詰
						Result := _FillChar(' ', li_Count) + Result;
					end;
				end;
			end;
		end;
	end;

	function _GetValue(const AType: T_MyType): WideString;
	begin
		if not(gfnbIsInsideRange(AType.iIndex, Low(Args), High(Args)))
		then begin
			Result := '';
		end
		else
		begin
			if (AType.iPrec < 0)
			then begin
				Result := WideFormat(AType.sType, Args);
			end
			else
			begin
				Result := Format(AType.sType, Args);
			end;
		end;
	end;

	procedure _InitFmtType(var AType: T_MyType);
	begin
		AType.sType   := '';
		AType.sChar   := #0;
//NG		AType.iIndex  := 0;
		AType.bLeft   := False;
		AType.iWidth  := -1;
		AType.iPrec   := -1;
		AType.iLength := 0;
	end;

	procedure _GetType(const pFormat: PWideChar; const iFmtPos: Integer; var AType: T_MyType);
		procedure _GetNum(var AType: T_MyType; var sNum: WideString; var bPrec: Boolean);
		begin
			if (sNum <> '')
			then begin
				if (bPrec)
				then begin
					AType.iPrec := gfniStrToInt(sNum);
					bPrec := False;
				end else
				begin
					AType.iWidth := gfniStrToInt(sNum);
				end;

				sNum := '';
			end;
		end;

		function _GetArg(var AType: T_MyType): WideString;
		var
			li_Num : Int64;
		begin
			if (AType.iIndex < 0)
			then begin
				AType.iIndex := 0;
			end;

			case Args[AType.iIndex].VType of
				vtInteger  : li_Num := Args[AType.iIndex].VInteger;
				vtInt64    : li_Num := Integer(Args[AType.iIndex].VInt64);
				vtBoolean  : li_Num := Integer(Args[AType.iIndex].VBoolean);
				vtExtended : li_Num := gfniRound(Args[AType.iIndex].VExtended^);
				vtCurrency : li_Num := gfniRound(Args[AType.iIndex].VCurrency^);
//				vtVariant    = 13;
				else
				begin
					Result := '0';
		Exit;
				end;
			end;

			Result := IntToStr(li_Num);
			Inc(AType.iIndex);
		end;
	var
		i: Integer;
		ls_Num : WideString;
		lb_Prec: Boolean;
	begin
		//初期化
		_InitFmtType(AType);
		lb_Prec := False;

		ls_Num := '';
		i := iFmtPos;
		while (pFormat[i] <> #0)
		do begin
			case pFormat[i] of
				'%'
				:begin
		Break;
				end;
				':' //引数指定子
				:begin
					//数値(引数のインデックス)の後に':'(コロン)がつく。
					if (ls_Num <> '')
					then begin
						if (lb_Prec)
						then begin
							AType.iPrec  := gfniStrToInt(ls_Num);
							//本来精度指定子の直後に引数指定子を置くことは不可であるが簡便のため0を指定したものとみなす。
							AType.iIndex := 0;
						end else
						begin
							AType.iIndex := gfniStrToInt(ls_Num);
						end;
						ls_Num := '';
					end else
					begin
						//':'の前に数値がなければ(本来はエラーだが)0を指定したものとする
						AType.iIndex := 0;
					end;
				end;
				'-' //左揃えインジケータ
				:begin
					AType.bLeft := True;
					_GetNum(AType, ls_Num, lb_Prec);
				end;
				'.' //精度指定子
				:begin
					//'.'の後に数値(桁数)が続く
					_GetNum(AType, ls_Num, lb_Prec);
					lb_Prec := True;
				end;
				'*' //アスタリスク
				:begin
					if (ls_Num <> '')
					then begin
						//本来はエラー
						ls_Num := ls_Num + _GetArg(AType);
					end else
					begin
						ls_Num := _GetArg(AType);
					end;
				end;
				'0'..'9' //幅指定子
				:begin
					ls_Num := ls_Num + pFormat[i];
				end;
				's', 'S', //文字列表現。引数は文字，文字列，PChar のいずれかの値でなくてはならない。
				'd', 'D', //10 進数。引数は整数値でなくてはならない。
				'u', 'U', //符号なし 10 進数。'd' と似ているが，符号は出力されない
				'e', 'E', //指数。引数は浮動小数点値でなくてはならない。
				'f', 'F', //固定小数点。引数は浮動小数点値でなくてはならない。
				'g', 'G', //汎用表現。引数は浮動小数点値でなくてはならない。
				'n', 'N', //数値表現。引数は浮動小数点値でなくてはならない。
				'm', 'M', //金額。引数は浮動小数点値でなくてはならない。
				'p', 'P', //ポインタ。引数はポインタ値でなくてはならない。
				'x', 'X'  //16 進数。引数は整数値でなくてはならない。
				:begin
					AType.sChar := pFormat[i];
					Inc(AType.iLength);
					_GetNum(AType, ls_Num, lb_Prec);
		Break;
				end;
				else
				begin
					//エラー
				end;
			end;
			Inc(i);
			Inc(AType.iLength);
		end;

		if (AType.iIndex > -1)
		then begin
			AType.sType := WideFormat('%d:', [AType.iIndex]);
		end;
		if (AType.bLeft)
		then begin
			AType.sType := AType.sType + '-';
		end;
		if (AType.iWidth > -1)
		then begin
			AType.sType := WideFormat('%s%d', [AType.sType, AType.iWidth]);
		end;
		if (AType.iPrec > -1)
		then begin
			AType.sType := WideFormat('%s.%d', [AType.sType, AType.iPrec]);
		end;
		AType.sType := WideFormat('%%%s%s', [AType.sType, AType.sChar]);
	end;

	function _GetPreText(pFormat: PWideChar; iPos: Integer): WideString;
	begin
		Result := Copy(WideString(pFormat), 1, iPos -1)
	end;

var
	l_List: array of WideString;
	li_Add: Integer;

	procedure _Add(sText: WideString);
	begin
		if (li_Add > High(l_List))
		then begin
			SetLength(l_List, High(l_List) +1 +1);
//			l_List[High(l_List)] := '';
		end;

		l_List[li_Add] := sText;
		Inc(li_Add);
	end;

var
	i: Integer;
	l_Type      : T_MyType;
	lp_Format   : PWideChar;
	li_FmtPos   : Integer;
	li_FmtIndex : Integer;
//	li_Len      : Integer;
begin
	Result := '';
{
	SetLength(l_List, High(Args) +1); //Highは最大-1の値なので配列の個数を確保するためには+1しないといけない
	for i := 0 to High(l_List)
	do begin
		l_List[i] := '';
	end;
}
//	li_Len := Length(sFormat);
	_InitFmtType(l_Type);
	l_Type.iIndex := 0; //必須
	li_FmtIndex := 0;
	li_Add      := 0;
	lp_Format   := PWideChar(sFormat);
	repeat
		lp_Format := @lp_Format[li_FmtIndex];
		li_FmtPos := Pos('%', WideString(lp_Format)); //PWideCharの添字は0から始まるのでPosの戻り値を渡すと'%'の次の文字になる
		if  (li_FmtPos > 0)
		and (lp_Format[li_FmtPos] <> #0)
		then begin
			//形式指定子があった
			case lp_Format[li_FmtPos] of
				'%' //'%%'の記述
				:begin
//					_InitFmtType(l_Type);
					l_Type.iLength := 1; //2017-02-02:%%の後の文字が消えるバグ解消
					_Add('%');
				end;
				else
				begin
					_GetType(lp_Format, li_FmtPos, l_Type);
					case l_Type.sChar of
						//文字列。4000文字を超えたあたりで例外が送出されてしまうので対処。
						's', 'S' //文字列表現。引数は文字，文字列，PChar のいずれかの値でなくてはならない。
						:begin
							_Add(_GetPreText(lp_Format, li_FmtPos) + _GetStr(l_Type));
						end;
						else
						begin
							_Add(_GetPreText(lp_Format, li_FmtPos) + _GetValue(l_Type));
						end;
					end;
					Inc(l_Type.iIndex);
				end;
			end;
			//lp_Formatの次のインデックスをセット
			li_FmtIndex := li_FmtPos + l_Type.iLength;
		end else
		begin
			Inc(li_FmtIndex);
		end;

{
if (G_Debug)
then begin
	myDebug.gpcDebug([WideString(lp_Format), li_FmtIndex, li_FmtPos, l_Type.sType, l_Type.iIndex]);
end;
}
	until (li_FmtPos = 0); // or ((li_FmtIndex +1) >= li_Len); //Trueで抜ける

//myDebug.gpcDebug(High(l_List));
	for i := 0 to High(l_List)
	do begin
//myDebug.gpcDebug(l_List[i]);
		Result := Result + l_List[i];
	end;

	if (lp_Format[li_FmtPos] <> #0)
	then begin
		Result := Result + WideString(lp_Format);
	end;
end;

//------------------------------------------------------------------------------
//文字コードの自動判定
//http://mrxray.on.coocan.jp/Delphi/plSamples/886_ChangeCodePage.htm
//http://www.delphikingdom.com/asp/answer.asp?IDAnswer=16895
const
	IID_IMultiLanguage2  : TGUID = '{DCCFC164-2B38-11D2-B7EC-00C04F8F5D9A}';
	CLASS_CMultiLanguage : TGUID = '{275C23E2-3747-11D0-9FEA-00AA003F8646}';

type
	tagMIMECPINFO = packed record
		dwFlags             : LongWord;
		uiCodePage          : SYSUINT;
		uiFamilyCodePage    : SYSUINT;
		wszDescription      : array[0..63] of Word;
		wszWebCharset       : array[0..49] of Word;
		wszHeaderCharset    : array[0..49] of Word;
		wszBodyCharset      : array[0..49] of Word;
		wszFixedWidthFont   : array[0..31] of Word;
		wszProportionalFont : array[0..31] of Word;
		bGDICharset         : Byte;
	end;

	tagMIMECSETINFO = packed record
		uiCodePage         : SYSUINT;
		uiInternetEncoding : SYSUINT;
		wszCharset         : array[0..49] of Word;
	end;

	tagRFC1766INFO = packed record
		lcid          : LongWord;
		wszRfc1766    : array[0..5]  of Word;
		wszLocaleName : array[0..31] of Word;
	end;

	tagDetectEncodingInfo = packed record
		nLangID     : SYSUINT;
		nCodePage   : SYSUINT;
		nDocPercent : SYSINT;
		nConfidence : SYSINT;
	end;

	tagSCRIPTINFO = packed record
		ScriptId            : Byte;
		uiCodePage          : SYSUINT;
		wszDescription      : array[0..47] of Word;
		wszFixedWidthFont   : array[0..31] of Word;
		wszProportionalFont : array[0..31] of Word;
	end;

	__MIDL_IWinTypes_0009 = record
		case Integer of
			0 : (hInproc : Integer);
			1 : (hRemote : Integer);
  end;

	_RemotableHandle = packed record
		fContext : Integer;
		u        : __MIDL_IWinTypes_0009;
	end;

// Constants for enum tagMIMECONTF
//type
	tagMIMECONTF = TOleEnum;

// *********************************************************************//
// Interface: IEnumCodePage
// Flags:    (0)
// GUID:      {275C23E3-3747-11D0-9FEA-00AA003F8646}
// *********************************************************************//
  IEnumCodePage = interface(IUnknown)
		['{275C23E3-3747-11D0-9FEA-00AA003F8646}']
    function Clone(out ppEnum: IEnumCodePage): HResult; stdcall;
		function Next(celt: LongWord; out rgelt: tagMIMECPINFO; out pceltFetched: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
		function Skip(celt: LongWord): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IEnumRfc1766
// Flags:    (0)
// GUID:      {3DC39D1D-C030-11D0-B81B-00C04FC9B31F}
// *********************************************************************//
	IEnumRfc1766 = interface(IUnknown)
    ['{3DC39D1D-C030-11D0-B81B-00C04FC9B31F}']
		function Clone(out ppEnum: IEnumRfc1766): HResult; stdcall;
		function Next(celt: LongWord; out rgelt: tagRFC1766INFO; out pceltFetched: LongWord): HResult; stdcall;
		function Reset: HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
	end;

// *********************************************************************//
// Interface: IMLangConvertCharset
// Flags:    (0)
// GUID:      {D66D6F98-CDAA-11D0-B822-00C04FC9B31F}
// *********************************************************************//
  IMLangConvertCharset = interface(IUnknown)
		['{D66D6F98-CDAA-11D0-B822-00C04FC9B31F}']
    function Initialize(uiSrcCodePage: SYSUINT; uiDstCodePage: SYSUINT; dwProperty: LongWord): HResult; stdcall;
		function GetSourceCodePage(out puiSrcCodePage: SYSUINT): HResult; stdcall;
    function GetDestinationCodePage(out puiDstCodePage: SYSUINT): HResult; stdcall;
		function GetProperty(out pdwProperty: LongWord): HResult; stdcall;
//*****
//		function DoConversion(var pSrcStr: Byte; var pcSrcSize: SYSUINT; var pDstStr: Byte;
//													var pcDstSize: SYSUINT): HResult; stdcall;
		function DoConversion(
				pSrcStr       : PAnsiChar;
				var pcSrcSize : SYSUINT;
				pDstStr       : PAnsiChar;
				var pcDstSize : SYSUINT
		) : HResult; stdcall;
		function DoConversionToUnicode(var pSrcStr: Shortint; var pcSrcSize: SYSUINT;
																	var pDstStr: Word; var pcDstSize: SYSUINT): HResult; stdcall;
		function DoConversionFromUnicode(var pSrcStr: Word; var pcSrcSize: SYSUINT;
                                    var pDstStr: Shortint; var pcDstSize: SYSUINT): HResult; stdcall;
	end;

// *********************************************************************//
// Interface: IEnumScript
// Flags:    (0)
// GUID:      {AE5F1430-388B-11D2-8380-00C04F8F5DA1}
// *********************************************************************//
  IEnumScript = interface(IUnknown)
		['{AE5F1430-388B-11D2-8380-00C04F8F5DA1}']
    function Clone(out ppEnum: IEnumScript): HResult; stdcall;
		function Next(celt: LongWord; out rgelt: tagSCRIPTINFO; out pceltFetched: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
		function Skip(celt: LongWord): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IMultiLanguage2
// Flags:    (0)
// GUID:      {DCCFC164-2B38-11D2-B7EC-00C04F8F5D9A}
// *********************************************************************//
	IMultiLanguage2 = interface(IUnknown)
    ['{DCCFC164-2B38-11D2-B7EC-00C04F8F5D9A}']
		function GetNumberOfCodePageInfo(out pcCodePage: SYSUINT): HResult; stdcall;
		function GetCodePageInfo(uiCodePage: SYSUINT; LangId: Word; out pCodePageInfo: tagMIMECPINFO): HResult; stdcall;
		function GetFamilyCodePage(uiCodePage: SYSUINT; out puiFamilyCodePage: SYSUINT): HResult; stdcall;
		function EnumCodePages(grfFlags: LongWord; LangId: Word; out ppEnumCodePage: IEnumCodePage): HResult; stdcall;
		function GetCharsetInfo(const Charset: WideString; out pCharsetInfo: tagMIMECSETINFO): HResult; stdcall;
    function IsConvertible(dwSrcEncoding: LongWord; dwDstEncoding: LongWord): HResult; stdcall;
//*****
//    function ConvertString(var pdwMode: LongWord; dwSrcEncoding: LongWord; dwDstEncoding: LongWord;
//                          var pSrcStr: Byte; var pcSrcSize: SYSUINT; var pDstStr: Byte;
//                          var pcDstSize: SYSUINT): HResult; stdcall;
		function ConvertString(
				var pdwMode   : LongWord;
				dwSrcEncoding : LongWord;
				dwDstEncoding : LongWord;
				var pSrcStr   : Byte;
				var pcSrcSize : SYSUINT;
				var pDstStr   : Byte;
				var pcDstSize : SYSUINT
		) : HResult; stdcall;
//*****
//    function ConvertStringToUnicode(var pdwMode: LongWord; dwEncoding: LongWord;
//																		var pSrcStr: Shortint; var pcSrcSize: SYSUINT;
//																		var pDstStr: Word; var pcDstSize: SYSUINT): HResult; stdcall;
		function ConvertStringToUnicode(
				var pdwMode   : DWORD;
				dwEncoding    : DWORD;
				pSrcStr       : PAnsiChar;
				var pcSrcSize : SYSUINT;
				pDstStr       : PWideChar;
				var pcDstSize : SYSUINT
		) : HResult; stdcall;
//*****
//		function ConvertStringFromUnicode(var pdwMode: LongWord; dwEncoding: LongWord;
//																			var pSrcStr: Word; var pcSrcSize: SYSUINT;
//																			var pDstStr: Shortint; var pcDstSize: SYSUINT): HResult; stdcall;
		function ConvertStringFromUnicode(
				var pdwMode   : DWORD;
				dwEncoding    : DWORD;
				pSrcStr       : PWideChar;
				var pcSrcSize : SYSUINT;
				pDstStr       : PAnsiChar;
				var pcDstSize : SYSUINT
		) : HResult; stdcall;
		function ConvertStringReset: HResult; stdcall;
		function GetRfc1766FromLcid(locale: LongWord; out pbstrRfc1766: WideString): HResult; stdcall;
    function GetLcidFromRfc1766(out plocale: LongWord; const bstrRfc1766: WideString): HResult; stdcall;
		function EnumRfc1766(LangId: Word; out ppEnumRfc1766: IEnumRfc1766): HResult; stdcall;
    function GetRfc1766Info(locale: LongWord; LangId: Word; out pRfc1766Info: tagRFC1766INFO): HResult; stdcall;
		function CreateConvertCharset(uiSrcCodePage: SYSUINT; uiDstCodePage: SYSUINT;
                                  dwProperty: LongWord; 
																	out ppMLangConvertCharset: IMLangConvertCharset): HResult; stdcall;
    function ConvertStringInIStream(var pdwMode: LongWord; dwFlag: LongWord; var lpFallBack: Word; 
																		dwSrcEncoding: LongWord; dwDstEncoding: LongWord;
                                    const pstmIn: ISequentialStream; 
																		const pstmOut: ISequentialStream): HResult; stdcall;
    function ConvertStringToUnicodeEx(var pdwMode: LongWord; dwEncoding: LongWord; 
																			var pSrcStr: Shortint; var pcSrcSize: SYSUINT;
                                      var pDstStr: Word; var pcDstSize: SYSUINT; dwFlag: LongWord; 
																			var lpFallBack: Word): HResult; stdcall;
    function ConvertStringFromUnicodeEx(var pdwMode: LongWord; dwEncoding: LongWord; 
																				var pSrcStr: Word; var pcSrcSize: SYSUINT;
                                        var pDstStr: Shortint; var pcDstSize: SYSUINT; 
																				dwFlag: LongWord; var lpFallBack: Word): HResult; stdcall;
    function DetectCodepageInIStream(dwFlag: LongWord; dwPrefWinCodePage: LongWord; 
																		const pstmIn: ISequentialStream;
																		var lpEncoding: tagDetectEncodingInfo; var pnScores: SYSINT): HResult; stdcall;
//*****
//    function DetectInputCodepage(dwFlag: LongWord; dwPrefWinCodePage: LongWord;
//                                var pSrcStr: Shortint; var pcSrcSize: SYSINT;
//                                var lpEncoding: tagDetectEncodingInfo; var pnScores: SYSINT): HResult; stdcall;
		function DetectInputCodepage(
				dwFlag            : DWORD;
				dwPrefWinCodePage : DWORD;
				pSrcStr           : PAnsiChar;
				var pcSrcSize     : SYSINT;
				var lpEncoding    : tagDetectEncodingInfo;
				var pnScores      : SYSINT
		) : HResult; stdcall;
		function ValidateCodePage(uiCodePage: SYSUINT; var hwnd: _RemotableHandle): HResult; stdcall;
    function GetCodePageDescription(uiCodePage: SYSUINT; lcid: LongWord; lpWideCharStr: PWideChar; 
																		cchWideChar: SYSINT): HResult; stdcall;
    function IsCodePageInstallable(uiCodePage: SYSUINT): HResult; stdcall;
		function SetMimeDBSource(dwSource: tagMIMECONTF): HResult; stdcall;
    function GetNumberOfScripts(out pnScripts: SYSUINT): HResult; stdcall;
		function EnumScripts(dwFlags: LongWord; LangId: Word; out ppEnumScript: IEnumScript): HResult; stdcall;
    function ValidateCodePageEx(uiCodePage: SYSUINT; var hwnd: _RemotableHandle; 
																dwfIODControl: LongWord): HResult; stdcall;
  end;

function gfnsLanguageGet(iLanguage: WORD): WideString;
//http://kwikwi.cocolog-nifty.com/blog/2007/05/index.html
var
	li_Len: Integer;
	lp_Buff: PWideChar;
begin
	Result := 'UnKnown';
	li_Len := GetLocaleInfoW(iLanguage, LOCALE_SENGLANGUAGE, nil, 0);
	if (li_Len > 0)
	then begin
		lp_Buff := AllocMem((li_Len +1) * SizeOf(WideChar));
		try
			GetLocaleInfoW(iLanguage, LOCALE_SLANGUAGE, lp_Buff, li_Len);
			Result := WideString(lp_Buff);
		finally
			FreeMem(lp_Buff);
		end;
	end;
(*
Exit;
//http://www.kanaya440.com/contents/script/vbs/others/lcid.html
	case iLanguage of
		 1078: Result := 'アフリカーンス語';
		 1052: Result := 'アルバニア語';
		14337: Result := 'アラビア語(U.A.E.)';
		15361: Result := 'アラビア語(バーレーン)';
		 5121: Result := 'アラビア語(アルジェリア)';
		 3073: Result := 'アラビア語(エジプト)';
		 2049: Result := 'アラビア語(イラク)';
		11265: Result := 'アラビア語(ヨルダン)';
		13313: Result := 'アラビア語(クウェート)';
		12289: Result := 'アラビア語(レバノン)';
		 4097: Result := 'アラビア語(リビア)';
		 6145: Result := 'アラビア語(モロッコ)';
		 8193: Result := 'アラビア語(オマーン)';
		16385: Result := 'アラビア語(カタール)';
		 1025: Result := 'アラビア語(サウジアラビア)';
		10241: Result := 'アラビア語(シリア)';
		 7169: Result := 'アラビア語(チュニジア)';
		 9217: Result := 'アラビア語(イエメン)';
		 1069: Result := 'バスク語';
		 1059: Result := 'ベラルーシ語';
		 1026: Result := 'ブルガリア語';
		 1027: Result := 'カタロニア語';
		 2052: Result := '中国語(中華人民共和国)';
		 3076: Result := '中国語(香港)';
		 4100: Result := '中国語(シンガポール)';
		 1028: Result := '中国語(台湾)';
		 1050: Result := 'クロアチア語';
		 1029: Result := 'チェコ語';
		 1030: Result := 'デンマーク語';
		 1043: Result := 'オランダ語';
		 2067: Result := 'オランダ語(ベルギー)';
		 3081: Result := '英語(オーストラリア)';
		10249: Result := '英語(ベリーズ)';
		 4105: Result := '英語(カナダ)';
		 6153: Result := '英語(アイルランド)';
		 8201: Result := '英語(ジャマイカ)';
		 5129: Result := '英語(ニュージーランド)';
		 7177: Result := '英語(南アフリカ)';
		11273: Result := '英語(トリニダード)';
		 2057: Result := '英語(U.K.)';
		 1033: Result := '英語(U.S.)';
		 1061: Result := 'エストニア語';
		 1065: Result := 'ペルシャ語';
		 1035: Result := 'フィンランド語';
		 1080: Result := 'フェロー語';
		 1036: Result := 'フランス語(フランス)';
		 2060: Result := 'フランス語(ベルギー)';
		 3084: Result := 'フランス語(カナダ)';
		 5132: Result := 'フランス語(ルクセンブルグ)';
		 4108: Result := 'フランス語(スイス)';
		 1084: Result := 'ゲール語(スコットランド)';
		 1031: Result := 'ドイツ語(ドイツ)';
		 3079: Result := 'ドイツ語(オーストリア)';
		 5127: Result := 'ドイツ語(リヒテンシュタイン)';
		 4103: Result := 'ドイツ語(ルクセンブルグ)';
		 2055: Result := 'ドイツ語(スイス)';
		 1032: Result := 'ギリシャ語';
		 1037: Result := 'ヘブライ語';
		 1081: Result := 'ヒンズー語';
		 1038: Result := 'ハンガリー語';
		 1039: Result := 'アイスランド語';
		 1057: Result := 'インドネシア語';
		 1040: Result := 'イタリア語(イタリア)';
		 2064: Result := 'イタリア語(スイス)';
		 1041: Result := '日本語';
		 1042: Result := '韓国語';
		 1062: Result := 'ラトビア語';
		 1063: Result := 'リトアニア語';
		 1071: Result := 'マケドニア語(FYROM)';
		 1086: Result := 'マレー語(マレーシア)';
		 1082: Result := 'マルタ語';
		 1044: Result := 'ノルウェー語(ブークモール)';
		 1045: Result := 'ポーランド語';
		 2070: Result := 'ポルトガル語(ポルトガル)';
		 1046: Result := 'ポルトガル語(ブラジル)';
		 1047: Result := 'レトロマン語';
		 1048: Result := 'ルーマニア語';
		 2072: Result := 'ルーマニア語(モルドバ)';
		 1049: Result := 'ロシア語';
		 2073: Result := 'ロシア語(モルドバ)';
		 3098: Result := 'セルビア語(キリル文字)';
		 1074: Result := 'ツワナ語';
		 1060: Result := 'スロベニア語';
		 1051: Result := 'スロバキア語';
		 1070: Result := 'ソルビア語';
		 1034: Result := 'スペイン語(スペイン)';
		11274: Result := 'スペイン語(アルゼンチン)';
		16394: Result := 'スペイン語(ボリビア)';
		13322: Result := 'スペイン語(チリ)';
		 9226: Result := 'スペイン語(コロンビア)';
		 5130: Result := 'スペイン語(コスタリカ)';
		 7178: Result := 'スペイン語(ドミニカ共和国)';
		12298: Result := 'スペイン語(エクアドル)';
		 4106: Result := 'スペイン語(グアテマラ)';
		18442: Result := 'スペイン語(ホンジュラス)';
		 2058: Result := 'スペイン語(メキシコ)';
		19466: Result := 'スペイン語(ニカラグア)';
		 6154: Result := 'スペイン語(パナマ)';
		10250: Result := 'スペイン語(ペルー)';
		20490: Result := 'スペイン語(プエルトリコ)';
		15370: Result := 'スペイン語(パラグアイ)';
		17418: Result := 'スペイン語(エルサルバドル)';
		14346: Result := 'スペイン語(ウルグアイ)';
		 8202: Result := 'スペイン語(ベネズエラ)';
		 1072: Result := 'ソト語';
		 1053: Result := 'スウェーデン語';
		 2077: Result := 'スウェーデン語(フィンランド)';
		 1054: Result := 'タイ語';
		 1055: Result := 'トルコ語';
		 1073: Result := 'ツォンガ語';
		 1058: Result := 'ウクライナ語';
		 1056: Result := 'ウルドゥー語(パキスタン)';
		 1066: Result := 'ベトナム語';
		 1076: Result := 'コーサ語';
		 1085: Result := 'イディッシュ語';
		 1077: Result := 'ズールー語';
		else   Result := '不明';
	end;
*)
end;

function gfnsCodePageGet(iLanguage, iCodePage: WORD): WideString;
//http://mrxray.on.coocan.jp/Delphi/plSamples/886_ChangeCodePage.htm
var
	l_IMultiLanguage: IMultiLanguage2;
	l_MIMECPInfo    : tagMIMECPINFO;
begin
	//指定されたCLSID関連付けクラスの1つの未初期化オブジェクトを作成
	if (Succeeded(CoCreateInstance(
		CLASS_CMultiLanguage, //オブジェクトのCLSID
		nil,                  //複数オブジェクトの一部の時はIUnknownインターフェイスのポインタ
		CLSCTX_INPROC_SERVER, //管理コードを実行するコンテキスト
		IID_IMultiLanguage2,  //取得するIID
		l_IMultiLanguage      //生成オブジェクトの変数アドレス
	)))
	then begin
		try
			FillChar(l_MIMECPInfo, SizeOf(l_MIMECPInfo), 0);
			if (Succeeded(l_IMultiLanguage.GetCodePageInfo(iCodePage, iLanguage, l_MIMECPInfo)))
			then begin
				Result := WideString(PWideChar(@l_MIMECPInfo.wszDescription));
			end;
		finally
			l_IMultiLanguage := nil;
		end;
	end;
end;


{
Unicode対応のファイル選択ダイアログ
TOpenFilename(OpenFilename構造体)について
http://homepage2.nifty.com/Mr_XRAY/Halbow/Chap18.html
コールバック関数について
http://www.vbstation.net/spec/S3_1.htm
}
//コールバック関数
function _CallbackFileDialog(hHandle: HWND; iMsg: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
var
	lh_Handle: HWND;
	lrc_Rect:  TRect;
begin
	if (iMsg = WM_INITDIALOG) then begin
		lh_Handle := GetParent(hHandle);  //ダイアログボックスのウィンドウハンドルを取得
		GetWindowRect(lh_Handle, lrc_Rect);
		//表示位置をモニターの真ん中に
		lrc_Rect := gfnrcRectCenter(gfnrcMonitorWorkAreaRectGet(lh_Handle), lrc_Rect);
		SetWindowPos(lh_Handle, HWND_TOP, lrc_Rect.Left, lrc_Rect.Top, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
	end;
	Result := 0;
end;

function gfnbOpenFileDialog(var sFileName: WideString; sDir: WideString; hHandle: HWND): Boolean;
{
Unicode対応のファイル選択ダイアログ。
http://delwiki.info/?%A5%B3%A1%BC%A5%C9%C1%D2%B8%CB%2FUnicode%C2%D0%B1%FE%B0%C6%A4%BD%A4%CE%A3%B2
上記サイトとDialogsのTOpenDialog.DoExecuteを参考。
}
const
	lcs_SEP = #0;
var
//	i : Integer;
	l_Info   : TOpenFilenameW;
	li_Flag  : DWORD;
//	ls_Path  : WideString;
//	ls_Item  : WideString;
//	li_Start : DWORD;
begin
	li_Flag := OFN_EXPLORER; //エクスプローラ風は必須(古いタイプのとでは区切りが違うので)

	FillChar(l_Info, SizeOf(l_Info), 0);  //0で初期化

	l_Info.lStructSize := SizeOf(l_Info);
	l_Info.hWndOwner   := hHandle;
	if (l_Info.hWndOwner = 0)
	then begin
		l_Info.hWndOwner := Application.Handle;
	end;

	l_Info.lpstrInitialDir := PWideChar(sDir);
	l_Info.FlagsEx := 0;
	l_Info.Flags   := li_Flag;

	if (hHandle = Application.Handle)
	then begin
		//Application.Handleだとダイアログが右下に表示されるのでフックを行って真ん中にする
		l_Info.Flags    := l_Info.Flags or OFN_ENABLEHOOK;
		l_Info.lpfnHook := _CallbackFileDialog;
	end
	else
	begin
		if ((l_Info.Flags and OFN_ENABLEHOOK) <> 0)
		then begin
			l_Info.Flags := l_Info.Flags - OFN_ENABLEHOOK;
		end;
		l_Info.lpfnHook := nil;
	end;
	l_Info.nMaxFile  := 1024 * 32; //とりあえずこれだけあれば大丈夫ではないかなと
	l_Info.lpstrFile := AllocMem((l_Info.nMaxFile + 2) * SizeOf(WideChar));  //終了マーカーの'#0#0'の分で + 2。Unicodeなのでその2倍。
	try
		Result := GetOpenFileNameW(l_Info);
		if (Result)
		then begin
			//一つだけ選択
			sFileName := WideString(l_Info.lpstrFile);
		end;
	finally
		FreeMem(l_Info.lpstrFile);
	end;
end;


//------------------------------------------------------------------------------
initialization

//Psapi.dll
	F_hPsapidllModule := LoadLibraryW(PWideChar(gfnsSystem32DirGet + 'Psapi.dll'));
	if (F_hPsapidllModule <> 0)
	then begin
		//GetProcessImageFileNameの関数ポインタを取得
		@F_GetProcessImageFileName := GetProcAddress(F_hPsapidllModule, 'GetProcessImageFileNameW');
	end
	else
	begin
		@F_GetProcessImageFileName := nil;
	end;

//Dwmapi.dll
	F_hDwmapidllModule := LoadLibraryW(PWideChar(gfnsSystem32DirGet + 'Dwmapi.dll'));
	if (F_hDwmapidllModule <> 0)
	then begin
		@F_DwmEnableComposition    := GetProcAddress(F_hDwmapidllModule, 'DwmEnableComposition');
		@F_DwmIsCompositionEnabled := GetProcAddress(F_hDwmapidllModule, 'DwmIsCompositionEnabled');
		@F_DwmGetWindowAttribute   := GetProcAddress(F_hDwmapidllModule, 'DwmGetWindowAttribute');
	end
	else
	begin
		@F_DwmEnableComposition    := nil;
		@F_DwmIsCompositionEnabled := nil;
		@F_DwmGetWindowAttribute   := nil;
	end;

//user32.dll
	F_hUser32dllModule := LoadLibraryW(PWideChar(gfnsSystem32DirGet + 'User32.dll'));
	if (F_hUser32dllModule <> 0)
	then begin
		// 各種の関数ポインタを取得
		@F_GetPhysicalCursorPos   := GetProcAddress(F_hUser32dllModule, 'GetPhysicalCursorPos');
		@F_LogicalToPhysicalPoint := GetProcAddress(F_hUser32dllModule, 'LogicalToPhysicalPoint');
		@F_PhysicalToLogicalPoint := GetProcAddress(F_hUser32dllModule, 'PhysicalToLogicalPoint');
		@F_SetProcessDPIAware     := GetProcAddress(F_hUser32dllModule, 'SetProcessDPIAware');

		@F_GetLayeredWindowAttributes := GetProcAddress(F_hUser32dllModule, 'GetLayeredWindowAttributes');
		@F_SetLayeredWindowAttributes := GetProcAddress(F_hUser32dllModule, 'SetLayeredWindowAttributes');
	end
	else
	begin
		@F_GetPhysicalCursorPos   := nil;
		@F_LogicalToPhysicalPoint := nil;
		@F_LogicalToPhysicalPoint := nil;
		@F_SetProcessDPIAware     := nil;
		@F_GetLayeredWindowAttributes := nil;
		@F_SetLayeredWindowAttributes := nil;
	end;



//myMessageDlg
	F_MessageDlgEvent := TMyMessageDlgEvent.Create;

finalization
	if (F_hPsapidllModule <> 0)
	then begin
		FreeLibrary(F_hPsapidllModule);
	end;

	if (F_hUser32dllModule <> 0)
	then begin
		FreeLibrary(F_hUser32dllModule);
	end;

	if (F_hDwmapidllModule <> 0)
	then begin
		FreeLibrary(F_hDwmapidllModule);
	end;

//myMessageDlg
	FreeAndNil(F_MessageDlgEvent);



end.