// これは...
これは Delphi Advent Calendar 2017 15 日目の記事です。
長くなってしまったので機能単位で分割しています。
[編集(E)]
まずは ActionList にアクションを追加しましょう。
カテゴリが [Edit] になっている事に注意してください。
| Action (Name) | Caption | Category | ShortCut |
|---|---|---|---|
| acUndo | 元に戻す(&U) | Edit | Ctrl+Z |
| acCut | 切り取り(&T) | Edit | Ctrl+X |
| acCopy | コピー(&C) | Edit | Ctrl+C |
| acPaste | 貼り付け(&P) | Edit | Ctrl+V |
| acDelete | 削除(&L) | Edit | Del |
| acFind | 検索(&F)... | Edit | Ctrl+F |
| acFindNext | 次を検索(&N) | Edit | F3 |
| acReplace | 置換(&R)... | Edit | Ctrl+H |
| acGoTo | 行へ移動(&G)... | Edit | Ctrl+G |
| acSelectAll | すべて選択(&A) | Edit | Ctrl+A |
| acTimeDate | 日付と時刻(&D) | Edit | F5 |
すべて登録するとこうなります。
次に MainMenu1 のコンポーネントエディタを開き、[ファイル(F)] の右横を選択します。
オブジェクトインスペクタで Caption プロパティに 編集(&E) と入力します。
[編集(E)] メニューができました。
今度は MainMenu1 のコンポーネントエディタで [編集(E)] メニューの下をクリックして、Edit のアクションを割り当てていきます。
セパレーターも入れておきましょう。
以下、実装となります。
[元に戻す(U)]
いわゆるアンドゥです。以前の操作を取り消します。
この機能は TMemo に最初から備わっており、例えば acUndo の ShortCut プロパティが空だったとしても、AAA と入力した後に〔Ctrl〕+〔Z〕を押すと入力が取り消されます。逆に ShortCut プロパティに Ctrl+Z が割り当てられていると、コードを記述しなくてはなりません。
procedure TForm1.acUndoExecute(Sender: TObject);
// Action: 元に戻す(U)
begin
Memo1.Undo;
end;
TMemo が持ってる機能なので簡単ですね。これでアンドゥの実装が終わりかと思ったらそうではありません。この [元に戻す(U)] メニューはアンドゥができない状態の時はグレーアウトするのです。例えばメモ帳を起動した直後に [編集(E)] メニューをドロップダウンしてみてください。
これを実現するにはいくつか方法の方法がありますが、今回は ActionList の OnUpdate イベントを使ってみましょう。このイベントの説明にはこうあります。
アプリケーションがアイドル状態に発生し、
アクション リストが、リスト内の特定のアクションを更新できるようにします。
つまりは
- アプリケーションが暇なときに発生する。
- ここでアクションの状態を変更しましょう。
という事です。
オブジェクトインスペクタで ActionList1 の OnUpdate イベントの値の部分をダブルクリックし、ActionList1Update() イベントハンドラを作ります。
acUndo の有効/無効は Enabled プロパティで切り替えられます。アクションがメニューアイテムに割り当てられている時、Enabled プロパティが False の場合にはメニューアイテムはグレーアウトします。
そして、TMemo がアンドゥ可能かどうかは CanUndo プロパティで調べられます。つまり、このようなコードになります。
// リスト更新
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
// [元に戻す(U)] の有効/無効
acUndo.Enabled := Memo1.CanUndo;
end;
〔Alt〕,〔E〕,〔U〕や〔Ctrl〕+〔Z〕で [元に戻す(U)] が実行される事を確認してください。
[切り取り(T)]
このメニューは、
- 選択した文字を切り取ってクリップボードにコピー
- 文字が選択されていなければグレーアウト
という処理を行う必要があります。
前者は TMemo の CutToClipboard メソッドを使います。
procedure TForm1.acCutExecute(Sender: TObject);
// Action: 切り取り(T)
begin
Memo1.CutToClipboard;
end;
後者は ActionList1Update() に追記すればいいです。TMemo には選択された文字数を返すメソッド SelLength() を使い、文字数が 0 かどうかで有効無効を切り替えればいいでしょう。
// リスト更新
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
(中略)
// [切り取り(T)] の有効/無効
acCut.Enabled := Memo1.SelLength <> 0;
end;
〔Alt〕,〔E〕,〔T〕や〔Ctrl〕+〔X〕で [切り取り(T)] が実行される事を確認してください。
[コピー(C)]
このメニューは、
- 選択した文字をコピークリップボードにコピー
- 文字が選択されていなければグレーアウト
という処理を行う必要があります。
前者は TMemo の CopyToClipboardメソッドを使います。
procedure TForm1.acCopyExecute(Sender: TObject);
// Action: コピー(C)
begin
Memo1.CopyToClipboard;
end;
後者は [切り取り(T)] と同様、SelLength() を使ったロジックとなります。
// リスト更新
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
(中略)
// [コピー(C)] の有効/無効
acCopy.Enabled := Memo1.SelLength <> 0;
end;
〔Alt〕,〔E〕,〔C〕や〔Ctrl〕+〔C〕で [コピー(C)] が実行される事を確認してください。
[貼り付け(P)]
このメニューは、
- クリップボードからテキストを貼り付け
- クリップボードにテキスト形式で格納されていなければグレーアウト
という処理を行う必要があります。
前者は TMemo の PasteFromClipboardメソッドを使います。
procedure TForm1.acPasteExecute(Sender: TObject);
// Action: 貼り付け(P)
begin
Memo1.PasteFromClipboard;
end;
後者は...ちょっと難しいですよ。クリップボードが特定の形式...今回ですとテキスト形式を格納しているかどうかを調べるには、まず uses 句に Vcl.Clipbrd を追加します。
unit frmuMain;
interface
uses
..., Vcl.Clipbrd;
...
このユニットを使うと、TClipboard のインスタンスを返す Clipboard() 関数が使えます。TClipboard にはクリップボードに特定のフォーマットのデータが含まれるかを調べる HasFormat() メソッドがありますので、このメソッドでテキスト形式 (CF_TEXT) が格納されているかどうかを調べればよさそうです。
// リスト更新
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
(中略)
// [貼り付け(P)] の有効/無効
acPaste.Enabled := ClipBoard.HasFormat(CF_TEXT);
end;
〔Alt〕,〔E〕,〔P〕や〔Ctrl〕+〔V〕で [貼り付け(P)] が実行される事を確認してください。
[削除(L)]
このメニューは、
- 選択文字を削除。
- 文字が選択されていなければグレーアウト
という処理を行う必要があります。
前者は TMemo の ClearSelectionメソッドを使います。
procedure TForm1.acDeleteExecute(Sender: TObject);
// Action: 削除(L)
begin
Memo1.ClearSelection;
end;
後者は [切り取り(T)] や [コピー(C)] と同様、SelLength() を使ったロジックとなります。
// リスト更新
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
(中略)
// [削除(L)] の有効/無効
acDelete.Enabled := Memo1.SelLength <> 0;
end;
あれ？選択された文字は消せますが、選択されていない文字を〔Del〕キーで消せませんね。これは acDelete のショートカットに Del が指定されているからです。ちょっと姑息な方法でこれを回避しましょう。
- 見えてない時は acDelete のショートカットを空にする。
- メニューが見えてる時はショートカットとして〔Del〕キーを割り当てる。
この [編集(E)] を選択し、
オブジェクトインスペクタで確認します。このメニューアイテム名は E1 のようですね。これの OnClick イベントをダブルクリックしてイベントハンドラを生成します。
[編集(E)] がクリックされた時の処理ですね。acDelete の ShortCut プロパティに〔Del〕キーを割り当てます。
procedure TForm1.E1Click(Sender: TObject);
begin
acDelete.ShortCut := TextToShortCut('Del');
end;
そして、暇なときには ShortCut プロパティを空にします。
// リスト更新
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
(中略)
// [削除(L)] の有効/無効
acDelete.Enabled := Memo1.SelLength <> 0;
acDelete.ShortCut := 0; // <----- 追加
end;
〔Alt〕,〔E〕,〔L〕や〔Del〕で [削除(L)] が実行される事を確認してください。
[検索(F)]
このメニューは、
- 検索ダイアログを出す。
- [次を検索(F)] ボタンが押されたら、検索条件を基に検索。
- 検索条件に一致しなかったら 「"検索文字列" が見つかりません。」というメッセージを出す。
- 一致したら文字列を選択状態にする。
- メモに何も入力されていなかったら [検索(F)] メニューをグレーアウト
という処理を行う必要があります。
検索ダイアログは TFindDialog がツールパレットの [Dialogs] にありますので、これを追加しておきます (FindDialog1)。
プレビューしてみると 単語単位で探す(W) がありますが、これは利用しないので、Options プロパティの frHideWholeWord フラグを True にします。プロパティとフラグの関係はこのようになっています。
これを踏まえて acFind アクションのイベントハンドラのコードを書くとこうなります。
procedure TForm1.acFindExecute(Sender: TObject);
// Action: 検索(F)
begin
FindDialog1.Execute;
end;
もちろんこれだけでは検索されません。検索の処理は TFindDialog の onFind イベントのイベントハンドラも記述する必要があります。検索処理を文字列処理だけで記述すると割と大変なので、正規表現ライブラリを使います。
unit frmuMain;
interface
uses
..., System.RegularExpressions, System.UITypes; // <- 追加
uses に System.RegularExpressions を追加すると正規表現ライブラリが使えるようになります。メッセージダイアログも使うので、System.UITypes もついでに追加しておきます。
次に、イベントハンドラ FindDialog1Find() を記述します。オブジェクトインスペクタで OnFind イベントの値部分をダブルクリックして FindDialog1Find() イベントハンドラを生成します。
ロジックは以下のようになります。
procedure TForm1.FindDialog1Find(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;
if Match.Success then
begin
// 一致する文字列があった
SetFocus;
Memo1.SelStart := Match.Index - 1;
Memo1.SelLength := Match.Length;
end
else
begin
// 一致する文字列がなかった
Msg := Format('"%s" が見つかりません。', [FindDialog1.FindText]);
MessageDlg(Msg, TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], -1);
end;
end;
TRegEx が正規表現用のレコードです。つまり、正規表現を平文検索に使っています。TRegEx.Escape() を使うのがミソです。
なぜ正規表現ライブラリを使うのかというと、以下のような利点があるからです。
- "単語単位で探す(W)" のような機能拡張が簡単
- バグがない
- 高速に動作する
Pos() や PosEx() を使えば単純な検索ロジックを構築するのは難しくはないのですが、”単語単位で検索” のような事をやろうとすると途端に難易度が上がります。そうして苦労して作ったロジックよりも正規表現ライブラリを使った方が高速に動作する、なんて事はよくある話です。
ロジックのすべてを説明すると長くなるので、各オブジェクトの説明へのリンクを張っておきます。
- Vcl.StdCtrls.TMemo
- System.RegularExpressions.TRegEx
- System.RegularExpressions.TMatch
- System.SysUtils.Format
- Vcl.Dialogs.MessageDlg
- 正規表現の活用 (主に Delphi 2009 以降) (VCL によるテクニック＆アルゴリズム)
おっと、グレーアウトの処理も追加しなくてはなりませんね。メモに文字が何も入力されていない (中身が空) とグレーアウトするようです。
// リスト更新
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
(中略)
// [検索(F)] の有効/無効
acFind.Enabled := Memo1.Lines.Text.Length > 0;
end;
〔Alt〕,〔E〕,〔F〕や〔Ctrl〕+〔F〕で [検索(F)] が実行される事を確認してください。
[次を検索(N)]
このメニューは、
- 一度も検索されていなければ検索ダイアログを出す。
- 検索ダイアログの [次を検索(F)] と同じ挙動。
- メモに何も入力されていなかったら[次を検索(N)] メニューをグレーアウト
という処理を行う必要があります。
acFindNext アクションのイベントハンドラのコードはこうなります。
procedure TForm1.acFindNextExecute(Sender: TObject);
// Action: 次を検索(N)
begin
if FindDialog1.FindText = '' then
acFind.Execute
else
FindDialog1Find(nil);
end;
FindDialog1 の検索文字列が空だったら acFind (検索) のイベントを実行し、そうでなかったら FindDialog1Find() イベントハンドラを直接呼びます。イベントハンドラもメソッドですから、引数さえ合えば呼び出す事ができます。OnFind イベントのイベントハンドラは引数に TObject 型の変数を渡す事になっていますが、イベントハンドラ内で Sender は使われていないので nill を渡します。
イベントハンドラを直接呼ぶのは行儀がいいとは言えません。本来ならイベントハンドラ内のロジックをメソッドとしておき、そのメソッドを FindDialog1Find() と acFindNextExecute() から呼び出すようにすべきです。
グレーアウトの処理は [検索(F)] と同じでいいようです。
// リスト更新
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
(中略)
// [次を検索(N)] の有効/無効
acFindNext.Enabled := Memo1.Lines.Text.Length > 0;
end;
〔Alt〕,〔E〕,〔N〕や〔F3〕で [次を検索(N)] が実行される事を確認してください。
[置換(R)]
このメニューは、
- 検索ダイアログを出す。
- [次を検索(F)] ボタンが押されたら、検索条件を基に検索。
- 検索条件に一致しなかったら 「"検索文字列" が見つかりません。」というメッセージを出す。
- 一致したら文字列を選択状態にする。
- [置換して次に(R)] ボタンが押されたら、検索文字列に一致した文字列を置換後の文字列で置換
- [すべて置換(A)] ボタンが押されたら、検索文字列に一致した文字列を置換後の文字列で一括置換
という処理を行う必要があります...かなり面倒ですね。
置換ダイアログは TReplaceDialog がツールパレットの [Dialogs] にありますので、これを追加しておきます (ReplaceDialog1)。
プレビューしてみると 単語単位で探す(W) がありますが、これは利用しないので、Options プロパティの frHideWholeWord フラグを True にします。プロパティとフラグの関係はこのようになっています。
[次を検索(F)] ボタンが押されたら OnFind イベントが発生し、[置換して次に(R)] または [すべて置換(A)] が押されたら OnReplace イベントが発生します。
...という事は、うまくいけば検索と置換で検索部分は共通化できそうです。
オブジェクトインスペクタで ReplaceDialog1 の [イベント] タブを開き、OnFind イベントをドロップダウンして、FindDialog1Find() イベントハンドラを割り当てます。
TFindDialog と TReplaceDialog の OnFind イベントのは同じ TNotifyEvent 型なので、イベントハンドラを共有する事ができます。
しかしながら、FindDialog1Find() という名前は紛らわしいので、ドロップダウンリストでイベントハンドラを選択した後に、名前を Dialog_Find に変更します。
コードエディタで確認すると、こちらでも名前が変わっていますね。
acFindNextExecute() の中は流石に自動で変わらないので、手動で変更します。
procedure TForm1.acFindNextExecute(Sender: TObject);
// Action: 次を検索(N)
begin
if FindDialog1.FindText = '' then
acFind.Execute
else
Dialog_Find(nil); // <--- 変更
end;
さて、このままですと共有した事にはなりません。FindDialog1 オブジェクトを直接参照している箇所があります。
このイベントハンドラは誰が処理しているのか判断する方法があります。それがイベントハンドラの Sender です。Sender でこのイベントを発生させたオブジェクトを知ることができます。
procedure TForm1.Dialog_Find(Sender: TObject);
...
begin
if (Sender is TReplaceDialog) then
begin
// イベントを発生させたのは TReplaceDialog 型の誰か
end
else
begin
// イベントを発生させたのは TFindDialog 型の誰か
end;
...
または
procedure TForm1.Dialog_Find(Sender: TObject);
...
begin
if (Sender = ReplaceDialog1) then
begin
// イベントを発生させたのは ReplaceDialog1
end
else
begin
// イベントを発生させたのは ReplaceDialog1 以外
end;
...
前者の方法だと、オブジェクトを直接指定していないので、ロジックが汎用的になりますが、
procedure TForm1.Dialog_Find(Sender: TObject);
...
begin
if (Sender is TFindDialog) then
begin
// イベントを発生させたのは TFindDialog (型の誰か)
end
else
begin
// イベントを発生させたのは TReplaceDialog (型の誰か)
end;
...
この判定ではダメです。何故なら TReplaceDialog クラスは TFindDialog から派生しているため、「あなたは TFindDialog なの？」と尋ねてもどちらも「はい」と答えるからです。
共通項の部分では TReplaceDialog は TFindDialog として振舞うことができます。この検索ロジックでは共通項の部分しか使わないので、以下のようなコードにする事ができます。
procedure TForm1.Dialog_Find(Sender: TObject);
// 検索イベントハンドラ
var
RegEx: TRegEx;
Exp, Msg: String;
Options: TRegExOptions;
Match, dMatch: TMatch;
StartPos, EndPos: Integer;
begin
// 検索文字列を共有
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;
FindDialog1 とオブジェクトを直接指定していた箇所を (Sender as TFindDialog) で置き換えてあります。ん？Sender を利用した...という事は？
procedure TForm1.acFindNextExecute(Sender: TObject);
// Action: 次を検索(N)
begin
if FindDialog1.FindText = '' then
acFind.Execute
else
Dialog_Find(FindDialog1); // <-- FindDialog1 を渡す
end;
こうしないと [次を検索(N)] で nil が渡ってきてしまいますね。後は acReplace アクションのイベントハンドラを書けば検索部分は OK です。
procedure TForm1.acReplaceExecute(Sender: TObject);
// Action: 置換(H)
begin
// 置換ダイアログを開く
ReplaceDialog1.Execute;
end;
とりあえずこの時点で〔F9〕を押して実行し、検索 / 次を検索 / 置換 (の検索) を試してみましょう。あー、オリジナルのメモ帳では検索と置換の検索文字列は共有しているのですね。では、こうなりますね。
procedure TForm1.Dialog_Find(Sender: TObject);
var
Exp, Msg: String;
Options: TRegExOptions;
dMatch: TMatch;
StartPos, EndPos: Integer;
begin
// 検索文字列を共有
FindDialog1.FindText := (Sender as TFindDialog).FindText; // <--- 追加
ReplaceDialog1.FindText := (Sender as TFindDialog).FindText; // <--- 追加
...
さて次は置換ロジックです。オブジェクトインスペクタで ReplaceDialog1 の OnReplace
イベントの値部分をダブルクリックして ReplaceDialog1Replace() イベントハンドラを生成します。
[置換して次へ] と [すべて置換] を分けるロジックはこのようになると思います。
procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
// 置換イベントハンドラ
begin
if (frReplaceAll in ReplaceDialog1.Options) then
begin
// [すべて置換]
// (処理)
end
else
begin
// [置換して次へ]
// (処理)
end;
end;
文字列の一括置換には StringReplace() 関数を使うのが簡単です。
procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
// 置換イベントハンドラ
var
srFlgs: TReplaceFlags;
begin
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
// [置換して次へ]
// (処理)
end;
end;
簡単でしたね。
なお、TReplaceFlags は集合でフラグビットの集まりです。集合にフラグビットを設定するにはこのようにします。
集合型 := [フラグ, フラグ...];
集合型にフラグを追加したい場合には、いずれかの方法でできます。
集合型 := 集合型 + [フラグ, フラグ...];
Include(集合型, フラグ);
集合型からフラグを削除したい場合には、いずれかの方法でできます。
集合型 := 集合型 - [フラグ, フラグ...];
Exclude(集合型, フラグ);
ちなみに、こういった置換関数は出来合いのものがあればそれを使うのがベストです。検索に一致した文字列を置換して検索位置を保存して...とやってると、バグを生むことがあるからです。
例えば A を BAKA に置換する場合、置換文字列に検索文字列が含まれるため、無限に置換するバグを生みます。また、検索文字列が長くて置換文字列が短い場合、置換されない文字列が出てくるバグを生みます。いずれも文字列を処理した位置を適切に管理しないと発生するバグです。
[置換して次へ] の処理ですが、これは
- 検索されていなければ検索
- 検索されていなければ置換して検索
- 検索条件に一致しなかったら 「"検索文字列" が見つかりません。」というメッセージを出す。
このようになっています。"検索されていなければ検索" の部分ですが、"検索されている" の判定は、**選択されているテキストが検索文字列と一致しているか？**というロジックのようです。ならば、この置換のロジックは、
- 選択されているテキストが検索文字列と一致しているか調べる
- 一致していれば選択文字列を置換文字列で置き換える
- 検索を行う
こうなります。TMemo.SelText が選択されているテキストのプロパティであり、このプロパティは代入可能というのがミソです。これを知っていると置換のロジックはシンプルになります。
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
// [置換して次へ]
// 検索済みかどうかの判定
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;
[置換(R)...] メニューは何故かグレーアウトしないようなので、置換処理はこれで完了となります。〔Alt〕,〔E〕,〔R〕や〔Ctrl〕+〔H〕で [置換(R)...] が実行される事を確認してください。
// 戻る
今回はここまでです。ここまでの全ソースを掲載しておきます。
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;
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);
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
procedure Init;
procedure SaveFile;
procedure UpdateCaption;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
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
// 上書き保存
SaveFile;
end;
end;
procedure TForm1.acSaveAsExecute(Sender: TObject);
// Action: 名前を付けて保存(A)...
begin
if SaveTextFileDialog1.Execute then
begin
// 値を保存
FFileName := SaveTextFileDialog1.FileName;
FEncodingIndex := SaveTextFileDialog1.EncodingIndex;
// キャプションを変更
UpdateCaption;
// ファイルへ保存
SaveFile;
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
// 検索文字列を共有
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.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;
end;
// メソッド
procedure TForm1.Init;
// エディタの初期化
begin
// 値を初期化
FFileName := '';
FEncodingIndex := 0;
Memo1.Lines.Clear; // Memo1 の中身を消去する。
// キャプションを変更
UpdateCaption;
end;
procedure TForm1.SaveFile;
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.