unit shortcut;

interface

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

type
  TApp_TOOLSetFont_ShortCut = class(TForm)
		ActionList1:       TActionList;
		actEdit_Undo:      TAction;
		actEdit_Redo:      TAction;
		actEdit_Cut:       TAction;
		actEdit_Copy:      TAction;
		actEdit_Paste:     TAction;
		actEdit_Delete:    TAction;
		actEdit_SelectAll: TAction;

		lblShortCut_Name:  TLabel;
    lblShortCut_Name2: TLabel;
		edtShortCut_Name:  TMyEdit;
		btnShortCut_Name:  TButton;
		lblShortCut_Path:  TLabel;
		edtShortCut_Path:  TMyEdit;
		btnShortCut_Path:  TButton;
		lblShortCut_Path2: TLabel;
		lblExe:            TLabel;
		lblExe2:           TLabel;
		edtExe:            TMyEdit;
		btnExe:            TButton;
		lblOpt:            TLabel;
		edtOpt:            TMyEdit;
		btnOk:             TButton;
		btnCancel:         TButton;
		StatusBar1:        TStatusBar;

		dlgSaveFile:   TMySaveFileDialog;
    dlgOpenFile: TMyOpenFileDialog;
    dlgOpenFolder: TMyOpenFolderDialog;
    mnuEdit: TPopupMenu;
    mniPEdit_Undo: TMenuItem;
    mniPEdit_Redo: TMenuItem;
    mniPLine_1: TMenuItem;
    mniPEdit_Cut: TMenuItem;
    mniPEdit_Copy: TMenuItem;
    mniPEdit_Paste: TMenuItem;
    mniPEdit_Delete: TMenuItem;
    mniPLine_2: TMenuItem;
    mniPEdit_SelectAll: TMenuItem;

		procedure actEdit_UndoExecute     (Sender: TObject);
		procedure actEdit_RedoExecute     (Sender: TObject);
		procedure actEdit_CutExecute      (Sender: TObject);
		procedure actEdit_CopyExecute     (Sender: TObject);
		procedure actEdit_PasteExecute    (Sender: TObject);
		procedure actEdit_DeleteExecute   (Sender: TObject);
		procedure actEdit_SelectAllExecute(Sender: TObject);

		procedure FormCreate(Sender: TObject);
		procedure FormShow  (Sender: TObject);

		procedure btnShortCut_NameClick (Sender: TObject);
		procedure btnExeClick           (Sender: TObject);
		procedure edtShortCut_NameChange(Sender: TObject);
		procedure btnShortCut_PathClick (Sender: TObject);
    procedure mnuEditPopup(Sender: TObject);
	private
    { Private 宣言 }
		function F_GetFocusEdit: TMyCustomEdit;
	public
    { Public 宣言 }
  end;

function gfnbShortCutCreate(sShortCutName, sShortCutPath, sFile, sArg, sWorkPath, sIcon: WideString): Boolean;


var
  App_TOOLSetFont_ShortCut: TApp_TOOLSetFont_ShortCut;

implementation
uses
	ActiveX,
//	CommCtrl,
	ComObj,
	ShlObj,
	myClipbrd,
	myFile,
	myMultiMonitor,
	myShortCut,
	myString;


{$R *.dfm}

procedure TApp_TOOLSetFont_ShortCut.FormCreate(Sender: TObject);
begin
	Self.Icon := Application.Icon;

	Self.Constraints.MinWidth  := Self.Width;
	Self.Constraints.MinHeight := Self.Height;
	Self.Constraints.MaxHeight := Self.Height;

	gpcMoveMonitorCenter(Self);
end;

procedure TApp_TOOLSetFont_ShortCut.FormShow(Sender: TObject);
begin
	edtShortCut_Name.SetFocus;
end;

procedure TApp_TOOLSetFont_ShortCut.btnShortCut_NameClick(Sender: TObject);
var
	ls_File: WideString;
begin
	if (dlgSaveFile.Execute) then begin
		dlgSaveFile.InitialDir := gfnsFilePathGet(dlgSaveFile.FileName);
		//拡張子を.lnkに変更する。
		//拡張子が.exeの場合取り除いて.lnkを付加する。
		ls_File := gfnsStrToLinkFileName(Trim(dlgSaveFile.FileName));
		edtShortCut_Name.Text := gfnsFileNameGet(ls_File);
//		if (edtShortCut_Path.Text <> '') then begin
			edtShortCut_Path.Text := gfnsFilePathGet(ls_File);
//		end;
	end;
end;

procedure TApp_TOOLSetFont_ShortCut.btnShortCut_PathClick(Sender: TObject);
begin
	if (dlgOpenFolder.Execute) then begin
		dlgOpenFolder.InitialDir := Trim(dlgOpenFolder.FolderName);
		edtShortCut_Path.Text := Trim(dlgOpenFolder.FolderName);
	end;
end;

procedure TApp_TOOLSetFont_ShortCut.btnExeClick(Sender: TObject);
begin
	if (dlgOpenFile.Execute) then begin
		dlgOpenFile.InitialDir := gfnsFilePathGet(dlgOpenFile.FileName);
		edtExe.Text := Trim(dlgOpenFile.FileName);
	end;
end;

procedure TApp_TOOLSetFont_ShortCut.edtShortCut_NameChange(Sender: TObject);
var
	l_Edit: TMyEdit;
begin
	if (csReadingState in Self.ControlState) then begin
Exit;
	end;

	if (Sender is TMyEdit) then begin
		l_Edit := TMyEdit(Sender);
		if (l_Edit = edtExe) then begin
			if (gfnbFileExists(l_Edit.Text)) then begin
				l_Edit.Font.Color := clWindowText;
			end else begin
				l_Edit.Font.Color := clGrayText;
			end;
		end;
	end;

	btnOk.Enabled :=
				(edtShortCut_Name.Text <> '')
		and (edtShortCut_Path.Text <> '')
		and (edtExe.Text           <> '')
	;
end;

function gfnbShortCutCreate(sShortCutName, sShortCutPath, sFile, sArg, sWorkPath, sIcon: WideString): Boolean;
{2010-12-18:
ショートカットファイルを作る。
http://www.geocities.jp/asumaroyuumaro/program/tips/CreateShortCut.html
sLink     : ショートカットファイル名
sFile     : リンクの参照先
sArg      : オプション
sWorkPath : 作業フォルダ
}
var
	lI_ShellLink:   IShellLinkW;
	lI_PersistFile: IPersistFile;
begin
	Result := False;

	lI_ShellLink   := (CreateComObject(CLSID_ShellLink) as IShellLinkW);
	lI_PersistFile := (lI_ShellLink as IPersistFile);

	//リンク先
	if not(lI_ShellLink.SetPath(PWideChar(WideFormat('"%s"', [sFile]))) = NOERROR) then begin;
Exit;
	end;

	//オプション
	if (sArg <> '') then begin
		if not(lI_ShellLink.SetArguments(PWideChar(sArg)) = NOERROR) then begin
Exit;
		end;
	end;

	//作業フォルダ
	if (sWorkPath = '') then begin
		sWorkPath := gfnsFileDirGet(sFile);
	end;
	if not(lI_ShellLink.SetWorkingDirectory(PWideChar(sWorkPath)) = NOERROR) then begin
Exit;
	end;

	//アイコン
	if (sIcon <> '') then begin
		if not(lI_ShellLink.SetIconLocation(PWideChar(sIcon), 0) = NOERROR) then begin
Exit;
		end;
	end;

	//ショートカットの名前＆保存
	if (sShortCutName = '') then begin
		sShortCutName := gfnsFileNameGet(sFile);
		if (sShortCutPath = '') then begin
			sShortCutPath := gfnsFilePathGet(sFile);
		end;
	end;

	//sShortCutPathが''の場合はカレントフォルダに作成される
	if (sShortCutPath <> '') then begin
		sShortCutPath := gfnsStrEndFit(sShortCutPath, '\');
		if not(gfnbFolderExists(sShortCutPath)) then begin
			//ディレクトリ作成
			if not(gfnbFolderCreate(sShortCutPath)) then begin
//エラーなら処理を抜ける
Exit;
			end;
		end;
	end;
	sShortCutName := sShortCutPath + gfnsFileExtChange(sShortCutName, '.lnk');
	//ショートカットを作成
	Result := (lI_PersistFile.Save(PWideChar(sShortCutName), False) = NOERROR);
end;


function TApp_TOOLSetFont_ShortCut.F_GetFocusEdit: TMyCustomEdit;
begin
	if (edtShortCut_Name.Focused) then begin
		Result := edtShortCut_Name;
	end else if (edtShortCut_Path.Focused) then begin
		Result := edtShortCut_Path;
	end else if (edtExe.Focused) then begin
		Result := edtExe;
	end else if (edtOpt.Focused) then begin
		Result := edtOpt;
	end else begin
		Result := nil;
	end;
end;

//元に戻す
procedure TApp_TOOLSetFont_ShortCut.actEdit_UndoExecute(Sender: TObject);
begin
	if (F_GetFocusEdit <> nil) then F_GetFocusEdit.Undo;
end;

//やり直し
procedure TApp_TOOLSetFont_ShortCut.actEdit_RedoExecute(Sender: TObject);
begin
	if (F_GetFocusEdit <> nil) then F_GetFocusEdit.Redo;
end;

//切り取り
procedure TApp_TOOLSetFont_ShortCut.actEdit_CutExecute(Sender: TObject);
begin
	if (F_GetFocusEdit <> nil) then F_GetFocusEdit.CutToClipboard;
end;

//コピー
procedure TApp_TOOLSetFont_ShortCut.actEdit_CopyExecute(Sender: TObject);
begin
	if (F_GetFocusEdit <> nil) then F_GetFocusEdit.CopyToClipboard;
end;

//貼り付け
procedure TApp_TOOLSetFont_ShortCut.actEdit_PasteExecute(Sender: TObject);
begin
	if (F_GetFocusEdit <> nil) then F_GetFocusEdit.PasteFromClipboard;
end;

//削除
procedure TApp_TOOLSetFont_ShortCut.actEdit_DeleteExecute(Sender: TObject);
begin
	if (F_GetFocusEdit <> nil) then F_GetFocusEdit.ClearSelection;
end;

//全て選択
procedure TApp_TOOLSetFont_ShortCut.actEdit_SelectAllExecute(Sender: TObject);
begin
	if (F_GetFocusEdit <> nil) then F_GetFocusEdit.SelectAll;
end;


procedure TApp_TOOLSetFont_ShortCut.mnuEditPopup(Sender: TObject);
var
	l_Edit: TMyCustomEdit;
begin
	l_Edit := F_GetFocusEdit;
	if (l_Edit = nil) then begin
		actEdit_Undo.Enabled   := False;
		actEdit_Redo.Enabled   := False;
		actEdit_Cut.Enabled    := False;
		actEdit_Copy.Enabled   := False;
		actEdit_Delete.Enabled := False;
		actEdit_Paste.Enabled  := (gfnsStrFromClipboard <> '');
		//すべて選択
		actEdit_SelectAll.Enabled := False;
Exit;
	end;

	actEdit_Undo.Enabled   := l_Edit.CanUndo;
	actEdit_Redo.Enabled   := l_Edit.CanRedo;
	actEdit_Cut.Enabled    := l_Edit.Selected;
	actEdit_Delete.Enabled := actEdit_Cut.Enabled;
	actEdit_Paste.Enabled  := (gfnsStrFromClipboard <> '');

	//すべて選択
	actEdit_SelectAll.Enabled := (l_Edit.Text <> '');
	//コピー
	actEdit_Copy.Enabled := l_Edit.Selected;
end;

end.