// これは...
これは Delphi Advent Calendar 2017 15 日目の記事です。
長くなってしまったので機能単位で分割しています。
[表示(V)]
まずは ActionList にアクションを追加しましょう。
カテゴリが [View] になっている事に注意してください。
Action (Name) | Caption | Category | ShortCut |
---|---|---|---|
acStatusBar | ステータスバー(&S) | View |
登録するとこうなります。
次に MainMenu1 のコンポーネントエディタを開き、[書式(O)] の右横を選択します。
オブジェクトインスペクタで Caption プロパティに 表示(&V) と入力します。
[表示(V)] メニューができました。
今度は MainMenu1 のコンポーネントエディタで [表示(V)] メニューの下をクリックして、Format のアクションを割り当てていきます。
こんな感じです。
以下、実装となります。
[ステータスバー(S)]
このメニューは、
- チェックが入っていればステータスバーを表示する。
- ステータスバーには現在の桁と行位置を表示する。
- [右側で折り返す(W)] にチェックが入っていればステータスバーを無効にする。
という処理を行う必要があります。
まずはステータスバーを追加しましょう。TStatusbar はツールパレットの [Win32] タブにあります。
TStatusbar (Statusbar1) を追加すると、メインフォームの下部にステータスバーが表示されます。
このステータスバーをダブルクリックすると、ステータスバーにパネルを追加できます。左上のボタンでパネルを2つ追加してください。ボタンを2回押すだけです。
このようにパネルが追加されます。このパネルには Statusbar1.Panels[n] でアクセスできます。
次にオブジェクトインスペクタで Statusbar1 のリサイズイベントをダブルクリックします。
Statusbar1.Panels[0] と Statusbar1.Panels[1] はクライアント幅の 75%:25% となるようなので、リサイズに合わせてパネル幅を変化させるようなコードを記述します。
procedure TForm1.StatusBar1Resize(Sender: TObject);
// ステータスバーのリサイズ
begin
StatusBar1.Panels[1].Width := StatusBar1.Width div 4;
StatusBar1.Panels[0].Width := StatusBar1.Width - StatusBar1.Panels[1].Width;
end;
行と列を表示するロジックは以下のようになります。
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
procedure DispRowCol; // <-- 追加
procedure Init;
procedure SaveFile;
procedure UpdateCaption;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
(中略)
...
// メソッド
procedure TForm1.DispRowCol;
var
Row, Col: Integer;
begin
// ステータスバーに行/列を表示
Row := Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
Col := Memo1. SelStart - Memo1.Perform(EM_LINEINDEX, WPARAM(ROW), 0);
StatusBar1.Panels[1].Text := Format(' %d行、%d列' , [Row + 1, Col + 1]);
end;
このメソッドをキーが押された時、またはマウスでクリックされた時に呼び出します。まずは Memo1 の onClick イベントです。
procedure TForm1.Memo1Click(Sender: TObject);
// Memo1 クリック時
begin
DispRowCol;
end;
同様に Memo1 の onKeyUp イベントです。
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
// Memo1 キーアップ時
begin
DispRowCol;
end;
Init() メソッドにも追記しておきます。
procedure TForm1.Init;
// エディタの初期化
begin
// 値を初期化
FFileName := '';
FEncodingIndex := 0;
Memo1.Lines.Clear; // Memo1 の中身を消去する。
// キャプションを変更
UpdateCaption;
// 行/列の表示
DispRowCol;
end;
acStatusBar アクションのイベントハンドラを作ります。
イベントハンドラの実装は以下のようになります。StatusBar1.Visible の状態をトグルさせます。
procedure TForm1.acStatusBarExecute(Sender: TObject);
// Action: [ステータスバー(S)]
begin
StatusBar1.Visible := not StatusBar1.Visible;
end;
[ステータスバー(S)] の有効無効を [書式(O) | 右側で折り返す(W)] のチェック状態に合わせるには以下のようなコードを記述します。
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
(中略)
// [ステータスバー(S)] の有効/無効
acStatusBar.Enabled := not Memo1.WordWrap;
// [ステータスバー(S)] のチェック状態
acStatusBar.Checked := StatusBar1.Visible;
end;
[書式(O) | 右側で折り返す(W)] がチェックされたらステータスバーを非表示にするよう、acWordwrapExecute() イベントハンドラに追記します。
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];
if Memo1.WordWrap then // <-- 追加
StatusBar1.Visible := False; // <-- 追加
end;
メモ帳ではステータスバーはデフォルトでオフなので、StatusBar1 の Visible プロパティを False にしておきます。
〔Alt〕,〔V〕,〔S〕で [ステータスバー(S)] が実行される事を確認してください。
// 戻る
だんだんそれっぽくなってきましたね。
今回はここまでです。ここまでの全ソースを掲載しておきます。
[メインフォーム]
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, Vcl.ComCtrls;
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;
acStatusBar: TAction;
N8: TMenuItem;
S2: TMenuItem;
StatusBar1: TStatusBar;
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);
procedure StatusBar1Resize(Sender: TObject);
procedure Memo1Click(Sender: TObject);
procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure acStatusBarExecute(Sender: TObject);
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
procedure DispRowCol;
procedure Init;
procedure SaveFile;
procedure UpdateCaption;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
frmuGotoLine;
procedure TForm1.FormCreate(Sender: TObject);
// フォーム作成時
begin
Init;
end;
procedure TForm1.StatusBar1Resize(Sender: TObject);
// ステータスバーのリサイズ
begin
StatusBar1.Panels[1].Width := StatusBar1.Width div 4;
StatusBar1.Panels[0].Width := StatusBar1.Width - StatusBar1.Panels[1].Width;
end;
procedure TForm1.Memo1Click(Sender: TObject);
// Memo1 クリック時
begin
DispRowCol;
end;
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
// Memo1 キーアップ時
begin
DispRowCol;
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
// 検索文字列を正規表現文字列へエスケープ
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];
if Memo1.WordWrap then // <-- 追加
StatusBar1.Visible := False; // <-- 追加
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.acStatusBarExecute(Sender: TObject);
// Action: [ステータスバー(S)]
begin
StatusBar1.Visible := not StatusBar1.Visible;
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;
// [ステータスバー(S)] の有効/無効
acStatusBar.Enabled := not Memo1.WordWrap;
// [ステータスバー(S)] のチェック状態
acStatusBar.Checked := StatusBar1.Visible;
end;
// メソッド
procedure TForm1.DispRowCol;
var
Row, Col: Integer;
begin
// ステータスバーに行/列を表示
Row := Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
Col := Memo1. SelStart - Memo1.Perform(EM_LINEINDEX, WPARAM(ROW), 0);
StatusBar1.Panels[1].Text := Format(' %d行、%d列' , [Row + 1, Col + 1]);
end;
procedure TForm1.Init;
// エディタの初期化
begin
// 値を初期化
FFileName := '';
FEncodingIndex := 0;
Memo1.Lines.Clear; // Memo1 の中身を消去する。
// キャプションを変更
UpdateCaption;
// 行/列の表示
DispRowCol;
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.
[行へ移動] ダイアログ
(変更ありません)