// これは...
これは Delphi Advent Calendar 2017 15 日目の記事です。
長くなってしまったので機能単位で分割しています。
その他の機能
重箱の隅をつついてみます。
リファクタリング
まずは重複するコードがありますのでまとめます。
[編集中のファイル名を返すメソッド]
編集中のファイル名を返すメソッドを作ります。
(前略)
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
FHeaderStr: string;
FFooterStr: string;
procedure DispRowCol;
function GetTextFileName: string; // <-- 追加
procedure Init;
procedure PrintText(const HeaderStr, FooterStr: string);
procedure SaveFile;
procedure UpdateCaption;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
(中略)
function TForm1.GetTextFileName: string;
// 編集中のファイル名を返す
begin
if FFileName = '' then
result := '無題'
else
result := TPath.GetFileName(FFileName);
end;
DrawHeaderFooter() 内を書き換えます ('F' の条件の所)。
procedure DrawHeaderFooter(const AStr: string; ARect: TRect; AFlgs: Integer; APage: Integer);
...
case UpCase(P^) of
'L', 'C', 'R':
ChangeAlign := True;
'D':
Str := Str + FormatDateTime('YYYY"年"M"月"M"日"', Date);
'T':
Str := Str + FormatDateTime('h:n:s', Time);
'F':
Str := Str + GetTextFileName; // <-- 変更
'P':
Str := Str + APage.ToString;
'&':
Str := Str + '&';
end;
...
UpdateCaption() 内も書き換えます。
procedure TForm1.UpdateCaption;
// キャプション (ファイル名) の更新
begin
Self.Caption := GetTextFileName + ' - メモ帳クローン';
end;
PrintText() 内も書き換えておきましょう。
procedure TForm1.PrintText(const HeaderStr, FooterStr: string);
// 印刷ロジック
...
// 印刷
Printer.Title := GetTextFileName; // <-- 追加
Printer.BeginDoc;
SetBkMode(Printer.Canvas.Handle, TRANSPARENT);
Printer.Canvas.Font.Assign(Memo1.Font); // Memo1 のフォントを Canvas に割り当て
こうしておくと印刷時のジョブ表示にファイル名が表示されるようになって便利です。
[編集中のファイルのエンコーディングを返すメソッド]
編集中のファイルのエンコーディング (TEncoding) を返すメソッドを作ります。
(前略)
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
FHeaderStr: string;
FFooterStr: string;
procedure DispRowCol;
function GetEditorEncoding: TEncoding;
function GetTextFileName: string;
procedure Init;
procedure PrintText(const HeaderStr, FooterStr: string);
procedure SaveFile;
procedure UpdateCaption;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
(中略)
function TForm1.GetEditorEncoding: TEncoding;
// 編集中のファイルのエンコーディングを返す
begin
case FEncodingIndex of
1: result := TEncoding.Unicode;
2: result := TEncoding.BigEndianUnicode;
3: result := TEncoding.UTF8;
else
result := TEncoding.Default;
end;
end;
acOpenExecute() イバントハンドラを書き換えます。
procedure TForm1.acOpenExecute(Sender: TObject);
// Action: 開く(O)...
begin
if OpenTextFileDialog1.Execute then
begin
// 値を保存
FFileName := OpenTextFileDialog1.FileName;
FEncodingIndex := OpenTextFileDialog1.EncodingIndex;
// キャプションを変更
UpdateCaption;
// エンコーディングを指定して読み込み
Memo1.Lines.LoadFromFile(FFileName, GetEditorEncoding); // <-- 変更
end;
end;
SaveFile() メソッドも書き換えます。
procedure TForm1.SaveFile;
begin
// エンコーディングを指定して保存
Memo1.Lines.SaveToFile(FFileName, GetEditorEncoding); // <-- 変更
end;
[アプリケーションのタイトル]
[プロジェクト | オプション] でプロジェクトオプションを開き、[アプリケーション | 表示] で [タイトル (T):] に "メモ帳クローン" と入力します。このタイトルはコード中から Application.Title として参照できます。逆にコードで Application.Title を設定することも可能です。
acAboutExecute() イベントハンドラを書き換えます。
procedure TForm1.acAboutExecute(Sender: TObject);
// Action: [バージョン情報(A)]
begin
ShellAbout(Self.Handle, PChar(Application.Title), '', Application.Icon.Handle); // <-- 変更
end;
UpdateCaption() 内も書き換えます。
procedure TForm1.UpdateCaption;
// キャプション (ファイル名) の更新
begin
Self.Caption := GetTextFileName + ' - ' + Application.Title; // <-- 変更
end;
ドラッグ&ドロップ
メモ帳にファイルをドラッグ&ドロップすると以下の挙動になります。
- [ファイル(F) | 開く(O)] と同じ挙動になる。
- 複数ドロップされても一つしか処理しない。
- 但し、エンコーディングは自動判別する。
エンコーディングの自動判別が地味に面倒なのですが、ANSI / UTF-16LE / UTF-16BE / UTF-8 の4つを区別すればいいのでそんなに難しくはありません。
- ファイルの先頭が 0xFE, 0xFF で始まれば UTF-16LE
- ファイルの先頭が 0xFF, 0xFE で始まれば UTF-16BE
- ファイルの先頭が 0xEF, 0xBB, 0xBF で始まれば UTF-8 (with BOM)
[ファイルの内容からエンコーディングを判定するメソッド]
とりあえず先頭の BOM を調べて、その後はちょっと説明が面倒なのでコードで書きます。
(前略)
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
FHeaderStr: string;
FFooterStr: string;
function DetectEncodingFromFile(FileName: string): Integer; // <-- 追加
procedure DispRowCol;
function GetEditorEncoding: TEncoding;
function GetTextFileName: string;
procedure Init;
procedure PrintText(const HeaderStr, FooterStr: string);
procedure SaveFile;
procedure UpdateCaption;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
(中略)
...
function TForm1.DetectEncodingFromFile(FileName: string): Integer;
// ファイルの内容からエンコーディングを判定する
var
MS: TMemoryStream;
BufSize: Integer;
B: Byte;
Buf: TBytes;
i, Idx, TrailByteCnt: Integer;
UTF8Flg: Boolean;
function UTF8TrailByteSize(Lead: Byte): Integer;
begin
case Lead of
$00..$7F: Result := 0;
$C2..$DF: Result := 1;
$E0..$EF: Result := 2;
$F0..$F7: Result := 3;
$F8..$FB: Result := 4;
$FC..$FD: Result := 5;
else
Result := 0;
end;
end;
begin
MS := TMemoryStream.Create;
try
MS.LoadFromFile(FileName);
// BOM がなければ ANSI
result := 0;
if (MS.Size < 2) then
Exit;
// BOM を調べて判定
BufSize := Min(2048, MS.Size);
SetLength(Buf, BufSize);
MS.ReadBuffer(Buf, BufSize);
if (Buf[0] = $FF) and (Buf[1] = $FE) then
result := 1
else if (Buf[0] = $FE) and (Buf[1] = $FF) then
result := 2
else if (MS.Size >= 3) and (Buf[0] = $EF) and (Buf[1] = $BB) and (Buf[2] = $BF) then
result := 3;
if result > 0 then // エンコーディングが判定されていれば抜ける
Exit;
// UTF-8 と ANSI を判定
result := 3;
Idx := 0;
while Idx < BufSize do
begin
if Buf[Idx] >= $80 then
begin
TrailByteCnt := UTF8TrailByteSize(Buf[Idx]);
if TrailByteCnt = 0 then
begin
result := 0;
Break;
end;
if (Idx + TrailByteCnt) < BufSize then
begin
UTF8Flg := True;
for i:=1 to TrailByteCnt do
begin
B := Buf[Idx + i];
if (B < $80) or (B > $BF) then
begin
UTF8Flg := False;
Break;
end;
end;
if not UTF8Flg then
begin
result := 0;
Break;
end;
end;
Inc(Idx, TrailByteCnt);
end;
Inc(Idx);
end;
finally
MS.Free;
end;
end;
まず、BOM を調べて判定し、それでも判定できない UTF-8 (BOM なし) と ANSI は先頭から 2KB 読み込んで判定しています。UTF-8 の構造から外れていれば ANSI とみなします。
[ドラッグ&ドロップの実装]
本題のドラッグ&ドロップです。Explorer からのファイルドロップを処理するため、WM_DROPFILES メッセージを処理する**メッセージメソッド (メッセージハンドラ)**を記述します。
(前略)
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
FHeaderStr: string;
FFooterStr: string;
function DetectEncodingFromFile(FileName: string): Integer;
procedure DispRowCol;
function GetEditorEncoding: TEncoding;
function GetTextFileName: string;
procedure Init;
procedure PrintText(const HeaderStr, FooterStr: string);
procedure SaveFile;
procedure UpdateCaption;
procedure WmDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; // <-- 追加
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
(中略)
procedure TForm1.WmDropFiles(var Msg: TWMDropFiles);
var
Buf: array [0..MAX_PATH] of Char;
begin
// ドロップされた (最初の) ファイル名を取得
DragQueryFile(Msg.Drop, 0, Buf, MAX_PATH);
DragFinish(Msg.Drop);
// ファイル名を保存
FFileName := StrPas(Buf);
FEncodingIndex := DetectEncodingFromFile(FFileName);
// キャプションを変更
UpdateCaption;
// エンコーディングを指定して読み込み
Memo1.Lines.LoadFromFile(FFileName, GetEditorEncoding);
end;
そして FormCreate() イベントハンドラ中に、DragAcceptFiles() を記述します。これはドロップを受け付けるコントロールを指定するもので、コードでは Self.Handle を指定しているのでフォーム全体がドロップ受け入れ対象となります。
procedure TForm1.FormCreate(Sender: TObject);
// フォーム作成時
begin
FHeaderStr := '&f';
FFooterStr := 'ページ(&p)';
Init;
DragAcceptFiles(Self.Handle, True); // <-- 追加
end;
コマンドライン引数
メモ帳にファイル名を渡すとそのファイルを開きます。実は他にもパラメータがあるようですが、細かくやるとキリがないので、ファイル名が渡された時だけを処理したいと思います。
パラメータ | 説明 |
---|---|
<ファイル名> | <ファイル名> に渡されたファイルを開く |
/A <ファイル名> | <ファイル名> で渡されたファイルを ANSI で開く |
/W <ファイル名> | <ファイル名> で渡されたファイルを Unicode で開く |
/P <ファイル名> | <ファイル名> で渡されたファイルを印刷する |
/PT <ファイル名> | <ファイル名> で渡されたファイルを指定されたプリンタで印刷する |
アプリケーションに渡されたパラメータは C 言語の場合、argc で引数の数を、argv[] で渡された文字列を取得できますが、Delphi の場合には ParamCount で引数の数を、ParamStr() で渡された文字列を取得できます。
ファイルを読み込むタイミングはフォームが生成された後 (すべてのコントロールの準備が終わった後)、がいいので、Form1 の OnShow イベントで処理する事にします。
この OnShow イベントはフォーム表示時のイベントですが、OnCreate イベントとは異なり一度だけ呼ばれるとは限りません。なので、OnShow のイベントハンドラ (FormShow) を一度しか処理したくないのであれば、以下のようにイベントハンドラの先頭で OnShow イベントとの関連付けを解除してやります。こうすれば FormShow は一度しか実行されません。
procedure TForm1.FormShow(Sender: TObject);
// フォーム表示時
begin
Self.OnShow := nil;
// 処理
end;
ここの処理ですが、Init() メソッドをちょっと変更すると便利そうです。
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
FHeaderStr: string;
FFooterStr: string;
function DetectEncodingFromFile(FileName: string): Integer;
procedure DispRowCol;
function GetEditorEncoding: TEncoding;
function GetTextFileName: string;
procedure Init(AFileName: string = ''); // <-- 変更
procedure PrintText(const HeaderStr, FooterStr: string);
procedure SaveFile;
procedure UpdateCaption;
procedure WmDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
public
{ Public 宣言 }
end;
(中略)
procedure TForm1.Init(AFileName: string); // <-- 変更
// エディタの初期化
begin
// 値を初期化
FFileName := AFileName; // <-- 変更
FEncodingIndex := 0;
Memo1.Lines.Clear; // Memo1 の中身を消去する。
// キャプションを変更
UpdateCaption;
// 行/列の表示
DispRowCol;
end;
この修正を行っても Init() をパラメータなしで呼び出している既存のコードの修正は必要ありません。FFileName は従来通り '' で初期化されます。これは宣言部で初期値が渡されているからです。初期値が設定されている場合、この引数は省略する事が可能です。Init() を引数付きで呼ぶと FFileName はその引数 AFileName で初期化されます。
FormShow() イベントハンドラは以下のようなコードになりました。
procedure TForm1.FormShow(Sender: TObject);
// フォーム表示時
var
FileName, Msg: string;
ret: Integer;
begin
Self.OnShow := nil;
if ParamCount = 0 then
Exit;
FileName := ParamStr(1);
if TFile.Exists(FileName) then
begin
// ファイルが存在する
FFileName := FileName;
// エンコーディングを判定
FEncodingIndex := DetectEncodingFromFile(FFileName);
// キャプションを変更
UpdateCaption;
// エンコーディングを指定して読み込み
Memo1.Lines.LoadFromFile(FFileName, GetEditorEncoding);
end
else
begin
// ファイルが存在しない
Msg := 'ファイル %s が見つかりません。' + sLineBreak + sLineBreak + '新しく作成しますか?';
Msg := Format(Msg, [TPath.GetFileName(FileName)]);
ret := MessageDlg(Msg, TMsgDlgType.mtConfirmation, [mbYes, mbNo, mbCancel], -1);
case ret of
ID_YES: // ファイル名を付けて [新規作成]
Init(FileName);
ID_NO: // [新規作成] と同じ...つまり、何もしない
;
ID_CANCEL: // アプリケーションを閉じる
PostMessage(Self.Handle, WM_CLOSE, 0, 0);
end;
end;
end;
ParamStr(1) が最初のパラメータです。ParamStr(0) には自分自身のファイル名が入っており、Application.ExeName と等価です。
sLineBreak とは改行コードを示す定数です。
MessageDlg() には 3 つのボタン [はい] [いいえ] [キャンセル] があります。ボタンが押されると、それぞれ ID_YES, ID_NO, ID_CANCEL が返ります。
PostMessage() でアプリケーションを閉じているのは、FormShow イベントハンドラ内ではアプリケーションを閉じれないためです。非同期でメッセージを投げる PostMessage() で自分自身に WM_CLOSE メッセージを送り、メッセージキューに突っ込んでおきます。OnShow イベントが処理され、メッセージキューが処理できる状態になるとフォームが閉じられます。
この機能のテストはコマンドプロンプトで試してもいいのですが、[実行 | 実行時引数] のパラメータに文字列を設定する事でも行えます。
テストが終わったら忘れずに外しておきましょう。
ファイルダイアログの初期値
現在のファイルのエンコーディングをファイルダイアログにも反映するようにしましょう。
procedure TForm1.acOpenExecute(Sender: TObject);
// Action: 開く(O)...
begin
OpenTextFileDialog1.EncodingIndex := FEncodingIndex; // <-- 追加
if OpenTextFileDialog1.Execute then
begin
// 値を保存
FFileName := OpenTextFileDialog1.FileName;
FEncodingIndex := OpenTextFileDialog1.EncodingIndex;
// キャプションを変更
UpdateCaption;
// エンコーディングを指定して読み込み
Memo1.Lines.LoadFromFile(FFileName, GetEditorEncoding);
end;
end;
保存ダイアログの時はファイル名も渡すようにします。
procedure TForm1.acSaveAsExecute(Sender: TObject);
// Action: 名前を付けて保存(A)...
begin
SaveTextFileDialog1.FileName := FFileName; // <-- 追加
SaveTextFileDialog1.EncodingIndex := FEncodingIndex; // <-- 追加
if SaveTextFileDialog1.Execute then
begin
// 値を保存
FFileName := SaveTextFileDialog1.FileName;
FEncodingIndex := SaveTextFileDialog1.EncodingIndex;
// キャプションを変更
UpdateCaption;
// ファイルへ保存
SaveFile;
end;
end;
状態の保存
メモ帳ではウィンドウサイズや位置などをレジストリに保存しています。レジストリの位置は
[HKEY_CURRENT_USER\Software\Microsoft\Notepad] です。
主要なものはこれくらいでしょうか?
名前 | 型 | 説明 |
---|---|---|
iWindowPosX | REG_DWORD | X 座標 |
iWindowPosY | REG_DWORD | Y 座標 |
iWindowPosDX | REG_DWORD | ウィンドウの幅 |
iWindowPosDY | REG_DWORD | ウィンドウの高さ |
szHeader | REG_SZ | 印刷: ヘッダー |
szTrailer | REG_SZ | 印刷: フッター |
iMarginTop | REG_DWORD | 印刷: 上マージン |
iMarginBottom | REG_DWORD | 印刷: 下マージン |
iMarginLeft | REG_DWORD | 印刷: 左マージン |
iMarginRight | REG_DWORD | 印刷: 右マージン |
lfFaceName | REG_SZ | フォント: フォント名 |
iPointSize | REG_DWORD | フォント: フォントサイズ |
fWrap | REG_DWORD | [右端で折り返す] の状態 |
StatusBar | REG_DWORD | [ステータスバー] の状態 |
このレジストリエントリをそのまま使うわけにはいかないので [HKEY_CURRENT_USER\Software\Notepad_Clone] に保存する事にします。レジストリを使うには uses に System.Win.Registry を追加します。
unit frmuMain;
interface
uses
..., System.Win.Registry; // <-- 追加
現状、マージンだけをどうにかすればよさそうですね。マージンを格納するフィールドを追加しておきます。
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
FHeaderStr: string;
FFooterStr: string;
FMarginTop: Integer; // <-- 追加
FMarginBottom: Integer; // <-- 追加
FMarginLeft: Integer; // <-- 追加
FMarginRight: Integer; // <-- 追加
function DetectEncodingFromFile(FileName: string): Integer;
procedure DispRowCol;
function GetEditorEncoding: TEncoding;
function GetTextFileName: string;
procedure Init(AFileName: string = '');
procedure PrintText(const HeaderStr, FooterStr: string);
procedure SaveFile;
procedure UpdateCaption;
procedure WmDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
public
{ Public 宣言 }
end;
[レジストリからの読み込み]
設定の読み込みは FormShow イベントハンドラで行います。
procedure TForm1.FormShow(Sender: TObject);
// フォーム表示時
var
FileName, Msg: string;
ret: Integer;
reg: TRegistryIniFile;
begin
Self.OnShow := nil;
// 設定の読み込み
reg := TRegistryIniFile.Create('Software\Notepad_Clone');
try
// ウィンドゥのサイズ
Self.Width := reg.ReadInteger('', 'iWindowPosDX', 640);
Self.Height := reg.ReadInteger('', 'iWindowPosDY', 480);
// ウィンドゥの位置
Self.Left := reg.ReadInteger('', 'iWindowPosX', (Screen.Width - Self.Width ) div 2);
Self.Top := reg.ReadInteger('', 'iWindowPosY', (Screen.Height - Self.Height) div 2);
// メモのフォント
Memo1.Font.Name := reg.ReadString('', 'lfFaceName', 'MS ゴシック');
Memo1.Font.Size := reg.ReadInteger('', 'iPointSize', 120) div 10;
// [右端で折り返す] の状態
Memo1.WordWrap := Boolean(reg.ReadInteger('', 'fWrap', 0) = 1);
if Memo1.WordWrap then
Memo1.ScrollBars := ssVertical;
// [ステータスバー] の状態
StatusBar1.Visible := Boolean(reg.ReadInteger('', 'StatusBar', 0) = 1);
// 印刷: ヘッダー/フッター
FHeaderStr := reg.ReadString('', 'szHeader' , '&f');
FFooterStr := reg.ReadString('', 'szTrailer', 'ページ(&p)');
// 印刷: マージン
FMarginTop := reg.ReadInteger('', 'iMarginTop' , 2000);
FMarginBottom := reg.ReadInteger('', 'iMarginBottom' , 2000);
FMarginLeft := reg.ReadInteger('', 'iMarginLeft' , 2500);
FMarginRight := reg.ReadInteger('', 'iMarginRight' , 2500);
finally
reg.Free;
end;
if ParamCount = 0 then
Exit;
(後略)
...
TRegistry より、TRegistryIniFile の方が簡単にレジストリを操作できます。
TRegIniFile.Readxxxxx() メソッドの3番目のパラメータはレジストリのキーが存在しない場合に読み込まれるデフォルト値です。コードではフォームをスクリーンの中央に表示させたりしています。
FormCreate() で FHeaderStr / FFooterStr の初期値を設定していましたね。これは削除します。
procedure TForm1.FormCreate(Sender: TObject);
// フォーム作成時
begin
Init;
DragAcceptFiles(Self.Handle, True);
end;
ヘッダー/フッターの部分は大丈夫なので、マージンの処理を追加します。
procedure TForm1.acPageSetupExecute(Sender: TObject);
// Action: ページ設定(U)...
begin
PageSetupDialog1.MarginTop := FMarginTop;
PageSetupDialog1.MarginBottom := FMarginBottom;
PageSetupDialog1.MarginLeft := FMarginLeft;
PageSetupDialog1.MarginRight := FMarginRight;
if PageSetupDialog1.Execute then
begin
FMarginTop := PageSetupDialog1.MarginTop;
FMarginBottom := PageSetupDialog1.MarginBottom;
FMarginLeft := PageSetupDialog1.MarginLeft;
FMarginRight := PageSetupDialog1.MarginRight;
end;
end;
[レジストリへの保存]
設定の保存は Form1 の OnClose イベントあたりが妥当でしょうか。
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
// フォームクローズ時
var
reg: TRegistryIniFile;
begin
// 設定の保存
reg := TRegistryIniFile.Create('Software\Notepad_Clone');
try
// ウィンドゥのサイズ
reg.WriteInteger('', 'iWindowPosDX', Self.Width );
reg.WriteInteger('', 'iWindowPosDY', Self.Height);
// ウィンドゥの位置
reg.WriteInteger('', 'iWindowPosX', Self.Left);
reg.WriteInteger('', 'iWindowPosY', Self.Top );
// メモのフォント
reg.WriteString('', 'lfFaceName', Memo1.Font.Name);
reg.WriteInteger('', 'iPointSize', Memo1.Font.Size * 10);
// [右端で折り返す] の状態
reg.WriteInteger('', 'fWrap', Integer(Memo1.WordWrap));
// [ステータスバー] の状態
reg.WriteInteger('', 'StatusBar', Integer(StatusBar1.Visible));
// 印刷: ヘッダー/フッター
reg.WriteString('', 'szHeader' , FHeaderStr);
reg.WriteString('', 'szTrailer', FFooterStr);
// 印刷: マージン
reg.WriteInteger('', 'iMarginTop' , FMarginTop );
reg.WriteInteger('', 'iMarginBottom' , FMarginBottom);
reg.WriteInteger('', 'iMarginLeft' , FMarginLeft );
reg.WriteInteger('', 'iMarginLeft' , FMarginRight );
finally
reg.Free;
end;
end;
アプリケーションを開いて閉じると値がレジストリに書き込まれるようになります。レジストリエディタで [HKEY_CURRENT_USER\Software\Notepad_Clone] を確認してみてください。
なお、System.IniFiles を uses に加えると、TIniFile クラスまたはTMemIniFile クラスで INI ファイルが扱えます。
エクステンド!
ここからは本筋とは関係ない余興となります。
[VCL スタイル]
今更ですが、メモ帳ってなんだか画面が地味ですよね...。
さて、最近の Delphi には VCL スタイル というものがあります。[プロジェクト | オプション] を開いてみてください。そして Carbon にチェックを入れ、[デフォルトスタイル] も Carbon にします。
このままコンパイルして実行すると...
はい、これが VCL スタイルです。複数のスタイルをリソースとして埋め込み、それをコードで切り替える事も可能です。
- [VCL スタイルの概要 (DocWiki)] (http://docwiki.embarcadero.com/RADStudio/Tokyo/ja/VCL_%E3%82%B9%E3%82%BF%E3%82%A4%E3%83%AB%E3%81%AE%E6%A6%82%E8%A6%81)
- Delphi / C++Builder で追加されたStyleとその他を紹介するよ (Qiita: @kazaiso)
- 889_VCL スタイルをリソースとして埋め込んで使用 (Mr.XRAY)
[ジェスチャ]
既にお気付きかもしれないのですけれど、例えば [開く(O)...] の機能は、TActionList に TAction を作って TMenuItem にアクションを割り当てる...なんて事をしなくとも、TMenuItem をダブルクリックして TMenuItem.OnClick イベントに直接処理を書く事ができます。
TActionList を使うのは、機能と GUI がごっちゃになって把握しにくくなる事を防ぐ意味合いがあります。それと今回は使いませんでしたが TPopUpMenu にもTMainMenu と同じ処理を割り当てたい...つまり、複数の場所から同じ機能を呼び出したい場合には TAction でまとめると便利です。有効/無効も一発で切り替えられますしね。
それとは別のメリットもあります。
フォームに TGestureManager (GestureManager1) を貼ります。TGestureManager はツールパレットの [Gestures] タブにあります。
貼ったら、Memo1 の Touch.GestureManager に GestureManager1 を指定します。
Touch.Gestures.Standard を展開するとこうなります。
DownLight にチェックを入れて、
acGoTo を割り当てます。
メモ帳クローンをコンパイルして実行したら、メモの上でこのようにマウスジェスチャしてみてください。
acGoTo...つまり [行へ移動] のアクションが実行されたと思います。これがジェスチャ機能です。
Touch.Gestures.Standard にはよくあるジェスチャが並んでおり、これに機能 (TAction) を割り当てることでジェスチャを実現しています。ですが、これが Standard って事は Standard でない機能もあるという事です。Touch.Gestures をダブルクリックするか […] ボタンを押してみてください。
するとさっきの Standard ジェスチャを選択するリストが出てきました。
左上のボタンを押してみましょう。
カスタムジェスチャが作れるのです。
カスタムジェスチャ作成画面の操作方法についてはドキュメントを参照してください。また、カスタムジェスチャ作成画面は、フォームデザイナ上の GestureManager1 をダブルクリックする事でも起動できます。
Touch.Gestures.Custom で自分が作ったカスタムジェスチャを割り当てられます。
あんまり複雑なジェスチャは再現するのが大変なので程々に...(w
このように TAction で機能を管理していると、ジェスチャ機能に対応するのがとても簡単になるというメリットもあります。
// 戻る
さて一通りの実装が終わりました。細かい事を言えば足りない部分もあるのですが、ここまでの話を理解したのであればさらなる改良はそんなに難しくはないと思います。
[メインフォーム]
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,
Vcl.Printers, System.Math, System.Win.Registry;
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;
PageSetupDialog1: TPageSetupDialog;
PrintDialog1: TPrintDialog;
acHeaderFooter: TAction;
H3: 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);
procedure acPageSetupExecute(Sender: TObject);
procedure acPrintExecute(Sender: TObject);
procedure acHeaderFooterExecute(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private 宣言 }
FFileName: String;
FEncodingIndex: Integer;
FHeaderStr: string;
FFooterStr: string;
FMarginTop: Integer;
FMarginBottom: Integer;
FMarginLeft: Integer;
FMarginRight: Integer;
function DetectEncodingFromFile(FileName: string): Integer;
procedure DispRowCol;
function GetEditorEncoding: TEncoding;
function GetTextFileName: string;
procedure Init(AFileName: string = '');
procedure PrintText(const HeaderStr, FooterStr: string);
procedure SaveFile;
procedure UpdateCaption;
procedure WmDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
frmuGotoLine,
frmuHeaderFooter;
procedure TForm1.WmDropFiles(var Msg: TWMDropFiles);
var
Buf: array [0..MAX_PATH] of Char;
begin
// ドロップされた (最初の) ファイル名を取得
DragQueryFile(Msg.Drop, 0, Buf, MAX_PATH);
DragFinish(Msg.Drop);
// ファイル名を保存
FFileName := StrPas(Buf);
// エンコーディングを判定
FEncodingIndex := DetectEncodingFromFile(FFileName);
// キャプションを変更
UpdateCaption;
// エンコーディングを指定して読み込み
Memo1.Lines.LoadFromFile(FFileName, GetEditorEncoding);
end;
procedure TForm1.FormCreate(Sender: TObject);
// フォーム作成時
begin
FHeaderStr := '&f';
FFooterStr := 'ページ(&p)';
Init;
DragAcceptFiles(Self.Handle, True);
end;
procedure TForm1.FormShow(Sender: TObject);
// フォーム表示時
var
FileName, Msg: string;
ret: Integer;
reg: TRegistryIniFile;
begin
Self.OnShow := nil;
// 設定の読み込み
reg := TRegistryIniFile.Create('Software\Notepad_Clone');
try
// ウィンドゥのサイズ
Self.Width := reg.ReadInteger('', 'iWindowPosDX', 640);
Self.Height := reg.ReadInteger('', 'iWindowPosDY', 480);
// ウィンドゥの位置
Self.Left := reg.ReadInteger('', 'iWindowPosX', (Screen.Width - Self.Width ) div 2);
Self.Top := reg.ReadInteger('', 'iWindowPosY', (Screen.Height - Self.Height) div 2);
// メモのフォント
Memo1.Font.Name := reg.ReadString('', 'lfFaceName', 'MS ゴシック');
Memo1.Font.Size := reg.ReadInteger('', 'iPointSize', 120) div 10;
// [右端で折り返す] の状態
Memo1.WordWrap := Boolean(reg.ReadInteger('', 'fWrap', 0) = 1);
if Memo1.WordWrap then
Memo1.ScrollBars := ssVertical;
// [ステータスバー] の状態
StatusBar1.Visible := Boolean(reg.ReadInteger('', 'StatusBar', 0) = 1);
// 印刷: ヘッダー/フッター
FHeaderStr := reg.ReadString('', 'szHeader' , '&f');
FFooterStr := reg.ReadString('', 'szTrailer', 'ページ(&p)');
// 印刷: マージン
FMarginTop := reg.ReadInteger('', 'iMarginTop' , 2000);
FMarginBottom := reg.ReadInteger('', 'iMarginBottom' , 2000);
FMarginLeft := reg.ReadInteger('', 'iMarginLeft' , 2500);
FMarginRight := reg.ReadInteger('', 'iMarginRight' , 2500);
finally
reg.Free;
end;
if ParamCount = 0 then
Exit;
FileName := ParamStr(1);
if TFile.Exists(FileName) then
begin
// ファイルが存在する
FFileName := FileName;
// エンコーディングを判定
FEncodingIndex := DetectEncodingFromFile(FFileName);
// キャプションを変更
UpdateCaption;
// エンコーディングを指定して読み込み
Memo1.Lines.LoadFromFile(FFileName, GetEditorEncoding);
end
else
begin
// ファイルが存在しない
Msg := 'ファイル %s が見つかりません。' + sLineBreak + sLineBreak + '新しく作成しますか?';
Msg := Format(Msg, [TPath.GetFileName(FileName)]);
ret := MessageDlg(Msg, TMsgDlgType.mtConfirmation, [mbYes, mbNo, mbCancel], -1);
case ret of
ID_YES: // ファイル名を付けて [新規作成]
Init(FileName);
ID_NO: // [新規作成] と同じ...つまり、何もしない
;
ID_CANCEL: // アプリケーションを閉じる
PostMessage(Self.Handle, WM_CLOSE, 0, 0);
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
// フォームクローズ時
var
reg: TRegistryIniFile;
begin
// 設定の保存
reg := TRegistryIniFile.Create('Software\Notepad_Clone');
try
// ウィンドゥのサイズ
reg.WriteInteger('', 'iWindowPosDX', Self.Width );
reg.WriteInteger('', 'iWindowPosDY', Self.Height);
// ウィンドゥの位置
reg.WriteInteger('', 'iWindowPosX', Self.Left);
reg.WriteInteger('', 'iWindowPosY', Self.Top );
// メモのフォント
reg.WriteString('', 'lfFaceName', Memo1.Font.Name);
reg.WriteInteger('', 'iPointSize', Memo1.Font.Size * 10);
// [右端で折り返す] の状態
reg.WriteInteger('', 'fWrap', Integer(Memo1.WordWrap));
// [ステータスバー] の状態
reg.WriteInteger('', 'StatusBar', Integer(StatusBar1.Visible));
// 印刷: ヘッダー/フッター
reg.WriteString('', 'szHeader' , FHeaderStr);
reg.WriteString('', 'szTrailer', FFooterStr);
// 印刷: マージン
reg.WriteInteger('', 'iMarginTop' , FMarginTop );
reg.WriteInteger('', 'iMarginBottom' , FMarginBottom);
reg.WriteInteger('', 'iMarginLeft' , FMarginLeft );
reg.WriteInteger('', 'iMarginLeft' , FMarginRight );
finally
reg.Free;
end;
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)...
begin
OpenTextFileDialog1.EncodingIndex := FEncodingIndex;
if OpenTextFileDialog1.Execute then
begin
// 値を保存
FFileName := OpenTextFileDialog1.FileName;
FEncodingIndex := OpenTextFileDialog1.EncodingIndex;
// キャプションを変更
UpdateCaption;
// エンコーディングを指定して読み込み
Memo1.Lines.LoadFromFile(FFileName, GetEditorEncoding);
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
SaveTextFileDialog1.FileName := FFileName;
SaveTextFileDialog1.EncodingIndex := FEncodingIndex;
if SaveTextFileDialog1.Execute then
begin
// 値を保存
FFileName := SaveTextFileDialog1.FileName;
FEncodingIndex := SaveTextFileDialog1.EncodingIndex;
// キャプションを変更
UpdateCaption;
// ファイルへ保存
SaveFile;
end;
end;
procedure TForm1.acPageSetupExecute(Sender: TObject);
// Action: ページ設定(U)...
begin
PageSetupDialog1.MarginTop := FMarginTop;
PageSetupDialog1.MarginBottom := FMarginBottom;
PageSetupDialog1.MarginLeft := FMarginLeft;
PageSetupDialog1.MarginRight := FMarginRight;
if PageSetupDialog1.Execute then
begin
FMarginTop := PageSetupDialog1.MarginTop;
FMarginBottom := PageSetupDialog1.MarginBottom;
FMarginLeft := PageSetupDialog1.MarginLeft;
FMarginRight := PageSetupDialog1.MarginRight;
end;
end;
procedure TForm1.acHeaderFooterExecute(Sender: TObject);
// Action: ヘッダーとフッター(H)
begin
Form3 := TForm3.Create(Self);
try
// ヘッダー文字列とフッター文字列を Form3 に渡す
Form3.Edit1.Text := FHeaderStr;
Form3.Edit2.Text := FFooterStr;
// Form3 をモーダルで表示
if Form3.ShowModal = mrOK then
begin
// [OK] ボタンが押されたら
FHeaderStr := Form3.Edit1.Text;
FFooterStr := Form3.Edit2.Text;
end;
finally
Form3.Free;
end;
end;
procedure TForm1.acPrintExecute(Sender: TObject);
// Action: 印刷(P)
begin
PrintText(FHeaderStr, FFooterStr);
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;
// [FORMAT] Actions
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;
// [VIEW] Actions
procedure TForm1.acStatusBarExecute(Sender: TObject);
// Action: [ステータスバー(S)]
begin
StatusBar1.Visible := not StatusBar1.Visible;
end;
// [HELP] Actions
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, PChar(Application.Title), '', 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;
// メソッド
function TForm1.DetectEncodingFromFile(FileName: string): Integer;
// ファイルの内容からエンコーディングを判定する
var
MS: TMemoryStream;
BufSize: Integer;
B: Byte;
Buf: TBytes;
i, Idx, TrailByteCnt: Integer;
UTF8Flg: Boolean;
function UTF8TrailByteSize(Lead: Byte): Integer;
begin
case Lead of
$00..$7F: Result := 0;
$C2..$DF: Result := 1;
$E0..$EF: Result := 2;
$F0..$F7: Result := 3;
$F8..$FB: Result := 4;
$FC..$FD: Result := 5;
else
Result := 0;
end;
end;
begin
MS := TMemoryStream.Create;
try
MS.LoadFromFile(FileName);
// BOM がなければ ANSI
result := 0;
if (MS.Size < 2) then
Exit;
// BOM を調べて判定
BufSize := Min(2048, MS.Size);
SetLength(Buf, BufSize);
MS.ReadBuffer(Buf, BufSize);
if (Buf[0] = $FF) and (Buf[1] = $FE) then
result := 1
else if (Buf[0] = $FE) and (Buf[1] = $FF) then
result := 2
else if (MS.Size >= 3) and (Buf[0] = $EF) and (Buf[1] = $BB) and (Buf[2] = $BF) then
result := 3;
if result > 0 then // エンコーディングが判定されていれば抜ける
Exit;
// UTF-8 と ANSI を判定
result := 3;
Idx := 0;
while Idx < BufSize do
begin
if Buf[Idx] >= $80 then
begin
TrailByteCnt := UTF8TrailByteSize(Buf[Idx]);
if TrailByteCnt = 0 then
begin
result := 0;
Break;
end;
if (Idx + TrailByteCnt) < BufSize then
begin
UTF8Flg := True;
for i:=1 to TrailByteCnt do
begin
B := Buf[Idx + i];
if (B < $80) or (B > $BF) then
begin
UTF8Flg := False;
Break;
end;
end;
if not UTF8Flg then
begin
result := 0;
Break;
end;
end;
Inc(Idx, TrailByteCnt);
end;
Inc(Idx);
end;
finally
MS.Free;
end;
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;
function TForm1.GetEditorEncoding: TEncoding;
// 編集中のファイルのエンコーディングを返す
begin
// EncodingIndex によりエンコーディングを指定
case FEncodingIndex of
1: result := TEncoding.Unicode;
2: result := TEncoding.BigEndianUnicode;
3: result := TEncoding.UTF8;
else
result := TEncoding.Default;
end;
end;
function TForm1.GetTextFileName;
// 編集中のファイル名を返す
begin
if FFileName = '' then
result := '無題'
else
result := TPath.GetFileName(FFileName);
end;
procedure TForm1.Init(AFileName: string);
// エディタの初期化
begin
// 値を初期化
FFileName := AFileName;
FEncodingIndex := 0;
Memo1.Lines.Clear; // Memo1 の中身を消去する。
// キャプションを変更
UpdateCaption;
// 行/列の表示
DispRowCol;
end;
procedure TForm1.PrintText(const HeaderStr, FooterStr: string);
// 印刷ロジック
const
DRAW_FLG = DT_NOPREFIX or DT_TOP or DT_LEFT or DT_WORDBREAK;
CALC_FLG = DRAW_FLG or DT_CALCRECT;
var
i, l, j, Index, LineCount, Sum, TextHeight, X_DPI, Y_DPI, PAGE_HEIGHT,
PAPER_WIDTH, PAPER_HEIGHT, MIN_HEIGHT, Copies: Integer;
PrintRect, CalcRect, CalcRect2, HeaderRect, FooterRect: TRect;
Text: String;
SL : TStringList;
Pages: array of Integer;
{ DrawHeaderFooter End}
procedure DrawHeaderFooter(const AStr: string; ARect: TRect; AFlgs: Integer; APage: Integer);
var
Flgs: Integer;
AlignFlg: Integer;
P: PChar;
Str: string;
ChangeAlign: Boolean;
begin
if AStr = '' then
Exit;
Flgs := AFlgs or DT_NOPREFIX or DT_SINGLELINE;
AlignFlg := DT_CENTER;
Str := '';
P := @AStr[1];
while (P^ <> #$00) do
begin
if P^ = '&' then
begin
Inc(P);
if P^ = #$00 then
Break;
ChangeAlign := False;
case UpCase(P^) of
'L', 'C', 'R':
ChangeAlign := True;
'D':
Str := Str + FormatDateTime('YYYY"年"M"月"M"日"', Date);
'T':
Str := Str + FormatDateTime('h:n:s', Time);
'F':
Str := Str + GetTextFileName;
'P':
Str := Str + APage.ToString;
'&':
Str := Str + '&';
end;
if (Str <> '') and ChangeAlign then
begin
DrawText(Printer.Canvas.Handle, PChar(Str), Length(Str), ARect, Flgs or AlignFlg);
Str := '';
end;
case UpCase(P^) of
'L': AlignFlg := DT_LEFT;
'C': AlignFlg := DT_CENTER;
'R': AlignFlg := DT_RIGHT;
end;
end
else
Str := Str + P^;
Inc(P);
end;
if Str <> '' then
begin
DrawText(Printer.Canvas.Handle, PChar(Str), Length(Str), ARect, Flgs or AlignFlg);
Str := '';
end;
end;
{ DrawHeaderFooter End}
{ DrawHeader Begin}
procedure DrawHeader(APage: Integer);
begin
DrawHeaderFooter(HeaderStr, HeaderRect, DT_TOP, APage);
end;
{ DrawHeader End}
{ DrawFooter Begin}
procedure DrawFooter(APage: Integer);
begin
DrawHeaderFooter(FooterStr, FooterRect, DT_BOTTOM, APage);
end;
{ DrawFooter End}
begin
if not PrintDialog1.Execute then
Exit;
// プリンタの DPI
X_DPI := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
Y_DPI := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
// 用紙の幅と高さ
PAPER_WIDTH := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH );
PAPER_HEIGHT := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
// 印刷領域
PrintRect.Top := Trunc(PageSetupDialog1.MarginTop / 2540 * Y_DPI);
PrintRect.Left := Trunc(PageSetupDialog1.MarginLeft / 2540 * X_DPI);
PrintRect.Bottom := PAPER_HEIGHT - Trunc(PageSetupDialog1.MarginBottom / 2540 * Y_DPI);
PrintRect.Right := PAPER_WIDTH - Trunc(PageSetupDialog1.MarginRight / 2540 * X_DPI);
// 印刷
Printer.Title := GetTextFileName;
Printer.BeginDoc;
SetBkMode(Printer.Canvas.Handle, TRANSPARENT);
Printer.Canvas.Font.Assign(Memo1.Font); // Memo1 のフォントを Canvas に割り当て
Text := 'A';
CalcRect := Rect(0, 0, Printer.PageWidth, 0);
DrawText(Printer.Canvas.Handle, PChar(Text), Length(Text), CalcRect, CALC_FLG);
MIN_HEIGHT := CalcRect.Bottom;
if HeaderStr <> '' then
begin
HeaderRect := PrintRect;
HeaderRect.Bottom := PrintRect.Top + MIN_HEIGHT * 2;
PrintRect.Top := HeaderRect.Bottom;
end;
if FooterStr <> '' then
begin
FooterRect := PrintRect;
FooterRect.Top := PrintRect.Bottom - MIN_HEIGHT * 2;
PrintRect.Bottom := FooterRect.Top;
end;
PAGE_HEIGHT := PrintRect.Bottom - PrintRect.Top;
SetLength(Pages, 1);
SL := TStringList.Create;
try
SL.Text := Memo1.Lines.Text;
// ページ数の計算
LineCount := 0;
Sum := 0;
for i:=0 to SL.Count-1 do
begin
Text := SL[i];
CalcRect := PrintRect;
CalcRect.Top := 0;
CalcRect.Bottom := 0;
DrawText(Printer.Canvas.Handle, PChar(Text), Length(Text), CalcRect, CALC_FLG);
TextHeight := Max(MIN_HEIGHT, CalcRect.Bottom);
if (Sum + TextHeight) > PAGE_HEIGHT then
begin
Pages[Length(Pages)-1] := LineCount;
SetLength(Pages, Length(Pages) + 1);
LineCount := 0;
Sum := 0;
end;
Inc(LineCount);
Inc(Sum, TextHeight);
end;
LineCount := SL.Count;
for i:=0 to Length(Pages) - 2 do
Dec(LineCount, Pages[i]);
Pages[Length(Pages)-1] := LineCount;
// 印刷
if PrintDialog1.Collate then
Copies := PrintDialog1.Copies // 部単位で印刷
else
Copies := 1;
for j:=1 to Copies do
begin
CalcRect := PrintRect;
Index := 0;
for l:=0 to Length(Pages) - 1 do
begin
// ヘッダ
DrawHeader(l+1);
// テキスト
CalcRect.Top := PrintRect.Top;
for i:=0 to Pages[l] - 1 do
begin
CalcRect2 := PrintRect;
CalcRect2.Top := 0;
CalcRect2.Bottom := 0;
Text := SL[Index];
DrawText(Printer.Canvas.Handle, PChar(Text), Length(Text), CalcRect2, CALC_FLG);
TextHeight := Max(MIN_HEIGHT, CalcRect2.Bottom);
DrawText(Printer.Canvas.Handle, PChar(Text), Length(Text), CalcRect, DRAW_FLG);
CalcRect.Top := CalcRect.Top + TextHeight;
Inc(Index);
end;
// フッタ
DrawFooter(l+1);
// 改ページ
if (l <> (Length(Pages) - 1)) or (J <> Copies) then
Printer.NewPage;
end;
end;
finally
SL.Free;
end;
Printer.EndDoc;
end;
procedure TForm1.SaveFile;
begin
// エンコーディングを指定して保存
Memo1.Lines.SaveToFile(FFileName, GetEditorEncoding);
end;
procedure TForm1.UpdateCaption;
// キャプション (ファイル名) の更新
begin
Self.Caption := GetTextFileName + ' - ' + Application.Title;
end;
end.
[行へ移動] ダイアログ
unit frmuGotoLine;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.UITypes;
type
TForm2 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private 宣言 }
FGotoLine: Integer;
FLineCount: Integer;
procedure SetGotoLine(Value: Integer);
public
{ Public 宣言 }
property GotoLine: Integer read FGotoLine write SetGotoLine;
property LineCount: Integer read FLineCount write FLineCount;
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.SetGotoLine(Value: Integer);
// SetGotoLine プロパティのセッター
begin
FGotoLine := Value;
Edit1.Text := FGotoLine.ToString;
end;
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
// フォーム修了確認時
var
dGoToLine: Integer;
begin
// mrOK でないボタンが押された場合には処理しない
if ModalResult <> mrOK then
begin
CanClose := True;
Exit;
end;
dGoToLine := StrToInt(Edit1.Text);
CanClose := (dGoToLine > 0) and (dGoToLine <= LineCount);
if CanClose then
begin
// 移動可能
FGotoLine := dGoToLine;
end
else
begin
// 移動不可
MessageDlg('指定した行番号は行の総数を超えています', TMsgDlgType.mtCustom, [TMsgDlgBtn.mbOK], -1);
GotoLine := FGotoLine;
Edit1.SelectAll;
Edit1.SetFocus;
end;
end;
end.
[ヘッダーとフッター] ダイアログ
unit frmuHeaderFooter;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm3 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
end.