第１２章 エディットとメモ

Delphi の TEdit クラスと TMemo クラスは、Win32 の EDIT コントロールの機能をカプセル化したものである｡ このクラスの特徴は､ ユーザーから１行の、あるいは複数行のテキスト文字列を受け取ったり､ それを編集できることだ。 複数行の EDIT コントロールは、それだけで簡単なエディタを実現できるほど高度な機能を持っている｡ この章では､ EDIT コントロールの機能をカプセル化して、ＶＣＬの TEdit と TMemo に相当するクラスを作って、ＡＰＩの機能を調べることにする｡

１２−０ この章の内容

第１２章 エディットとメモ
１２−１ エディットをコードでつくる
１２−２ メモをコードでつくる
１２−３ TAPIEdit クラス
１２−４ TAPIMemo クラス
１２−５ 極私的ＨＴＭＬエディタ
１２−６ まとめ


| arrw18c.gif 前の章へ | 総目次へ | 次の章へ arrw18d.gif ｜

１２−１ エディットをコードでつくる

一行の EDIT コントロールは、ＶＣＬの TEdit に相当する｡ これは、CreateWindow( ) の第一パラメータに定義済みのクラスである 'EDIT' を指定して作られる子ウィンドウである｡ EDIT クラスのウィンドウスタイルに指定できるものは、windows.pas に以下のように定義されている｡

const
  { Edit Control Styles }
  ES_LEFT = 0; 		// テキストを左揃えする。デフォルト。
  ES_CENTER = 1;		// テキストを水平方向で中央に表示する。
  ES_RIGHT = 2;		// テキストを右揃えする。
  ES_MULTILINE = 4;	// 複数行エディットを作成する。
  ES_UPPERCASE = 8;	// 入力文字を大文字にする。
  ES_LOWERCASE = $10;	// 入力文字を小文字にする。
  ES_PASSWORD = $20;	// 入力文字をデフォルトでは * にして表示する。
  ES_AUTOVSCROLL = $40;	// 最後の行で自動的に垂直スクロールをする。
  ES_AUTOHSCROLL = $80;	// 入力範囲を越えたら自動的に水平スクロールする。
  ES_NOHIDESEL = $100;	// フォーカスを失っても選択範囲を表示する。
  ES_OEMCONVERT = $400; // 入力文字を ＯＥＭ文字セットに変換する。
  ES_READONLY = $800;	// 読みとり専用にする｡ 選択してコピーはできる。
  ES_WANTRETURN = $1000;// 複数行エディットで Enter キーで改行する。
  ES_NUMBER = $2000;	// 数値入力専用にする。

ＶＣＬの TEdit のデフォルトのインスタンスのウィンドウ情報を参考にすると､ 

  ExStyle = $200	// WS_EX_CLIENTEDGE
  Style   = $540100C0

が得られる｡ Style を分解すると

デフォルトスタイルが     $540100C0

WS_CHILD =              $40000000
WS_VISIBLE =            $10000000
WS_CLIPSIBLINGS =        $4000000
WS_TABSTOP =               $10000
ES_AUTOVSCROLL =              $40
ES_AUTOHSCROLL =              $80
ES_LEFT =                       0

であることが分かる。この節では､ これらの値を参考にして一行のエディットクラスのウィンドウを作って、テストしてみよう。

  1. エクスプローラを使って、新しいフォルダを 1201Edit01 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1106MessageTrapper フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで Edit01.dpr という名前で保存する｡
  5. コードエディタで以下のように編集する｡
  6. コンパイルして実行する｡

Edit01.dprの全リストを以下に示す｡

program Edit01;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  hEdit1, hEdit2: HWND;

  L1,L2,L3: TAPILabel;
  Btn: TAPIButton;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure BtnClick(var Msg: TMessage);
var
  Len,code: integer;
  s: string;
  r: double;
begin
  SetLength(s,30);
  Len := SendMessage(hEdit2,WM_GETTEXT,30,integer(PChar(s)));
  SetLength(s,Len);
  Val(s,r,code);
  if code = 0 then begin
    Str(sqrt(r):16:10,s);
    L3.Text := s;
  end else
    L3.Text := '正しくない数字です';
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  hEdit1 := CreateWindowEx(WS_EX_CLIENTEDGE,
                          'EDIT',
                          '',
                          WS_CHILD or WS_VISIBLE or WS_TABSTOP or
                          WS_CLIPSIBLINGS or ES_AUTOHSCROLL,
                          10,10,200,30,
                          hWindow,
                          1234,
                          hInstance,
                          nil);

  L1 := Createlabel(hWindow,10,50,340,60,'');

  hEdit2 := CreateWindowEx(WS_EX_CLIENTEDGE,
                          'EDIT',
                          '',
                          WS_CHILD or WS_VISIBLE or WS_TABSTOP or
                          WS_CLIPSIBLINGS or ES_AUTOHSCROLL,
                          210,120,120,30,
                          hWindow,
                          1235,
                          hInstance,
                          nil);

  L2 := Createlabel(hWindow,10,120,190,30,'数字を入れてください');
  L2.TextAlign := DT_RIGHT;
  L2.BkMode := TRANSPARENT;

  Btn := CreateButton(hWindow,180,170,150,30,'平方根',BtnClick);

  L3 := CreateLabel(hWindow,10,210,330,30,'');
  L3.TextAlign := DT_RIGHT;

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
end;

procedure MainCommand(var Msg: TMessage);
var
  Len: integer;
  s: string;
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
  if (Msg.LParam = LPARAM(hEdit1)) and (Msg.WParamLo = 1234) then  // from Edit1
    case Msg.WParamHi of
      EN_CHANGE:begin
         SetLength(s,200);
         Len := SendMessage(hEdit1,WM_GETTEXT,200,integer(PChar(s)));
         SetLength(s,Len);
         L1.Text := s;
      end;
    end;
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.
DownloadExe.gifEdit01.zip(17.128kB)
Edit01.gif

実行すると右の図のようになる。上の EDIT に文字を入力するとそれがそのまま下のラベルに表示される｡ ES_AUTOHSCROLL スタイルを指定しているので、長い文字列を入力しても自動的に左にスクロールする｡ 下の EDIT に任意の正の数字を入れでボタンを押すと平方根の値が下のラベルに表示される。
コードを見てみよう｡ MainCreate( ) ハンドラで CreateWindowEx( ) を使って二つの EDIT コントロールを作成している｡ ExStyle は WS_EX_CLIENTEDGE であり、 Style には WS_CHILD or WS_VISIBLE or WS_TABSTOP or WS_CLIPSIBLINGS or ES_AUTOHSCROLL を指定している｡ このクラスもボタンやリストボックスと同様、コントロールの状態に変化が起こったときは、WM_COMMAND を親コントロールのウィンドウ関数に送る。このとき、LParam には、このコントロールのウィンドウハンドル、WParamLo にはコントロールＩＤ、WParamHi には、以下のような通知コードが設定されている｡

{ Edit Control Notification Codes }
const
  EN_SETFOCUS  = $0100; // 入力フォーカスを得た。
  EN_KILLFOCUS = $0200; // 入力フォーカスを失った。
  EN_CHANGE    = $0300; // テキストが変更された｡
  EN_UPDATE    = $0400; // テキストの内容が変更される。
  EN_ERRSPACE  = $0500; // 文字列バッファのメモリ割り当てに失敗した。
  EN_MAXTEXT   = $0501; // 文字数が上限を越えた。
  EN_HSCROLL   = $0601; // 水平スクロールを行う｡
  EN_VSCROLL   = $0602; // 垂直スクロールを行う｡

MainCommand( ) ハンドラでは、ハンドルとコントロールIDを調べてこのメッセージが Edit1 からであることを確かめてから、EN_CHANGE の通知だけを捕まえて、ラベルに文字列を表示している｡ 表示文字列を取得するには WM_GETTEXT メッセージを送ればよい｡ EDIT クラスが応答できるメッセージを以下に示す｡

{ Edit Control Messages }

const
  EM_GETSEL              = $00B0; //選択開始位置と終了位置の取得
  EM_SETSEL              = $00B1; //選択開始位置と終了位置の設定
  EM_GETRECT             = $00B2; //書式化矩形の取得
  EM_SETRECT             = $00B3; //書式化矩形の設定と再描画 
  EM_SETRECTNP           = $00B4; //書式化矩形の設定だけ
  EM_SCROLL              = $00B5; //垂直スクロールメッセージ
  EM_LINESCROLL          = $00B6; //垂直・水平スクロールメッセージ
  EM_SCROLLCARET         = $00B7; //キャレットを見える位置までスクロール
  EM_GETMODIFY           = $00B8; //変更フラグの取得
  EM_SETMODIFY           = $00B9; //変更フラグの設定
  EM_GETLINECOUNT        = $00BA; //行数の取得
  EM_LINEINDEX           = $00BB; //行の文字インデックスの取得
  EM_SETHANDLE           = $00BC; //表示テキストのためのメモリハンドルの設定
  EM_GETHANDLE           = $00BD; //表示テキストのためのメモリハンドルの取得
  EM_GETTHUMB            = $00BE; //スクロールボックス（つまみ）位置の取得
  EM_LINELENGTH          = $00C1; //行の長さ（文字数）の取得
  EM_REPLACESEL          = $00C2; //選択文字列を指定の文字列に置換
  EM_GETLINE             = $00C4; //指定の一行のテキストの取得
  EM_LIMITTEXT           = $00C5; //最大テキスト量（文字数）の設定
  EM_CANUNDO             = $00C6; //「元に戻す」の可能性を取得
  EM_UNDO                = $00C7; //「元に戻す」の実行
  EM_FMTLINES            = $00C8; //ソフト改行のオン・オフ
  EM_LINEFROMCHAR        = $00C9; //指定文字インデックスから行インデックスを取得
  EM_SETTABSTOPS         = $00CB; //タブストップの設定
  EM_SETPASSWORDCHAR     = $00CC; //パスワード文字の設定・解除
  EM_EMPTYUNDOBUFFER     = $00CD; //「元に戻す」フラグのリセット
  EM_GETFIRSTVISIBLELINE = $00CE; //市場縫えの可視行の取得
  EM_SETREADONLY         = $00CF; //読みとり専用スタイルの設定と解除
  EM_SETWORDBREAKPROC    = $00D0; //ワードラップ関数の設定
  EM_GETWORDBREAKPROC    = $00D1; //ワードラップ関数の取得
  EM_GETPASSWORDCHAR     = $00D2; //パスワード文字の取得
  EM_SETMARGINS          = 211;   //左右のマージンの設定
  EM_GETMARGINS          = 212;   //左右のマージンの取得
  EM_SETLIMITTEXT        = EM_LIMITTEXT;    //win40 Name change
  EM_GETLIMITTEXT        = 213;   //最大テキスト量（文字数）の取得
  EM_POSFROMCHAR         = 214;   //指定文字の位置（座標）の取得
  EM_CHARFROMPOS         = 215;   //指定座標の文字インデックスと行インデックスの取得

  WM_SETTEXT          = $000C;    //テキストの設定
  WM_GETTEXT          = $000D;    //テキストの取得
  WM_GETTEXTLENGTH    = $000E;    //テキストの長さの取得（NULLを含まず）

  WM_CUT              = $0300;    //選択文字列を削除してクリップボードにコピーする
  WM_COPY             = $0301;    //選択文字列をクリップボードにコピーする
  WM_PASTE            = $0302;    //クリップボードからテキストを「貼付け」
  WM_CLEAR            = $0303;    //選択文字を削除
  WM_UNDO             = $0304;    //「元に戻す」の実行

非常にたくさんのメッセージに応答できるということは､ このクラスの高機能性を物語る｡ これらのメッセージの意味を網羅的に説明することは出来ないが､ 例えば EM_SETMARGINS の場合は､ Delphi に付属する Win32.hlp から以下のことが分かる｡

EM_SETMARGINS 

wParam = (WPARAM) fwMargin;			// left and/or right margins 
lParam = (LPARAM) MAKELONG(wLeft, wRight);	// width of left or right margins, in pixels

そして、WParam に指定できる定数は、このヘルプから windows.pas に定義されている以下の定数であることが分かるだろう｡

  { Edit control EM_SETMARGIN parameters }
  EC_LEFTMARGIN = 1;
  EC_RIGHTMARGIN = 2;
  EC_USEFONTINFO = 65535;

メッセージの定義そのものから、その機能はおよそ推察できるだろう｡ 他にレファレンス本が手元にないときは、Win32.hlp で十分間に合うことが多い｡

インスタンス作成後にウィンドウスタイルを変更できる場合がある。多くの場合は、GetWindowLong( ) でスタイルを取得し、設定するスタイルと or をとって SetWindowLong( ) で設定する｡ インスタンス作成後に設定できるスタイルを以下に示す｡

  ES_UPPERCASE
  ES_LOWERCASE
  ES_OEMCONVERT
  ES_READONLY
  ES_WANTRETURN
  ES_NUMBER

以上で、このコントロールのおおよその機能が理解できただろう｡ ＶＣＬの TEdit とほぼ同じだ｡ これらの豊富な機能のうちの重要なものを選んで、カプセル化したクラス TAPIEdit を以下の節で作る｡ プロパティーやメソッドの実装には、上記のような知識が役に立つのが分かるだろう｡

greenbal.gifこの章の目次へ戻る

１２−２ メモをコードでつくる

ＶＣＬの TMemo コンポーネントに相当するのは、複数行の 'EDIT' コントロールである｡ これは、ES_MULTILINE スタイルを指定して、CreateWindowEx( ) ＡＰＩで作ることができる｡ この節では､ TAPIMemo クラスを作る準備として、コードで複数行 EDIT コントロールを作ってみよう｡ ＶＣＬの TMemo のウィンドウスタイルは、ExStyle が $200 = WS_EX_CLIENTEDGE、Style が ＄54210044 である。これを分解してみると以下のようになる｡

デフォルトスタイルが     $54210044

WS_CHILD =              $40000000
WS_VISIBLE =            $10000000
WS_CLIPSIBLINGS =        $4000000
WS_VSCROLL =              $200000
WS_TABSTOP =               $10000
ES_AUTOVSCROLL =              $40
ES_MULTILINE =                  4

となる。このスタイルを参考にして、コードで複数行 EDIT コントロールを作ってテストするプログラムを作ろう｡

  1. エクスプローラを使って、新しいフォルダを 1202Memo01 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1201Edit01 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで Memo01.dpr という名前で保存する｡
  5. コードエディタで以下のように編集する｡
  6. コンパイルして実行する｡

以下に Memo01.dpr の全リストを示す｡

program Memo01;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  hMemo: HWND;
  DD: TAPIDragDrop;
  L1: TAPILabel;
  PL: TAPIPanel;
  LB: TAPILIstBox;
  BA: TBorderArranger;

  TxtColor,BkColor: COLORREF;
//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure LBADD;
begin
  LB.AddString('TextLength');  //0
  LB.AddString('LineCount');   //1
  LB.AddString('CaretPos');    //2
  LB.AddString('SetCaretPos'); //3
  LB.AddString('LineText');    //4
  LB.AddString('SelRange');    //5
  LB.AddString('SelText');     //6
  LB.AddString('SetSel');      //7
  LB.AddString('ReplaceSel');  //8
  LB.AddString('GetLimitText');//9
  LB.AddString('SetLimitText');//10
  LB.AddString('SetMargin');   //11
  LB.AddString('SetReadOnly'); //12
  LB.AddString('ResetReadOnly');//13
  LB.AddString('SetTabStop');  //14
  LB.AddString('SelectAll');   //15
  LB.AddString('ChangeColor'); //16
  LB.AddString('ClearAll');    //17
  LB.AddString('CharLower');   //18
  LB.AddString('CharUpper');   //19
  LB.AddString('FindStr');     //20
  LB.AddString('FindStrNext'); //21
  LB.AddString('SaveText');    //22
end;

function GetTextLength:integer;
begin
  result := SendMessage(hMemo,WM_GETTEXTLENGTH,0,0);
end;

function GetLineCount:integer;
begin
  result := SendMessage(hMemo,EM_GETLINECOUNT,0,0);
end;

procedure GetSel(var st,ed:integer);
begin
  SendMessage(hMemo,EM_GETSEL,integer(@st),integer(@ed));
end;

function CaretPos:integer;
var
  st,ed:integer;
begin
  GetSel(st,ed);
  result := ed;
end;

procedure SetCaretPos(i:integer);
begin
  SendMessage(hMemo,EM_SETSEL,i,i);
end;

function LineFromChar(CharPos: integer): integer;
begin
  result := SendMessage(hMemo,EM_LINEFROMCHAR,CharPos,0);
end;

function LineLength(line: integer):integer;
var
  CharPos: integer;
begin
  CharPos := SendMessage(hMemo,EM_LINEINDEX,line,0);
  result := SendMessage(hMemo,EM_LINELENGTH,CharPos,0);
end;

function GetLine(line: integer): string;
var
  PC: PChar;
  PCLen: Word;
  Len: integer;
begin
  PCLen := LineLength(line);
  PCLen := PCLen+1;
  GetMem(PC,PCLen);
  Move(PCLen,PC^,SizeOf(Word));
  Len := SendMessage(hMemo,EM_GETLINE,line,integer(PC));
  SetString(result,PC,Len);
  FreeMem(PC);
end;

function GetText:string;
var
  Len: integer;
  PC: PChar;
begin
  Len := GetTextLength + 1;
  GetMem(PC,Len);
  FillChar(PC^,Len,0);
  Len := SendMessage(hMemo,WM_GETTEXT,Len,integer(PC));
  SetString(result,PC,Len);
  FreeMem(PC);
end;

function GetSelText:string;
var
  st,ed: integer;
  s: string;
  PCS: PChar;
begin
  GetSel(st,ed);
  if (ed-st) <> 0 then begin
    s := GetText;
    PCS := PChar(integer(PChar(s))+st);
    SetString(result,PCS,ed-st);
  end else
    result := '';
end;

procedure ReplaceSel;
var
  s: string;
begin
  s := GetSelText;
  s := ''+s+'';
  SendMessage(hMemo,EM_REPLACESEL,1,integer(PChar(s)));
end;

procedure SelectAll;
begin
  SendMessage(hMemo,EM_SETSEL,0,-1);
end;

procedure ClearAll;
begin
  SelectAll;
  SendMessage(hMemo,WM_CLEAR,0,0);
end;

procedure LowerChar;
var
  s: string;
begin
  s := GetText;
  CharLower(PChar(s));
  SendMessage(hMemo,WM_SETTEXT,0,integer(PChar(s)));
end;

procedure UpperChar;
var
  s: string;
begin
  s := GetText;
  CharUpper(PChar(s));
  SendMessage(hMemo,WM_SETTEXT,0,integer(PChar(s)));
end;

function FindString(s: string; StartPos:integer):integer;
var
  st,ed: integer;
  Txt: string;
  PCS: PChar;
begin
  Txt := GetText;
  PCS := PChar(integer(PChar(Txt))+StartPos);
  st := Pos(s,string(PCS));
  if st <> 0 then begin
    st := st-1+StartPos;
    ed := st+Length(s);
    SendMessage(hMemo,EM_SETSEL,st,ed);
    SendMessage(hMemo,EM_SCROLLCARET,0,0);
  end;
  result := st;
end;

procedure SaveText(filename:string);
var
  f: TextFile;
  Buf: array[0..$1FFF] of Char;
begin
  AssignFile(f,filename);
    SetTextBuf(f,Buf);
    ReWrite(f);
    write(f,GetText);
    Flush(f);
  CloseFile(f);
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure LBSelChange(var Msg: Tmessage);
var
  i,j: integer;
begin
  case LB.SelIndex of
    3: SetCaretPos(100);
    1: L1.Text := 'LineCount : '+AIntToStr(GetLineCount);
    2: L1.Text := 'CaretPos : '+AIntToStr(CaretPos);
    0: L1.Text := 'TextLength : '+AIntToStr(GetTextLength);
    5: begin
         GetSel(i,j);
         L1.Text := 'SelRange : Start = '+AIntToStr(i)+
                    '   End  = '+AIntToStr(j);
       end;
    4: L1.Text := GetLine(LineFromChar(CaretPos));
    6: L1.Text := GetSelText;
    7: SendMessage(hMemo,EM_SETSEL,100,113);
    8: ReplaceSel;
    9: begin
         i := SendMessage(hMemo,EM_GETLIMITTEXT,0,0);
         L1.Text := 'GetLimitText :  '+AIntToStr(i);
       end;
    10: SendMessage(hMemo,EM_SETLIMITTEXT,0,0);
    11: SendMessage(hMemo,EM_SETMARGINS,
                   EC_LEFTMARGIN or EC_RIGHTMARGIN,MakeLong(5,5));
    12: SendMessage(hMemo,EM_SETREADONLY,1,0);
    13: SendMessage(hMemo,EM_SETREADONLY,0,0);
    14: begin
          i := 16;
          SendMessage(hMemo,EM_SETTABSTOPS,1,integer(@i));
        end;
    15: SelectAll;
    16: begin
          TxtColor := clrWhite;
          BkColor := clrGreen;
          InvalidateRect(hMemo,nil,true);
        end;
    17: ClearAll;
    18: LowerChar;
    19: UpperChar;
    20: FindString('確認',0);
    21: FindString('確認',CaretPos);
    22: begin
          Savetext('C:\TestMemo01.txt');
          L1.Text := 'C:\TestMemo01.txt に保存しました｡';
        end;
  end; //case
  SetFocus(hMemo);
end;

procedure DDDrop(var AMsg: TMessage);
var
  F: file;
  Size,NumRead: Integer;
  P: PChar;
begin
  L1.Text := DD.Files[0];

  AssignFile(F,DD.Files[0]);
  Reset(F,1);
  try
    Size := FileSize(F);
    GetMem(P, Size);
    try
      BlockRead(F, P^, Size,NumRead);
      SendMessage(hMemo,WM_SETTEXT,0,integer(P));
    finally
      FreeMem(P);
    end;
  finally
    CloseFile(F);
  end;

  DD.SetFocus(hMemo);
end;

procedure BASize(var Msg: Tmessage);
var
  r: TRect;
begin
  r := BA.Arrange(TBorderPos(0));
  PL.Dimension := r;
  L1.Dimension := SetDim(r.Top+4,r.Left+4,r.Right-8,r.Bottom-8);
  LB.Dimension := BA.Arrange(TBorderPos(2));
  r := BA.Arrange(TBorderPos(4));
  MoveWindow(hMemo,r.Left,r.Top,r.Right,r.Bottom,true);
end;

procedure MainCtlColorEdit(var Msg: TMessage);
begin
  if Msg.LParam = LPARAM(hMemo) then begin
    SetBkColor(Msg.WParam,BkColor);
    SetTextColor(Msg.WParam,TxtColor);
    Msg.Result := CreateSolidBrush(BkColor);
  end;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;

  TxtColor := clrBlack; BkColor := clrWhite;

  hMemo := CreateWindowEx(WS_EX_CLIENTEDGE,
                          'EDIT',
                          'APIMemo Control',
                          $54210044 or ES_NOHIDESEL or ES_WANTRETURN,
                          0,0,0,0,
                          hWindow,
                          1234,
                          hInstance,
                          nil);

  PL := CreatePanel(hWindow,0,0,0,0);
  PL.OuterEdge := esNone;
  L1 := Createlabel(PL.Handle,0,0,0,0,'Remark');
  LB := CreateListBox(hWindow,0,0,0,0,LBSelChange);
  LBADD;
  BA := CreateBorderArranger(hWindow,36,0,150,0,0,0,0,0,BASize);

  DD := TAPIDragDrop.Create(hWindow);
  DD.OnDrop := DDDrop;

  with MainWnd do begin
    Trap(WM_CTLCOLOREDIT,MainCtlColorEdit);
    ClientWidth := 700;
    ClientHeight := 400;
    Center;
  end;
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;

end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifMemo01.zip(19.634kB)
Memo01.gif

実行して､ 任意のテキストファイルをエクスプローラからドロップすると、その内容が複数行エディットコントロールに表示される｡ 上のラベルには､ ファイルのフルパス付きの名前が表示される｡ このときの様子を右図に示した｡ 左のリストボックスには、このエディットに対する操作のコマンドがリストされている｡ 個別の操作コマンドを調べて見よう。

テキストファイルの読み込み

エクスプローラからファイル名を受け取って、エディットに読み込んでいる DDDrop( ) ハンドラを見てみよう｡

procedure DDDrop(var AMsg: TMessage);
var
  F: file;
  Size,NumRead: Integer;
  P: PChar;
begin
  L1.Text := DD.Files[0];

  AssignFile(F,DD.Files[0]);
  Reset(F,1);
  try
    Size := FileSize(F);
    GetMem(P, Size);
    try
      BlockRead(F, P^, Size,NumRead);
      SendMessage(hMemo,WM_SETTEXT,0,integer(P));
    finally
      FreeMem(P);
    end;
  finally
    CloseFile(F);
  end;

  DD.SetFocus(hMemo);
end;

まだＡＰＩをつかったディスクファイルの操作については説明していないので、ここではパスカルの手続きをつかって読み込んでいる｡ PChar 型の変数 P に GetMem( ) でファイルサイズ分のメモリを確保し、BlockRead( ) を使って読み込んでいる｡ そして、エディットに WM_SETTEXT メッセージを送って文字列をセットしている｡

WM_SETTEXT 
wParam = 0;                     // not used; must be zero 
lParam = (LPARAM)(LPCTSTR)lpsz; // address of window-text string

これでエディットコントロールにテキストファイルの内容が表示される｡

文字インデックスと行インデックス

リストボックスの最初のコマンド TextLength をクリックするとエディットが保持しているテキストの文字数（半角換算）が表示される。テキストの中の特定の文字の位置は、先頭をゼロとする順番付け（半角換算）がされており、文字インデックスという｡ 文字の総数は、エディットに WM_GETTEXTLENGTH を送ると得られる｡ LineCount をクリックすると行の総数が表示される。ここで作った複数行エディットコントロールには ES_AUTOHSCROLL スタイルを設定していないので、テキストは自動的に「右端で折り返す」仕様になっている。 したがって、ウィンドウのサイズを変更すると行数も変化する。試してほしい｡ エディットコントロールを操作するために送られる EM_XXXX メッセージには、ゼロベースの行のインデックスと文字インデックスを設定するものが多い｡ キャレットを任意のところにおいて、CaretPos コマンドをクリックすると、キャレット位置の直後の文字のインデックスを得ることができる｡ 矢印キーで一文字だけ前後にずらしてみて試してほしい。日本語の２バイト文字では、インデックスが２ずつ変化するのが分かる｡ 現在のキャレット位置の文字インデックスを得るためには EM_GETSEL メッセージを送る。

EM_GETSEL
wParam = (WPARAM) (LPDWORD) lpdwStart; // receives starting position 
lParam = (LPARAM) (LPDWORD) lpdwEnd;   // receives ending position

このメッセージは、もともと選択領域の開始と終了位置を取得するものだ。文字が選択されていないときは、現在のキャレット位置を文字インデックスで得ることができる｡ wParam と lParam には、値を受け取る integer 型の変数のアドレスを指定する｡ メモ帳などで試してみれば分かるが､ マウスや{Ctl}キーと矢印キーを使って文字列を選択すると、選択する方向によってキャレットの位置が選択領域の前か後ろかに別れる。EM_GETSEL メッセージでは、どちらがキャレット位置なのか分からないので、ここでは終了位置をキャレット位置としている｡ SetCaretPos をクリックするとキャレット位置が１００の位置に移動する｡ この位置がちょうど２バイト文字の「真ん中」であったときには９９の位置になる｡ コードでキャレット位置を設定するには EM_SETSEL メッセージを送る。

EM_SETSEL
wParam = (WPARAM) (INT) nStart;    // starting position 
lParam = (LPARAM) (INT) nEnd;      // ending position

このメッセージは、明らかに選択領域を設定するものである｡ 開始位置と終了位置を同じにすることでキャレットの位置を指定できる｡ SetSel をクリックすると １００から１１２間での文字をコードで選択することができる。これが本来の EM_SETSEL の役割である｡ SelRange では、EM_GETSEL で選択領域を取得している。

部分文字列の取得

LineText をクリックすると、キャレット位置を含む一行の文字列が取得されてラベルに表示される｡ このとき使われているヘルパ関数を以下に示す｡

function LineLength(line: integer):integer;
var
  CharPos: integer;
begin
  CharPos := SendMessage(hMemo,EM_LINEINDEX,line,0);
  result := SendMessage(hMemo,EM_LINELENGTH,CharPos,0);
end;

function GetLine(line: integer): string;
var
  PC: PChar;
  PCLen: Word;
  Len: integer;
begin
  PCLen := LineLength(line);
  PCLen := PCLen+1;
  GetMem(PC,PCLen);
  Move(PCLen,PC^,SizeOf(Word));
  Len := SendMessage(hMemo,EM_GETLINE,line,integer(PC));
  SetString(result,PC,Len);
  FreeMem(PC);
end;

まず LineLength( ) 関数で行の長さを取得する。EM_LINELENGTH メッセージは、行インデックスではなく、その行に含まれている文字のインデックスを設定しなければならない。

EM_LINELENGTH
wParam = (WPARAM) ich;  // character index 
lParam = 0;

そこで、行インデックスを指定して、その行の先頭文字の文字インデックスを取得するために EM_LINEINDEX メッセージを最初に送っている。

EM_LINEINDEX
wParam = (WPARAM) line; // line number 
lParam = 0;             // not used; must be zero

これらのメッセージを使用して LineLength( ) 関数で任意の行の長さを知ることができる。GetLine( ) 関数では PChar 型の変数にこの長さにヌル文字のための長さ１を加えた分のメモリを確保し､ その先頭の２バイトに Move( ) を使ってバッファ長さを設定している。このようにしてから、EM_GETLINE メッセージを送って行のテキストを取得している｡

EM_GETLINE
wParam = (WPARAM) line;          // line number to retrieve 
lParam = (LPARAM) (LPCSTR) lpch; // address of buffer for line

このようにして GetLine( ) 関数では任意の行の文字列を取得できる｡ つぎに、選択された文字列を取得するために、マウスで適当に文字列を選択し、SelText をクリックしてみよう｡ このときのヘルパ関数を以下に示す｡

function GetText:string;
var
  Len: integer;
  PC: PChar;
begin
  Len := GetTextLength + 1;
  GetMem(PC,Len);
  FillChar(PC^,Len,0);
  Len := SendMessage(hMemo,WM_GETTEXT,Len,integer(PC));
  SetString(result,PC,Len);
  FreeMem(PC);
end;

function GetSelText:string;
var
  st,ed: integer;
  s: string;
  PCS: PChar;
begin
  GetSel(st,ed);
  if (ed-st) <> 0 then begin
    s := GetText;
    PCS := PChar(integer(PChar(s))+st);
    SetString(result,PCS,ed-st);
  end else
    result := '';
end;

不思議なことに、選択文字列を直接取得できるようなメッセージをエディットコントロールはもっていない｡ そこで GetText 関数で全テキストを取得し、その後、ポインタを開始位置分だけずらしてから、SetString( ) 手続きで選択文字列を取得している｡ 文字列を選択して ReplaceSel をクリックするとＨＴＭＬの「太字タグ」が選択文字列の前後に挿入される｡ 

EM_REPLACESEL
fCanUndo = (BOOL) wParam ;        // flag that specifies whether replacement can be undone 
lpszReplace = (LPCTSTR) lParam ;  // pointer to replacement text string

このメッセージを送ると選択文字列を任意の文字列で置き換えることができる｡ wParam にゼロを設定すると「元に戻す」を無効に、ゼロ以外を設定すると「元に戻す」ことができる。lParam には置き換える文字列を PChar 型で指定し、integer に型キャストする｡ このプログラムでは、GetSelText を呼び出して選択文字列を取得し、前後にタグを加えてから EM_REPLACESEL で設定している｡

文字列バッファ

GetLimitText をクリックするとラベルにエディットコントロールのデフォルトの文字列バッファの大きさがバイト数で表示される｡ 筆者の環境ではちょうど３万と表示された｡ つぎに、SetLimitText をクリックし、続いて再び GetLimitText をクリックすると表示が変化するのが分かるだろう｡ 筆者の環境では ６５５３５ と表示される｡ エディットコントロールが文字列を保持するためにメモリに確保しているバッファの大きさは EM_GETLIMITTEXT メッセージを送ると取得できる。

EM_GETLIMITTEXT 
wParam = 0;  // not used, must be zero 
lParam = 0;  // not used, must be zero

また、何らかの理由によりバッファのサイズを制限したいときは EM_SETLIMITTEXT を送る。

EM_SETLIMITTEXT 
wParam = (WPARAM) cbMax;    // new text limits, in bytes 
lParam = 0;

このとき wParam にゼロを設定すると、最大実装できるサイズにすることができる｡ そのサイズは、Windows のバージョンによって異なる可能性がある｡

読みとり専用

SetReadOnly をクリックして EM_SETREADONLY メッセージを wParam をゼロ以外に設定して送ると､ エディットコントロールを読みとり専用にすることができる。このとき､ 背景が灰色になり、マウスで選択してコピーはできるがテキストの内容を変更する貼付けや切り取りなどは出来ない｡ wParam をゼロに設定して送ると読みとり専用を解除できる｡

タブ幅と左右のマージン

タブ幅は EM_SETTABSTOPS メッセージを送って設定する。

EM_SETTABSTOPS
wParam = (WPARAM) cTabs;               // number of tab stops 
lParam = (LPARAM) (LPDWORD) lpdwTabs;  // tab stop array

cTabs には設定するタブの数を、lpdwTabs にはタブ幅を定義した DWORD の配列のアドレスを設定する。タブ幅はダイアログ単位で設定し、cTabs にゼロを設定するとデフォルトの３２ダイアログ単位になる。これは、等幅フォントで８文字分に相当する。cTabs に１を設定して、lpdwTabs にタブ幅を含む integer 型の変数のアドレスを設定すると、全てのタブ幅が一度に等間隔に設定できる｡ この例のプログラムではこの方法を採用している｡
エディットコントロールの文字表示の左右のマージンを設定するには、EM_SETMARGINS メッセージを送る。

EM_SETMARGINS 
wParam = (WPARAM) fwMargin;                    // left and/or right margins 
lParam = (LPARAM) MAKELONG(wLeft, wRight);     // width of left or right margins, in pixels

fwMargin には、以下の値の幾つかを or で結合して設定する｡

  { Edit control EM_SETMARGIN parameters }
  EC_LEFTMARGIN = 1;         // 左マージンを設定
  EC_RIGHTMARGIN = 2;        // 右マージンを設定
  EC_USEFONTINFO = 65535;    // 現在のフォント情報で設定

EC_USEFONTINFO を含む場合は、lParam は無視され、右マージンはＡ文字の幅、左マージンはＣ文字の幅に設定される｡

「全て選択」と「全てクリア」

現在保持している全てのテキストを選択状態にするには、既に説明した EM_SETSEL メッセージを、wParam をゼロに、lParam を -１にセットして送ればよい｡ 全てのテキストを削除するには、まず、全てのテキストを選択状態にし、それから WM_CLEAR メッセージを送る｡

大文字・小文字の変換

以下のＡＰＩを使えば、大文字・小文字の間の変換ができる。

function CharUpper(lpsz: PChar): PChar; stdcall;
function CharLower(lpsz: PChar): PChar; stdcall;

例のプログラムでは、全テキストに適用しているが、選択文字列だけに適用するには、すでに説明した方法で選択テキストを取得し、変換したあとに EM_REPLACESEL メッセージを送って入れ替えるとよい｡

文字列の検索

エディットコントロールには、文字列を検索するためのメッセージが用意されていないので、このプログラムではパスカルの Pos( ) 関数を使った FindString( ) 関数をつくって実現している｡ これを試すには、テキストの任意の二カ所の位置に「確認」と打ち込んでおき、FindStr をクリックする｡ 最初の文字列が選択状態になることが分かるだろう｡ さらに FindStrNext をクリックすると二番目の文字列が選択状態になる｡ 

function FindString(s: string; StartPos:integer):integer;
var
  st,ed: integer;
  Txt: string;
  PCS: PChar;
begin
  Txt := GetText;
  PCS := PChar(integer(PChar(Txt))+StartPos);
  st := Pos(s,string(PCS));
  if st <> 0 then begin
    st := st-1+StartPos;
    ed := st+Length(s);
    SendMessage(hMemo,EM_SETSEL,st,ed);
    SendMessage(hMemo,EM_SCROLLCARET,0,0);
  end;
  result := st;
end;

StartPos には、検索を開始する文字インデックスを指定する。この関数では、全文字列を取得し、開始位置にポインタをずらしてから Pos( ) 関数で位置を検索し、EM_SETSEL メッセージを送って文字列を選択状態にしている。次に EM_SCROLLCARET メッセージを送って、選択領域が見えるように表示をスクロールしている｡ この関数は、選択開始位置を返す。

テキストのディスクファイルへの格納

SaveText をクリックするとハードディスクにテキストがセーブされる｡ 

procedure SaveText(filename:string);
var
  f: TextFile;
  Buf: array[0..$1FFF] of Char;
begin
  AssignFile(f,filename);
    SetTextBuf(f,Buf);
    ReWrite(f);
    write(f,GetText);
    Flush(f);
  CloseFile(f);
end;

ここでもパスカルの標準手続きを使ってファイルに書き込み、バッファをフラッシュしてファイルを閉じている｡

以上で、複数行エディットコントロールの制御方法が大体理解出来ただろう｡ 次節以降で、これらをプロパティーやメソッドに置き換えたエディットコントロールのラッパークラスを作成しよう｡

greenbal.gifこの章の目次へ戻る

１２−３ TAPIEdit クラス

前節までに､ 一行と複数行のエディットコントロールをコードで作成し、メッセージのやりとりすることによりこのコントロールの制御方法を調べてきた｡ 一行と複数行のエディットにはメッセージの一部で相違があるだけで、共通点がたくさんある｡ ＶＣＬと同様に TAPIEdit と TAPIMemo を作りたいが、ここではまず共通の性質をもつ TAPIEditBase クラスを作成し、これから派生して上の二つのクラスを作成しよう｡

  1. エクスプローラを使って、新しいフォルダを 1203Edit02 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1202Memo01 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで Edit02.dpr という名前で保存する｡
  5. [Ctrl]+[f12] キーを押して、表示されるダイアログから APIControl.pas を選んでコードエディタに表示させる。
  6. コードエディタで以下のように編集する｡
  7. コンパイルして実行する｡

最初に APIControl.pas に TAPIEditBase クラスを作成しよう。宣言部を以下に示す｡

//---------- TAPIEditBase -------------------------------------
TAPIEditBase = class(TAPIControl)
private
  FColor: COLORREF;
  FTxtColor: COLORREF;
  FOnSetFocus: TNotifyMessage;
  FOnKillFocus: TNotifyMessage;
  FOnChange: TNotifyMessage;
  FOnUpdate: TNotifyMessage;
  FOnNotice: TNotifyMessage;
  function GetTextLength: integer;
  function GetText: string;
  procedure SetText(value: string);
  function GetCaretPos:integer;
  procedure SetCaretPos(value: integer);
  function GetSelTextLength: integer;
  function GetSelText:string;
  function GetReadOnly: Boolean;
  procedure SetReadOnly(value: Boolean);
  function GetLeftMargin: integer;
  procedure SetLeftMargin(value: integer);
  procedure SetColor(value: COLORREF);
  procedure SetTxtColor(value: COLORREF);
protected
  procedure Initialize; override;
public
  procedure DefaultHandler(var Message); override;
  procedure Cut;
  procedure Copy;
  procedure Paste;
  procedure Clear;
  procedure SelectAll;
  procedure ClearAll;
  property TextLength: integer read GetTextLength;
  property Text: string read GetText write SetText;
  property CaretPos: integer read GetCaretPos write SetCaretPos;
  property SelTextLength: integer read GetSelTextLength;
  property SelText: string read GetSelText;
  property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
  property LeftMargin: integer read GetLeftMargin write SetLeftMargin;
  property Color: COLORREF read FColor write SetColor;
  property TextColor: COLORREF read FTxtColor write SetTxtColor;
  property OnSetFocus: TNotifyMessage read FOnSetFocus write FOnSetFocus;
  property OnKillFocus: TNotifyMessage read FOnKillFocus write FOnKillFocus;
  property OnChange: TNotifyMessage read FOnChange write FOnChange;
  property OnUpdate: TNotifyMessage read FOnUpdate write FOnUpdate;
  property OnNotice: TNotifyMessage read FOnNotice write FOnNotice;
end;

この宣言を見れば分かるように、DefaultHandler( ) 以外のメソッドやプロパティーは前節までにコードで試したものばかりである｡ 実装部を以下に示す｡

//---------- TAPIEditBase -------------------------------------
procedure TAPIEditBase.Initialize;
begin
  inherited Initialize;
  FColor := clrWhite;
  FTxtColor := clrBlack;
  Dispatcher.TrapMessage(WM_CTLCOLOREDIT,self);
end;

procedure TAPIEditBase.DefaultHandler(var Message);
var
  AMsg: TMessage;
begin
  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_COMMAND: begin
      if (AMsg.LParam <> LPARAM(FHandle)) then exit;

      case AMsg.WParamHi of

        EN_SETFOCUS: if Assigned(FOnSetFocus) then begin
          AMsg.Msg := UINT(self); // sender
          OnSetFocus(AMsg);
        end;

        EN_KILLFOCUS: if Assigned(FOnKillFocus) then begin
          AMsg.Msg := UINT(self); // sender
          OnKillFocus(AMsg);
        end;

        EN_CHANGE: if Assigned(FOnChange) then begin
          AMsg.Msg := UINT(self); // sender
          OnChange(AMsg);
        end;

        EN_UPDATE: if Assigned(FOnUpdate) then begin
          AMsg.Msg := UINT(self); // sender
          OnUpdate(AMsg);
        end;

        EN_ERRSPACE,EN_MAXTEXT:MessageBox(Parent,'Edit Control Buffer Full!',
                                              'Warning',MB_OK);
      end;// case
    end;

    WM_CTLCOLOREDIT:if AMsg.LParam = LPARAM(FHandle) then begin
                      SetBkColor(AMsg.WParam,FColor);
                      SetTextColor(AMsg.WParam,FTxtColor);
                      TMessage(Message).Result := CreateSolidBrush(FColor);
                    end;

    WM_KEYUP, WM_LBUTTONUP:if Assigned(FOnNotice) then OnNotice(AMsg);

  end;//case
end;

function TAPIEditBase.GetTextLength: integer;
begin
  result := SendMessage(FHandle,WM_GETTEXTLENGTH,0,0);
end;

function TAPIEditBase.GetText: string;
var
  Len: integer;
  PC: PChar;
begin
  Len := GetTextLength + 1;
  GetMem(PC,Len);
  FillChar(PC^,Len,0);
  Len := SendMessage(FHandle,WM_GETTEXT,Len,integer(PC));
  SetString(result,PC,Len);
  FreeMem(PC);
end;

procedure TAPIEditBase.SetText(value: string);
begin
  SendMessage(FHandle,WM_SETTEXT,0,integer(PChar(value)));
end;

function TAPIEditBase.GetCaretPos:integer;
var
  st, ed: integer;
begin
  SendMessage(FHandle,EM_GETSEL,integer(@st),integer(@ed));
  if ed < st then result := st else result := ed;
end;

procedure TAPIEditBase.SetCaretPos(value:integer);
begin
  SendMessage(FHandle,EM_SETSEL,value,value);
end;

function TAPIEditBase.GetSelTextLength: integer;
var
  st,ed: integer;
begin
  SendMessage(FHandle,EM_GETSEL,integer(@st),integer(@ed));
  result := ed-st;
end;

function TAPIEditBase.GetSelText:string;
var
  st,ed: integer;
  s: string;
  PCS: PChar;
begin
  SendMessage(FHandle,EM_GETSEL,integer(@st),integer(@ed));
  if (ed-st) <> 0 then begin
    s := GetText;
    PCS := PChar(integer(PChar(s))+st);
    SetString(result,PCS,ed-st);
  end else
    result := '';
end;

procedure TAPIEditBase.Cut;
begin
  SendMessage(FHandle,WM_CUT,0,0);
end;

procedure TAPIEditBase.Copy;
begin
  SendMessage(FHandle,WM_COPY,0,0);
end;

procedure TAPIEditBase.Paste;
begin
  SendMessage(FHandle,WM_PASTE,0,0);
end;

procedure TAPIEditBase.Clear;
begin
  SendMessage(FHandle,WM_CLEAR,0,0);
end;

procedure TAPIEditBase.SelectAll;
begin
  SendMessage(FHandle,EM_SETSEL,0,-1);
end;

procedure TAPIEditBase.ClearAll;
begin
  SelectAll;
  Clear;
end;

function TAPIEditBase.GetReadOnly: Boolean;
var
  i: integer;
begin
  i := GetWindowLong(FHandle,GWL_STYLE);
  i := ( i and ES_READONLY);
  result := ( i <> 0 );
end;

procedure TAPIEditBase.SetReadOnly(value: Boolean);
begin
  SendMessage(FHandle,EM_SETREADONLY,integer(value),0);
end;

function TAPIEditBase.GetLeftMargin: integer;
begin
  result := LOWORD(SendMessage(FHandle,EM_SETMARGINS,0,0));
end;

procedure TAPIEditBase.SetLeftMargin(value: integer);
begin
  SendMessage(FHandle,EM_SETMARGINS,EC_LEFTMARGIN,MakeLong(value,0));
end;

procedure TAPIEditBase.SetColor(value: COLORREF);
begin
  FColor := value;
  InvalidateRect(FHandle,nil,true);
end;

procedure TAPIEditBase.SetTxtColor(value: COLORREF);
begin
  FTxtColor := value;
  InvalidateRect(FHandle,nil,true);
end;

Initialize メソッドでは、文字と背景の色のデフォルトを設定し Dispatcher に WM_CTLCOLOREDIT メッセージを送ってくれるよう依頼している。DefaultHandler( ) では WM_COMMAND メッセージとともに送られてくる五つの通知メッセージを捕獲してイベントとして公開している。また、WM_CTLCOLOREDIT メッセージでは、背景と文字の色を設定している。さらに、WM_KEYUP, WM_LBUTTONUP も捕まえて、キーボードやマウスでカーソルの位置が変更された事をイベントとして公開している。他のメソッドやプロパティーのアクセスメソッドについては、既に前節でコードを示したものばかりである。このクラスでは APICreateParams( ) をオーバーライドしていないので、 TSelfSubClass での抽象メソッドのままであり、したがって、このクラスは抽象クラスでありインスタンス化出来ない。それでは、次にこのクラスから派生して一行のエディットコントロールのラッパークラスである TAPIEdit クラスを作成しよう。宣言部を以下に示す。

//---------- TAPIEdit ----------------------------------------------
TAPIEdit = class(TAPIEditBase)
private
  function GetNumEdit:Boolean;
  procedure SetNumEdit(value:Boolean);
protected
  procedure APICreateParams(var Params: TAPICreateParams); override;
public
  property NumEdit: Boolean read GetNumEdit write SetNumEdit;
end;

//---------- TAPIPasswordEdit ----------------------------------------------
TAPIPasswordEdit = class(TAPIEdit)
private
protected
  procedure APICreateParams(var Params: TAPICreateParams); override;
public
end;

TAPIEdit クラスは、TAPIEditBase クラスから派生し、APICreateParams( ) メソッドをオーバーライドした具体クラスである。唯一の追加のプロパティーは NumEdit であり、これを true にすると数値入力専用になる。ES_PASSWORD スタイルはせく政治にしか設定できないので、TAPIEdit をさらに継承して、TAPIPasswordEdit クラスも作成している。実装部を以下に示す。

//---------- TAPIEdit ----------------------------------------------
procedure TAPIEdit.APICreateParams(var Params: TAPICreateParams);
begin
  with Params do begin
    Caption := '';
    Style := WS_CHILD or WS_VISIBLE or WS_TABSTOP or
             WS_CLIPSIBLINGS or ES_AUTOHSCROLL or ES_LEFT;
    ExStyle := WS_EX_CLIENTEDGE;
    X := 50;
    Y := 50;
    Width := 150;
    Height := 32;
    WinClassName := 'EDIT';
  end;
end;

function TAPIEdit.GetNumEdit:Boolean;
var
  i: integer;
begin
  i := GetWindowLong(FHandle,GWL_STYLE);
  i := ( i and ES_NUMBER);
  result := ( i <> 0 );
end;

procedure TAPIEdit.SetNumEdit(value:Boolean);
var
  i: integer;
begin
  i := GetWindowLong(FHandle,GWL_STYLE);
  if value then
    i := i or ES_NUMBER
  else
    i := i and ( not ES_NUMBER);
  SetWindowLong(FHandle,GWL_STYLE,i);
end;

//---------- TAPIPasswordEdit ----------------------------------------------
procedure TAPIPasswordEdit.APICreateParams(var Params: TAPICreateParams);
begin
  inherited APICreateParams(Params);
  Params.Style := Params.Style or ES_PASSWORD;
end;

NumEdit のアクセスメソッドは、ES_NUMBER スタイルを設定取得するものだ。また、TAPIPasswordEdit クラスでは ES_PASSWORD スタイルを追加しているだけである。これで、これらのクラスが完成したので、いつもどおりインスタンス作成関数をつくろう。宣言部を以下に示す｡

function CreateEdit(hParent: HWND; x,y,cx,cy: integer; txt: string;
                      sOnChange:TNotifyMessage): TAPIEdit;

function CreatePasswordEdit(hParent: HWND; x,y,cx,cy: integer; txt: string;
                      sOnChange:TNotifyMessage): TAPIPasswordEdit;

実装部を以下に示す｡

function CreateEdit(hParent: HWND; x,y,cx,cy: integer; txt: string;
                      sOnChange:TNotifyMessage): TAPIEdit;
begin
  result := TAPIEdit.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Text := txt;
    OnChange := sOnChange;
  end;
end;

function CreatePasswordEdit(hParent: HWND; x,y,cx,cy: integer; txt: string;
                      sOnChange:TNotifyMessage): TAPIPasswordEdit;
begin
  result := TAPIPasswordEdit.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Text := txt;
    OnChange := sOnChange;
  end;
end;

これらのクラスをテストするプログラムを Edit02.dpr に作る。以下に全リストを示す。

program Edit02;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  L1,L2,L3,L4: TAPILabel;

  ED1,ED2: TAPIEdit;
  PED: TAPIPasswordEdit;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure ED1Change(var Msg:TMessage);
begin
  L1.Text := ED1.Text;
end;

procedure ED1Notice(var Msg:TMessage);
begin
  L4.Text := 'CaretPos : '+AIntToStr(ED1.CaretPos);
end;

procedure ED2Change(var Msg:TMessage);
begin
  L2.Text := ED2.Text;
end;

procedure PEDChange(var Msg:TMessage);
begin
  L3.Text := PED.Text;
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  L1 := CreateLabel(hWindow,10,10,200,35,'L1:Label');
  ED1 := CreateEdit(hWindow,10,50,200,35,'EDIT',ED1Change);
  ED1.OnNotice := ED1Notice;
  L4 := Createlabel(hWindow,220,10,130,35,'L4:Label');

  L2 := CreateLabel(hWindow,10,100,200,35,'L2:Label');
  ED2 := CreateEdit(hWindow,10,140,200,35,'EDIT',ED2Change);
  ED2.NumEdit := true;

  L3 := CreateLabel(hWindow,10,190,200,35,'L5:Label');
  PED := CreatePasswordEdit(hWindow,10,230,200,35,'PEdit',PEDChange);

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 280;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  {ED1.Color := clrGreen;
  ED1.TextColor := clrWhite;}
  L4.Text := PED.SelText;
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifEdit02.zip(16.347kB)
Edit02.gif

実行すると右図のようになる。三つのエディットのうち一番上のものが通常のエディットコントロールであり、入力するとそれがそのまま直上のラベルに表示される。真ん中のエディットは数値入力専用であり、小数点も入力できない。一番下のものはパスワード入力用であり、入力した半角文字が星印に置き換えられて表示される。しかし、その内容は、上のラベルに示したとおり通常のままである。

greenbal.gifこの章の目次へ戻る

１２−４ TAPIMemo クラス

この節では､ 複数行 EDIT コントロールの機能をカプセル化した TAPIMemo クラスを作ってテストするプログラムを作る｡ このクラスは、ＶＣＬの TMemo クラスに相当する｡ すでに、前節まででコードにより CreateWindowEx( ) ＡＰＩでこのコントロールを作り､ 認識できるメッセージのうちの幾つかを使ってこのコントロールをテストした｡ ここでは､ TAPIEditBase から派生して、TAPIMemo クラスを作る｡ このクラスのウィンドウオブジェクトである複数行 EDIT コントロールにメッセージを送ることにより､ クラスのメソッドやプロパティーのアクセスメソッドが実現されている｡ それでは､ APIControl.pas に実装して､ テストしてみよう。

  1. エクスプローラを使って、新しいフォルダを 1204Memo02 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1203Edit02 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで Memo02.dpr という名前で保存する｡
  5. [Ctrl]+[f12] キーを押して、表示されるダイアログから APIControl.pas を選んでコードエディタに表示させる。
  6. コードエディタで以下のように編集する｡
  7. コンパイルして実行する｡

最初に APICotrol.pas に TAPIMemo クラスを作成する｡ 宣言部を以下にしめす。

//---------- TAPIMemo -----------------------------------------------
TAPIMemo = class(TAPIEditBase)
private
  function GetLineCount: integer;
  function GetCanUndo: Boolean;
  procedure SetModified(value: Boolean);
  function GetModified: Boolean;
  function GetLineNo: integer;
  function GetColNo: integer;
protected
  procedure APICreateParams(var Params: TAPICreateParams); override;
  procedure Initialize; override;
public
  procedure Undo;
  procedure Add(s: string);
  procedure LoadText(filename:string);
  procedure SaveText(filename:string);
  procedure SetSelRange(StartPos,EndPos:integer);
  procedure GetSelRange(var StartPos,EndPos: integer);
  procedure ReplaceSel(s:string);
  procedure ScrollCaret;
  procedure Scroll(line:integer);
  procedure SetTabStop(value: integer);
  function FindString(s: string; StartPos:integer):integer;
  function GetLineLength(line: integer):integer;
  function GetLineFromChar(CharPos: integer):integer;
  function GetLine(line: integer): string;
  property LineCount: integer read GetLineCount;
  property CanUndo: Boolean read GetCanUndo;
  property LineNo: Integer read GetLineNo;
  property ColNo: integer read GetColNo;
  property Modified: Boolean read GetModified write SetModified;
end;

複数行エディットでは、ディスクファイルへの読み書きメソッドと選択文字列操作に関するメソッド、スクロールに関するメソッド、文字インデックスと行インデックスに関するプロパティーなどが追加されている｡ 実装部を以下に示す｡

//---------- TAPIMemo ----------------------------------------------
procedure TAPIMemo.Initialize;
begin
  inherited Initialize;
  SendMessage(FHandle,EM_SETLIMITTEXT,0,0)
end;

procedure TAPIMemo.APICreateParams(var Params: TAPICreateParams);
begin
  with Params do begin
    Caption := '';
    Style := WS_CHILD or WS_VISIBLE or WS_TABSTOP or
             WS_CLIPSIBLINGS or WS_VSCROLL or ES_NOHIDESEL or
             ES_AUTOVSCROLL or ES_MULTILINE or ES_LEFT or ES_WANTRETURN;
    ExStyle := WS_EX_CLIENTEDGE;
    X := 50;
    Y := 50;
    Width := 150;
    Height := 32;
    WinClassName := 'EDIT';
  end;
end;

procedure TAPIMemo.Undo;
begin
  SendMessage(FHandle,EM_UNDO,0,0);
end;

procedure TAPIMemo.Add(s: string);
begin
  Text := Text+#13#10+s;
  Scroll(LineCount);
end;

function TAPIMemo.FindString(s: string; StartPos:integer):integer;
var
  st,ed: integer;
  Txt: string;
  PCS: PChar;
begin
  Txt := Text;
  PCS := PChar(integer(PChar(Txt))+StartPos);
  st := Pos(s,string(PCS));
  if st <> 0 then begin
    st := st-1+StartPos;
    ed := st+Length(s);
    SetSelRange(st,ed);
    ScrollCaret;
  end;
  result := st;
end;

procedure TAPIMemo.ScrollCaret;
begin
  SendMessage(FHandle,EM_SCROLLCARET,0,0);
end;

procedure TAPIMemo.Scroll(line:integer);
begin
  SendMessage(FHandle,EM_LINESCROLL,0,line);
end;

procedure TAPIMemo.SetTabStop(value: integer);
begin
  SendMessage(FHandle,EM_SETTABSTOPS,1,integer(@value));;
end;

function TAPIMemo.GetLine(line: integer): string;
var
  PC: PChar;
  PCLen: Word;
  Len: integer;
begin
  PCLen := GetLineLength(line);
  PCLen := PCLen+1;
  GetMem(PC,PCLen);
  Move(PCLen,PC^,SizeOf(Word));
  Len := SendMessage(FHandle,EM_GETLINE,line,integer(PC));
  SetString(result,PC,Len);
  FreeMem(PC);
end;

function TAPIMemo.GetLineCount: integer;
begin
  result := SendMessage(FHandle,EM_GETLINECOUNT,0,0);
end;

procedure TAPIMemo.LoadText(filename:string);
var
  F: file;
  Size,NumRead: Integer;
  P: PChar;
  s:string;
begin
  AssignFile(F,filename);
  Reset(F,1);
  try
    Size := FileSize(F);
    GetMem(P, Size);
    try
      BlockRead(F, P^, Size,NumRead);
    finally
      s := string(p);
      SetLength(s,NumRead);
      Text := s;
      FreeMem(P);
    end;
  finally
    CloseFile(F);
  end;
end;

procedure TAPIMemo.SaveText(filename:string);
var
  f: TextFile;
  Buf: array[0..$1FFF] of Char;
begin
  AssignFile(f,filename);
    SetTextBuf(f,Buf);
    ReWrite(f);
    write(f,Text);
    Flush(f);
  CloseFile(f);
end;

procedure TAPIMemo.SetSelRange(StartPos,EndPos:integer);
begin
  SendMessage(FHandle,EM_SETSEL,StartPos,EndPos);
end;

procedure TAPIMemo.GetSelRange(var StartPos,EndPos: integer);
begin
  SendMessage(FHandle,EM_GETSEL,integer(@StartPos),integer(@EndPos));
end;

procedure TAPIMemo.ReplaceSel(s:string);
begin
  SendMessage(FHandle,EM_REPLACESEL,1,integer(PChar(s)));
end;

function TAPIMemo.GetCanUndo: Boolean;
begin
  result := Boolean(SendMessage(FHandle,EM_CANUNDO,0,0));
end;

function TAPIMemo.GetLineLength(line:integer): integer;
var
  CharPos: integer;
begin
  CharPos := SendMessage(FHandle,EM_LINEINDEX,line,0);
  result := SendMessage(FHandle,EM_LINELENGTH,CharPos,0);
end;

function TAPIMemo.GetLineFromChar(CharPos: integer):integer;
begin
  result := SendMessage(FHandle,EM_LINEFROMCHAR,CharPos,0);
end;

procedure TAPIMemo.SetModified(value: Boolean);
begin
  SendMessage(FHandle,EM_SETMODIFY,UINT(value),0);
end;

function TAPIMemo.GetModified: Boolean;
begin
  result := Boolean(SendMessage(FHandle,EM_GETMODIFY,0,0));
end;

function TAPIMemo.GetLineNo: integer;
begin
  result := SendMessage(FHandle,EM_LINEFROMCHAR,-1,0);
end;

function TAPIMemo.GetColNo: integer;
begin
  result := CaretPos-SendMessage(FHandle,EM_LINEINDEX,LineNo,0);
end;

ここのコードは、上の第２節で説明したものばかりである。これで、TAPIMemo クラスが完成したので、いつもどおりインスタンス作成関数をつくろう。宣言部を以下に示す｡

function CreateMemo(hParent: HWND; x,y,cx,cy: integer): TAPIMemo;

実装部を以下に示す｡

function CreateMemo(hParent: HWND; x,y,cx,cy: integer): TAPIMemo;
begin
  result := TAPIMemo.Create(hParent);
  result.Dimension := SetDim(x,y,cx,cy);
end;

それでは、このクラスをテストするプログラムを Edit02.dpr に作成しよう｡ 以下に全リストを示す｡

program Memo02;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  MM: TAPIMemo;
  DD: TAPIDragDrop;
  L1,L2: TAPILabel;
  PL: TAPIPanel;
  LB: TAPILIstBox;
  BA: TBorderArranger;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure LBADD;
begin
  LB.AddString('SetCaretPos');
  LB.AddString('GETLINECOUNT');
  LB.AddString('GETTEXTLENGTH');
  LB.AddString('LINEFROMCHAR');
  LB.AddString('GETSEL');
  LB.AddString('GETLINE');
  LB.AddString('GETSELTEXT');
  LB.AddString('REPLACESEL');
  LB.AddString('GETLIMITTEXT');
  LB.AddString('SETLIMITTEXT');
  LB.AddString('SETMARGIN');
  LB.AddString('SETREADONLY');
  LB.AddString('RESETREADONLY');
  LB.AddString('SETSEL');
  LB.AddString('SETTABSTOPS');
  LB.AddString('SelectAll');
  LB.AddString('ChangeColor');
  LB.AddString('ClearAll');
  LB.AddString('CharLower');
  LB.AddString('CharUpper');
  LB.AddString('FindStr');
  LB.AddString('FindStrNext');
  LB.AddString('SaveText');
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure LBSelChange(var Msg: Tmessage);
var
  i,j: integer;
begin
  case LB.SelIndex of
    0: begin;
       MM.CaretPos := 100;
       MM.ScrollCaret;
       end;
    1: L1.Text := 'LINECOUNT : '+AIntToStr(MM.LineCount);
    2: L1.Text := 'TEXTLENGTH : '+AIntToStr(MM.TextLength);
    3: L1.Text := 'LineNo : '+AIntToStr(MM.LineNo);
    4: begin
         MM.GetSelRange(i,j);
         L1.Text := 'GetSelRange Result: Start = '+AIntToStr(i)+
                    '   End  = '+AIntToStr(j);
       end;
    5: L1.Text := MM.GetLine(MM.LineNo);
    6: L1.Text := MM.SelText;
    7: MM.ReplaceSel(''+MM.SelText+'');
    8: begin
         i := SendMessage(MM.Handle,EM_GETLIMITTEXT,0,0);
         L1.Text := 'GetLimitText :  '+AIntToStr(i);
       end;
    9: SendMessage(MM.Handle,EM_SETLIMITTEXT,0,0);
    10: MM.LeftMargin := 5;
    11: MM.ReadOnly := true;
    12: MM.ReadOnly := false;
    13: MM.SetSelRange(100,200);
    14: MM.SetTabStop(16);
    15: MM.SelectAll;
    16: begin
          MM.TextColor := clrWhite;
          MM.Color := clrGreen;
        end;
    17: MM.ClearAll;
    18: begin end;//LowerChar;
    19: begin end;//UpperChar;
    20: MM.FindString('確認',0);
    21: begin
          i := MM.FindString('確認',0);
          MM.FindString('確認',i+1);
        end;
    22: MM.SaveText('C:\TestMemo01.txt');
  end; //case
  SetFocus(MM.Handle);
end;

procedure DDDrop(var AMsg: TMessage);
begin
  L1.Text := DD.Files[0];
  MM.LoadText(DD.Files[0]);
  DD.SetFocus(MM.Handle);
end;

procedure BASize(var Msg: Tmessage);
var
  r: TRect;
begin
  r := BA.Arrange(TBorderPos(0));
  PL.Dimension := r;
  L1.Dimension := SetDim(r.Top+4,r.Left+4,r.Right-8-150,r.Bottom-8);
  L2.Dimension := SetDim(r.Top+r.Right-150,r.Left+4,146,r.Bottom-8);
  LB.Dimension := BA.Arrange(TBorderPos(2));
  MM.Dimension := BA.Arrange(TBorderPos(4));
end;

procedure MMNotice(var Msg: Tmessage);
begin
  L2.Text := AIntToStr(MM.LineNo)+' / '+AIntToStr(MM.ColNo);
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  MM := CreateMemo(hWindow,0,0,0,0);
  MM.OnNotice := MMNotice;

  PL := CreatePanel(hWindow,0,0,0,0);
  PL.OuterEdge := esNone;
  L1 := Createlabel(PL.Handle,0,0,0,0,'L1');
  L2 := Createlabel(PL.Handle,0,0,0,0,'L2');
  LB := CreateListBox(hWindow,0,0,0,0,LBSelChange);
  LBADD;
  BA := CreateBorderArranger(hWindow,36,0,150,0,0,0,0,0,BASize);

  DD := TAPIDragDrop.Create(hWindow);
  DD.OnDrop := DDDrop;

  with MainWnd do begin
    ClientWidth := 700;
    ClientHeight := 400;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MessageBeep($FFFFFFFF);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifMemo02.zip(20.511kB)
Memo02.gif


実行すると上図のようになる｡ これは、２節のものとほとんど同じである｡ ここでは、WM_KEYUP と WM_LBUTTONUP メッセージに同期して呼び出される OnNotice イベントハンドラで、通常のエディタのようにキャレットの行と列の位置を右上のラベルに表示される｡

greenbal.gifこの章の目次へ戻る

１２−５ 極私的ＨＴＭＬエディタ

TAPIMemo クラスの応用としてＨＴＭＬエディタを作ることを考えよう｡ 本稿は、ご覧のようにインターネットのホームページとして公開していますから、当然、ＨＴＭＬというマークアップ言語を使用して作成しています｡ 本ページの外観上の特徴は､ トップページと目次ページ以外は、同じような形式の章ページが延々と続いていることです｡ これは、記事の内容上仕方のないことですが、このようなとき各ページの外観を統一するにはスタイルシートを使用することになります｡ そうすると、ブロック要素やライン要素にスタイルを適用するのが簡単になり、外観も統一されたものになります｡ しかし、ＭＳＩＥ５ と ＮＣ4 ではスタイルの適用方法が微妙に異なります｡ どちらもほぼ同じように見えるようにするためには、各タグにスタイルを設定するのではなく、ブロック要素の場合は <DIV> タグに、インライン要素のときは <SPAN> に設定するのが良いことが分かりました｡ この場合、適応するスタイルによってクラスわけして指定することになります｡ そうすると

<DIV CLASS="xxx"><P> </P></DIV>

のような組み合わせを頻繁に使うことになります。このようなタグをワンアクションで挿入するようなエディタはそう多くはありません｡ 私が、便利に使っているのは M.Okada 氏（http://www2.e-net.or.jp/~o_cadr/）が作られたフリーソフト FakeHTML です｡ このエディタの特徴は、あらかじめ登録されているタグは一つもなく、すべてユーザが登録したタグを挿入することです｡ 原理的に、タグに関係なくある程度長い文字列をキャレットの位置に挿入できます｡ このエディタは、ソフトウェアとしての完成度も高く､ しかも､ 発想の斬新さが素晴らしいと思います｡ある程度スタイルが固まってくると、使用するタグの種類は限定されたものになり、しかも、カスタマイズされたものになります｡ このようなときに FakeHTML は非常に便利です｡ この節では､ この FakeHTML の文字列挿入部分を見習って、任意の文字列をキャレット位置に挿入するエディタを作ってみます｡

前節で作成した TAPIMemo クラスの ReplaceSel( ) メソッドを使えば、選択文字列を任意の文字列に置き換えたり、選択されていないときにはキャレットの位置に任意の文字列を挿入できることは第２節で示した。この機能を使って、FakeHTML 風のタグ挿入を試みます｡ 本家に敬意を表して、FakeFakeHTML として作成しましょう｡

  1. エクスプローラを使って、新しいフォルダを 1205FakeFakeHTML という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1204Memo02 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで FakeFakeHTML.dpr という名前で保存する｡
  5. コードエディタで以下のように編集する｡
  6. [Ctrl]+[F.9]でコンパイルだけする｡

以下に FakeFakeHTML.dpr の全リストを示します。

program FakeFakeHTML;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  MM: TAPIMemo;
  LB: TAPILIstBox;
  DD: TAPIDragDrop;
  BA: TBorderArranger;

  filename: string;

  KeyDef: array[1..9] of string;
  Shift_KeyDef: array[1..9] of string;
  Ctrl_KeyDef: array[1..9] of string;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure LBADD;
var
  i,j: integer;
  F: TextFile;
  S: string;
begin
  i := 1;
  AssignFile(F,'KeyDef.txt');
  Reset(F);
  while not Eof(F) do begin
    Readln(F, S);
    j := pos('|',S);
    S := Copy(S,0,j-1);
    if i < 10 then
      KeyDef[i] := S
    else if i < 19 then
           Shift_KeyDef[i-9] := S
         else
           Ctrl_KeyDef[i-18] := S;
    inc(i);
  end;
  CloseFile(F);

  for i := 1 to 9 do
    LB.AddString('f.'+AIntToStr(i)+' '+KeyDef[i]);

  LB.AddString('');LB.AddString('--- Shift + ---');LB.AddString('');

  for i := 1 to 9 do
    LB.AddString('f.'+AIntToStr(i)+' '+Shift_KeyDef[i]);

  LB.AddString('');LB.AddString('--- Ctrl + ---');LB.AddString('');

  for i := 1 to 9 do
    LB.AddString('f.'+AIntToStr(i)+' '+Ctrl_KeyDef[i]);

end;

function LoadText(filename:string):string;
var
  F: file;
  Size,NumRead: Integer;
  P: PChar;
begin
  AssignFile(F,filename);
  Reset(F,1);
  try
    Size := FileSize(F);
    GetMem(P, Size);
    try
      BlockRead(F, P^, Size,NumRead);
    finally
      SetString(result,P,NumRead);
      FreeMem(P);
    end;
  finally
    CloseFile(F);
  end;
end;
//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure BASize(var Msg: TMessage);
begin
  LB.Dimension := BA.Arrange(TBorderPos(2));
  MM.Dimension := BA.Arrange(TBorderPos(4));
end;

procedure DDDrop(var AMsg: TMessage);
begin
  filename := DD.Files[0];
  MM.LoadText(filename);
  DD.SetFocus(MM.Handle);
end;

procedure MMNotice(var Msg: TMessage);
var
  s: string;
  i: integer;
begin
  if Msg.Msg <> WM_KEYUP then exit;

  if (Msg.wParam <112) or (Msg.wParam >120) then exit;// f1 - f9
  if (GetAsyncKeyState(VK_SHIFT) and $8000)= 0 then
    if (GetAsyncKeyState(VK_CONTROL) and $8000)= 0 then
       MM.ReplaceSel(KeyDef[Msg.wParam-111])
    else begin
       s := LB.ItemString[Msg.wParam-88]+'.txt';    // Ctrl
       i := pos(' ',s);
       s := Copy(s,i+1, Length(s));
       s := LoadText(s);
       MM.ReplaceSel(s);
    end
  else
     MM.ReplaceSel(Shift_KeyDef[Msg.wParam-111]);   // Shift
end;

procedure LBSelChange(var Msg: TMessage);
var
  s: string;
begin
  if LB.SelIndex < 9 then
    MM.ReplaceSel(KeyDef[LB.SelIndex+1])
  else if (LB.SelIndex>11) and (LB.SelIndex<20) then
    MM.ReplaceSel(Shift_KeyDef[LB.SelIndex-11])
  else if (LB.SelIndex>23) and (LB.SelIndex<33) then begin
         s := Ctrl_KeyDef[LB.SelIndex-23]+'.txt';    // Ctrl
         s := LoadText(s);
         MM.ReplaceSel(s);
       end;

  SetFocus(MM.Handle);
end;


//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  MM := CreateMemo(hWindow,0,0,0,0);
  MM.OnNotice := MMNotice;

  LB := CreateListBox(hWindow,0,0,0,0,LBSelChange);
  LBADD;

  DD := TAPIDragDrop.Create(hWindow);
  DD.OnDrop := DDDrop;

  BA := CreateBorderArranger(hWindow,0,0,200,0,0,0,0,0,BASize);

  with MainWnd do begin
    ClientWidth := 900;
    ClientHeight := 600;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  if Length(filename) > 0 then
    MM.SaveText(filename) // 上書き保存！
  else
    MM.SaveText('FFHTML.html');
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifFakeFakeHTML.zip(22.255kB)
FakeFakeHTML.gif

実行すると上図のようになる｡ このプログラムは、コンパイルしてすぐに実行するとランタイムエラーが起こります｡ それは ＩＤＥ から実行するとカレントディレクトリが違うのでタグ定義ファイルを見つけられないからです｡ コンパイルした実行ファイルがあるディレクトリに以下のような KeyDef.txt というタグ定義ファイルを作成してエクスプローラから起動すれば正常に動作します｡ この例は､ 私の設定です｡

<B>|                      f.1
</B>|                     f.2
<P CLASS="indent">|       f.3
<DIV CLASS="ol"><OL>|     f.4
<LI>|                     f.5
</OL></DIV>|              f.6
<DIV CLASS="list"><PRE>|  f.7
<DIV CLASS="ref"><PRE>|   f.8
</PRE></DIV>|             f.9
<P>|                      sf.1
</P>|                     sf.2
<BR>|                     sf.3
<BR CLEAR="right">|       sf.4
<H4>|                     sf.5
</H4>|                    sf.6
&nbsp;|                     sf.7
<HR>|                     sf.8
|                            sf.9
章開始|                   cf.1
章目次|                   cf.2
節開始|                   cf.3
項開始|                   cf.4
この章の目次へ戻る|       cf.5
DownloadExe|              cf.6
ここまでのプログラムファイル|  cf.7
ProgCode|                cf.8
背景の記録|               cf.9
縦棒（｜）はデリミタであり、この前までが挿入タグを定義しています｡ このファイルは、MainOnCreate( ) から呼び出される LBADD 手続きによって読み込まれ、文字列が設定され右側のリストボックスに表示されます｡ 対応するタグを挿入するには、[F.1] から [F.9] までのファンクションキーと [Shift] キーおよび [Ctrl] キーの組み合わせで最大３６個登録できますが､ ここでは [Shift] + [Ctrl] の組み合わせは実装していません｡ [F.10] キーは IME 使用時に半角変換として使うので、除外しました｡ 例えば、上のキー定義ファイルでは、[F.1] を押すとキャレットの位置に <B> が挿入され、[Shift] + [F.1] では <P> が挿入されます｡ これは、TAPIMemo クラスの WM_KEYUP メッセージを処理する MMNotice( ) ハンドラで実現しています｡ 

procedure MMNotice(var Msg: TMessage);
var
  s: string;
  i: integer;
begin
  if Msg.Msg <> WM_KEYUP then exit;

  if (Msg.wParam <112) or (Msg.wParam >120) then exit;// f1 - f9
  if (GetAsyncKeyState(VK_SHIFT) and $8000)= 0 then
    if (GetAsyncKeyState(VK_CONTROL) and $8000)= 0 then
       MM.ReplaceSel(KeyDef[Msg.wParam-111])
    else begin
       s := LB.ItemString[Msg.wParam-88]+'.txt';    // Ctrl
       i := pos(' ',s);
       s := Copy(s,i+1, Length(s));
       s := LoadText(s);
       MM.ReplaceSel(s);
    end
  else
     MM.ReplaceSel(Shift_KeyDef[Msg.wParam-111]);   // Shift
end;

このハンドラでは、エディットコントロールの WM_KEYUP メッセージを捕まえて、押しているキーを wParam から取得します｡ 

WM_KEYUP
nVirtKey = (int) wParam;    // virtual-key code 
lKeyData = lParam;          // key data

windows.pas にある仮想キーの定義の一部を以下に示します｡

const
  VK_F1 = 112;
  VK_F2 = 113;
  VK_F3 = 114;
  VK_F4 = 115;
  VK_F5 = 116;
  VK_F6 = 117;
  VK_F7 = 118;
  VK_F8 = 119;
  VK_F9 = 120;

これで、どのファンクションキーが押されているか分かります｡ [Shift] と [Ctrl] キーはこのメッセージからは分かりませんが、GetAsyncKeyState( ) ＡＰＩを使ってこの関数が実行された時点で押されているか判断することが出来ます｡ これは、上記のコードを見れば分かるだろうが､ 押されていれば戻り値の最上位ビット $8000 がゼットされています｡ [Shift] キーが押されているかどうかを判断して、対応する文字列を ReplaceSel( ) で出力しています｡ [Ctrl] キーが押されているときは、対応するテキストファイルを読み込んでその内容を出力します。これは、文書全体のテンプレートとか、テーブルの一行分のテンプレートとか、タグを含む大きな構造のテキストを出力します｡ 例えば､ [Ctrl] + [F.3] では、「節開始.txt」というファイルが読み込まれ、その内容が挿入されます｡

また本家の FakeHTML と同じようにリストボックスをクリックしても挿入できます｡ 

procedure LBSelChange(var Msg: TMessage);
var
  s: string;
begin
  if LB.SelIndex < 9 then
    MM.ReplaceSel(KeyDef[LB.SelIndex+1])
  else if (LB.SelIndex>11) and (LB.SelIndex<20) then
    MM.ReplaceSel(Shift_KeyDef[LB.SelIndex-11])
  else if (LB.SelIndex>23) and (LB.SelIndex<33) then begin
         s := Ctrl_KeyDef[LB.SelIndex-23]+'.txt';    // Ctrl
         s := LoadText(s);
         MM.ReplaceSel(s);
       end;

  SetFocus(MM.Handle);
end;

これはクリックされたリストボックスのインデックス LB.SelIndex と文字列を対応付けて、それぞれの処理をしています｡

このように、この FakeFakeHTML はキーボードだけで比較的少ないアクションで複雑なタグを一度に挿入できます｡ この文章もこれで書きました｡ KeyDef.txt をエディタで編集すれば、自分独自のタグを挿入できます｡ また ＨＴＭＬ によく似た構造の TeX のコマンドを定義しても使えると思います。TeX のコマンドのほうが ＨＴＭＬ のタグより、直にタイピングすると遙かに挿入しにくいので、このほうが実用的かもしれません｡ 登録できるキー数が少ないのはキー入力にこだわったためであり､ リストボックス入力に限定すれば数千個のコマンドが登録できますが、そのような使い方はこのソフトの設計思想から外れているように思います｡

なお、既にあるファイルを編集するときはエクスプローラからドラグドロップして開きます｡ その場合は、Test! メニューから上書き保存出来ます｡ 新規作成したときは、Test! メニューで、この実行ファイルがあるディレクトリに FFHTML.html という名前で保存されますので、適当なディレクトリに移動してリネームするとよいです｡ なお、エディットコントロールの限界から、５０ｋＢを越えるような大きなファイは編集できません｡ 今見ているこのページも丸ごとは編集出来ないので、節毎に編集してからクリップボード経由でエディタに貼り付けて作成しました｡ このアプリケーションは、改良の余地がたくさんあるが、ここではこれでやめておきます。

最後に、本家 FakeHTML の作者である M.Okada 氏に謝意を表します｡

greenbal.gifこの章の目次へ戻る

１２−６ まとめ

この章では、エディットコントロールをコードで作成し、その機能と操作方法を調べた。そして、ＶＣＬ の TMemo と TEdit に相当するラッパークラス TAPIMemo と TAPIEdit を作成した。その応用として、簡単なＨＴＭＬタグ挿入エディタを作成した｡

ここまでのプログラムファイル

  1. Skeleton03.dpr (2 kB)
  2. UtilFunc.pas (10 kB)
  3. UtilClass.pas (31 kB)
  4. GDIObject.pas (16 kB)
  5. APIControl.pas (42 kB)
  6. APIWindow.pas (19 kB)


greenbal.gifこの章の目次へ戻る