unit main; //{$DEFINE DEBUG} //Unicodeキャプション //{$DEFINE UNICODEAPP} //{$DEFINE UNICODEFORM} interface uses Windows, Messages, SysUtils, ActnList, AppEvnts, Buttons, Classes, ComCtrls, Controls, Dialogs, ExtCtrls, Forms, Graphics, Grids, ImgList, Menus, StdCtrls, ToolWin, myEdit, myFileDialog, myFileTextDialog, myLabel, mySendTo, myType, myWStrings, notification; type TMy_LineNum = record iHeight, iStart, iLine, iLoop, iTop, iWidth: Integer; end; TApp_sPad = class(TForm) ActionList1: TActionList; actSpc: TAction; Action_FileNew: TAction; Action_FileOpen: TAction; Action_FileSave: TAction; Action_FileSaveAs: TAction; Action_FileFileName: TAction; Action_FileFileNameOnly: TAction; Action_FileExit: TAction; Action_EditUndo: TAction; Action_EditRedo: TAction; Action_EditCut: TAction; Action_EditCopy: TAction; Action_EditPaste: TAction; Action_EditDelete: TAction; Action_EditSelectAll: TAction; Action_ConvertInsSpc: TAction; Action_ConvertStrToUCode: TAction; Action_ConvertUCodeToStr: TAction; Action_ConvertStrToSJisCode: TAction; Action_ConvertSJisCodeToStr: TAction; Action_ConvertUrlToStr: TAction; Action_ConvertStrToUrl: TAction; Action_CmdEditDelWordEnd: TAction; Action_CmdEditDelWordHead: TAction; Action_CmdMoveWordEnd: TAction; Action_CmdMoveWordHead: TAction; Action_CmdMoveLineHead: TAction; Action_CmdMoveLineEnd: TAction; Action_CmdEditDelLine: TAction; Action_SortStr: TAction; Action_SortText: TAction; Action_SortFileName: TAction; Action_SortNum: TAction; Action_SortReverse: TAction; Action_FindFindDown: TAction; Action_FindFindUp: TAction; Action_FindFindSelDown: TAction; Action_FindFindSelUp: TAction; Action_FindWord: TAction; Action_FindCase: TAction; Action_Search: TAction; Action_SearchSelectSite: TAction; Action_TextWordWrap: TAction; Action_TextTab: TAction; Action_TextTab1: TAction; Action_TextTab2: TAction; Action_TextTab4: TAction; Action_TextTab8: TAction; Action_TextAutoIndent: TAction; Action_TextFont: TAction; Action_OptReadOnly: TAction; Action_OptLineNum: TAction; Action_OptStatusBar: TAction; Action_CustomSetting: TAction; Action_CustomMenu: TAction; Action_CustomToolBar: TAction; Action_CustomShortCut: TAction; Action_HelpVersionInfo: TAction; ActionList2: TActionList; Action_Convert: TAction; Action_Sort: TAction; MainMenu_Main: TMainMenu; MenuItem_File: TMenuItem; MenuItem_FileNew: TMenuItem; MenuItem_FileOpen: TMenuItem; MenuItem_FileSave: TMenuItem; MenuItem_FileSaveAs: TMenuItem; MenuItem_FileLine1: TMenuItem; MenuItem_FileFileName: TMenuItem; MenuItem_FileFileNameOnly: TMenuItem; MenuItem_FileLine2: TMenuItem; MenuItem_FileExit: TMenuItem; MenuItem_Edit: TMenuItem; MenuItem_EditUndo: TMenuItem; MenuItem_EditRedo: TMenuItem; MenuItem_EditLine1: TMenuItem; MenuItem_EditCut: TMenuItem; MenuItem_EditCopy: TMenuItem; MenuItem_EditPaste: TMenuItem; MenuItem_EditDelete: TMenuItem; MenuItem_EditLine2: TMenuItem; MenuItem_EditSelectAll: TMenuItem; MenuItem_EditLine3: TMenuItem; MenuItem_Convert: TMenuItem; MenuItem_ConvertStrToUCode: TMenuItem; MenuItem_ConvertStrToSJisCode: TMenuItem; MenuItem_ConvertLine1: TMenuItem; MenuItem_ConvertInsSpc: TMenuItem; MenuItem_ConvertLine2: TMenuItem; MenuItem_ConvertUCodeToStr: TMenuItem; MenuItem_ConvertSJisCodeToStr: TMenuItem; MenuItem_ConvertLine3: TMenuItem; MenuItem_ConvertStrToUrl: TMenuItem; MenuItem_ConvertUrlToStr: TMenuItem; MenuItem_Sort: TMenuItem; MenuItem_SortStr: TMenuItem; MenuItem_SortText: TMenuItem; MenuItem_SortNum: TMenuItem; MenuItem_SortFileName: TMenuItem; MenuItem_SortLine1: TMenuItem; MenuItem_SortReverse: TMenuItem; MenuItem_Find: TMenuItem; MenuItem_FindFindUp: TMenuItem; MenuItem_FindFindDown: TMenuItem; MenuItem_FindLine1: TMenuItem; MenuItem_FindFindSelDown: TMenuItem; MenuItem_FindFindSelUp: TMenuItem; MenuItem_FindLine2: TMenuItem; MenuItem_FindWord: TMenuItem; MenuItem_FindCase: TMenuItem; MenuItem_FindLine3: TMenuItem; MenuItem_Search: TMenuItem; MenuItem_SearchSelectSite: TMenuItem; MenuItem_Opt: TMenuItem; MenuItem_TextWordWrap: TMenuItem; MenuItem_TextTab: TMenuItem; MenuItem_TextTab1: TMenuItem; MenuItem_TextTab2: TMenuItem; MenuItem_TextTab4: TMenuItem; MenuItem_TextTab8: TMenuItem; MenuItem_OptReadOnly: TMenuItem; MenuItem_OptLine1: TMenuItem; MenuItem_TextFont: TMenuItem; MenuItem_OptLine2: TMenuItem; MenuItem_OptLineNum: TMenuItem; MenuItem_OptStatusBar: TMenuItem; MenuItem_OptLine3: TMenuItem; MenuItem_CustomSetting: TMenuItem; MenuItem_CustomMenu: TMenuItem; MenuItem_CustomToolBar: TMenuItem; MenuItem_CustomShortCut: TMenuItem; MenuItem_Help: TMenuItem; MenuItem_HelpFileVersion: TMenuItem; MenuItem_TextAutoIndent: TMenuItem; MenuItem_FileLine3: TMenuItem; MenuItem_SendTo: TMenuItem; PopupMenu_Edit: TPopupMenu; MenuItem_PEditUndo: TMenuItem; MenuItem_PEditRedo: TMenuItem; MenuItem_PEditLine1: TMenuItem; MenuItem_PEditCut: TMenuItem; MenuItem_PEditCopy: TMenuItem; MenuItem_PEditPaste: TMenuItem; MenuItem_PEditDelete: TMenuItem; MenuItem_PEditLine2: TMenuItem; MenuItem_PEditSelectAll: TMenuItem; MenuItem_PEditLine3: TMenuItem; MenuItem_PEditFindSelDown: TMenuItem; MenuItem_PEditFindSelUp: TMenuItem; MenuItem_PEditLine4: TMenuItem; MenuItem_PEditLine5: TMenuItem; MenuItem_PConvert: TMenuItem; MenuItem_PConvertStrToUCode: TMenuItem; MenuItem_PConvertStrToSJisCode: TMenuItem; MenuItem_PConvertLine1: TMenuItem; MenuItem_PConvertInsSpc: TMenuItem; MenuItem_PConvertLine2: TMenuItem; MenuItem_PConvertUCodeToStr: TMenuItem; MenuItem_PConvertSJisCodeToStr: TMenuItem; MenuItem_PConvertLine3: TMenuItem; MenuItem_PConvertStrToUrl: TMenuItem; MenuItem_PConvertUrlToStr: TMenuItem; MenuItem_PSort: TMenuItem; MenuItem_PSortStr: TMenuItem; MenuItem_PSortText: TMenuItem; MenuItem_PSortNum: TMenuItem; MenuItem_PSortFileName: TMenuItem; MenuItem_PSortLine1: TMenuItem; MenuItem_PSortReverse: TMenuItem; __MenuItem_PEdit_Tab: TMenuItem; __MenuItem_PEdit_CtrlTab: TMenuItem; __MenuItem_PEdit_CtrlF: TMenuItem; PopupMenu_Find: TPopupMenu; MenuItem_PFindEditUndo: TMenuItem; MenuItem_PFindEditRedo: TMenuItem; MenuItem_PFindLine1: TMenuItem; MenuItem_PFindEditCut: TMenuItem; MenuItem_PFindEditCopy: TMenuItem; MenuItem_PFindEditPaste: TMenuItem; MenuItem_PFindEditDelete: TMenuItem; MenuItem_PFindLine2: TMenuItem; MenuItem_PFindEditSelectAll: TMenuItem; MenuItem_PFindLine3: TMenuItem; MenuItem_PFindFindSelDown: TMenuItem; MenuItem_PFindSelUp: TMenuItem; MenuItem_PFindLine4: TMenuItem; MenuItem_PFindCase: TMenuItem; MenuItem_PFindWord: TMenuItem; PopupMenu_Tab: TPopupMenu; MenuItem_PTextTab_1: TMenuItem; MenuItem_PTextTab_2: TMenuItem; MenuItem_PTextTab_4: TMenuItem; MenuItem_PTextTab_8: TMenuItem; PopupMenu_FileOpenHistory: TPopupMenu; PopupMenu_FindHistory: TPopupMenu; ToolBar1: TToolBar; ToolButton_FileOpen: TToolButton; ToolButton_FileSaveAs: TToolButton; ToolButton_Spc1: TToolButton; ToolButton_EditUndo: TToolButton; ToolButton_EditRedo: TToolButton; ToolButton_EditCut: TToolButton; ToolButton_EditCopy: TToolButton; ToolButton_EditPaste: TToolButton; ToolButton_EditSelectAll: TToolButton; ToolButton_Spc2: TToolButton; Panel_Find: TPanel; Edit_Find: TMyEdit; SpeedButton_FindHistory: TSpeedButton; ToolButton_FindDown: TToolButton; ToolButton__FindUp: TToolButton; ToolButton_Spc3: TToolButton; ToolButton_TextWrap: TToolButton; ToolButton_TextTab: TToolButton; ToolButton_TextAutoIndent: TToolButton; Memo_Text: TMyMemo; Panel_LineNum: TPanel; PaintBox_LineNum: TPaintBox; Shape_LineNum: TShape; Panel_Status: TPanel; Shape_Status: TShape; Label_StatusPos: TMyLabel; Bevel_Spc1: TBevel; Label_StatusChar: TMyLabel; Bevel_Spc2: TBevel; Label_StatusAnsi: TMyLabel; Bevel_Spc3: TBevel; Label_StatusUtf16: TMyLabel; Bevel_Spc4: TBevel; Label_StatusUtf8: TMyLabel; Bevel_Spc5: TBevel; Label_StatusEncode: TMyLabel; Bevel_SpcLoad: TBevel; Label_StatusLoad: TMyLabel; Dialog_OpenFile: TMyOpenTextFileDialog; Dialog_SaveFile: TMySaveTextFileDialog; Dialog_FileName: TMyOpenFileDialog; FontDialog1: TFontDialog; ImageList1: TImageList; ApplicationEvents1: TApplicationEvents; Timer_LoadProgress: TTimer; Action_CustomExt: TAction; MenuItem_CustomExt: TMenuItem; ToolButton_MoveBracked: TToolButton; Action_MoveBracket: TAction; MenuItem_FindLine4: TMenuItem; MenuItem_MoveBracket: TMenuItem; Action_Replace: TAction; MenuItem_FindLine5: TMenuItem; Replace1: TMenuItem; Action_Edit_PasteAnsi: TAction; MenuItem_Edit_PasteAnsi: TMenuItem; MenuItem_PEdit_PasteAnsi: TMenuItem; procedure Action_FileNewExecute (Sender: TObject); procedure Action_FileOpenExecute (Sender: TObject); procedure Action_FileSaveAsExecute (Sender: TObject); procedure Action_FileSaveExecute (Sender: TObject); procedure Action_FileFileNameExecute (Sender: TObject); { procedure Action_SendToSelProgramExecute (Sender: TObject); procedure Action_SendToOpenFolderExecute (Sender: TObject); procedure Action_SendToRegistExecute (Sender: TObject); procedure Action_SendToPropertyExecute (Sender: TObject); } procedure Action_FileExitExecute (Sender: TObject); procedure Action_EditUndoExecute (Sender: TObject); procedure Action_EditRedoExecute (Sender: TObject); procedure Action_EditCutExecute (Sender: TObject); procedure Action_EditCopyExecute (Sender: TObject); procedure Action_EditPasteExecute (Sender: TObject); procedure Action_EditDeleteExecute (Sender: TObject); procedure Action_EditSelectAllExecute (Sender: TObject); procedure Action_CmdEditDelWordHeadExecute (Sender: TObject); procedure Action_CmdEditDelWordEndExecute (Sender: TObject); procedure Action_CmdEditDelLineExecute (Sender: TObject); procedure Action_CmdMoveWordHeadExecute (Sender: TObject); procedure Action_CmdMoveWordEndExecute (Sender: TObject); procedure Action_CmdMoveLineHeadExecute (Sender: TObject); procedure Action_CmdMoveLineEndExecute (Sender: TObject); procedure Action_ConvertStrToUCodeExecute (Sender: TObject); procedure Action_ConvertUCodeToStrExecute (Sender: TObject); procedure Action_ConvertSJisCodeToStrExecute(Sender: TObject); procedure Action_ConvertStrToUrlExecute (Sender: TObject); procedure Action_ConvertUrlToStrExecute (Sender: TObject); procedure Action_SortStrExecute (Sender: TObject); procedure Action_SortReverseExecute (Sender: TObject); procedure Action_FindFindDownExecute (Sender: TObject); procedure Action_FindSelFindDownExecuteion (Sender: TObject); procedure Action_FindWordExecute (Sender: TObject); procedure Action_FindCaseExecute (Sender: TObject); procedure Action_MoveBracketExecute (Sender: TObject); procedure Action_ReplaceExecute (Sender: TObject); procedure Action_SearchExecute (Sender: TObject); procedure Action_TextWordWrapExecute (Sender: TObject); procedure Action_TextTabExecute (Sender: TObject); procedure Action_TextAutoIndentExecute (Sender: TObject); procedure Action_TextFontExecute (Sender: TObject); procedure Action_OptLineNumExecute (Sender: TObject); procedure Action_OptStatusBarExecute (Sender: TObject); procedure Action_OptReadOnlyExecute (Sender: TObject); procedure Action_CustomSettingExecute (Sender: TObject); procedure Action_CustomMenuExecute (Sender: TObject); procedure Action_CustomToolBarExecute (Sender: TObject); procedure Action_CustomShortCutExecute (Sender: TObject); procedure Action_CustomExtExecute (Sender: TObject); procedure Action_HelpVersionInfoExecute (Sender: TObject); procedure actNop (Sender: TObject); procedure MenuItem_HistoryDrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure MenuItem_AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure MenuItem_MeasureItem (Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); procedure PopupMenu_EditPopup (Sender: TObject); // procedure MenuItem_SendToDrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); // procedure MenuItem_SendToClick (Sender: TObject); procedure FormCreate (Sender: TObject); procedure FormDestroy (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure FormActivate(Sender: TObject); procedure Memo_TextKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Memo_TextKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Memo_TextSelectionChange (Sender: TObject); procedure Memo_TextUpdate (Sender: TObject); procedure Memo_TextResize (Sender: TObject); procedure Memo_TextEnter (Sender: TObject); procedure Memo_TextMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Memo_TextMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Memo_TextMouseWheel (Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure Edit_FindEnter (Sender: TObject); procedure Edit_FindKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Edit_FindChange (Sender: TObject); procedure __MenuItem_PEdit_TabClick (Sender: TObject); procedure __MenuItem_PEdit_CtrlFClick (Sender: TObject); procedure __MenuItem_PEdit_CtrlTabClick (Sender: TObject); procedure SpeedButton_FindHistoryClick (Sender: TObject); procedure SpeedButton_FindHistoryMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Panel_LineNumResize (Sender: TObject); procedure PaintBox_LineNumPaint (Sender: TObject); procedure PaintBox_LineNumDblClick (Sender: TObject); procedure PaintBox_LineNumMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PaintBox_LineNumMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ApplicationEvents1Activate (Sender: TObject); procedure Timer_LoadProgressTimer (Sender: TObject); procedure Action_Edit_PasteAnsiExecute(Sender: TObject); private { Private 宣言 } FsFileName : WideString; FcdCharCode : TMyCharCode; //LoadFromFileの引数がvarであるために必要 FbNewLine : Boolean; //コマンドラインオプションで改行コードを指定する場合 FFocusEdit : TMyCustomEdit; FbFindDown : Boolean; FKey : WORD; FptMouse : TPoint; //マウスジェスチャ FbKeyDown : Boolean; //キーを押しているかのフラグ。ステータス表示のせいでキー移動が遅くなるのを防ぐため FbFileUpdate : Boolean; //ファイル更新チェック FNotification : TMyChangeNotification; FhNextHandle : HWND; //クリップボード監視 //行番号表示 FbmpLineNum : TBitmap; FrLineNum : TMy_LineNum; //読み込みの経過表示 FiLoadCount : Integer; FiFileSize : Int64; //送る FSendTo : TMySendTo; procedure FAddHistory(AMenuItem: TMenuItem; sText: WideString); overload; procedure FAddHistory(AMenuItem: TMenuItem; AList: TMyWStrings); overload; function FConfirmSave: Boolean; function FDisposeShortCut(var Key: Word; Shift: TShiftState): Boolean; procedure FFileOpenHistoryClick(Sender: TObject); procedure FFindFindHistoryClick(Sender: TObject); function FGetFocusEdit: TMyCustomEdit; procedure FOpenFile(AList: TMyWStrings); procedure FSetFileName(sFile: WideString); procedure FSetLineNum; procedure FOnSearchChange(Sender: TObject); procedure FOnLoadCount(Sender: TObject; iCount: Integer; iLength: Int64); procedure FLoadIni; procedure FSaveIni; //クリップボード監視 procedure FEntryClipboardViewer; procedure FRemoveClipboardViewer; procedure WMDrawClipboard(var Msg: TWMDrawClipboard); message WM_DRAWCLIPBOARD; procedure WMChangeCBChain(var Msg: TWMChangeCBChain); message WM_CHANGECBCHAIN; //ドラッグアンドドロップ procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; //システム終了 procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QUERYENDSESSION; protected procedure WndProc(var Msg: TMessage); override; public { Public 宣言 } // procedure CreateSendToMenu; procedure SetFileUpdate; end; var App_sPad : TApp_sPad; G_MainForm : TApp_sPad; G_ActionList : TActionList; implementation uses {$IFDEF DEBUG} myDebug, {$ENDIF} CommCtrl, CommDlg, HTTPApp, Math, RichEdit, ShellAPI, myApp, myClipbrd, myControl, myCustomExt, myDragAndDrop, myFile, myFileStrings, myGraphic, myHelpVersionInfo, myHintWindow, myIniFile, myList, myMessageBox, myMonitor, myMultiMonitor, myMenu, myNum, myParam, mySearch, myShortCut, mySize, myString, myWindow, { //------------------------------------------------------------------------------ //準汎用フォーム用 custom_base, custom_menu, custom_toolbar, custom_shortcut, custom_help; //------------------------------------------------------------------------------ } replace_form; {$R *.dfm} const F_csSENDTOFOLDER = 'SendTo'; //送るメニューの送り先のリンクファイル格納フォルダ F_csSENDTOEXT : array[0..1]of WideString = ('.bat', '.lnk'); //------------------------------------------------------------------------------ procedure TApp_sPad.FSetFileName(sFile: WideString); var ls_Title : WideString; begin FsFileName := sFile; if (FsFileName = '') then begin ls_Title := '無題'; end else begin ls_Title := gfnsFileNameGet(FsFileName); end; {$IFDEF UNICODEAPP} SetWindowText(Application.Handle, PAnsiChar(PWideChar(ls_Title))); {$ELSE} Application.Title := ls_Title; {$ENDIF} {$IFDEF UNICODEFORM} SetWindowText(Self.Handle, PAnsiChar(PWideChar(ls_Title))); {$ELSE} Self.Caption := ls_Title; {$ENDIF} end; //------------------------------------------------------------------------------ //クリップボード監視ルーチン procedure TApp_sPad.FEntryClipboardViewer; begin FhNextHandle := SetClipboardViewer(Self.Handle); if (FhNextHandle = 0) and (GetLastError <> 0) then begin {エラーだったら} //クリップボードの更新チェックの登録処理に失敗した場合の処理 //ShowMessage('クリップボードの更新チェックの登録処理に失敗しました'); end; end; procedure TApp_sPad.FRemoveClipboardViewer; begin //クリップボード監視処理の破棄 ChangeClipboardChain(Self.Handle, FhNextHandle); end; procedure TApp_sPad.WMDrawClipboard(var Msg: TWMDrawClipboard); //クリップボード更新フック //更新された後に流れてくる。 //アプリが立ち上がった瞬間も流れる begin inherited; if (FhNextHandle <> 0) then begin //次の監視ウィンドウへメッセージ送信 SendMessage(FhNextHandle, WM_DRAWCLIPBOARD, 0, 0); end; PopupMenu_EditPopup(nil); end; procedure TApp_sPad.WMChangeCBChain(var Msg: TWMChangeCBChain); begin if (Msg.Remove = FhNextHandle) then begin //クリップボードをフックしている次のウィンドウがフックを解除した FhNextHandle := Msg.Next; end; if (FhNextHandle <> 0) then begin //次のビューアへメッセージ送信 SendMessage(FhNextHandle, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next); end; end; //------------------------------------------------------------------------------ //ドラッグアンドドロップ procedure TApp_sPad.WMDropFiles(var Msg: TWMDropFiles); var l_Drop: TMyDropFiles; begin l_Drop := TMyDropFiles.Create(Msg, Self); try FcdCharCode := cdAuto; //自動判定 FOpenFile(l_Drop.Files); finally l_Drop.Free; end; end; function TApp_sPad.FDisposeShortCut(var Key: Word; Shift: TShiftState): Boolean; begin Result := False; if (ssCtrl in Shift) then begin FKey := Key; //RichEditコントロールが持つ以下のショートカットキーを無効化。 case Key of Ord('E'), //センタリング Ord('J'), //自動 Ord('L'), //左詰 Ord('R'), //右詰 Ord('+'), //上付き文字 Ord('='), // Ord('1'), //行間調整 Ord('2'), //行間調整 Ord('5'), //行間調整 VK_N, //空行挿入用 VK_T, //単語削除用 VK_Y //一行削除用 :begin Result := True; end; end; end else begin FKey := 0; end; if (Result) then begin Key := 0; end; end; procedure TApp_sPad.Memo_TextKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin FbKeyDown := True; FDisposeShortCut(Key, Shift); case Key of VK_TAB :begin Key := 0; end; end; end; procedure TApp_sPad.Memo_TextKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin FbKeyDown := False; case FKey of VK_N :begin Memo_Text.InsertLine(Memo_Text.CurrentLine, ''); end; VK_T :begin if (ssShift in Shift) then begin //カーソル位置から単語の始めまで削除 Action_CmdEditDelWordHeadExecute(nil); end else begin //カーソル位置から単語の終わりまで削除 Action_CmdEditDelWordEndExecute(nil); end; end; VK_Y :begin Action_CmdEditDelLineExecute(nil); end; end; FKey := 0; Memo_TextSelectionChange(nil); end; procedure SendKey( hWindow : HWND; iKey : WORD; bShift : Boolean; bControl : Boolean ); { Send One VirtualKey, to other Window } //http://gec02670.cocolog-nifty.com/blog/2008/04/delphisendkey_9cdb.html var li_LParam : LPARAM; l_KeyboardState : TKeyBoardState; begin li_LParam := $00000001; if (bShift or bControl )then begin { Set KeyboardState } GetKeyBoardState(l_KeyboardState); if (bShift) then begin PostMessage(hWindow, WM_KEYDOWN, VK_SHIFT, li_LParam); l_KeyboardState[VK_SHIFT] := $81; end; if (bControl) then begin PostMessage(hWindow, WM_KEYDOWN, VK_CONTROL, li_LParam); l_KeyboardState[VK_CONTROL] := $81; end; SetKeyBoardState(l_KeyboardState); end; PostMessage(hWindow, WM_KEYDOWN, iKey, li_LParam); Application.ProcessMessages; li_LParam := Longint($C0000001); PostMessage(hWindow, WM_KEYUP, iKey, li_LParam); end; procedure TApp_sPad.Edit_FindKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if not(FDisposeShortCut(Key, Shift)) then begin case Key of VK_TAB :begin Key := 0; if (ssCtrl in Shift) and not(ssShift in Shift) then begin __MenuItem_PEdit_CtrlTabClick(nil); end; end; VK_RETURN :begin Key := 0; if (Edit_Find.Text <> '') then begin FbFindDown := True; end; end; Ord('F') :begin if (ssCtrl in Shift) and not(ssShift in Shift) then begin Key := 0; __MenuItem_PEdit_CtrlFClick(nil); end; end; end; end; end; //http://mrxray.on.coocan.jp/Halbow/Notes/N016.html function NibbleToBinaryStr(value:Byte):string; const Bit:array[0..1] of Char = ('0','1'); var i:integer; begin SetLength(result,4); for i := 0 to 3 do begin result[4-i] := Bit[value and 1]; value := value shr 1; end; end; function ByteToBinaryStr(value:Byte):string; begin result := NibbleToBinaryStr(value shr 4) + NibbleToBinaryStr(value and $F); end; procedure TApp_sPad.Memo_TextSelectionChange(Sender: TObject); function _GetUtf8Code(sStr: WideString): WideString; function _GetBin(pBuff: PAnsiChar; iCount: Integer): AnsiString; var i: Integer; begin Result := ''; for i := 0 to iCount-1 do begin Result := Result + ' ' + ByteToBinaryStr(Ord(pBuff[i])); end; end; var i: Integer; ls_Utf8 : Utf8String; ls_Bin : AnsiString; begin Result := ''; ls_Utf8 := gfnsWideToUtf8(sStr); for i := 1 to Length(ls_Utf8) do begin Result := WideFormat('%s%.2x', [Result, Ord(ls_Utf8[i])]); end; if (Result <> '') then begin ls_Bin := _GetBin(PAnsiChar(ls_Utf8), Length(ls_Utf8)); Result := WideFormat('UTF-8 U+%s %s', [Result, Trim(ls_Bin)]); end; end; var ls_Str : WideString; ls_SJis : AnsiString; li_Code : Longint; begin if (Tag = 0) or (Application.Terminated) then begin Exit; end; PopupMenu_EditPopup(nil); //行番号 FSetLineNum; if (FbKeyDown) or (gfnbKeyState(VK_LBUTTON)) then begin Exit; end; Action_MoveBracket.Enabled := gfnbIsStrParenth(Memo_Text.Text, Memo_Text.SelStart +1); if (Action_OptStatusBar.Checked) then begin //キャラクタコード表示 ls_Str := Memo_Text.StrCopy(1); if (ls_Str = '') then begin Label_StatusChar.ParentColor := True; Label_StatusChar.Caption := ''; Label_StatusAnsi.Caption := ''; Label_StatusUtf16.Caption := ''; Label_StatusUtf8.Caption := ''; end else begin li_Code := Ord(ls_Str[1]); case li_Code of $D800..$DBFF :begin //サロゲートペア //http://codezine.jp/article/detail/1592 ls_Str := Memo_Text.StrCopy(2); Label_StatusUtf16.Caption := WideFormat('UTF-16 U+%.5x(%.4x+%.4x)', [(Ord(ls_Str[1]) - $D800) * $400 + (Ord(ls_Str[2]) - $DC00) + $10000, Ord(ls_Str[1]), Ord(ls_Str[2])]); Label_StatusUtf8.Caption := _GetUtf8Code(ls_Str); end else begin Label_StatusUtf16.Caption := WideFormat('UTF-16 U+%.4x', [Ord(ls_Str[1])]); Label_StatusUtf8.Caption := _GetUtf8Code(ls_Str); end; end; case li_Code of $0: Label_StatusChar.Caption := 'NUL'; $1: Label_StatusChar.Caption := 'SOH'; $2: Label_StatusChar.Caption := 'STX'; $3: Label_StatusChar.Caption := 'ETX'; $4: Label_StatusChar.Caption := 'EOT'; $5: Label_StatusChar.Caption := 'ENQ'; $6: Label_StatusChar.Caption := 'ACK'; $7: Label_StatusChar.Caption := 'BEL'; $8: Label_StatusChar.Caption := 'BS'; $9: Label_StatusChar.Caption := 'Tab'; $A: Label_StatusChar.Caption := 'LF'; $B: Label_StatusChar.Caption := 'VT'; $C: Label_StatusChar.Caption := 'FF'; $D: Label_StatusChar.Caption := 'CR'; $E: Label_StatusChar.Caption := 'SO'; $F: Label_StatusChar.Caption := 'SI'; $10: Label_StatusChar.Caption := 'DLE'; $11: Label_StatusChar.Caption := 'DC1'; $12: Label_StatusChar.Caption := 'DC2'; $13: Label_StatusChar.Caption := 'DC3'; $14: Label_StatusChar.Caption := 'DC4'; $15: Label_StatusChar.Caption := 'NAK'; $16: Label_StatusChar.Caption := 'SYN'; $17: Label_StatusChar.Caption := 'ETB'; $18: Label_StatusChar.Caption := 'CAN'; $19: Label_StatusChar.Caption := 'EM'; $1A: Label_StatusChar.Caption := 'SUB'; $1B: Label_StatusChar.Caption := 'ESC'; $1C: Label_StatusChar.Caption := 'FS'; $1D: Label_StatusChar.Caption := 'GS'; $1E: Label_StatusChar.Caption := 'RS'; $1F: Label_StatusChar.Caption := 'US'; $20: Label_StatusChar.Caption := '半角スペース'; $7F: Label_StatusChar.Caption := 'DEL'; $3000: Label_StatusChar.Caption := '全角スペース'; else Label_StatusChar.Caption := ls_Str; end; // Label_StatusChar.Caption := WideFormat('(%s)', [Label_StatusChar.Caption]); if (li_Code < $20) or (li_Code = $7F) then begin Label_StatusChar.Color := clAqua; end else begin Label_StatusChar.ParentColor := True; end; if (gfnbIsUnicode(ls_Str)) then begin Label_StatusAnsi.Caption := 'SJIS -'; end else begin ls_SJis := WideString(ls_Str); if (Length(ls_SJis) > 1) then begin //2バイト文字 Label_StatusAnsi.Caption := Format('SJIS 0x%.2x%.2x', [Ord(ls_SJis[1]), Ord(ls_SJis[2])]); end else if (ls_SJis <> '') then begin //1バイト文字 Label_StatusAnsi.Caption := Format('SJIS 0x%.2x', [Ord(ls_SJis[1])]); end else begin //空文字 Label_StatusAnsi.Caption := ''; end; end; end; //位置表示 Label_StatusPos.Caption := Format('%d行 %d文字', [Memo_Text.CurrentLine +1, Memo_Text.Column +1{, Memo_Text.SelStart +1}]); end; end; //============================================================================== procedure TApp_sPad.FormCreate(Sender: TObject); const lci_STATUS_SPACE = 8; var i: Integer; l_Option : TMyParamOption; lsl_Files : TMyWStrings; begin {$IFDEF DEBUG} // myDebug.gpcMessageModeSet(True); {$ENDIF} Memo_Text.Align := alClient; Memo_Text.AutoFont := True; Memo_Text.OnLoadProgress := FOnLoadCount; FcdCharCode := cdAuto; //文字コードは自動判定 FbNewLine := False; //改行コードは指定しない Action_Edit_PasteAnsi.ShortCut := TextToShortCut('Ctrl+Shift+V'); //------------------------------------------------------------------------------ //準汎用フォーム用 G_MainForm := Self; G_ActionList := ActionList1; (* G_sHelpURL := 'http://drang.s4.xrea.com/program/tool/epad/simple/help/'; gpcCreateCustomBaseForm(Self); //メニュー gpcCreateMenuForm; App_CustomMenu.AddMenu('プレイヤー・メインメニュー', MainMenu1); //ツールバー gpcCreateToolBarForm(Self); App_CustomToolBar.AddToolBar('プレイヤーのツールバー', ToolBar1); //ショートカット gpcSetInitShortCut(ActionList1); gpcSetInitMouseGesture( actFile_FileName, //上 actFile_Open, //下 actEdit_Undo, //左 actEdit_Redo //右 ); *) //------------------------------------------------------------------------------ FbFindDown := False; //ステータスバー、情報表示用 Label_StatusEncode.Caption := ''; Label_StatusPos.Caption := ''; Label_StatusChar.Caption := ''; Label_StatusAnsi.Caption := ''; Label_StatusUtf16.Caption := ''; Label_StatusUtf8.Caption := ''; //行番号表示 PaintBox_LineNum.Align := alClient; FbmpLineNum := TBitmap.Create; FbmpLineNum.Width := PaintBox_LineNum.ClientWidth; FrLineNum.iStart := 0; FrLineNum.iLine := 0; //0ベース FrLineNum.iLoop := -1; FrLineNum.iTop := 0; //クリップボード監視 FEntryClipboardViewer; //送る FSendTo := TMySendTo.Create(Self); FSendTo.AddMenuItem(MenuItem_SendTo); FSendTo.CreateSendToMenu; // Dialog_OpenFile.Filter := gfnsInitTextFilterGet; //拡張子のカスタマイズ myCustomExt.gpcCustomExtLoadIni; FLoadIni; Tag := 1; if (ParamCount > 0) then begin lsl_Files := TMyFileStrings.Create; try for i := 1 to ParamW.Count-1 do //1から始めるのはParamWの0番目は実行ファイル名だから begin l_Option := ParamW.OptionParam[i]; (* R: [ON|OFF] 書込み禁止。 T: {8|1|2|4} タブ幅。 W: [ON|OFF] 右端で折り返す。 N: [ON|OFF] ファイル名を取得。 NO:[ON|OFF] ファイル名のみを取得。 CI:{A|S|16L|16B|8|7|E|J|B} 読み込み文字コードを指定。 CO:{S|16L|16LN|16B|16BN|8|8N|7|E|J} 書き込む文字コードを指定。 NL:[CRLL|CR|LF] 書き込む改行コードを指定。 *) if (l_Option.IsOption) then begin //オプションだった if (l_Option.CompareOption(['R', 'ReadOnly'])) then begin //書込み禁止 Action_OptReadOnly.Checked := l_Option.CompareValue('ON'); Action_OptReadOnlyExecute(nil); end else if (l_Option.CompareOption(['T', 'Tab', 'TabStop'])) then begin //タブ幅 case (l_Option.ValueInt) of 1: Action_TextTabExecute(Action_TextTab1); 2: Action_TextTabExecute(Action_TextTab2); 4: Action_TextTabExecute(Action_TextTab4); else Action_TextTabExecute(Action_TextTab8); end; end else if (l_Option.CompareOption(['W', 'Wrap', 'WordWrap'])) then begin //右端で折り返す Action_TextWordWrap.Checked := l_Option.CompareValue('ON'); Action_TextWordWrapExecute(nil); end else if (l_Option.CompareOption(['N', 'FileName'])) then begin Action_FileFileName.Checked := l_Option.CompareValue('ON'); end else if (l_Option.CompareOption(['NO', 'FileNameOnly'])) then begin Action_FileFileNameOnly.Checked := l_Option.CompareValue('ON'); end else if (l_Option.CompareOption(['CI', 'InputCharCode'])) then begin if (l_Option.CompareValue(['A', 'AUTO'])) then begin //自動認識 end else if (l_Option.CompareValue(['S', 'SJIS', 'SHIFTJIS', 'SHIFT-JIS', 'SHIFT_JIS'])) then begin //シフトJIS Memo_Text.Memo.CharCode := cdSJis; end else if (l_Option.CompareValue(['U', 'UL', 'UTF16', 'UTF-16', 'UTF16LE', 'UTF-16LE', 'UNICODE'])) then begin //UTF-16リトルエンディアン Memo_Text.Memo.CharCode := cdUTF_16LE; end else if (l_Option.CompareValue(['UB', 'UTF16B', 'UTF-16B', 'UTF16BE', 'UTF-16BE'])) then begin //UTF-16ビッグエンディアン Memo_Text.Memo.CharCode := cdUTF_16BE; end else if (l_Option.CompareValue(['8', 'UTF8', 'UTF-8'])) then begin //UTF-8 Memo_Text.Memo.CharCode := cdUTF_8; end else if (l_Option.CompareValue(['7', 'UTF7', 'UTF-7'])) then begin //UTF-7 Memo_Text.Memo.CharCode := cdUTF_7; end else if (l_Option.CompareValue(['E', 'EUC'])) then begin //EUC Memo_Text.Memo.CharCode := cdEUC; end else if (l_Option.CompareValue(['J', 'JIS'])) then begin //JIS Memo_Text.Memo.CharCode := cdJIS; end else if (l_Option.CompareValue(['B', 'BIN', 'DUMP'])) then begin //バイナリダンプ Memo_Text.Memo.CharCode := cdBINDUMP; end; end else if (l_Option.CompareOption(['CO', 'OutputCharCode'])) then begin if (l_Option.CompareValue(['S', 'SJIS', 'SHIFTJIS', 'SHIFT-JIS', 'SHIFT_JIS'])) then begin //シフトJIS Memo_Text.Memo.CharCode := cdSJis; end else if (l_Option.CompareValue(['U', 'UTF16', 'UTF-16', 'UTF16LE', 'UTF-16LE'])) then begin //UTF-16リトルエンディアンBOMあり Memo_Text.Memo.CharCode := cdUnicodeLE; end else if (l_Option.CompareValue(['UN', 'UTF16N', 'UTF-16N', 'UTF16LEN', 'UTF-16LEN'])) then begin //UTF-16リトルエンディアンBOMなし Memo_Text.Memo.CharCode := cdUTF_16LE; end else if (l_Option.CompareValue(['UB', 'UTF16B', 'UTF-16B', 'UTF16BE', 'UTF-16BE'])) then begin //UTF-16ビッグエンディアン Memo_Text.Memo.CharCode := cdUnicodeBE; end else if (l_Option.CompareValue(['UBN', 'UTF16BN', 'UTF-16BN', 'UTF16BEN', 'UTF-16BEN'])) then begin //UTF-16ビッグエンディアン Memo_Text.Memo.CharCode := cdUTF_16BE; end else if (l_Option.CompareValue(['8', 'UTF8', 'UTF-8'])) then begin //UTF-8 Memo_Text.Memo.CharCode := cdUTF_8; end else if (l_Option.CompareValue(['8N', 'UTF8N', 'UTF-8N'])) then begin //UTF-8N Memo_Text.Memo.CharCode := cdUTF_8N; end else if (l_Option.CompareValue(['7', 'UTF7', 'UTF-7'])) then begin //UTF-7 Memo_Text.Memo.CharCode := cdUTF_7; end else if (l_Option.CompareValue(['E', 'EUC'])) then begin //EUC Memo_Text.Memo.CharCode := cdEUC; end else if (l_Option.CompareValue(['J', 'JIS'])) then begin //JIS Memo_Text.Memo.CharCode := cdJIS; end; end else if (l_Option.CompareOption(['NL', 'NewLine'])) then begin //出力改行コード if (l_Option.CompareValue(['CL', 'CRLF', 'CR-LF', 'CR+LF'])) then begin //CRLF Dialog_SaveFile.NewLine := nlCRLF; end else if (l_Option.CompareValue(['C', 'CR'])) then begin //CR Dialog_SaveFile.NewLine := nlCR; end else if (l_Option.CompareValue(['L', 'LF'])) then begin //LF Dialog_SaveFile.NewLine := nlLF; end; end; end else begin lsl_Files.Add(l_Option.ParamString); end; end; if (lsl_Files.Count > 0) then begin //ショートカットにドロップされたファイルの処理 FOpenFile(lsl_Files); end; finally lsl_Files.Free; end; end else begin Action_FileNewExecute(nil); end; Dialog_SaveFile.Filter := Dialog_OpenFile.Filter; Dialog_FileName.Filter := Dialog_OpenFile.Filter; //ドラッグアンドドロップの受け入れ DragAcceptFiles(Handle, True); // gpcMenuShortCutDel(PopupMenu_Edit, True); Show; myApp.gpcFormBringToFront(Self); Memo_Text.SetFocus; end; procedure TApp_sPad.FormClose(Sender: TObject; var Action: TCloseAction); begin if (Tag <> 0) then begin if not(FConfirmSave) then begin Action := caNone; end else begin Tag := 0; end; end; end; procedure TApp_sPad.FormDestroy(Sender: TObject); //終了処理 begin if (Tag <> 0) then begin Close; end; Tag := 0; Hide; //クリップボード監視を解除 FRemoveClipboardViewer; FNotification.Free; FSaveIni; FbmpLineNum.Free; gpcMenuItemFree(PopupMenu_FileOpenHistory.Items); gpcMenuItemFree(PopupMenu_FindHistory.Items); Memo_Text.Clear; end; procedure TApp_sPad.WMQueryEndSession(var Msg: TWMQueryEndSession); begin //http://www.wwlnk.com/boheme/delphi/tips/tec0690.htm FormDestroy(Self); // Close; Msg.Result := 1; end; //------------------------------------------------------------------------------ procedure TApp_sPad.SpeedButton_FindHistoryMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //検索・置換履歴ポップアップ var l_SpeedButton: TSpeedButton; begin if not(Sender is TSpeedButton) then Exit; l_SpeedButton := TSpeedButton(Sender); l_SpeedButton.PopupMenu.PopupComponent := l_SpeedButton; end; procedure TApp_sPad.SpeedButton_FindHistoryClick(Sender: TObject); var l_SpeedButton: TSpeedButton; l_Popup: TPopupMenu; begin l_SpeedButton := TSpeedButton(Sender); l_Popup := l_SpeedButton.PopupMenu; if (l_Popup.Items.Count > 0) then begin l_Popup.Popup(l_SpeedButton.ClientOrigin.X, l_SpeedButton.ClientOrigin.Y + l_SpeedButton.Height); end; end; procedure TApp_sPad.FFileOpenHistoryClick(Sender: TObject); begin Dialog_OpenFile.Files.Clear; Dialog_OpenFile.FileName := gfnsAnsiToWideEx(TMenuItem(Sender).Caption); //myDebug.gpcDebug(dlgOpenFile.Files.AnsiStrings); // actFile_OpenExecute(nil); FcdCharCode := cdAuto; FOpenFile(Dialog_OpenFile.Files); end; procedure TApp_sPad.MenuItem_AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); begin myMenu.MenuItem_AdvancedDrawItem(Sender, ACanvas, ARect, State); end; procedure TApp_sPad.MenuItem_HistoryDrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); const lci_MARGIN = 6; var l_Rect : TRect; ls_File : WideString; begin l_Rect := ARect; with ACanvas do begin FillRect(l_Rect); Inc(l_Rect.Left, lci_MARGIN); ls_File := gfnsAnsiToWideEx(TMenuItem(Sender).Hint); //キャプションでないのがミソ DrawTextW(Handle, PWideChar(ls_File), -1, l_Rect, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER); end; end; procedure TApp_sPad.MenuItem_MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); begin myMenu.MenuItem_MeasureItem(Sender, ACanvas, Width, Height); end; procedure TApp_sPad.FFindFindHistoryClick(Sender: TObject); //検索・置換履歴から選択 begin Edit_Find.Text := gfnsAnsiToWideEx(TMenuItem(Sender).Caption); // edtFind.CurrentCaret := F_Edit.Length; Edit_Find.SetFocus; end; procedure TApp_sPad.FAddHistory(AMenuItem: TMenuItem; sText: WideString); //検索・置換履歴に追加 const lci_HISTORY = 10; var i : Integer; ls_Caption : AnsiString; ls_Text : AnsiString; l_OnClick : TNotifyEvent; l_MenuItem : TMenuItem; begin ls_Caption := gfnsWideToAnsiEx(sText); //履歴の最初がsTextなら処理を抜ける if (AMenuItem.Count > 0) and (AMenuItem.Items[0].Caption = ls_Caption) then begin Exit; end; for i := AMenuItem.Count -1 downto 0 do begin ls_Text := AMenuItem.Items[i].Caption; if (ls_Text = ls_Caption) or (ls_Text = '') then begin AMenuItem.Items[i].Free; end; end; if (ls_Caption = '') then begin Exit; end; if (AMenuItem = PopupMenu_FileOpenHistory.Items) then begin l_OnClick := FFileOpenHistoryClick; end else begin l_OnClick := FFindFindHistoryClick; end; l_MenuItem := NewItem( ls_Caption, //Caption 0, //ShortCut False, //Checked True, //Enabled l_OnClick, //OnClickイベント 0, //HelpContext gfnsAvailableName(AMenuItem.Name) //Name ); l_MenuItem.OnAdvancedDrawItem := MenuItem_HistoryDrawItem; //Unicode対応のため l_MenuItem.OnMeasureItem := MenuItem_MeasureItem; l_MenuItem.Hint := ls_Caption; //最後に追加ではなく頭に挿入 AMenuItem.Insert(0, l_MenuItem); if (AMenuItem.Count > lci_HISTORY) then begin AMenuItem.Items[AMenuItem.Count -1].Free; //最後をFree end; end; procedure TApp_sPad.FAddHistory(AMenuItem: TMenuItem; AList: TMyWStrings); var i: Integer; begin for i := 0 to AList.Count-1 do begin FAddHistory(AMenuItem, AList[i]); end; end; function TApp_sPad.FConfirmSave: Boolean; var li_Sel: Word; begin //文書が変更されていて、確認ダイアログでキャンセルを押さなければTrueを返す Result := True; if (Memo_Text.Modified) then begin li_Sel := gfniMessageBoxYesNoCancel('文書が変更されています。保存しますか'); Result := (li_Sel <> mrCancel); if (li_Sel = mrYes) then begin Action_FileSaveExecute(nil); end; end; end; procedure TApp_sPad.Action_FileNewExecute(Sender: TObject); //新規作成 begin if (FConfirmSave) then begin FSetFileName(''); Panel_Status.Hint := ''; Memo_Text.Text := ''; Label_StatusEncode.Caption := ''; Label_StatusPos.Caption := ''; Memo_TextSelectionChange(nil); end; end; procedure TApp_sPad.FOpenFile(AList: TMyWStrings); //ファイルを開く const lci_READBIN = 1024 * 64; //64KB lcI_MSGSIZE = 1024 * 1024 * 2; //2MB var i : Integer; ls_File : WideString; l_FileList : TMyWStrings; lb_Loaded : Boolean; li_Ret : Integer; begin Self.Enabled := False; Screen.Cursor := crHourGlass; Application.ProcessMessages; if (Action_FileFileName.Checked) then begin //ファイル名を挿入 Memo_Text.InsertLine(Memo_Text.CurrentLine, TrimRight(AList.Text)); end else if (Action_FileFileNameOnly.Checked) then begin //ファイルの名前のみを挿入 l_FileList := TMyWStrings.Create; try l_FileList.Assign(AList); for i := 0 to l_FileList.Count-1 do begin l_FileList[i] := gfnsFileNameGet(l_FileList[i]); end; Memo_Text.InsertLine(Memo_Text.CurrentLine, TrimRight(l_FileList.Text)); finally l_FileList.Free; end; end else begin //ファイルの中身を読み込み(↑と違い挿入ではなく置換) lb_Loaded := False; for i := 0 to AList.Count -1 do begin ls_File := AList[i]; if (gfnbIsShortCut(ls_File)) then begin //ショートカットファイルではなくリンク先のファイル ls_File := gfnsLinkToFile(ls_File); end; if not(gfnbFileExists(ls_File)) then begin //存在しないファイルだった Beep; end else begin if not(lb_Loaded) then begin //読み込んでいない // F_iReadSize := 0; FiFileSize := gfniFileSizeGet(ls_File); if (FcdCharCode = cdBINDUMP) and (FiFileSize > lci_READBIN) then begin //バイナリダンプは読み込みにえらく時間がかかるので指定サイズまでに制限する。 li_Ret := gfniMessageBoxYesNo(WideFormat('%s'#13#13'バイナリダンプは処理に時間がかかるので先頭からの64KBまでに制限しています'#13'また上書き保存すると元ファイルが壊れてしまうので注意してください'#13'よろしいですか', [ls_File])); end else if (FiFileSize > lci_MSGSIZE) then begin //5MB以上なら確認ダイアログを出す li_Ret := gfniMessageBoxYesNo(WideFormat('%s [%s]'#13#13'このファイルはサイズが大きいので処理に時間がかかります'#13'よろしいですか', [gfnsFileNameGet(ls_File), gfnsFileSizeGet(ls_File)])); if (li_Ret = ID_YES) then begin Self.Caption := '読み込んでいます。しばらくお待ちください..'; if not(Self.Visible) then begin Show; end; end; end else begin li_Ret := ID_YES; end; if (li_Ret = ID_YES) then begin lb_Loaded := True; // F_SetFileName(ls_File); FsFileName := ls_File; //↑をコメントアウトし場合は必ず必要。 Memo_Text.Clear; Memo_TextSelectionChange(nil); //ステータスを消す if (FcdCharCode = cdBINDUMP) then begin //バイナリダンプは保存するととんでもないことになるのでリードオンリーにする。 Action_OptReadOnly.Checked := True; Action_OptReadOnlyExecute(nil); end; try Timer_LoadProgress.Enabled := True; if (FcdCharCode = cdBINDUMP) then begin Memo_Text.LoadFromFile(FsFileName, FcdCharCode, lci_READBIN); Memo_Text.Font := FontDialog1.Font; end else begin Memo_Text.LoadFromFile(FsFileName, FcdCharCode); end; except on E: Exception do gpcShowMessage(E.Message); { on EOutOfMemory do begin gpcShowMessage('データが大きすぎて読み込みを完了できませんでした。'); end else begin gpcShowMessage('読み込みを完了できませんでした。'); end; } end; // edtMemo.Modified := False; FSetFileName(ls_File); FreeAndNil(FNotification); FNotification := TMyChangeNotification.Create(FsFileName); FAddHistory(PopupMenu_FileOpenHistory.Items, FsFileName); if (gfnbFileIsReadOnly(FsFileName)) then begin Action_OptReadOnly.Checked := True; Action_OptReadOnlyExecute(nil); end; Label_StatusEncode.Caption := WideFormat('%s(%s)', [gfnsCharCodeToText(FcdCharCode), gfnsNewLineToDescription(Memo_Text.NewLine)]); Memo_TextSelectionChange(nil); Panel_Status.Hint := gfnsWideToAnsiEx(FsFileName); end; end else begin //読み込み済みなので他のファイルは別プロセスで起動 gpcExecute(gfnsExeNameGet, WideFormat('"%s"', [ls_File])); end; end; end; end; Screen.Cursor := crDefault; Self.Enabled := True; Timer_LoadProgress.Enabled := False; Timer_LoadProgressTimer(nil); end; procedure TApp_sPad.Action_FileOpenExecute(Sender: TObject); //開く var ls_InitDir: WideString; begin if (Action_FileFileName.Checked) or (Action_FileFilenameOnly.Checked) then begin Action_FileFileNameExecute(nil); end else begin if (FConfirmSave) then begin if (Action_OptReadOnly.Checked) then begin Dialog_OpenFile.Options := Dialog_OpenFile.Options + [ofReadOnly]; end else begin Dialog_OpenFile.Options := Dialog_OpenFile.Options - [ofReadOnly]; end; Dialog_OpenFile.FileName := FsFileName; if (Dialog_OpenFile.FileName = '') then begin //2011-12-31:ファイルの種類を設定ファイルに持つようにしたためコメントアウト。 // Dialog_OpenFile.FilterIndex := 1; end else begin Dialog_OpenFile.FilterIndex := gfniFilterIndexGet(Dialog_OpenFile.Filter, gfnsFileExtGet(Dialog_OpenFile.FileName)); end; ls_InitDir := Dialog_OpenFile.InitialDir; Dialog_OpenFile.InitialDir := gfnsFilePathGet(Dialog_OpenFile.FileName); if (Dialog_OpenFile.Execute) then begin Action_OptReadOnly.Checked := (ofReadOnly in Dialog_OpenFile.Options); Action_OptReadOnlyExecute(nil); FcdCharCode := Dialog_OpenFile.CharCode; FOpenFile(Dialog_OpenFile.Files); end else begin FcdCharCode := Dialog_OpenFile.CharCode; //キャンセルしても文字コードは設定される Dialog_OpenFile.InitialDir := ls_InitDir; end; end; end; end; //上書き保存 procedure TApp_sPad.Action_FileSaveExecute(Sender: TObject); var ls_Msg: WideString; li_Ret: Integer; begin //保存したかどうかのフラグ。保存したら1になる。 Action_FileSave.Tag := 0; if (FsFileName = '') then begin //新規作成でファイル名がなければダイアログを出す Action_FileSaveAsExecute(Sender); Exit; end else if (gfnbFileIsReadOnly(FsFileName)) then begin //読み取り専用だったのでメッセージを出して処理を抜ける gpcShowMessage(WideFormat('%s'#13'このファイルには読み取り専用属性が設定されています。'#13'別のファイル名を使用してください。', [gfnsFileNameGet(FsFileName)]), '名前を付けて保存'); Exit; end else begin li_Ret := ID_YES; if (gfnbIsUnicode(Memo_Text.Text)) then begin case (FcdCharCode) of cdUnicodeLE, cdUnicodeBE, cdUTF_16LE, cdUTF_16BE, cdUTF_8, cdUTF_8N, cdUTF_7 :begin //Unicode OK end; else begin ls_Msg := WideFormat('この文書は、%s テキストファイルとして保存すると代替文字に変換されてしまうUnicode形式の文字を含んでいます。'#13'よろしいですか', [gfnsCharCodeToDescription(FcdCharCode)]); li_Ret := gfniMessageBoxYesNo(ls_Msg); end; end; end; if (li_Ret = ID_YES) then begin Screen.Cursor := crHourglass; try FreeAndNil(FNotification); if (Memo_Text.SaveToFile(FsFileName, FcdCharCode, Dialog_SaveFile.NewLine)) then begin Action_FileSave.Tag := 1; if (Action_OptReadOnly.Checked) then begin Action_OptReadOnly.Checked := False; Action_OptReadOnlyExecute(nil); end; end; Memo_Text.Modified := False; FNotification := TMyChangeNotification.Create(FsFileName); finally Screen.Cursor := crDefault; end; end; end; end; //名前をつけて保存 procedure TApp_sPad.Action_FileSaveAsExecute(Sender: TObject); var li_Ret: Integer; ls_OldFileName: WideString; l_NewLine: TMyNewLine; begin ls_OldFileName := FsFileName; Dialog_SaveFile.FileName := FsFileName; Dialog_SaveFile.FilterIndex := gfniFilterIndexGet(Dialog_SaveFile.Filter, gfnsFileExtGet(Dialog_SaveFile.FileName)); Dialog_SaveFile.InitialDir := gfnsFilePathGet(FsFileName); Dialog_SaveFile.CharCode := FcdCharCode; l_NewLine := Dialog_SaveFile.NewLine; if not(FbNewLine) then begin Dialog_SaveFile.NewLine := Memo_Text.NewLine; end; if (Dialog_SaveFile.Execute) then begin Dialog_SaveFile.InitialDir := gfnsFilePathGet(Dialog_SaveFile.FileName); FcdCharCode := Dialog_SaveFile.CharCode; Memo_Text.NewLine := Dialog_SaveFile.NewLine; if (FbNewLine and (Dialog_SaveFile.NewLine <> l_NewLine)) then begin //ダイアログで改行コードを変更したらコマンドラインの改行オプションを無効にする FbNewLine := False; end; FsFileName := Dialog_SaveFile.FileName; if (gfnbFileExists(FsFileName)) then begin li_Ret := gfniMessageBoxYesNo(WideFormat('%s'#13'既に存在します。上書きしますか?', [FsFileName])); end else begin li_Ret := ID_YES; end; if (li_Ret = ID_YES) then begin Action_FileSaveExecute(nil); end; //保存しなかった、あるいはできなかったらファイル名を戻す if (Action_FileSave.Tag = 0) then begin //保存しなかった FSetFileName(ls_OldFileName); end else begin //保存した FSetFileName(FsFileName); Label_StatusEncode.Caption := WideFormat('%s(%s)', [gfnsCharCodeToText(FcdCharCode), gfnsNewLineToDescription(Memo_Text.NewLine)]); Memo_TextSelectionChange(nil); end; end; end; procedure TApp_sPad.Action_FileFileNameExecute(Sender: TObject); //ファイル名を挿入 begin Dialog_FileName.FilterIndex := gfniFilterIndexGet(Dialog_FileName.Filter, gfnsFileExtGet(Dialog_FileName.FileName)); if (Dialog_FileName.Execute) then begin Dialog_FileName.InitialDir := gfnsFilePathGet(Dialog_FileName.FileName); // Memo_Text.Insert(Dialog_FileName.Files.Text); FOpenFile(Dialog_FileName.Files); end; end; //終了 procedure TApp_sPad.Action_FileExitExecute(Sender: TObject); begin Close; end; // 編集 ------------------------------------------------------------------------ //現在フォーカスのあるエディットを返す function TApp_sPad.FGetFocusEdit: TMyCustomEdit; begin if (Edit_Find.Focused) then begin Result := Edit_Find; end else if (Memo_Text.Focused) then begin Result := Memo_Text; end else begin Result := Memo_Text; // Result := nil; end; end; //メインメニュー //http://www2.big.or.jp/~osamu/Delphi/Tips/key.cgi?key=29#0066.txt procedure TApp_sPad.WndProc(var Msg: TMessage); begin if (Msg.Msg = WM_INITMENU) and (Msg.WParam = WPARAM(Menu.Handle)) then begin PopupMenu_EditPopup(nil); end; inherited; end; //状況に応じたメニューの変更 procedure TApp_sPad.PopupMenu_EditPopup(Sender: TObject); var l_Edit: TMyCustomEdit; begin if (Tag = 0) then begin Exit; end; l_Edit := FGetFocusEdit; // if (l_Edit = nil) then begin // l_Edit := edtMemo.Memo; //AIU // end; if (l_Edit = Memo_Text) and (Memo_Text.ReadOnly) then begin //リードオンリーなら書き換えは不可 Action_EditUndo.Enabled := False; Action_EditRedo.Enabled := False; Action_EditCut.Enabled := False; Action_EditPaste.Enabled := False; Action_EditDelete.Enabled := False; end else begin Action_EditUndo.Enabled := l_Edit.CanUndo; Action_EditRedo.Enabled := l_Edit.CanRedo; Action_EditCut.Enabled := l_Edit.Selected; Action_EditDelete.Enabled := Action_EditCut.Enabled; Action_EditPaste.Enabled := (gfnsStrFromClipboard <> ''); end; //すべて選択 Action_EditSelectAll.Enabled := (l_Edit.Text <> ''); //コピー Action_EditCopy.Enabled := l_Edit.Selected; Action_FindFindSelDown.Enabled := Memo_Text.Selected; Action_FindFindSelUp.Enabled := Action_FindFindSelDown.Enabled; //ネット検索 Action_Search.Enabled := Action_FindFindSelDown.Enabled; gpcSetMenuDefault(MenuItem_SearchSelectSite); Action_FileFileName.Enabled := not(Action_OptReadOnly.Checked); Action_FileFileNameOnly.Enabled := Action_FileFileName.Enabled; //変換 // Action_Convert.Enabled := Action_EditCopy.Enabled and not(Action_OptReadOnly.Checked); Action_ConvertStrToUCode.Enabled := Action_EditCopy.Enabled and not(Action_OptReadOnly.Checked); Action_ConvertUCodeToStr.Enabled := Action_ConvertStrToUCode.Enabled; Action_ConvertStrToSJisCode.Enabled := Action_ConvertStrToUCode.Enabled; Action_ConvertSJisCodeToStr.Enabled := Action_ConvertStrToUCode.Enabled; Action_ConvertUrlToStr.Enabled := Action_ConvertStrToUCode.Enabled; Action_ConvertStrToUrl.Enabled := Action_ConvertStrToUCode.Enabled; // Action_Sort.Enabled := Action_ConvertStrToUCode.Enabled; Action_Sort.Enabled := Memo_Text.LineCount > 1; if (FSendTo <> nil) then begin FSendTo.MenuItemState; end; end; //元に戻す procedure TApp_sPad.Action_EditUndoExecute(Sender: TObject); begin if (FGetFocusEdit <> nil) then begin FGetFocusEdit.Undo; end; end; //やり直し procedure TApp_sPad.Action_EditRedoExecute(Sender: TObject); begin if (FGetFocusEdit <> nil) then begin FGetFocusEdit.Redo; end; end; //切り取り procedure TApp_sPad.Action_EditCutExecute(Sender: TObject); begin if (FGetFocusEdit <> nil) then begin FGetFocusEdit.CutToClipboard; end; end; //コピー procedure TApp_sPad.Action_EditCopyExecute(Sender: TObject); begin if (FGetFocusEdit <> nil) then begin FGetFocusEdit.CopyToClipboard; end; end; //貼り付け procedure TApp_sPad.Action_EditPasteExecute(Sender: TObject); begin if (FGetFocusEdit <> nil) then begin FGetFocusEdit.PasteFromClipboard; end; end; procedure TApp_sPad.Action_Edit_PasteAnsiExecute(Sender: TObject); begin if (FGetFocusEdit <> nil) then begin FGetFocusEdit.PasteFromClipboardAnsi; end; end; //削除 procedure TApp_sPad.Action_EditDeleteExecute(Sender: TObject); begin if (FGetFocusEdit <> nil) then begin FGetFocusEdit.ClearSelection; end; end; //全て選択 procedure TApp_sPad.Action_EditSelectAllExecute(Sender: TObject); begin if (FGetFocusEdit <> nil) then begin FGetFocusEdit.SelectAll; end; end; procedure TApp_sPad.Action_OptReadOnlyExecute(Sender: TObject); //書込み禁止 begin Memo_Text.ReadOnly := Action_OptReadOnly.Checked; if (Memo_Text.ReadOnly) then begin Memo_Text.Color := clBtnFace; Memo_Text.Font.Color := clBtnText; end else begin Memo_Text.Color := clWindow; Memo_Text.Font.Color := clWindowText; end; end; procedure TApp_sPad.SetFileUpdate; //更新 procedure l_ReloadFile; begin Memo_Text.Clear; Memo_Text.Memo.LoadFromFile(FsFileName); FbFileUpdate := False; Memo_Text.Memo.Modified := False; Memo_TextSelectionChange(nil); end; begin if (GetActiveWindow = Handle) then begin if (Action_OptReadOnly.Checked) then begin //書込み禁止 if (gfniMessageBoxYesNo('文書ファイルが更新されていますが書き込み禁止モードになっています'#13'読み込み直しますか') = ID_YES) then begin l_ReloadFile; end; end else begin if (gfniMessageBoxYesNo('文書ファイルが更新されています'#13'読み込み直しますか') = ID_YES) then begin l_ReloadFile; end; end; FbFileUpdate := False; end else begin FbFileUpdate := True; end; end; procedure TApp_sPad.ApplicationEvents1Activate(Sender: TObject); //アプリケーションがアクティブになった→更新処理が必要か begin if (Tag = 0) or (Application.Terminated) then begin Exit; end; FormActivate(nil); if (FbFileUpdate) then begin SetFileUpdate; end; end; procedure TApp_sPad.FormActivate(Sender: TObject); begin if (Tag = 0) or (Application.Terminated) then begin Exit; end; if (Assigned(FFocusEdit)) then begin FFocusEdit.SetFocus; end; end; procedure TApp_sPad.Action_FindFindDownExecute(Sender: TObject); //検索 begin Memo_Text.FindForward := (Sender = Action_FindFindDown) or (Sender = Action_FindFindSelDown) ; if (Edit_Find.Text = '') and (Memo_Text.Selected) then begin Edit_Find.Text := Memo_Text.SelText; end; if not(Memo_Text.Find(Edit_Find.Text)) then begin //検索対象がみつからなかった Beep; end; //履歴に追加 FAddHistory(PopupMenu_FindHistory.Items, Edit_Find.Text); end; procedure TApp_sPad.Action_FindSelFindDownExecuteion(Sender: TObject); //選択範囲を検索 begin Edit_Find.Text := Memo_Text.SelText; Action_FindFindDownExecute(Sender); end; procedure TApp_sPad.Action_FindWordExecute(Sender: TObject); //単語検索オプション begin Memo_Text.FindWholeWord := Action_FindWord.Checked; end; procedure TApp_sPad.Action_FindCaseExecute(Sender: TObject); //大小文字の区別 begin Memo_Text.FindIgnoreCase := not(Action_FindCase.Checked); end; procedure TApp_sPad.Action_SearchExecute(Sender: TObject); begin // if (Memo_Text.SelText <> '') then begin G_SearchList.Search(Memo_Text.SelText); end; end; procedure TApp_sPad.FOnSearchChange(Sender: TObject); begin gpcSearchMenuCreate(MenuItem_SearchSelectSite, Action_SearchExecute); end; procedure TApp_sPad.__MenuItem_PEdit_TabClick(Sender: TObject); //Tabの入力 begin if (FGetFocusEdit <> nil) then FGetFocusEdit.Insert(#9); end; procedure TApp_sPad.__MenuItem_PEdit_CtrlTabClick(Sender: TObject); //コントロールの移動 begin if (Edit_Find.Focused) then begin Memo_Text.SetFocus; end else if (Memo_Text.Focused) then begin Edit_Find.SetFocus; end; end; procedure TApp_sPad.__MenuItem_PEdit_CtrlFClick(Sender: TObject); //検索欄へフォーカス begin if (Edit_Find.Focused) then begin Memo_Text.SetFocus; end else if (Memo_Text.Focused) then begin Edit_Find.SetFocus; end; end; //------------------------------------------------------------------------------ //表示 procedure TApp_sPad.Action_TextWordWrapExecute(Sender: TObject); //右端で折り返す begin Memo_Text.WordWrap := Action_TextWordWrap.Checked; end; procedure TApp_sPad.Action_TextTabExecute(Sender: TObject); //タブ間隔 var l_Action: TAction; begin l_Action := TAction(Sender); l_Action.Checked := True; Memo_Text.Tab := l_Action.Tag; Action_TextTab.ImageIndex := l_Action.ImageIndex; end; procedure TApp_sPad.Action_TextAutoIndentExecute(Sender: TObject); //オートインデント begin Memo_Text.AutoIndent := Action_TextAutoIndent.Checked; end; procedure TApp_sPad.Action_TextFontExecute(Sender: TObject); //フォント選択 var l_Edit: TMyCustomEdit; begin l_Edit := FGetFocusEdit; FontDialog1.Font := Memo_Text.Font; if (Sender = nil) or (FontDialog1.Execute) then begin Memo_Text.Font := FontDialog1.Font; //行番号表示用 FrLineNum.iHeight := gfniCanvasTextHeightGet(Memo_Text.Font); end; l_Edit.SetFocus; end; procedure TApp_sPad.Action_HelpVersionInfoExecute(Sender: TObject); //ヘルプ begin gpcVersionInfoCreate; gpcVersionInfoURLSet('http://drang.s4.xrea.com/program/tool/epad/simple/help/'); gpcVersionInfoShowModal; gpcVersionInfoRelease; end; procedure TApp_sPad.actNop(Sender: TObject); begin // end; //変換 procedure TApp_sPad.Action_ConvertStrToUCodeExecute(Sender: TObject); var i: Integer; ls_Str, ls_Code, ls_Fmt: WideString; ls_AChar: AnsiString; begin if (Sender = Action_ConvertStrToUCode) or (Sender = Action_ConvertStrToSJisCode) then begin if (Action_ConvertInsSpc.Checked) then begin ls_Fmt := '%s '; end else begin ls_Fmt := '%s'; end; ls_Code := ''; ls_Str := Memo_Text.SelText; for i := 1 to Length(ls_Str) do begin if (Sender = Action_ConvertStrToUCode) then begin ls_Code := WideFormat(ls_Fmt + '%.4x', [ls_Code, Ord(ls_Str[i])]); end else begin ls_AChar := AnsiString(ls_Str[i]); if (Length(ls_AChar) = 1) then begin ls_Code := WideFormat(ls_Fmt + '%.2x', [ls_Code, Ord(ls_AChar[1])]); end else begin ls_Code := WideFormat(ls_Fmt + '%.2x%.2x', [ls_Code, Ord(ls_AChar[1]), Ord(ls_AChar[2])]); end; end; end; Memo_Text.SelText := Trim(ls_Code); end; end; procedure TApp_sPad.Action_ConvertUCodeToStrExecute(Sender: TObject); function lfnb_IsHex(sChar: WideChar): Boolean; begin Result := Pos(WideUpperCase(sChar), '0123456789ABCDEF') > 0; end; procedure lpc_CodeToStr(var sStr, sNum: WideString); begin sStr := sStr + WideChar(gfniStrToInt('$' + sNum)); sNum := ''; end; var i, li_Num, li_Len: Integer; ls_Str, ls_Code, ls_Num: WideString; lb_Spc: Boolean; begin if (Sender = Action_ConvertUCodeToStr) then begin lb_Spc := False; ls_Str := ''; ls_Code := Memo_Text.SelText; li_Len := Length(ls_Code); ls_Num := ''; li_Num := 0; for i := 1 to li_Len do begin if (lfnb_IsHex(ls_Code[i])) then begin ls_Num := ls_Num + ls_Code[i]; Inc(li_Num); if (i = li_Len) or (li_Num = 4) then begin lpc_CodeToStr(ls_Str, ls_Num); li_Num := 0; lb_Spc := Action_ConvertInsSpc.Checked; end; end else begin if (ls_Num <> '') then begin //数値以外だったので区切りとみなし文字に変換 lpc_CodeToStr(ls_Str, ls_Num); lb_Spc := (ls_Code[i] = ' ') and (Action_ConvertInsSpc.Checked); end; if not(lb_Spc) then begin ls_Str := ls_Str + ls_Code[i]; lb_Spc := False; end; end; end; Memo_Text.SelText := ls_Str; end; end; procedure TApp_sPad.Action_ConvertSJisCodeToStrExecute(Sender: TObject); function lfnb_IsHex(sChar: WideChar): Boolean; begin Result := Pos(WideUpperCase(sChar), '0123456789ABCDEF') > 0; end; procedure lpc_CodeToStr(var sStr: AnsiString; var sNum: WideString); begin sStr := sStr + AnsiChar(gfniStrToInt('$' + sNum)); sNum := ''; end; var i, li_Num, li_Len: Integer; ls_Str, ls_Code, ls_Num: WideString; ls_AChar: AnsiString; begin if (Sender = Action_ConvertSJisCodeToStr) then begin ls_AChar := ''; ls_Str := ''; ls_Code := Memo_Text.SelText; li_Len := Length(ls_Code); ls_Num := ''; li_Num := 0; for i := 1 to li_Len do begin if (lfnb_IsHex(ls_Code[i])) then begin ls_Num := ls_Num + ls_Code[i]; Inc(li_Num); if (i = li_Len) or ((Sender = Action_ConvertSJisCodeToStr) and (li_Num = 2)) or (li_Num = 4) then begin lpc_CodeToStr(ls_AChar, ls_Num); li_Num := 0; end; end else begin if (ls_Num <> '') then begin //数値以外だったので区切りとみなし文字に変換 lpc_CodeToStr(ls_AChar, ls_Num); end; ls_Str := ls_Str + ls_AChar + ls_Code[i]; ls_AChar := ''; end; end; if (ls_AChar <> '') then begin ls_Str := ls_Str + ls_AChar; end; Memo_Text.SelText := ls_Str; end; end; procedure TApp_sPad.Action_ConvertStrToUrlExecute(Sender: TObject); //Urlエンコード begin Memo_Text.SelText := HTTPEncode(Utf8Encode(Memo_Text.SelText)); end; procedure TApp_sPad.Action_ConvertUrlToStrExecute(Sender: TObject); //Urlデコード begin Memo_Text.SelText := Utf8Decode(HTTPDecode(gfnsWideToAnsi(Memo_Text.SelText))); end; //ソート //数値でソート function F_CompareNum(AList: TMyWStrings; iIndex1, iIndex2: Integer): Integer; var li_Num1 : Integer; li_Num2 : Integer; li_Type : DWORD; begin li_Type := gciNUM_HALF or gciNUM_FULL or gciNUM_KANJI or gciNUM_DAIJI or gciNUM_MARU or gciNUM_ROMA ; li_Num1 := gfniStrToIntEx(AList[iIndex1], li_Type); li_Num2 := gfniStrToIntEx(AList[iIndex2], li_Type); if (li_Num1 > li_Num2) then begin Result := 1; end else if (li_Num1 < li_Num2) then begin Result := -1; end else begin // li_Num = li_Num2 Result := gfniFuncAscendingTextSort(AList, iIndex1, iIndex2); // Result := 0; end; end; procedure TApp_sPad.Action_SortStrExecute(Sender: TObject); var l_List : TMyFileStrings; begin Self.Enabled := False; Screen.Cursor := crHourglass; try l_List := TMyFileStrings.Create; try l_List.NewLine := nlCR; if (Memo_Text.Selected) then begin l_List.Text := Memo_Text.SelText; end else begin l_List.Text := Memo_Text.Text; end; if (Sender = Action_SortStr) then begin //大文字小文字を区別してソート l_List.CaseSensitive := True; l_List.Sort; end else if (Sender = Action_SortText) then begin //大文字小文字を区別せずソート l_List.CaseSensitive := False; l_List.Sort; end else if (Sender = Action_SortNum) then begin //数値でソート l_List.CaseSensitive := False; l_List.CustomSort(F_CompareNum); end else if (Sender = Action_SortFileName) then begin //ファイル名でソート l_List.FileSort; end; if not(Memo_Text.Selected) then begin //Memo_Text := 'テキスト' のようにすると「元に戻す」が効かなくなるため Memo_Text.SelectAll; end; // Memo_Text.SelText := gfnsStrEndCut(l_List.Text, #$D); Memo_Text.SelText := l_List.Text; finally l_List.Free; end; finally Screen.Cursor := crDefault; Self.Enabled := True; end; end; procedure TApp_sPad.Action_SortReverseExecute(Sender: TObject); var l_List : TMyFileStrings; begin l_List := TMyFileStrings.Create; try l_List.Text := Memo_Text.SelText; l_List.Reverse; Memo_Text.SelText := l_List.Text; finally l_List.Free; end; end; procedure TApp_sPad.Edit_FindChange(Sender: TObject); begin Action_FindFindDown.Enabled := Edit_Find.Text <> ''; Action_FindFindUp.Enabled := Action_FindFindDown.Enabled; end; procedure TApp_sPad.Edit_FindEnter(Sender: TObject); begin FFocusEdit := Edit_Find; end; procedure TApp_sPad.Memo_TextEnter(Sender: TObject); begin FFocusEdit := Memo_Text; end; procedure TApp_sPad.Action_OptStatusBarExecute(Sender: TObject); //ステータスバーのオンオフ begin Panel_Status.Visible := Action_OptStatusBar.Checked; if (Action_OptStatusBar.Checked) then begin Memo_TextSelectionChange(nil); end; end; procedure TApp_sPad.FSetLineNum; var li_Current : Integer; begin if (Action_OptLineNum.Checked) then begin li_Current := Memo_Text.Memo.CurrentLine; if (li_Current <> FrLineNum.iLine) then begin FrLineNum.iLine := li_Current; Memo_TextUpdate(nil); end; end; end; procedure TApp_sPad.Action_OptLineNumExecute(Sender: TObject); //行番号表示のオンオフ begin Panel_LineNum.Visible := Action_OptLineNum.Checked; end; procedure TApp_sPad.Memo_TextUpdate(Sender: TObject); //行番号表示 const lci_MARGIN = 2; lci_MINWIDTH = 3; var i, li_Shift, li_Width, li_Start, li_Line: Integer; lb_Current: Boolean; lrc_Rect: TRect; begin if not(Panel_LineNum.Visible) then begin Exit; end; //行番号の幅 li_Width := Length(IntToStr(Memo_Text.Memo.Count)); li_Width := gfniNumLimit(li_Width, lci_MINWIDTH, li_Width); if (li_Width <> FrLineNum.iWidth) then begin FrLineNum.iWidth := li_Width; Panel_LineNum.Width := li_Width * FbmpLineNum.Canvas.TextWidth('0') + lci_MARGIN * 2 + Shape_LineNum.Width; end; //最初の表示行を取得 li_Start := Memo_Text.Memo.LineFromPos(Point(0, 0)); if (li_Start <> FrLineNum.iStart) then begin FrLineNum.iStart := li_Start; end; //行番号の出力位置。クライアントからの縦方向のシフト量。 li_Shift := Memo_Text.Memo.GetLinePos(li_Start).Y; //myDebug.gpcDebug([li_Start, li_Shift]); FbmpLineNum.Canvas.FillRect(PaintBox_LineNum.ClientRect); lrc_Rect := Rect(lci_MARGIN, FrLineNum.iTop + li_Shift, FbmpLineNum.Width, FrLineNum.iTop + li_Shift + FrLineNum.iHeight); for i := 0 to FrLineNum.iLoop do begin li_Line := FrLineNum.iStart + i +1; lb_Current := (li_Line = Memo_Text.Memo.CurrentLine +1); if (lb_Current) then begin //カレント行を色分け表示。 FbmpLineNum.Canvas.Brush.Color := clBtnText; FbmpLineNum.Canvas.Font.Color := clBtnFace; FbmpLineNum.Canvas.FillRect(lrc_Rect); end; //5行ごとに表示。 if (li_Line = 1) or (li_Line mod 5 = 0) then begin Dec(lrc_Rect.Right); DrawText(FbmpLineNum.Canvas.Handle, PChar(Format('%*d', [li_Width, li_Line])), -1, lrc_Rect, DT_SINGLELINE or DT_NOPREFIX or DT_BOTTOM or DT_RIGHT); Inc(lrc_Rect.Right); end; Inc(lrc_Rect.Top, FrLineNum.iHeight); Inc(lrc_Rect.Bottom, FrLineNum.iHeight); if (lb_Current) then begin //色分け表示を元に戻す。 FbmpLineNum.Canvas.Brush.Color := clBtnFace; FbmpLineNum.Canvas.Font.Color := clBtnText; end; end; PaintBox_LineNumPaint(nil); Sleep(1); // Application.ProcessMessages; これがあるとテキストに日本語がある場合表示が乱れる end; procedure TApp_sPad.PaintBox_LineNumPaint(Sender: TObject); //行番号描画 begin PaintBox_LineNum.Canvas.CopyRect(PaintBox_LineNum.ClientRect, FbmpLineNum.Canvas, PaintBox_LineNum.ClientRect); end; procedure TApp_sPad.Memo_TextResize(Sender: TObject); //メモのリサイズ⇒行番号リサイズ begin if (Tag = 0) then begin Exit; end; FrLineNum.iLoop := gfniRoundUp(Memo_Text.ClientHeight / FrLineNum.iHeight); end; procedure TApp_sPad.Panel_LineNumResize(Sender: TObject); //行番号リサイズ begin FbmpLineNum.Width := PaintBox_LineNum.Width; FbmpLineNum.Height := PaintBox_LineNum.Height; end; procedure TApp_sPad.PaintBox_LineNumDblClick(Sender: TObject); //行選択 var lpt_Pos: TPoint; li_Caret, li_Line, li_Len: Integer; begin lpt_Pos := PaintBox_LineNum.ScreenToClient(gfnptMousePosGet); li_Line := Memo_Text.LineFromPos(Point(0, lpt_Pos.Y)); //0ベース li_Caret := Memo_Text.CaretFromLine(li_Line); li_Len := Length(Memo_Text.GetLine(li_Line)); Memo_Text.SelStart := li_Caret; Memo_Text.SelLength := li_Len; end; procedure TApp_sPad.PaintBox_LineNumMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //行移動 var li_Line, li_Caret: Integer; begin if (Button = mbLeft) then begin li_Line := Memo_Text.LineFromPos(Point(0, Y)); //0ベース li_Caret := Memo_Text.CaretFromLine(li_Line); // Memo_Text.SelLength := 0; if (Memo_Text.SelStart <> li_Caret) then begin Memo_Text.SelStart := li_Caret; FSetLineNum; end; end; end; procedure TApp_sPad.PaintBox_LineNumMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var l_Pos : TPoint; begin Memo_Text.SetFocus; Memo_TextSelectionChange(nil); if (Button = mbRight) and (GetFocus = Memo_Text.Memo.Handle) then begin l_Pos := gfnptMousePosGet; PopupMenu_Edit.Popup(l_Pos.X, l_Pos.Y); end; end; procedure TApp_sPad.FOnLoadCount(Sender: TObject; iCount: Integer; iLength: Int64); begin FiLoadCount := iCount; end; procedure TApp_sPad.Timer_LoadProgressTimer(Sender: TObject); //var // li_Progress: Integer; begin if (Label_StatusLoad.Visible <> Timer_LoadProgress.Enabled) then begin Label_StatusLoad.Visible := Timer_LoadProgress.Enabled; end; if not(Label_StatusLoad.Visible) then begin Label_StatusLoad.Caption := ''; end else if (FiLoadCount <= 0) then begin Label_StatusLoad.Caption := WideFormat('処理を開始します', [FiLoadCount]); end else begin Label_StatusLoad.Caption := WideFormat('処理中... %d行', [FiLoadCount]); end; end; //------------------------------------------------------------------------------ //設定ファイル const lcsSECT_FILE = 'File'; lcsKEY_DLGOPEN = 'Dialog_OpenFile'; lcsKEY_DLGSAVE = 'Dialog_SaveFile'; lcsKEY_DLGFILENAME = 'Dialog_FileName'; lcsKEY_DLGOPENKIND = 'Dialog_OpenKind'; lcsSECT_OPENHISTORY = 'OpenHistory'; lcsSECT_SAVEHISTORY = 'SaveHistory'; { lcsSECT_FIND = 'Find'; lcsKEY_FINDCASE = 'Case'; lcsKEY_FINDWORD = 'Word'; } lcsSECT_FINDHISTORY = 'FindHistroy'; // lcsSECT_REPLACEFROMHISTORY = 'ReplaceFromHistory'; // lcsSECT_REPLACETOHISTORY = 'ReplaceToHistory'; lcsSECT_TEXT = 'Text'; lcsKEY_TEXTWRAP = 'Wrap'; lcsKEY_TEXTAUTOINDENT = 'AutoIndent'; lcsKEY_TEXTTAB = 'Tab'; lcsKEY_TEXTFONT = 'Font'; lcsSECT_OPT = 'Option'; lcsKEY_OPTLINENUM = 'LineNumber'; lcsKEY_OPTSTATUSBAR = 'StatusBar'; //設定読み込み procedure TApp_sPad.FLoadIni; var l_IniFile : TMyIniFile; li_Index : Integer; lsl_List : TMyWStrings; begin if (gfnbKeyStateAnd([VK_SHIFT, VK_CONTROL])) then begin Action_TextAutoIndentExecute(nil); Action_TextFontExecute(nil); Action_TextWordWrapExecute(nil); Action_TextTabExecute(MenuItem_TextTab.Items[MenuItem_TextTab8.MenuIndex].Action); Action_OptLineNumExecute(nil); Action_OptStatusBarExecute(nil); Exit; end; l_IniFile := TMyIniFile.Create; try with l_IniFile do begin //[Bounds] if not(gfnbKeyState(VK_SHIFT)) then begin SetMonitorBoundsRect(Self); end; //[File] Dialog_OpenFile.InitialDir := ReadString (lcsSECT_FILE, lcsKEY_DLGOPEN, Dialog_OpenFile.InitialDir); Dialog_SaveFile.InitialDir := ReadString (lcsSECT_FILE, lcsKEY_DLGSAVE, Dialog_SaveFile.InitialDir); Dialog_FileName.InitialDir := ReadString (lcsSECT_FILE, lcsKEY_DLGFILENAME, Dialog_FileName.InitialDir); Dialog_OpenFile.FilterIndex := ReadInteger(lcsSECT_FILE, lcsKEY_DLGOPENKIND, Dialog_OpenFile.FilterIndex); lsl_List := TMyWStrings.Create; try ReadSectionText(lcsSECT_OPENHISTORY, lsl_List); if (lsl_List.Count > 0) then begin gpcListTrimBottom(lsl_List); lsl_List.Reverse; FAddHistory(PopupMenu_FileOpenHistory.Items, lsl_List); end; lsl_List.Clear; //[Find] ReadSectionText(lcsSECT_FINDHISTORY, lsl_List); if (lsl_List.Count > 0) then begin gpcListTrimBottom(lsl_List); lsl_List.Reverse; FAddHistory(PopupMenu_FindHistory.Items, lsl_List); end; finally lsl_List.Free; end; // Action_FindCase.Checked := ReadBool(lcsSECT_FIND, lcsKEY_FINDCASE, Action_FindCase.Checked); // Action_FindWord.Checked := ReadBool(lcsSECT_FIND, lcsKEY_FINDWORD, Action_FindWord.Checked); //[SEARCH] mySearch.gpcLoadIniSearch(l_IniFile); FOnSearchChange(nil); mySearch.G_SearchList.OnChange := FOnSearchChange; //[Text] Action_TextWordWrap.Checked := ReadBool(lcsSECT_TEXT, lcsKEY_TEXTWRAP, Action_TextWordWrap.Checked); Action_TextWordWrapExecute(nil); li_Index := gfniNumLimit(ReadInteger(lcsSECT_TEXT, lcsKEY_TEXTTAB, MenuItem_TextTab.MenuIndex), 0, MenuItem_TextTab8.MenuIndex); Action_TextTabExecute(MenuItem_TextTab.Items[li_Index].Action); Action_TextAutoIndent.Checked := ReadBool(lcsSECT_TEXT, lcsKEY_TEXTAUTOINDENT, Action_TextAutoIndent.Checked); Action_TextAutoIndentExecute(nil); SetFont(lcsSECT_TEXT, lcsKEY_TEXTFONT, Memo_Text.Font); FontDialog1.Font := Memo_Text.Font; Action_TextFontExecute(nil); //[Opt] Action_OptLineNum.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPTLINENUM, Action_OptLineNum.Checked); Action_OptLineNumExecute(nil); Action_OptStatusBar.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPTSTATUSBAR, Action_OptStatusBar.Checked); Action_OptStatusBarExecute(nil); //送る FSendTo.LoadIni(l_IniFile); end; finally l_IniFile.Free; end; end; //設定保存 procedure TApp_sPad.FSaveIni; var i : Integer; l_IniFile : TMyIniFile; li_Index : Integer; lsl_List : TMyWStrings; begin if (gfnbKeyStateAnd([VK_SHIFT, VK_CONTROL])) then begin Exit; end; l_IniFile := TMyIniFile.Create; try with l_IniFile do begin //[Bounds] WriteBoundsRect(Self); //[File] WriteString (lcsSECT_FILE, lcsKEY_DLGOPEN, Dialog_OpenFile.InitialDir); WriteString (lcsSECT_FILE, lcsKEY_DLGSAVE, Dialog_SaveFile.InitialDir); WriteString (lcsSECT_FILE, lcsKEY_DLGFILENAME, Dialog_FileName.InitialDir); WriteInteger(lcsSECT_FILE, lcsKEY_DLGOPENKIND, Dialog_OpenFile.FilterIndex); //履歴 if (PopupMenu_FileOpenHistory.Items.Count > 0) then begin lsl_List := TMyWStrings.Create; try for i := 0 to PopupMenu_FileOpenHistory.Items.Count-1 do begin lsl_List.Add(gfnsAnsiToWideEx(PopupMenu_FileOpenHistory.Items[i].Caption)); end; WriteSectionText(lcsSECT_OPENHISTORY, lsl_List); finally lsl_List.Free; end; end; //[Find] //検索履歴 if (PopupMenu_FindHistory.Items.Count > 0) then begin lsl_List := TMyWStrings.Create; try for i := 0 to PopupMenu_FindHistory.Items.Count -1 do begin lsl_List.Add(gfnsAnsiToWideEx(PopupMenu_FindHistory.Items[i].Caption)); end; WriteSectionText(lcsSECT_FINDHISTORY, lsl_List); finally lsl_List.Free; end; end; // WriteBool(lcsSECT_FIND, lcsKEY_FINDCASE, Action_FindCase.Checked); // WriteBool(lcsSECT_FIND, lcsKEY_FINDWORD, Action_FindWord.Checked); //[SEARCH] mySearch.gpcSaveIniSearch(l_IniFile); //[Text] WriteBool(lcsSECT_TEXT, lcsKEY_TEXTWRAP, Action_TextWordWrap.Checked); if (Action_TextTab1.Checked) then begin li_Index := MenuItem_TextTab1.MenuIndex; end else if (Action_TextTab2.Checked) then begin li_Index := MenuItem_TextTab2.MenuIndex; end else if (Action_TextTab4.Checked) then begin li_Index := MenuItem_TextTab4.MenuIndex; end else begin li_Index := MenuItem_TextTab8.MenuIndex; end; WriteBool(lcsSECT_TEXT, lcsKEY_TEXTAUTOINDENT, Action_TextAutoIndent.Checked); WriteInteger(lcsSECT_TEXT, lcsKEY_TEXTTAB, li_Index); WriteFont (lcsSECT_TEXT, lcsKEY_TEXTFONT, Memo_Text.Font); //[Opt] WriteBool(lcsSECT_OPT, lcsKEY_OPTLINENUM, Action_OptLineNum.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPTSTATUSBAR, Action_OptStatusBar.Checked); //送る FSendTo.SaveIni(l_IniFile); end; finally l_IniFile.Free; end; end; //マウスジェスチャ procedure TApp_sPad.Memo_TextMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbRight) then begin FptMouse := Point(X, Y); end; end; procedure TApp_sPad.Memo_TextMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var ls_Compas : WideString; lpt_Pos : TPoint; l_Action : TAction; begin if (Button = mbLeft) then begin Memo_TextSelectionChange(nil); end else if (Button = mbRight) and ((FptMouse.X > 0) or (FptMouse.Y > 0)) then begin //マウスジェスチャー ls_Compas := gfnsCompasGet(FptMouse, Point(X, Y)); if (ls_Compas = '') then begin //いわゆる右クリック //ポップアップメニュー lpt_Pos := gfnptMousePosGet; PopupMenu_Edit.Popup(lpt_Pos.X, lpt_Pos.Y); end else begin if (ls_Compas = '上') then begin l_Action := Action_FileFileName; end else if (ls_Compas = '下') then begin l_Action := Action_FileOpen; end else if (ls_Compas = '左') then begin l_Action := Action_EditUndo; end else if (ls_Compas = '右') then begin l_Action := Action_EditRedo; end else begin l_Action := nil; end; if (l_Action <> nil) then begin l_Action.Execute; end; end; end; FptMouse := Point(-1, -1); end; procedure TApp_sPad.Memo_TextMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); const lci_MINSIZE = 8; lci_MAXSIZE = 144; lci_SHIFTUP = 5; var li_Size : Integer; begin //範囲選択状態でスクロールさせるとCtrlキーを押していないにも関わらず押されてい //ような動作になってしまうことがある。 if not(ssCtrl in Shift) then begin Exit; end; //AIU if not(gfnbKeyState(VK_CONTROL)) then begin //Beep; Exit; end; Handled := True; li_Size := Memo_Text.Font.Size; if (WheelDelta > 0) then begin Inc(li_Size); end else begin Dec(li_Size); end; li_Size := gfniNumLimit(li_Size, lci_MINSIZE, lci_MAXSIZE); if (li_Size <> Memo_Text.Font.Size) then begin Memo_Text.Font.Size := li_Size; end; end; procedure TApp_sPad.Action_CustomSettingExecute(Sender: TObject); begin // gpcSetTabSheet('Option'); end; procedure TApp_sPad.Action_CustomMenuExecute(Sender: TObject); begin // gpcCreateMenuForm; // gpcSetTabSheet('Menu'); end; procedure TApp_sPad.Action_CustomToolBarExecute(Sender: TObject); begin // gpcCreateToolBarForm(Self); // gpcSetTabSheet('ToolBar'); end; procedure TApp_sPad.Action_CustomShortCutExecute(Sender: TObject); begin // gpcCreateShortCutForm; // gpcSetTabSheet('ShortCut'); end; procedure TApp_sPad.Action_CustomExtExecute(Sender: TObject); //拡張子カスタマイズ begin gpcCreateCustomExtForm(Self); with App_CustomExtForm do begin try AddDialog('ファイル/開くダイアログ', Dialog_OpenFile); // AddDialog('ファイル/名前をつけて保存ダイアログ', Dialog_SaveFile); // AddDialog('ファイル/ファイル名を取得ダイアログ', Dialog_FileName); LoadIni; if (ShowModal = mrOk) then begin Dialog_SaveFile.Filter := Dialog_OpenFile.Filter; Dialog_FileName.Filter := Dialog_OpenFile.Filter; SaveIni; end; finally Release; end; end; end; //コマンド procedure TApp_sPad.Action_CmdEditDelLineExecute(Sender: TObject); begin //1行削除 Memo_Text.SelStart := Memo_Text.CaretFromLine(Memo_Text.CurrentLine); Memo_Text.SelLength := Memo_Text.Memo.GetLineLength(Memo_Text.CurrentLine) +1; //改行も含めて削除 Memo_Text.ClearSelection; end; procedure TApp_sPad.Action_CmdEditDelWordHeadExecute(Sender: TObject); //単語の先頭まで削除 begin SendKey(Memo_Text.Memo.Handle, VK_BACK, False, True); end; procedure TApp_sPad.Action_CmdEditDelWordEndExecute(Sender: TObject); //単語末まで削除 begin SendKey(Memo_Text.Memo.Handle, VK_DELETE, False, True); end; procedure TApp_sPad.Action_CmdMoveWordHeadExecute(Sender: TObject); //単語の先頭まで移動 begin SendKey(Memo_Text.Memo.Handle, VK_LEFT, False, True); end; procedure TApp_sPad.Action_CmdMoveWordEndExecute(Sender: TObject); //単語末まで移動 begin SendKey(Memo_Text.Memo.Handle, VK_RIGHT, False, True); end; procedure TApp_sPad.Action_CmdMoveLineHeadExecute(Sender: TObject); //行頭へ移動 begin SendKey(Memo_Text.Memo.Handle, VK_HOME, False, False); end; procedure TApp_sPad.Action_CmdMoveLineEndExecute(Sender: TObject); //行末へ移動 begin SendKey(Memo_Text.Memo.Handle, VK_END, False, False); end; procedure TApp_sPad.Action_MoveBracketExecute(Sender: TObject); var li_Pair : Integer; ls_Src : WideString; li_Start : Integer; begin ls_Src := Memo_Text.Text; li_Start := Memo_Text.SelStart +1; li_Pair := gfniStrParenthKindGet(ls_Src, li_Start); if (li_Pair <> 0) then begin Memo_Text.SelStart := gfniStrParenthIndexGet(Memo_Text.Text, Memo_Text.SelStart); Memo_Text.SelLength := 1; end; end; procedure TApp_sPad.Action_ReplaceExecute(Sender: TObject); { var l_ReplaceForm : TApp_sPadReplaceForm; begin l_ReplaceForm := nil; try l_ReplaceForm := TApp_sPadReplaceForm.Create(Self); l_ReplaceForm.ShowModal; finally l_ReplaceForm.Release; end; end; } begin if (App_sPadReplaceForm = nil) then begin App_sPadReplaceForm := TApp_sPadReplaceForm.Create(Self); end; App_sPadReplaceForm.Show; end; end.