unit main;
//{$DEFINE DEBUG}


interface

uses
	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
	Dialogs, StdCtrls, ExtCtrls, ActnList, ComCtrls, Menus,
	myEdit,
	myFileDialog;


type
	T_ExecList = class(TObject)
	private
		F_slList: TList;
		function F_GetPID: DWORD;
	public
		constructor Create;
		destructor  Destroy; override;
		procedure Add(iPID: DWORD);
		procedure Reflesh;
		property  GetPID: DWORD read F_GetPID;
	end;

type
	TApp_TOOLSetFont = class(TForm)
		ActionList1:             TActionList;
		actFile_SelWindowStart:  TAction;
    actFile_SelWindowCancel: TAction;
		actFile_Open:            TAction;
		actFile_CreateShortCut:  TAction;
		actFile_Exit:            TAction;
		actFont_FixedFont:       TAction;
		actHelp_VersionInfo:     TAction;

		PopupMenu1:              TPopupMenu;
		mniFile_Open:            TMenuItem;
		mniFile_CreateShortCut:  TMenuItem;
		mniLine_1:               TMenuItem;
		mniFile_SelWindowStart:  TMenuItem;
		mniFile_SelWindowCancel: TMenuItem;
		mniLine_2:               TMenuItem;
		mniHelp_VersionInfo:     TMenuItem;
		mniLine_3:               TMenuItem;
		mniFile_Exit:            TMenuItem;

		grpSelProgram:        TGroupBox;
			btnOpen:            TButton;
			btnCreateShortCut:  TButton;
		grpSelWindow:         TGroupBox;
			lblSelKey:          TLabel;
			lstHotKey:          TComboBox;
			btnSelWindowStart:  TButton;
			btnSelWindowCancel: TButton;
		chkFont_FixedFont:    TCheckBox;
		btnHelp:              TButton;
		btnExit:              TButton;
		StatusBar1:           TStatusBar;

		Timer1:      TTimer;
		dlgOpenFile: TMyOpenFileDialog;
		edtHelp:     TMemo;
    Button1: TButton;

		procedure actFile_SelWindowStartExecute (Sender: TObject);
		procedure actFile_SelWindowCancelExecute(Sender: TObject);
		procedure actFile_OpenExecute           (Sender: TObject);
		procedure actFile_CreateShortCutExecute (Sender: TObject);
		procedure actFile_ExitExecute           (Sender: TObject);
		procedure actHelp_VersionInfoExecute    (Sender: TObject);
		procedure actFont_FixedFontExecute      (Sender: TObject);
		procedure FormCreate        (Sender: TObject);
		procedure FormDestroy       (Sender: TObject);
		procedure lstHotKeySelect   (Sender: TObject);
		procedure Timer1Timer       (Sender: TObject);
    procedure Button1Click(Sender: TObject);
	private
		{ Private 宣言 }
		F_iVKeyCode:     Integer;
		F_bKeyPress:     Boolean;
		F_sShortCutFile: WideString;
		F_slExecList:    T_ExecList;

		procedure F_SetHotKey(sKey: WideString);
		function  F_LoadIni: Boolean;
		procedure F_SaveIni;

		//ドラッグアンドドロップ
		procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
		//システム終了
		procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QUERYENDSESSION;
	public
		{ Public 宣言 }
		property OpenedFile: WideString write F_sShortCutFile;
		property ExecList: T_ExecList read F_slExecList;
	end;

var
	App_TOOLSetFont: TApp_TOOLSetFont;

implementation
uses
{$IFDEF DEBUG}
	myDebug,
{$ENDIF}
	ShellAPI,
	TLHELP32,
	myDragAndDrop,
	myFile,
	myHelpVersionInfo,
	myIniFile,
	myMessageBox,
	myShortCut,
	myWindow,
	general,
	shortcut;

{$R *.dfm}


//------------------------------------------------------------------------------
{T_Exec}
type
	T_Exec = class(TObject)
	private
		F_iPID:   DWORD;
		F_bExist: Boolean;
		F_bDone:  Boolean;
	public
		constructor Create(iPID: DWORD);
		property Exist: Boolean read F_bExist write F_bExist;
		property Done:  Boolean read F_bDone  write F_bDone;
		property PID:   DWORD   read F_iPID;
	end;

constructor T_Exec.Create(iPID: DWORD);
begin
	inherited Create;
	F_iPID   := iPID;
	F_bExist := True;
	F_bDone  := False;
end;

{T_ExecList}
constructor T_ExecList.Create;
begin
	inherited Create;
	F_slList := TList.Create;
end;

destructor T_ExecList.Destroy;
var
	i: Integer;
begin
	for i := F_slList.Count-1 downto 0 do begin
		T_Exec(F_slList[i]).Free;
		F_slList.Delete(i);
	end;
	F_slList.Free;

	inherited Destroy;
end;

procedure T_ExecList.Add(iPID: DWORD);
var
	i: Integer;
	l_Exec: T_Exec;
begin
	for i := 0 to F_slList.Count-1 do begin
		l_Exec := T_Exec(F_slList[i]);
		if (l_Exec.PID = iPID) then begin
			l_Exec.Exist := True;
Exit;
		end;
	end;

	l_Exec := T_Exec.Create(iPID);
	F_slList.Add(l_Exec);
end;

procedure T_ExecList.Reflesh;
var
	i: Integer;
	l_Exec: T_Exec;
begin
	for i := F_slList.Count-1 downto 0 do begin
		l_Exec := T_Exec(F_slList[i]);
		if not(l_Exec.Exist) then begin
			l_Exec.Free;
			F_slList.Delete(i);
		end else begin
			l_Exec.Exist := False;
		end;
	end;
end;

function T_ExecList.F_GetPID: DWORD;
var
	i: Integer;
	l_Exec: T_Exec;
begin
	Result := 0;
	for i := F_slList.Count-1 downto 0 do begin
		l_Exec := T_Exec(F_slList[i]);
		if not(l_Exec.F_bDone) then begin
			Result := l_Exec.PID;
Exit;
		end;
	end;
end;


//------------------------------------------------------------------------------
procedure TApp_TOOLSetFont.WMDropFiles(var Msg: TWMDropFiles);
var
	l_Drop: TMyDropFiles;
begin
	l_Drop := TMyDropFiles.Create(Msg, Self);
	try
		G_pcSetFont(l_Drop.Files);
	finally
		l_Drop.Free;
	end;
end;

procedure TApp_TOOLSetFont.FormCreate(Sender: TObject);
begin
{$IFDEF DEBUG}
	myDebug.gpcMessageModeSet(True);
{$ENDIF}
	Self.Icon := Application.Icon;
	ShowWindow(chkFont_FixedFont.Handle, SW_HIDE);

	F_LoadIni;
	lstHotKeySelect(nil);

	F_slExecList := T_ExecList.Create;

	DragAcceptFiles(Self.Handle, True);
end;

procedure TApp_TOOLSetFont.FormDestroy(Sender: TObject);
begin
	Hide;
	actFile_SelWindowCancelExecute(nil);
	F_SaveIni;
	F_slExecList.Free;
end;

procedure TApp_TOOLSetFont.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
//http://www.wwlnk.com/boheme/delphi/tips/tec0690.htm
	FormDestroy(Self);
	Msg.Result := 1;
end;


//------------------------------------------------------------------------------
procedure TApp_TOOLSetFont.F_SetHotKey(sKey: WideString);
begin
	if (sKey = '右クリック')
	or (sKey = 'RB')
	or (sKey = 'RBUTTON')
	then begin
		F_iVKeyCode := VK_RBUTTON;
	end else
	if (sKey = '中クリック')
	or (sKey = 'MB')
	or (sKey = 'MBUTTON')
	then begin
		F_iVKeyCode := VK_MBUTTON;
	end else
	if (sKey = 'シフトキー')
	or (sKey = 'SHIFT')
	then begin
		F_iVKeyCode := VK_SHIFT;
	end else
	if (sKey = 'スペースキー')
	or (sKey = 'SP')
	or (sKey = 'SPC')
	or (sKey = 'SPACE')
	then begin
		F_iVKeyCode := VK_SPACE;
	end else
	if (sKey = 'Escキー')
	or (sKey = 'ESC')
	or (sKey = 'ESCAPE')
	then begin
		F_iVKeyCode := VK_ESCAPE;
	end else if (sKey = 'F1') then begin
		F_iVKeyCode := VK_F1;
	end else if (sKey = 'F2') then begin
		F_iVKeyCode := VK_F2;
	end else if (sKey = 'F3') then begin
		F_iVKeyCode := VK_F3;
	end else if (sKey = 'F4') then begin
		F_iVKeyCode := VK_F4;
	end else if (sKey = 'F5') then begin
		F_iVKeyCode := VK_F5;
	end else if (sKey = 'F6') then begin
		F_iVKeyCode := VK_F6;
	end else if (sKey = 'F7') then begin
		F_iVKeyCode := VK_F7;
	end else if (sKey = 'F8') then begin
		F_iVKeyCode := VK_F8;
	end else if (sKey = 'F9') then begin
		F_iVKeyCode := VK_F9;
	end else if (sKey = 'F10') then begin
		F_iVKeyCode := VK_F10;
	end else if (sKey = 'F11') then begin
		F_iVKeyCode := VK_F11;
	end else if (sKey = 'F12') then begin
		F_iVKeyCode := VK_F12;
	end;
end;

procedure TApp_TOOLSetFont.lstHotKeySelect(Sender: TObject);
begin
	F_SetHotKey(lstHotKey.Items[lstHotKey.ItemIndex]);
end;

procedure TApp_TOOLSetFont.Timer1Timer(Sender: TObject);
var
	li_Key: SHORT;
	lh_Handle: HWND;
begin
	Timer1.Enabled := False;
	if (Application.Terminated) then begin
Exit;
	end;

	li_Key := GetAsyncKeyState(F_iVKeyCode);
	if (BOOL(Hi(li_Key)){ and BOOL(Lo(li_Key))}) then begin
		if not(F_bKeyPress)	then begin
			lh_Handle := gfnhTopLevelWindowGet(gfnptMousePosGet);
			G_pcSetFont(lh_Handle);
//			F_sShortCutFile := gfnsExeNameGet(lh_Handle);
			Beep;
			//F_bKeyPress := True;
			//↓でフォントセットの終了処理を行っている
			actFile_SelWindowCancelExecute(nil);
		end;
	end;

	if not(F_bKeyPress) then begin
		Timer1.Enabled := True;
	end;
end;

procedure TApp_TOOLSetFont.actFile_SelWindowStartExecute(Sender: TObject);
begin
	actFile_SelWindowStart.Enabled  := False;
	actFile_SelWindowCancel.Enabled := True;
	F_bKeyPress    := False;
	Timer1.Enabled := True;
end;

procedure TApp_TOOLSetFont.actFile_SelWindowCancelExecute(Sender: TObject);
begin
	F_bKeyPress    := True;
	Timer1.Enabled := False;
	actFile_SelWindowStart.Enabled  := True;
	actFile_SelWindowCancel.Enabled := False;
end;

procedure TApp_TOOLSetFont.actFile_ExitExecute(Sender: TObject);
begin
	Close;
end;

procedure TApp_TOOLSetFont.actHelp_VersionInfoExecute(Sender: TObject);
begin
	actFile_SelWindowCancelExecute(nil);

	gpcVersionInfoCreate;
	gpcVersionInfoMemoSet(gfnsVersionInfoMemoGet + #13#13 + edtHelp.Text);
	gpcVersionInfoURLSet('http://drang.s4.xrea.com/program/tool/tool/setfont/help/');
	gpcVersionInfoShowModal;
	gpcVersionInfoRelease;
end;

procedure TApp_TOOLSetFont.actFile_OpenExecute(Sender: TObject);
begin
	actFile_SelWindowCancelExecute(nil);
	if (dlgOpenFile.Execute) then begin
		G_pcSetFont(dlgOpenFile.FileName);
//		F_sShortCutFile := dlgOpenFile.FileName;
	end;
end;

procedure TApp_TOOLSetFont.actFile_CreateShortCutExecute(Sender: TObject);
var
	li_Ret: Integer;

begin
	actFile_SelWindowCancelExecute(nil);

	App_TOOLSetFont_ShortCut := TApp_TOOLSetFont_ShortCut.Create(Self);
	with App_TOOLSetFont_ShortCut do begin
		try
			dlgOpenFile.FileName     := F_sShortCutFile;
			dlgOpenFolder.InitialDir := gfnsFilePathGet(F_sShortCutFile);
			dlgSaveFile.InitialDir   := dlgOpenFolder.InitialDir;
			li_Ret := ShowModal;
			if (li_Ret = mrOK) then begin
				edtShortCut_Name.Text := Trim(edtShortCut_Name.Text);
				edtShortCut_Path.Text := Trim(edtShortCut_Path.Text);
				edtExe.Text           := Trim(edtExe.Text);
				if (gfnbShortCutCreate(
					edtShortCut_Name.Text,                             //ショートカットのファイル名
					edtShortCut_Path.Text,                             //ショートカットの保存先フォルダ
					gfnsExeNameGet,                                    //参照先
					WideFormat('"%s" %s', [edtExe.Text, edtOpt.Text]), //オプション
					gfnsFilePathGet(edtExe.Text),                      //作業フォルダ
					edtExe.Text                                        //アイコン
				))
				then begin
//					gpcShowMessage('ショートカットの作成に成功しました');
				end else begin
					gpcShowMessage('ショートカットの作成に失敗しました');
				end;
			end;
		finally
			Release;
		end;
	end;
end;

procedure TApp_TOOLSetFont.actFont_FixedFontExecute(Sender: TObject);
//固定幅フォント
begin
	G_bFixedFont := actFont_FixedFont.Checked;
end;


//------------------------------------------------------------------------------
//IniFile
const
	lcsSECT_BOUNDS          = 'Bounds';
	lcsSECT_OPT             = 'Option';
		lcsKEY_HOTKEY         =  'HotKey';
	lcsSECT_DIALOG          = 'Dialog';
		lcsKEY_DLGOPENPATH    =  'OpenPath';
		lcsKEY_DLGLNKOPENPATH =  'ShortCutOpenPath';
		lcsKEY_DLGLNKSAVEPATH =  'ShortCutSavePath';


function TApp_TOOLSetFont.F_LoadIni: Boolean;
var
	l_IniFile:  TMyIniFile;
begin
	Result := False;

	//Shift+Ctrl起動で設定を読み込まない。
	if (gfnbKeyState(VK_SHIFT) and gfnbKeyState(VK_CONTROL)) then begin
Exit;
	end;

	l_IniFile := TMyIniFile.Create;
	with l_IniFile do begin
		try
			SetMonitorBoundsRect(Self);

			//[Option]
			lstHotKey.ItemIndex  := ReadInteger(lcsSECT_OPT, lcsKEY_HOTKEY,  lstHotKey.ItemIndex);

			//[Dialog]
			dlgOpenFile.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_DLGOPENPATH, dlgOpenFile.InitialDir);
		finally
			Free;
		end;
	end;

	Result := True;
end;

//設定保存
procedure TApp_TOOLSetFont.F_SaveIni;
var
	l_IniFile: TMyIniFile;
begin
	//Shift+Ctrl起動で設定を書き込まない。
	if (gfnbKeyState(VK_SHIFT) and gfnbKeyState(VK_CONTROL)) then begin
Exit;
	end;

	l_IniFile := TMyIniFile.Create;
	with l_IniFile do begin
		try
			WriteBoundsRect(Self);

			//[Option]
			WriteInteger(lcsSECT_OPT, lcsKEY_HOTKEY, lstHotKey.ItemIndex);

			//[Dialog]
			WriteString(lcsSECT_DIALOG, lcsKEY_DLGOPENPATH, dlgOpenFile.InitialDir);
			try
				UpdateFile;
			except end;
		finally
			Free;
		end;
	end;
end;


procedure TApp_TOOLSetFont.Button1Click(Sender: TObject);
var
	lh_ExeProcess: THandle;
	lh_Handle: THandle;
	lh_SelfPID: DWORD;
	l_Info: TProcessEntry32W;
begin
	if (dlgOpenFile.Execute) then begin
		lh_ExeProcess := gfnhExecute(dlgOpenFile.FileName, '');
		try
			FillChar(l_Info, SizeOf(l_Info), 0);
			l_Info.dwSize := Sizeof(l_Info);

			lh_Handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, lh_ExeProcess);
			try
				if (Process32FirstW(lh_Handle, l_Info)) then begin
					lh_SelfPID := gfniProcessIDGet(Self.Handle);
					repeat
//						myDebug.gpcDebug([WideString(l_Info.szExeFile), l_Info.th32ParentProcessID, gfniProcessIDGet(Self.Handle)]);
						if (l_Info.th32ParentProcessID = lh_SelfPID) then begin
						end;
					until not(Process32NextW(lh_Handle, l_Info));
				end;
			finally
				CloseHandle(lh_Handle);
			end;
		finally
			CloseHandle(lh_ExeProcess);
		end;
	end;
end;
{
begin
	if (dlgOpenFile.Execute) then begin
		myDebug.gpcDebug(gfnhExecute(dlgOpenFile.FileName, ''));
//		gpcShowMessage(gfnsExecutableFileGet(dlgOpenFile.FileName));
	end;
end;
}


end.