// これは...
これは Delphi Advent Calendar 2017 15 日目の記事です。
長くなってしまったので機能単位で分割しています。
[書式(O)]
まずは ActionList にアクションを追加しましょう。
カテゴリが [Format] になっている事に注意してください。
Action (Name) | Caption | Category | ShortCut |
---|---|---|---|
acWordwrap | 右側で折り返す(&W) | Format | |
acFont | フォント(&F)... | Format | |
すべて登録するとこうなります。 |
次に MainMenu1 のコンポーネントエディタを開き、[編集(E)] の右横を選択します。
オブジェクトインスペクタで Caption プロパティに 書式(&O) と入力します。
[書式(O)] メニューができました。
今度は MainMenu1 のコンポーネントエディタで [書式(O)] メニューの下をクリックして、Format のアクションを割り当てていきます。
こんな感じです。
以下、実装となります。
[右側で折り返す(W)]
このメニューは、
- チェックが入っていれば長い文字列をコントロール内で折り返す。
- チェックが入っていれば [編集(E) | 行へ移動(G)] を無効にする。
- チェックが入っていれば [表示(V) | ステータスバー(S)] を無効にする。
という処理を行う必要があります。最後の一つはメニューが未実装なので後回しにします。
右端で折り返すかどうかは TMemo の WordWrap プロパティで取得/指定できます。まずは取得です。以下のコードで現在の折り返しの状態をメニューアイテムのチェックに反映させます。
// リスト更新
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
(中略)
// [右側で折り返す(W)] のチェック状態
acWordwrap.Checked := Memo1.WordWrap;
end;
今度は フォームエディタにして acWordWrap アクションのイベントハンドラを作ります。
acWordWrapExecute イベントハンドラの実装は以下のようになります。Memo1.WordWrap の状態をトグルさせます。
ScrollBars プロパティが ssBoth になっていて水平スクロールバーが表示されていると折り返しができないので、右側で折り返す設定の時は垂直スクロールバーのみにします。
procedure TForm1.acWordwrapExecute(Sender: TObject);
// Action: [右側で折り返す(W)]
const
SB: array [Boolean] of TScrollStyle = (ssBoth, ssVertical);
begin
Memo1.WordWrap := not Memo1.WordWrap;
Memo1.ScrollBars := SB[Memo1.WordWrap];
end;
[編集(E) | 行へ移動(G)] の有効無効を [右側で折り返す(W)] のチェック状態に合わせるには以下のようなコードを記述します。
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
(中略)
// [右側で折り返す(W)] のチェック状態
acWordwrap.Checked := Memo1.WordWrap;
// [行へ移動(&G)] の有効/無効
acGoTo.Enabled := not Memo1.WordWrap;
end;
この部分は以下のようにしてもいいのですが、記述する順序に依存してしまいます。
// [右側で折り返す(W)] のチェック状態
acWordwrap.Checked := Memo1.WordWrap;
// [行へ移動(&G)] の有効/無効
acGoTo.Enabled := not acWordwrap.Checked;
〔Alt〕,〔O〕,〔W〕で [右側で折り返す(W)] が実行される事を確認してください。
[フォント(F)...]
このメニューは、
- フォントを変更するダイアログを出す。
- [OK] が押されたら指定されたフォントを Memo1 に適用する。
という処理を行う必要があります。
フォントを選択するダイアログはツールパレットの [Dialogs] にありますので、これをフォームに貼り付けておきます。
acFont アクションのイベントハンドラを作ります。
acWordWrapExecute イベントハンドラの実装は以下のようになります。
procedure TForm1.acFontExecute(Sender: TObject);
// Action: [フォント(F)...]
begin
FontDialog1.Font := Memo1.Font; // Memo1 のフォントをコピー
if FontDialog1.Execute then
Memo1.Font := FontDialog1.Font; // FontDialog1 のフォントをコピー
end;
〔Alt〕,〔O〕,〔F〕で [フォント(F)...] が実行される事を確認してください。
Memo1 のプロパティ
ここで Memo1 のプロパティをいくつか変更しておきます。
プロパティ | 値 | 説明 |
---|---|---|
Font.Name | MS ゴシック | オリジナルのメモ帳のデフォルトのフォント名です。 |
Font.Size | 12 | オリジナルのメモ帳のデフォルトのフォントサイズです。 |
WantTabs | True | タブ文字を入力できるようにします。 |
WordWrap | False | オリジナルのメモ帳はデフォルトで折り返していないようです。 |
今更ですが、TFont のプロパティはプロパティエディタを持っているので、オブジェクトインスペクタで値部分をダブルクリックするか […] ボタンを押すと、フォント選択ダイアログでフォントを選択できます。
// 戻る
今回はここまでです。ここまでの全ソースを掲載しておきます。
[メインフォーム]
unit frmuMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Actions,
Vcl.ActnList, Vcl.Menus, Vcl.ExtDlgs, System.IOUtils, Vcl.Clipbrd,
System.RegularExpressions, System.UITypes;
type
TForm1 = class(TForm)
Memo1: TMemo;
MainMenu1: TMainMenu;
ActionList1: TActionList;
acNew: TAction;
acOpen: TAction;
acSave: TAction;
acSaveAs: TAction;
acPageSetup: TAction;
acPrint: TAction;
acExit: TAction;
F1: TMenuItem;
N1: TMenuItem;
O1: TMenuItem;
S1: TMenuItem;
A1: TMenuItem;
U1: TMenuItem;
P1: TMenuItem;
X1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
OpenTextFileDialog1: TOpenTextFileDialog;
SaveTextFileDialog1: TSaveTextFileDialog;
acUndo: TAction;
acCut: TAction;
acCopy: TAction;
acPaste: TAction;
acDelete: TAction;
acFind: TAction;
acFindNext: TAction;
acReplace: TAction;
acGoTo: TAction;
acSelectAll: TAction;
acTimeDate: TAction;
E1: TMenuItem;
U2: TMenuItem;
N4: TMenuItem;
C1: TMenuItem;
T1: TMenuItem;
P2: TMenuItem;
L1: TMenuItem;
N5: TMenuItem;
F2: TMenuItem;
N6: TMenuItem;
R1: TMenuItem;
G1: TMenuItem;
N7: TMenuItem;
A2: TMenuItem;
D1: TMenuItem;
FindDialog1: TFindDialog;
ReplaceDialog1: TReplaceDialog;
acWordwrap: TAction;
acFont: TAction;
O2: TMenuItem;
W1: TMenuItem;
F3: TMenuItem;
FontDialog1: TFontDialog;
procedure FormCreate(Sender: TObject);
procedure acExitExecute(Sender: TObject);
procedure acOpenExecute(Sender: TObject);
procedure acSaveExecute(Sender: TObject);
procedure acSaveAsExecute(Sender: TObject);
procedure acNewExecute(Sender: TObject);
procedure acUndoExecute(Sender: TObject);
procedure ActionList1Update(Action: TBasicAction; var Handled: Boolean);
procedure acCutExecute(Sender: TObject);
procedure acCopyExecute(Sender: TObject);
procedure acPasteExecute(Sender: TObject);
procedure E1Click(Sender: TObject);
procedure acFindExecute(Sender: TObject);
procedure Dialog_Find(Sender: TObject);
procedure acFindNextExecute(Sender: TObject);
procedure acDeleteExecute(Sender: TObject);
procedure acReplaceExecute(Sender: TObject);
procedure ReplaceDialog1Replace(Sender: TObject);
procedure acGoToExecute(Sender: TObject);
procedure acSelectAllExecute(Sender: TObject);
procedure acTimeDateExecute(Sender: TObject);
procedure acWordwrapExecute(Sender: TObject);
procedure acFontExecute(Sender: TObject);
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
procedure Init;
procedure SsaveFile;
procedure UpdateCaption;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
frmuGotoLine;
procedure TForm1.FormCreate(Sender: TObject);
// フォーム作成時
begin
Init;
end;
// [FILE] Actions
procedure TForm1.acNewExecute(Sender: TObject);
// Action: 新規(N)
begin
Init;
end;
procedure TForm1.acOpenExecute(Sender: TObject);
// Action: 開く(O)...
var
Enc: TEncoding;
begin
if OpenTextFileDialog1.Execute then
begin
// 値を保存
FFileName := OpenTextFileDialog1.FileName;
FEncodingIndex := OpenTextFileDialog1.EncodingIndex;
// キャプションを変更
UpdateCaption;
// EncodingIndex によりエンコーディングを指定
case FEncodingIndex of
1: Enc := TEncoding.Unicode;
2: Enc := TEncoding.BigEndianUnicode;
3: Enc := TEncoding.UTF8;
else
Enc := TEncoding.Default;
end;
// エンコーディングを指定して読み込み
Memo1.Lines.LoadFromFile(FFileName, Enc);
end;
end;
procedure TForm1.acSaveExecute(Sender: TObject);
// Action: 上書き保存(S)
begin
if (FFileName = '') then
begin
// 名前を付けて保存
acSaveAs.Execute;
end
else
begin
// 上書き保存
SsaveFile;
end;
end;
procedure TForm1.acSaveAsExecute(Sender: TObject);
// Action: 名前を付けて保存(A)...
begin
if SaveTextFileDialog1.Execute then
begin
// 値を保存
FFileName := SaveTextFileDialog1.FileName;
FEncodingIndex := SaveTextFileDialog1.EncodingIndex;
// キャプションを変更
UpdateCaption;
// ファイルへ保存
SsaveFile;
end;
end;
procedure TForm1.acExitExecute(Sender: TObject);
// Action: メモ帳の終了(X)
begin
Self.Close;
end;
// [EDIT] Actions
procedure TForm1.E1Click(Sender: TObject);
begin
acDelete.ShortCut := TextToShortCut('Del');
end;
procedure TForm1.acUndoExecute(Sender: TObject);
// Action: 元に戻す(U)
begin
Memo1.Undo;
end;
procedure TForm1.acCutExecute(Sender: TObject);
// Action: 切り取り(T)
begin
Memo1.CutToClipboard;
end;
procedure TForm1.acCopyExecute(Sender: TObject);
// Action: コピー(C)
begin
Memo1.CopyToClipboard;
end;
procedure TForm1.acPasteExecute(Sender: TObject);
// Action: 貼り付け(P)
begin
Memo1.PasteFromClipboard;
end;
procedure TForm1.acDeleteExecute(Sender: TObject);
// Action: 削除(L)
begin
Memo1.ClearSelection;
end;
procedure TForm1.acFindExecute(Sender: TObject);
// Action: 検索(F)
begin
// 検索ダイアログを開く
FindDialog1.Execute;
end;
procedure TForm1.acFindNextExecute(Sender: TObject);
// Action: 次を検索(N)
begin
if FindDialog1.FindText = '' then
acFind.Execute
else
Dialog_Find(FindDialog1);
end;
procedure TForm1.acReplaceExecute(Sender: TObject);
// Action: 置換(H)
begin
// 置換ダイアログを開く
ReplaceDialog1.Execute;
end;
procedure TForm1.Dialog_Find(Sender: TObject);
// 検索イベントハンドラ
var
RegEx: TRegEx;
Exp, Msg: String;
Options: TRegExOptions;
Match, dMatch: TMatch;
StartPos, EndPos: Integer;
begin
// 検索文字列を正規表現文字列へエスケープ
Exp := TRegEx.Escape(FindDialog1.FindText);
// "大文字と小文字を区別する" にチェックが入っていなければ
// オプションに roIgnoreCase (大文字小文字を区別しない) を追加
if not (frMatchCase in FindDialog1.Options) then
Include(Options, roIgnoreCase);
// 正規表現オブジェクトの生成
RegEx := TRegEx.Create(Exp, Options);
if (frDown in FindDialog1.Options) then
begin
// 順方向検索 (下へ)
StartPos := Memo1.SelStart + Memo1.SelLength + 1;
Match := RegEx.Match(Memo1.Lines.Text, StartPos);
end
else
begin
// 逆方向検索 (上へ)
StartPos := 0;
EndPos := Memo1.SelStart + 1;
Match := RegEx.Match(Memo1.Lines.Text, StartPos, EndPos);
while Match.Success do
begin
// 最後にマッチした箇所を探す
dMatch := Match.NextMatch;
if dMatch.Success then
Match := dMatch
else
break;
end;
end;
// 検索文字列を共有
FindDialog1.FindText := (Sender as TFindDialog).FindText;
ReplaceDialog1.FindText := (Sender as TFindDialog).FindText;
// 検索文字列を正規表現文字列へエスケープ
Exp := TRegEx.Escape((Sender as TFindDialog).FindText);
// "大文字と小文字を区別する" にチェックが入っていなければ
// オプションに roIgnoreCase (大文字小文字を区別しない) を追加
if not (frMatchCase in (Sender as TFindDialog).Options) then
Include(Options, roIgnoreCase);
// 正規表現オブジェクトの生成
RegEx := TRegEx.Create(Exp, Options);
if (frDown in (Sender as TFindDialog).Options) then
begin
// 順方向検索 (下へ)
StartPos := Memo1.SelStart + Memo1.SelLength + 1;
Match := RegEx.Match(Memo1.Lines.Text, StartPos);
end
else
begin
// 逆方向検索 (上へ)
StartPos := 0;
EndPos := Memo1.SelStart + 1;
Match := RegEx.Match(Memo1.Lines.Text, StartPos, EndPos);
while Match.Success do
begin
// 最後にマッチした箇所を探す
dMatch := Match.NextMatch;
if dMatch.Success then
Match := dMatch
else
break;
end;
end;
if Match.Success then
begin
// 一致する文字列があった
SetFocus;
Memo1.SelStart := Match.Index - 1;
Memo1.SelLength := Match.Length;
end
else
begin
// 一致する文字列がなかった
Msg := Format('"%s" が見つかりません。', [(Sender as TFindDialog).FindText]);
MessageDlg(Msg, TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], -1);
end;
end;
procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
// 置換イベントハンドラ
var
srFlgs: TReplaceFlags;
FindText: string;
SelectFlg: Boolean;
begin
// 検索文字列を共有
FindDialog1.FindText := (Sender as TFindDialog).FindText;
ReplaceDialog1.FindText := (Sender as TFindDialog).FindText;
// フラグ
if (frReplaceAll in ReplaceDialog1.Options) then
begin
// [すべて置換]
srFlgs := [rfReplaceAll]; // すべて置換
if not (frMatchCase in ReplaceDialog1.Options) then
Include(srFlgs, rfIgnoreCase);
Memo1.Lines.Text := StringReplace(Memo1.Lines.Text, ReplaceDialog1.FindText, ReplaceDialog1.ReplaceText, srFlgs);
end
else
begin
// [置換して次へ]
srFlgs := []; // 最初の一回だけ置換
if not (frMatchCase in ReplaceDialog1.Options) then
Include(srFlgs, rfIgnoreCase);
// 検索済みかどうかの判定
FindText := (Sender as TFindDialog).FindText;
if (frMatchCase in ReplaceDialog1.Options) then
SelectFlg := SameStr(Memo1.SelText, FindText) // 大文字小文字を区別する
else
SelectFlg := SameText(Memo1.SelText, FindText); // 大文字小文字を区別しない
// 検索済みか?
if SelectFlg then
Memo1.SelText := ReplaceDialog1.ReplaceText;
// 検索
Dialog_Find(ReplaceDialog1);
end;
end;
procedure TForm1.acGoToExecute(Sender: TObject);
// Action: 行へ移動(G)
begin
Form2 := TForm2.Create(Self);
try
// 現在行と最大行を Form2 に渡す
Form2.GotoLine := Memo1.Perform(EM_LINEFROMCHAR, WPARAM(-1), 0) + 1; // 0 オリジンなので + 1 する
Form2.LineCount := Memo1.Perform(EM_GETLINECOUNT, 0, 0);
// Form2 をモーダルで表示
if Form2.ShowModal = mrOK then
begin
// [OK] ボタンが押されたら
Memo1.SelLength := 0;
Memo1.SelStart := Memo1.Perform(EM_LINEINDEX, Form2.GotoLine - 1, 0);
Memo1.Perform(EM_SCROLLCARET,0 , 0);
end;
finally
Form2.Free;
end;
end;
procedure TForm1.acSelectAllExecute(Sender: TObject);
// Action: すべて選択(A)
begin
Memo1.SelectAll;
end;
procedure TForm1.acTimeDateExecute(Sender: TObject);
// Action: 日付と時刻(D)
begin
Memo1.SelText := FormatDateTime('hh:nn yyyy/mm/dd', Now);
end;
procedure TForm1.acWordwrapExecute(Sender: TObject);
// Action: [右側で折り返す(W)]
const
SB: array [Boolean] of TScrollStyle = (ssBoth, ssVertical);
begin
Memo1.WordWrap := not Memo1.WordWrap;
Memo1.ScrollBars := SB[Memo1.WordWrap];
end;
procedure TForm1.acFontExecute(Sender: TObject);
// Action: [フォント(F)...]
begin
FontDialog1.Font := Memo1.Font; // Memo1 のフォントをコピー
if FontDialog1.Execute then
Memo1.Font := FontDialog1.Font; // FontDialog1 のフォントをコピー
end;
// リスト更新
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
// [元に戻す(U)] の有効/無効
acUndo.Enabled := Memo1.CanUndo;
// [切り取り(T)] の有効/無効
acCut.Enabled := Memo1.SelLength <> 0;
// [コピー(C)] の有効/無効
acCopy.Enabled := Memo1.SelLength <> 0;
// [貼り付け(P)] の有効/無効
acPaste.Enabled := ClipBoard.HasFormat(CF_TEXT);
// [削除(L)] の有効/無効
acDelete.Enabled := Memo1.SelLength <> 0;
acDelete.ShortCut := 0;
// [検索(F)] の有効/無効
acFind.Enabled := Memo1.Lines.Text.Length > 0;
// [次を検索(N)] の有効/無効
acFindNext.Enabled := Memo1.Lines.Text.Length > 0;
// [右側で折り返す(W)] のチェック状態
acWordwrap.Checked := Memo1.WordWrap;
// [行へ移動(&G)] の有効/無効
acGoTo.Enabled := not Memo1.WordWrap;
end;
// メソッド
procedure TForm1.Init;
// エディタの初期化
begin
// 値を初期化
FFileName := '';
FEncodingIndex := 0;
Memo1.Lines.Clear; // Memo1 の中身を消去する。
// キャプションを変更
UpdateCaption;
end;
procedure TForm1.SsaveFile;
var
Enc: TEncoding;
begin
// EncodingIndex によりエンコーディングを指定
case FEncodingIndex of
1: Enc := TEncoding.Unicode;
2: Enc := TEncoding.BigEndianUnicode;
3: Enc := TEncoding.UTF8;
else
Enc := TEncoding.Default;
end;
// エンコーディングを指定して保存
Memo1.Lines.SaveToFile(FFileName, Enc);
end;
procedure TForm1.UpdateCaption;
// キャプション (ファイル名) の更新
var
Dmy: String;
begin
if FFileName = '' then
Dmy := '無題'
else
Dmy := TPath.GetFileName(FFileName);
Self.Caption := Dmy + ' - メモ帳クローン';
end;
end.
[行へ移動] ダイアログ
(変更ありません)