Go to Qiita Advent Calendar 2024 Top
LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@ht_deko(Hideaki Tominaga)

Delphi Starter Edition でメモ帳クローンを作る - 2nd Edition - [表示(V)]

Last updated at Posted at 2017-12-15

// これは...

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

[表示(V)]

まずは ActionList にアクションを追加しましょう。

image.png

カテゴリが [View] になっている事に注意してください。

Action (Name) Caption Category ShortCut
acStatusBar ステータスバー(&S) View

登録するとこうなります。

image.png

次に MainMenu1 のコンポーネントエディタを開き、[書式(O)] の右横を選択します。

image.png

オブジェクトインスペクタで Caption プロパティに 表示(&V) と入力します。

image.png

[表示(V)] メニューができました。

image.png

今度は MainMenu1 のコンポーネントエディタで [表示(V)] メニューの下をクリックして、Format のアクションを割り当てていきます。

image.png

こんな感じです。

image.png

以下、実装となります。

[ステータスバー(S)]

このメニューは、

  • チェックが入っていればステータスバーを表示する。
  • ステータスバーには現在の桁と行位置を表示する。
  • [右側で折り返す(W)] にチェックが入っていればステータスバーを無効にする。

という処理を行う必要があります。

まずはステータスバーを追加しましょう。TStatusbar はツールパレットの [Win32] タブにあります。

image.png

TStatusbar (Statusbar1) を追加すると、メインフォームの下部にステータスバーが表示されます。

image.png

このステータスバーをダブルクリックすると、ステータスバーにパネルを追加できます。左上のボタンでパネルを２つ追加してください。ボタンを２回押すだけです。

image.png

このようにパネルが追加されます。このパネルには Statusbar1.Panels[n] でアクセスできます。

image.png

次にオブジェクトインスペクタで Statusbar1 のリサイズイベントをダブルクリックします。

image.png

Statusbar1.Panels[0] と Statusbar1.Panels[1] はクライアント幅の 75%:25% となるようなので、リサイズに合わせてパネル幅を変化させるようなコードを記述します。

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

行と列を表示するロジックは以下のようになります。

frmuMain.pas
  private
    { Private 宣言 }
    FFileName: String;
    FEncodingIndex: Integer;
    procedure DispRowCol;    // <-- 追加
    procedure Init;
    procedure SaveFile;
    procedure UpdateCaption;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

(中略)

...

// メソッド

procedure TForm1.DispRowCol;
var
  Row, Col: Integer;
begin
  // ステータスバーに行/列を表示
  Row := Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
  Col := Memo1. SelStart -  Memo1.Perform(EM_LINEINDEX, WPARAM(ROW), 0);
  StatusBar1.Panels[1].Text := Format(' %d行、%d列' , [Row + 1, Col + 1]);
end;

このメソッドをキーが押された時、またはマウスでクリックされた時に呼び出します。まずは Memo1 の onClick イベントです。

image.png

frmuMain.pas
procedure TForm1.Memo1Click(Sender: TObject);
// Memo1 クリック時
begin
  DispRowCol;
end;

同様に Memo1 の onKeyUp イベントです。

image.png

frmuMain.pas
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
// Memo1 キーアップ時
begin
  DispRowCol;
end;

Init() メソッドにも追記しておきます。

frmuMain.pas
procedure TForm1.Init;
// エディタの初期化
begin
 // 値を初期化
  FFileName := '';
  FEncodingIndex := 0;
  Memo1.Lines.Clear; // Memo1 の中身を消去する。
  // キャプションを変更
  UpdateCaption;
  // 行/列の表示
  DispRowCol;
end;

acStatusBar アクションのイベントハンドラを作ります。

image.png

イベントハンドラの実装は以下のようになります。StatusBar1.Visible の状態をトグルさせます。

frmuMain.pas
procedure TForm1.acStatusBarExecute(Sender: TObject);
// Action: [ステータスバー(S)]
begin
  StatusBar1.Visible := not StatusBar1.Visible;
end;

[ステータスバー(S)] の有効無効を [書式(O) | 右側で折り返す(W)] のチェック状態に合わせるには以下のようなコードを記述します。

frmuGotoLine.pas
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
  (中略)

  // [ステータスバー(S)] の有効/無効
  acStatusBar.Enabled := not Memo1.WordWrap;
  // [ステータスバー(S)] のチェック状態
  acStatusBar.Checked := StatusBar1.Visible;
end;

[書式(O) | 右側で折り返す(W)] がチェックされたらステータスバーを非表示にするよう、acWordwrapExecute() イベントハンドラに追記します。

frmuGotoLine.pas
procedure TForm1.acWordwrapExecute(Sender: TObject);
// Action: [右側で折り返す(W)]
const
  SB: array [Boolean] of TScrollStyle = (ssBoth, ssVertical);
begin
  Memo1.WordWrap := not Memo1.WordWrap;
  Memo1.ScrollBars := SB[Memo1.WordWrap];
  if Memo1.WordWrap then         // <-- 追加
    StatusBar1.Visible := False; // <-- 追加
end;

メモ帳ではステータスバーはデフォルトでオフなので、StatusBar1 の Visible プロパティを False にしておきます。

image.png

〔Alt〕,〔V〕,〔S〕で [ステータスバー(S)] が実行される事を確認してください。

// 戻る

だんだんそれっぽくなってきましたね。

image.png

今回はここまでです。ここまでの全ソースを掲載しておきます。

[メインフォーム]

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;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    MainMenu1: TMainMenu;
    ActionList1: TActionList;
    acNew: TAction;
    acOpen: TAction;
    acSave: TAction;
    acSaveAs: TAction;
    acPageSetup: TAction;
    acPrint: TAction;
    acExit: TAction;
    F1: TMenuItem;
    N1: TMenuItem;
    O1: TMenuItem;
    S1: TMenuItem;
    A1: TMenuItem;
    U1: TMenuItem;
    P1: TMenuItem;
    X1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    OpenTextFileDialog1: TOpenTextFileDialog;
    SaveTextFileDialog1: TSaveTextFileDialog;
    acUndo: TAction;
    acCut: TAction;
    acCopy: TAction;
    acPaste: TAction;
    acDelete: TAction;
    acFind: TAction;
    acFindNext: TAction;
    acReplace: TAction;
    acGoTo: TAction;
    acSelectAll: TAction;
    acTimeDate: TAction;
    E1: TMenuItem;
    U2: TMenuItem;
    N4: TMenuItem;
    C1: TMenuItem;
    T1: TMenuItem;
    P2: TMenuItem;
    L1: TMenuItem;
    N5: TMenuItem;
    F2: TMenuItem;
    N6: TMenuItem;
    R1: TMenuItem;
    G1: TMenuItem;
    N7: TMenuItem;
    A2: TMenuItem;
    D1: TMenuItem;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    acWordwrap: TAction;
    acFont: TAction;
    O2: TMenuItem;
    W1: TMenuItem;
    F3: TMenuItem;
    FontDialog1: TFontDialog;
    acStatusBar: TAction;
    N8: TMenuItem;
    S2: TMenuItem;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure acExitExecute(Sender: TObject);
    procedure acOpenExecute(Sender: TObject);
    procedure acSaveExecute(Sender: TObject);
    procedure acSaveAsExecute(Sender: TObject);
    procedure acNewExecute(Sender: TObject);
    procedure acUndoExecute(Sender: TObject);
    procedure ActionList1Update(Action: TBasicAction; var Handled: Boolean);
    procedure acCutExecute(Sender: TObject);
    procedure acCopyExecute(Sender: TObject);
    procedure acPasteExecute(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure acFindExecute(Sender: TObject);
    procedure Dialog_Find(Sender: TObject);
    procedure acFindNextExecute(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acReplaceExecute(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure acGoToExecute(Sender: TObject);
    procedure acSelectAllExecute(Sender: TObject);
    procedure acTimeDateExecute(Sender: TObject);
    procedure acWordwrapExecute(Sender: TObject);
    procedure acFontExecute(Sender: TObject);
    procedure StatusBar1Resize(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure acStatusBarExecute(Sender: TObject);
  private
    { Private 宣言 }
    FFileName: String;
    FEncodingIndex: Integer;
    procedure DispRowCol;
    procedure Init;
    procedure SaveFile;
    procedure UpdateCaption;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  frmuGotoLine;

procedure TForm1.FormCreate(Sender: TObject);
// フォーム作成時
begin
  Init;
end;

procedure TForm1.StatusBar1Resize(Sender: TObject);
// ステータスバーのリサイズ
begin
  StatusBar1.Panels[1].Width := StatusBar1.Width div 4;
  StatusBar1.Panels[0].Width := StatusBar1.Width - StatusBar1.Panels[1].Width;
end;

procedure TForm1.Memo1Click(Sender: TObject);
// Memo1 クリック時
begin
  DispRowCol;
end;


procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
// Memo1 キーアップ時
begin
  DispRowCol;
end;

// [FILE] Actions

procedure TForm1.acNewExecute(Sender: TObject);
// Action: 新規(N)
begin
  Init;
end;

procedure TForm1.acOpenExecute(Sender: TObject);
// Action: 開く(O)...
var
  Enc: TEncoding;
begin
  if OpenTextFileDialog1.Execute then
    begin
      // 値を保存
      FFileName := OpenTextFileDialog1.FileName;
      FEncodingIndex := OpenTextFileDialog1.EncodingIndex;
      // キャプションを変更
      UpdateCaption;
      // EncodingIndex によりエンコーディングを指定
      case FEncodingIndex of
        1: Enc := TEncoding.Unicode;
        2: Enc := TEncoding.BigEndianUnicode;
        3: Enc := TEncoding.UTF8;
      else
        Enc := TEncoding.Default;
      end;
      // エンコーディングを指定して読み込み
      Memo1.Lines.LoadFromFile(FFileName, Enc);
    end;
end;

procedure TForm1.acSaveExecute(Sender: TObject);
// Action: 上書き保存(S)
begin
  if (FFileName = '') then
    begin
      // 名前を付けて保存
      acSaveAs.Execute;
    end
  else
    begin
      // 上書き保存
      SaveFile;
    end;
end;

procedure TForm1.acSaveAsExecute(Sender: TObject);
// Action: 名前を付けて保存(A)...
begin
  if SaveTextFileDialog1.Execute then
    begin
      // 値を保存
      FFileName := SaveTextFileDialog1.FileName;
      FEncodingIndex := SaveTextFileDialog1.EncodingIndex;
      // キャプションを変更
      UpdateCaption;
      // ファイルへ保存
      SaveFile;
    end;
end;

procedure TForm1.acExitExecute(Sender: TObject);
// Action: メモ帳の終了(X)
begin
  Self.Close;
end;

// [EDIT] Actions

procedure TForm1.E1Click(Sender: TObject);
begin
  acDelete.ShortCut := TextToShortCut('Del');
end;

procedure TForm1.acUndoExecute(Sender: TObject);
// Action: 元に戻す(U)
begin
  Memo1.Undo;
end;

procedure TForm1.acCutExecute(Sender: TObject);
// Action: 切り取り(T)
begin
  Memo1.CutToClipboard;
end;

procedure TForm1.acCopyExecute(Sender: TObject);
// Action: コピー(C)
begin
  Memo1.CopyToClipboard;
end;

procedure TForm1.acPasteExecute(Sender: TObject);
// Action: 貼り付け(P)
begin
  Memo1.PasteFromClipboard;
end;

procedure TForm1.acDeleteExecute(Sender: TObject);
// Action: 削除(L)
begin
  Memo1.ClearSelection;
end;

procedure TForm1.acFindExecute(Sender: TObject);
// Action: 検索(F)
begin
  // 検索ダイアログを開く
  FindDialog1.Execute;
end;

procedure TForm1.acFindNextExecute(Sender: TObject);
// Action: 次を検索(N)
begin
  if FindDialog1.FindText = '' then
    acFind.Execute
  else
    Dialog_Find(FindDialog1);
end;

procedure TForm1.acReplaceExecute(Sender: TObject);
// Action: 置換(H)
begin
  // 置換ダイアログを開く
  ReplaceDialog1.Execute;
end;

procedure TForm1.Dialog_Find(Sender: TObject);
// 検索イベントハンドラ
var
  RegEx: TRegEx;
  Exp, Msg: String;
  Options: TRegExOptions;
  Match, dMatch: TMatch;
  StartPos, EndPos: Integer;
begin
  // 検索文字列を正規表現文字列へエスケープ
  Exp := TRegEx.Escape(FindDialog1.FindText);

  // "大文字と小文字を区別する" にチェックが入っていなければ
  // オプションに roIgnoreCase (大文字小文字を区別しない) を追加
  if not (frMatchCase in FindDialog1.Options) then
    Include(Options, roIgnoreCase);

  // 正規表現オブジェクトの生成
  RegEx := TRegEx.Create(Exp, Options);

  if (frDown in FindDialog1.Options) then
    begin
      // 順方向検索 (下へ)
      StartPos  := Memo1.SelStart + Memo1.SelLength + 1;
      Match := RegEx.Match(Memo1.Lines.Text, StartPos);
    end
  else
    begin
      // 逆方向検索 (上へ)
      StartPos := 0;
      EndPos   := Memo1.SelStart + 1;
      Match := RegEx.Match(Memo1.Lines.Text, StartPos, EndPos);
      while Match.Success do
        begin
          // 最後にマッチした箇所を探す
          dMatch := Match.NextMatch;
          if dMatch.Success then
            Match := dMatch
          else
            break;
        end;
    end;

  // 検索文字列を共有
  FindDialog1.FindText := (Sender as TFindDialog).FindText;
  ReplaceDialog1.FindText := (Sender as TFindDialog).FindText;

  // 検索文字列を正規表現文字列へエスケープ
  Exp := TRegEx.Escape((Sender as TFindDialog).FindText);

  // "大文字と小文字を区別する" にチェックが入っていなければ
  // オプションに roIgnoreCase (大文字小文字を区別しない) を追加
  if not (frMatchCase in (Sender as TFindDialog).Options) then
    Include(Options, roIgnoreCase);

  // 正規表現オブジェクトの生成
  RegEx := TRegEx.Create(Exp, Options);
  if (frDown in (Sender as TFindDialog).Options) then
    begin
      // 順方向検索 (下へ)
      StartPos  := Memo1.SelStart + Memo1.SelLength + 1;
      Match := RegEx.Match(Memo1.Lines.Text, StartPos);
    end
  else
    begin
      // 逆方向検索 (上へ)
      StartPos := 0;
      EndPos   := Memo1.SelStart + 1;
      Match := RegEx.Match(Memo1.Lines.Text, StartPos, EndPos);
      while Match.Success do
        begin
          // 最後にマッチした箇所を探す
          dMatch := Match.NextMatch;
          if dMatch.Success then
            Match := dMatch
          else
            break;
        end;
    end;

  if Match.Success then
    begin
      // 一致する文字列があった
      SetFocus;
      Memo1.SelStart := Match.Index - 1;
      Memo1.SelLength := Match.Length;
    end
  else
    begin
      // 一致する文字列がなかった
      Msg := Format('"%s" が見つかりません。', [(Sender as TFindDialog).FindText]);
      MessageDlg(Msg, TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], -1);
    end;
end;

procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
// 置換イベントハンドラ
var
  srFlgs: TReplaceFlags;
  FindText: string;
  SelectFlg: Boolean;
begin
  // 検索文字列を共有
  FindDialog1.FindText := (Sender as TFindDialog).FindText;
  ReplaceDialog1.FindText := (Sender as TFindDialog).FindText;

  // フラグ
  if (frReplaceAll in ReplaceDialog1.Options) then
    begin
      // [すべて置換]
      srFlgs := [rfReplaceAll]; // すべて置換
      if  not (frMatchCase in ReplaceDialog1.Options) then
        Include(srFlgs, rfIgnoreCase);
      Memo1.Lines.Text := StringReplace(Memo1.Lines.Text, ReplaceDialog1.FindText, ReplaceDialog1.ReplaceText, srFlgs);
    end
  else
    begin
      // [置換して次へ]
      srFlgs := []; // 最初の一回だけ置換
      if  not (frMatchCase in ReplaceDialog1.Options) then
        Include(srFlgs, rfIgnoreCase);
      // 検索済みかどうかの判定
      FindText := (Sender as TFindDialog).FindText;
      if (frMatchCase in ReplaceDialog1.Options) then
        SelectFlg := SameStr(Memo1.SelText, FindText)   // 大文字小文字を区別する
      else
        SelectFlg := SameText(Memo1.SelText, FindText); // 大文字小文字を区別しない
      // 検索済みか？
      if SelectFlg then
        Memo1.SelText := ReplaceDialog1.ReplaceText;
      // 検索
      Dialog_Find(ReplaceDialog1);
    end;
end;

procedure TForm1.acGoToExecute(Sender: TObject);
// Action: 行へ移動(G)
begin
  Form2 := TForm2.Create(Self);
  try
    // 現在行と最大行を Form2 に渡す
    Form2.GotoLine := Memo1.Perform(EM_LINEFROMCHAR, WPARAM(-1), 0) + 1; // 0 オリジンなので + 1 する
    Form2.LineCount := Memo1.Perform(EM_GETLINECOUNT, 0, 0);
    // Form2 をモーダルで表示
    if Form2.ShowModal = mrOK then
      begin
        // [OK] ボタンが押されたら
        Memo1.SelLength := 0;
        Memo1.SelStart := Memo1.Perform(EM_LINEINDEX, Form2.GotoLine - 1, 0);
        Memo1.Perform(EM_SCROLLCARET,0 , 0);
      end;
  finally
    Form2.Free;
  end;
end;

procedure TForm1.acSelectAllExecute(Sender: TObject);
// Action: すべて選択(A)
begin
  Memo1.SelectAll;
end;

procedure TForm1.acTimeDateExecute(Sender: TObject);
// Action: 日付と時刻(D)
begin
  Memo1.SelText := FormatDateTime('hh:nn yyyy/mm/dd', Now);
end;

procedure TForm1.acWordwrapExecute(Sender: TObject);
// Action: [右側で折り返す(W)]
const
  SB: array [Boolean] of TScrollStyle = (ssBoth, ssVertical);
begin
  Memo1.WordWrap := not Memo1.WordWrap;
  Memo1.ScrollBars := SB[Memo1.WordWrap];
  if Memo1.WordWrap then         // <-- 追加
    StatusBar1.Visible := False; // <-- 追加
end;

procedure TForm1.acFontExecute(Sender: TObject);
// Action: [フォント(F)...]
begin
  FontDialog1.Font := Memo1.Font;   // Memo1 のフォントをコピー
  if FontDialog1.Execute then
    Memo1.Font := FontDialog1.Font; // FontDialog1 のフォントをコピー
end;

procedure TForm1.acStatusBarExecute(Sender: TObject);
// Action: [ステータスバー(S)]
begin
  StatusBar1.Visible := not StatusBar1.Visible;
end;

// リスト更新

procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
  // [元に戻す(U)] の有効/無効
  acUndo.Enabled := Memo1.CanUndo;
  // [切り取り(T)] の有効/無効
  acCut.Enabled := Memo1.SelLength <> 0;
  // [コピー(C)] の有効/無効
  acCopy.Enabled := Memo1.SelLength <> 0;
  // [貼り付け(P)] の有効/無効
  acPaste.Enabled := ClipBoard.HasFormat(CF_TEXT);
  // [削除(L)] の有効/無効
  acDelete.Enabled := Memo1.SelLength <> 0;
  acDelete.ShortCut := 0;
  // [検索(F)] の有効/無効
  acFind.Enabled := Memo1.Lines.Text.Length > 0;
  // [次を検索(N)] の有効/無効
  acFindNext.Enabled := Memo1.Lines.Text.Length > 0;
  // [右側で折り返す(W)] のチェック状態
  acWordwrap.Checked := Memo1.WordWrap;
  // [行へ移動(&G)] の有効/無効
  acGoTo.Enabled := not Memo1.WordWrap;
  // [ステータスバー(S)] の有効/無効
  acStatusBar.Enabled := not Memo1.WordWrap;
  // [ステータスバー(S)] のチェック状態
  acStatusBar.Checked := StatusBar1.Visible;
end;

// メソッド

procedure TForm1.DispRowCol;
var
  Row, Col: Integer;
begin
  // ステータスバーに行/列を表示
  Row := Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
  Col := Memo1. SelStart -  Memo1.Perform(EM_LINEINDEX, WPARAM(ROW), 0);
  StatusBar1.Panels[1].Text := Format(' %d行、%d列' , [Row + 1, Col + 1]);
end;

procedure TForm1.Init;
// エディタの初期化
begin
 // 値を初期化
  FFileName := '';
  FEncodingIndex := 0;
  Memo1.Lines.Clear; // Memo1 の中身を消去する。
  // キャプションを変更
  UpdateCaption;
  // 行/列の表示
  DispRowCol;
end;

procedure TForm1.SaveFile;
var
  Enc: TEncoding;
begin
  // EncodingIndex によりエンコーディングを指定
  case FEncodingIndex of
    1: Enc := TEncoding.Unicode;
    2: Enc := TEncoding.BigEndianUnicode;
    3: Enc := TEncoding.UTF8;
  else
    Enc := TEncoding.Default;
  end;
  // エンコーディングを指定して保存
  Memo1.Lines.SaveToFile(FFileName, Enc);
end;

procedure TForm1.UpdateCaption;
// キャプション (ファイル名) の更新
var
  Dmy: String;
begin
  if FFileName = '' then
    Dmy := '無題'
  else
    Dmy := TPath.GetFileName(FFileName);
  Self.Caption := Dmy + ' - メモ帳クローン';
end;

end.

[行へ移動] ダイアログ
(変更ありません)

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

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

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?