// これは...
これは Delphi Advent Calendar 2017 15 日目の記事です。
長くなってしまったので機能単位で分割しています。
[ヘルプ(H)]
まずは ActionList にアクションを追加しましょう。
カテゴリが [Help] になっている事に注意してください。
Action (Name) | Caption | Category | ShortCut |
---|---|---|---|
acHelp | ヘルプの表示(&H) | Help | |
acAbout | バージョン情報(&A)... | Help |
登録するとこうなります。
次に MainMenu1 のコンポーネントエディタを開き、[表示(V)] の右横を選択します。
オブジェクトインスペクタで Caption プロパティに ヘルプ(&H) と入力します。
今度は MainMenu1 のコンポーネントエディタで [ヘルプ(&H)] メニューの下をクリックして、Help のアクションを割り当てていきます。
こんな感じです。スプリッター (分割線) も忘れずに入れておきましょう。
以下、実装となります。
[ヘルプの表示(H)]
このメニューは、
という処理を行う必要があります。
昔のメモ帳は使い方がヘルプで表示されていました。XP だとメニューアイテムも [トピックの検索(H)] でした。
Microsoft のサイトに飛ばしても面白くないので、エンバカさんのサイトに飛ばしましょう。Delphi 製品情報ページ (https://www.embarcadero.com/jp/products/delphi) がいいかな?関連付けられたものを開くには Shell API の ShellExecute() を使います。uses に WinAPI.ShellAPI を追記します。
uses
..., WinAPI.ShellAPI; // <-- 追加
そして acHelp アクションのイベントハンドラを作ります。
イベントハンドラの実装は以下のようになります。
procedure TForm1.acHelpExecute(Sender: TObject);
// Action: [ヘルプ(H)]
begin
ShellExecute(0, 'open', 'https://www.embarcadero.com/jp/products/delphi', nil, nil, SW_SHOWNORMAL);
end;
ShellExecute() の第2~第4引数は String ではなく PWideChar 型なので、
procedure TForm1.acHelpExecute(Sender: TObject);
// Action: [ヘルプ(H)]
var
URL: string;
begin
URL := 'https://www.embarcadero.com/jp/products/delphi';
ShellExecute(0, 'open', URL, nil, nil, SW_SHOWNORMAL);
end;
このようなコードはエラーになります。String 型の変数を使いたいのなら、PWideChar() でキャストします。
procedure TForm1.acHelpExecute(Sender: TObject);
// Action: [ヘルプ(H)]
var
URL: string;
begin
URL := 'https://www.embarcadero.com/jp/products/delphi';
ShellExecute(0, 'open', PWideChar(URL), nil, nil, SW_SHOWNORMAL);
end;
〔Alt〕,〔H〕,〔H〕で [ヘルプ(H)] が実行される事を確認してください。
[バージョン情報(A)...]
このメニューは、
- バージョン情報ダイアログを表示する。
という処理を行う必要があります。
メモ帳ではこのようなバージョン情報ダイアログが表示されます。
acabout アクションのイベントハンドラを作ります。
イベントハンドラの実装は以下のようになります。
procedure TForm1.acAboutExecute(Sender: TObject);
// Action: [バージョン情報(A)]
begin
ShellAbout(Self.Handle, 'メモ帳クローン', '', Application.Icon.Handle);
end;
実はあのダイアログは ShellAPI に用意されているのです。[編集(E) | 行へ移動(G)...] みたいにダイアログを書く必要があると思いましたか?
ShellAbout() の第1引数には自分 (Form1) のウィンドウハンドルを渡していますが、ここを ShellExecute() の時みたいに 0 を渡すとモーダルではない独立したウィンドウになります。つまり、バージョン情報を出しながらメモに入力ができてしまいます。
ShellAbout() の第4引数に渡した Application.Icon というのは [プロジェクト | オプション] の "アプリケーション" で指定できるアプリケーションのアイコンの事です。アプリケーションアイコンは好きなアイコンに差し替えることが可能です。
ちなみに [ファイル | 新規作成 | その他] の [Delphi プロジェクト | Delphi ファイル] で [バージョン情報ダイアログ] を自前で作る方法もあります。
こんな感じのダイアログです。アイコン等は自前で用意する必要があります。
〔Alt〕,〔H〕,〔A〕で [バージョン情報(A)] が実行される事を確認してください。
// 戻る
殆どの機能を実装しましたね。
今回はここまでです。ここまでの全ソースを掲載しておきます。
[メインフォーム]
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, WinAPI.ShellAPI;
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;
acHelp: TAction;
acAbout: TAction;
H1: TMenuItem;
H2: TMenuItem;
A3: TMenuItem;
N9: TMenuItem;
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);
procedure acHelpExecute(Sender: TObject);
procedure acAboutExecute(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.acHelpExecute(Sender: TObject);
// Action: [ヘルプ(H)]
var
URL: string;
begin
URL := 'https://www.embarcadero.com/jp/products/delphi';
ShellExecute(0, 'open', PWideChar(URL), nil, nil, SW_SHOWNORMAL);
end;
procedure TForm1.acAboutExecute(Sender: TObject);
// Action: [バージョン情報(A)]
begin
ShellAbout(Self.Handle, 'メモ帳クローン', '', Application.Icon.Handle);
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.
[行へ移動] ダイアログ
(変更ありません)