LoginSignup
0
0
@ht_deko(Hideaki Tominaga)

Delphi Starter Edition でメモ帳クローンを作る - 2nd Edition - その他の機能

Last updated at Posted at 2017-12-15

// これは...

これは Delphi Advent Calendar 2017 15 日目の記事です。
長くなってしまったので機能単位で分割しています。

その他の機能

重箱の隅をつついてみます。

リファクタリング

まずは重複するコードがありますのでまとめます。

[編集中のファイル名を返すメソッド]

編集中のファイル名を返すメソッドを作ります。

frmuMain.pas
  (前略)
  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' の条件の所)。

frmuMain.pas
  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() 内も書き換えます。

frmuMain.pas
procedure TForm1.UpdateCaption;
// キャプション (ファイル名) の更新
begin
  Self.Caption := GetTextFileName + ' - メモ帳クローン';
end;

PrintText() 内も書き換えておきましょう。

frmuMain.pas
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 に割り当て

こうしておくと印刷時のジョブ表示にファイル名が表示されるようになって便利です。

image.png

[編集中のファイルのエンコーディングを返すメソッド]

編集中のファイルのエンコーディング (TEncoding) を返すメソッドを作ります。

frmuMain.pas
  (前略)
  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() イバントハンドラを書き換えます。

frmuMain.pas
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() メソッドも書き換えます。

frmuMain.pas
procedure TForm1.SaveFile;
begin
  // エンコーディングを指定して保存
  Memo1.Lines.SaveToFile(FFileName, GetEditorEncoding); // <-- 変更
end;

[アプリケーションのタイトル]

[プロジェクト | オプション] でプロジェクトオプションを開き、[アプリケーション | 表示] で [タイトル (T):] に "メモ帳クローン" と入力します。このタイトルはコード中から Application.Title として参照できます。逆にコードで Application.Title を設定することも可能です。

image.png

acAboutExecute() イベントハンドラを書き換えます。

frmuMain.pas
procedure TForm1.acAboutExecute(Sender: TObject);
// Action: [バージョン情報(A)]
begin
  ShellAbout(Self.Handle, PChar(Application.Title), '', Application.Icon.Handle); // <-- 変更
end;

UpdateCaption() 内も書き換えます。

frmuMain.pas
procedure TForm1.UpdateCaption;
// キャプション (ファイル名) の更新
begin
  Self.Caption := GetTextFileName + ' - ' + Application.Title; // <-- 変更
end;

ドラッグ＆ドロップ

メモ帳にファイルをドラッグ＆ドロップすると以下の挙動になります。

  • [ファイル(F) | 開く(O)] と同じ挙動になる。
  • 複数ドロップされても一つしか処理しない。
  • 但し、エンコーディングは自動判別する。

エンコーディングの自動判別が地味に面倒なのですが、ANSI / UTF-16LE / UTF-16BE / UTF-8 の４つを区別すればいいのでそんなに難しくはありません。

  1. ファイルの先頭が 0xFE, 0xFF で始まれば UTF-16LE
  2. ファイルの先頭が 0xFF, 0xFE で始まれば UTF-16BE
  3. ファイルの先頭が 0xEF, 0xBB, 0xBF で始まれば UTF-8 (with BOM)

[ファイルの内容からエンコーディングを判定するメソッド]

とりあえず先頭の BOM を調べて、その後はちょっと説明が面倒なのでコードで書きます。

frmuMain.pas
  (前略)
  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 メッセージを処理する**メッセージメソッド (メッセージハンドラ)**を記述します。

frmuMain.pas
  (前略)
  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 を指定しているのでフォーム全体がドロップ受け入れ対象となります。

frmuMain.pas
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 イベントで処理する事にします。

image.png

この OnShow イベントはフォーム表示時のイベントですが、OnCreate イベントとは異なり一度だけ呼ばれるとは限りません。なので、OnShow のイベントハンドラ (FormShow) を一度しか処理したくないのであれば、以下のようにイベントハンドラの先頭で OnShow イベントとの関連付けを解除してやります。こうすれば FormShow は一度しか実行されません。

frmuMain.pas
procedure TForm1.FormShow(Sender: TObject);
// フォーム表示時
begin
  Self.OnShow := nil;

  // 処理
end;

ここの処理ですが、Init() メソッドをちょっと変更すると便利そうです。

frmuMain.pas

  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() イベントハンドラは以下のようなコードになりました。

frmuMain.pas
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 イベントが処理され、メッセージキューが処理できる状態になるとフォームが閉じられます。

この機能のテストはコマンドプロンプトで試してもいいのですが、[実行 | 実行時引数] のパラメータに文字列を設定する事でも行えます。

image.png

テストが終わったら忘れずに外しておきましょう。

ファイルダイアログの初期値

現在のファイルのエンコーディングをファイルダイアログにも反映するようにしましょう。

frmuMain.pas
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;

保存ダイアログの時はファイル名も渡すようにします。

frmuMain.pas
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] です。

image.png

主要なものはこれくらいでしょうか？

名前 型 説明
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 を追加します。

frmuMain.pas
unit frmuMain;

interface

uses
  ..., System.Win.Registry; // <-- 追加

現状、マージンだけをどうにかすればよさそうですね。マージンを格納するフィールドを追加しておきます。

frmuMain.pas
  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 イベントハンドラで行います。

frmuMain.pas
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', 'ＭＳ ゴシック');
    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() メソッドの３番目のパラメータはレジストリのキーが存在しない場合に読み込まれるデフォルト値です。コードではフォームをスクリーンの中央に表示させたりしています。

FormCreate() で FHeaderStr / FFooterStr の初期値を設定していましたね。これは削除します。

frmuMain.pas
procedure TForm1.FormCreate(Sender: TObject);
// フォーム作成時
begin
  Init;
  DragAcceptFiles(Self.Handle, True);
end;

ヘッダー/フッターの部分は大丈夫なので、マージンの処理を追加します。

frmuMain.pas
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 イベントあたりが妥当でしょうか。

image.png

frmuMain.pas
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] を確認してみてください。

image.png

なお、System.IniFiles を uses に加えると、TIniFile クラスまたはTMemIniFile クラスで INI ファイルが扱えます。

エクステンド！

ここからは本筋とは関係ない余興となります。

[VCL スタイル]

今更ですが、メモ帳ってなんだか画面が地味ですよね...。

image.png

さて、最近の Delphi には VCL スタイル というものがあります。[プロジェクト | オプション] を開いてみてください。そして Carbon にチェックを入れ、[デフォルトスタイル] も Carbon にします。

image.png

このままコンパイルして実行すると...

image.png

はい、これが VCL スタイルです。複数のスタイルをリソースとして埋め込み、それをコードで切り替える事も可能です。

[ジェスチャ]

既にお気付きかもしれないのですけれど、例えば [開く(O)...] の機能は、TActionList に TAction を作って TMenuItem にアクションを割り当てる...なんて事をしなくとも、TMenuItem をダブルクリックして TMenuItem.OnClick イベントに直接処理を書く事ができます。

TActionList　を使うのは、機能と GUI がごっちゃになって把握しにくくなる事を防ぐ意味合いがあります。それと今回は使いませんでしたが TPopUpMenu にもTMainMenu と同じ処理を割り当てたい...つまり、複数の場所から同じ機能を呼び出したい場合には TAction でまとめると便利です。有効/無効も一発で切り替えられますしね。

それとは別のメリットもあります。

フォームに TGestureManager (GestureManager1) を貼ります。TGestureManager はツールパレットの [Gestures] タブにあります。

image.png

貼ったら、Memo1 の Touch.GestureManager に GestureManager1 を指定します。

image.png

Touch.Gestures.Standard を展開するとこうなります。

image.png

DownLight にチェックを入れて、

image.png

acGoTo を割り当てます。

image.png

メモ帳クローンをコンパイルして実行したら、メモの上でこのようにマウスジェスチャしてみてください。

image.png

acGoTo...つまり [行へ移動] のアクションが実行されたと思います。これがジェスチャ機能です。

image.png

Touch.Gestures.Standard にはよくあるジェスチャが並んでおり、これに機能 (TAction) を割り当てることでジェスチャを実現しています。ですが、これが Standard って事は Standard でない機能もあるという事です。Touch.Gestures をダブルクリックするか […] ボタンを押してみてください。

image.png

するとさっきの Standard ジェスチャを選択するリストが出てきました。

image.png

左上のボタンを押してみましょう。

image.png

カスタムジェスチャが作れるのです。

image.png

カスタムジェスチャ作成画面の操作方法についてはドキュメントを参照してください。また、カスタムジェスチャ作成画面は、フォームデザイナ上の GestureManager1 をダブルクリックする事でも起動できます。

-［カスタム ジェスチャ デザイナ］(DocWiki)

image.png

Touch.Gestures.Custom で自分が作ったカスタムジェスチャを割り当てられます。

image.png

あんまり複雑なジェスチャは再現するのが大変なので程々に...(w

このように TAction で機能を管理していると、ジェスチャ機能に対応するのがとても簡単になるというメリットもあります。

// 戻る

さて一通りの実装が終わりました。細かい事を言えば足りない部分もあるのですが、ここまでの話を理解したのであればさらなる改良はそんなに難しくはないと思います。

[メインフォーム]

frmuMain.pas
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', 'ＭＳ ゴシック');
    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.

[行へ移動] ダイアログ

frmuGotoLine.pas
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.

[ヘッダーとフッター] ダイアログ

frmuHeaderFooter.pas
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.

[前の記事へ] [親記事へ] [次の記事へ]

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0