Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2014年12月10日] [更新 2017年05月21日]　Delphi サンプルプログラム集
168_上下方向のアライメント機能付きの TEdit
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
168_TEdit_VerticalAligment.zip　[4,735 KB]　2017年05月21日版 (EXE 同梱)



  • 2014年12月12日
  • 入力文字を制限するプロパティ PermitChars を追加
  • [Ctrl] + [A] (全てを選択) の操作の対応コードを追加
  • PasswordChar (パスワードのマスク文字) プロパティの対応コードを追加
  • 以上の変更・修正で，Delphi 2007 以前で使用するには修正が必要となった
  • 2014年12月15日
  • コンポーネントのクラス名を単純な名前に変更して，ファイル名も変更した
  • 既にインストール済の場合は，前のコンポーネントの削除が必要
  • 2014年12月19日
  • 上下方向のアライメントの設定の際，RecreateWnd を実行するようにした
  • 数値入力用関係のサンプルと記事等を追加
  • 2014年12月20日
  • 数値入力用のサンプルで，桁数の検出方法に間違いがあったので修正
  • 整数値入力専用のコンポーネントを追加
  • 2015年02月02日
  • TSaNumEdit コンポーネントを利用する際の注意記事を追加
  • 2017年05月21日
  • Ctl3D プロパティを False にした時に左右の枠線が消えてしまう現象を修正



上下方向と左右方向の表示位置の指定が可能な TEdit


TEdit の文字列 (テキスト) の表示位置を指定することができるコンポーネントです．
上下方向 (縦方向・垂直方向) は，上端，中央，下端，左右方向 (横方向・水平方向) は，左端，中央，右端の指定ができます．「中央」は，「真ん中」と言うこともあります．
左右にインデントも設定できるようにしています．インデントは，左側または右側に入力できない領域を設定します．エディットコントロール内に画像を表示したり，ボタン等，他のコントロールを配置したコンポーネントを作成する際に利用できるかも知れません．

TLabel にも上下方向の表示位置を設定するプロパティがあります．TLabel コントロールの上下方向の位置設定のプロパティの名前は Layout ですが，本コンポーネントでは VertAlignment という名前にしています．



図1
TLabel の上下方向のアライメント
  • Layout という名前のプロパティ



Delphi 2009 の TEdit には NumbersOnly という，数字だけを入力可能にするプロパティが実装されています．個人的には，このプロパティを使用するよりも，キーイベント内で，CharInSet 関数等を使用して処理した方がいいのではないかと思っています．
2014年12月12日の更新で，この CharInSet 関数を使用して，入力文字を制限するプロパティを追加しました．この関数は，Delphi 2007 以前にはありません．Delpi 2007 以前では，下記の [その他のコーディング上の問題・注意点] の記事にあるように，従来の in 演算子を使用することになります．






01_動作確認用のテストプログラム


動作の確認のために作成したテストプログラムです．

  • エディットコントロールのサイズを変更した場合
  • フォントサイズを変更した場合
  • 左右 (横方向) のアライメントを変更した場合
  • 上下 (縦方向) のアライメントを変更した場合
  • 左右のインデントを変更した場合
の表示位置が確認できます．


図2
設計時画面
  • オブジェクトインスペクタでの設定
    AutoSize := False
    Alignment := taCenter
    VertAlignment := tvaCenter
図3
EXE の起動直後
図4
左上に表示
  • これが標準の TEdit の表示位置
図5
左右中央で，上下中央に表示
図6
右寄せで上下中央に表示
図7
右端にインデントを設定

リスト1
動作確認用のテストプログラム		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plEdit, Buttons;

type
  TForm1 = class(TForm)
    FontDialog1: TFontDialog;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    plEdit1: TplEdit;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
  private
    { Private 宣言 }
    FOriginWidth  : Integer;
    FOriginHeight : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  オブジェクトインスペクタでAutoSizeプロパティをFalseにしている
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FOriginWidth  := plEdit1.Width;
  FOriginHeight := plEdit1.Height;

  plEdit1.Text := '文字列';
end;

//=============================================================================
//  エディットコントロールのサイズを変更
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if plEdit1.Width = FOriginWidth then begin
    plEdit1.Width   := Self.ClientWidth  - plEdit1.Left - 10;
    plEdit1.Height  := Self.ClientHeight - plEdit1.Top  - 10;
    plEdit1.Anchors := [akLeft, akRight, akTop, akBottom];
  end else begin
    plEdit1.Anchors := [akLeft, akTop];
    plEdit1.Width   := FOriginWidth;
    plEdit1.Height  := FOriginHeight;
  end;
end;

//=============================================================================
//  エディットコントロールのフォントを変更
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  if FontDialog1.Execute(Handle) then begin
    plEdit1.Font.Assign(FontDialog1.Font);
  end;
end;

//=============================================================================
//  エディットコントロールの横方向のアライメントを変更
//=============================================================================
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  if plEdit1.Alignment = taLeftJustify then begin
    plEdit1.Alignment := taCenter;
  end else
  if plEdit1.Alignment = taCenter then begin
    plEdit1.Alignment := taRightJustify;
  end else
  if plEdit1.Alignment = taRightJustify then begin
    plEdit1.Alignment := taLeftJustify;
  end;
end;

//=============================================================================
//  エディットコントロールの縦方向のアライメントを変更
//=============================================================================
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  if plEdit1.VertAlignment = tvaTop then begin
    plEdit1.VertAlignment := tvaCenter;
  end else
  if plEdit1.VertAlignment = tvaCenter then begin
    plEdit1.VertAlignment := tvaBottom;
  end else
  if plEdit1.VertAlignment = tvaBottom then begin
    plEdit1.VertAlignment := tvaTop;
  end;
end;

//=============================================================================
//  左側のインデントの設定を変更
//=============================================================================
procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
  if plEdit1.LeftIndent = 0 then begin
    plEdit1.LeftIndent := 15;
    TSpeedButton(Sender).Caption := 'LeftIndent = 15';
  end else begin
    plEdit1.LeftIndent := 0;
    TSpeedButton(Sender).Caption := 'LeftIndent = 0';
  end;
end;

//=============================================================================
//  右側のインデントの設定を変更
//=============================================================================
procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
  if plEdit1.RightIndent = 0 then begin
    plEdit1.RightIndent := 15;
    TSpeedButton(Sender).Caption := 'RightIndent = 15';
  end else begin
    plEdit1.RightIndent := 0;
    TSpeedButton(Sender).Caption := 'RightIndent = 0';
  end;
end;

end.



02_コンポーネントのソースコード


標準の TEdit コンポーネントに追加したプロパティとソースコードです．
横方向のアライメントの Alignment プロパティは，Delphi 2009 で実装されていますが，再設定しています．
入力文字を制限する PermitChars プロパティは，Text プロパティに文字列をセットする場合と，[貼り付け] 操作の際，このプロパティで設定した値だけをセットします．注意してください．この仕様については，意見が分かれるかも知れません．

このコンポーネントは編集範囲を設定することにより，表示位置を設定しています．このため，左寄せ表示以外ではこの範囲を超えた入力ができない場合があります．この現象を避けたい場合は，TEdit をそのまま使用した方が無難なようです．
例えば，TShape、TPanel、TBevel 等の上に TEdit を配置します．TEdit の AutoSize を True にして BorderStyle は bsNone とします．そして TEdit の位置を調整するという方法も考えられます．TEdit の枠に相当する部分は，TPanel 等のプロパティで調整することになります．

もっとも，左右の中央寄せ，あるいは，右寄せ表示の設定で，入力欄を超えた範囲の値を表示することに意味があるとは思えません．

Delphi 2007 以前で使用するには修正が必要です．本ページの，ここまでの参考リンクの記事等を参考にしてください．



凡例 ■ published
□ public
▲ ReadOnly

■ Alignment TAlignment 横方向 (水平方向) のアライメント
左寄せ，中央，右寄せ．Delphi 2009 では標準実装
■ VertAlignment TplVertAlignment 縦方向 (垂直方向) のアライメント
上端，中央，下端
□ LeftIndent Integer 左側のインデント
この位置より左側には入力できない
□ RightIndent Integer 右側のインデント
右端からこの幅の範囲は，入力できない領域となる
□ PermitChars TSysCharSet

入力制限文字の設定用
ここで設定した文字以外は入力できなくなる
デフォルト値は [] で，全ての文字の入力を許可



PermitChars プロパティは，例えば以下のように利用できます．
これらの入力規則を設定すると，クリップボードから貼り付けしても，これらの文字しか貼り付けしません．コンポーネントの内部で，他の文字は削除するようにしています．



PermitChars の値の例 機能
['0'..'9'] 数字だけの入力を許可
['0'..'9', '.', '-', ','] 数字と小数点とマイナス記号とカンマ記号だけの入力を許可
['A'..'Z', 'a'..'z'] アルファベットの文字だけの入力を許可
['A'..'Z', 'a'..'z', '0'..'9'] 英数字だけの入力を許可
['0', '1'] 2 進数の文字だけの入力を許可
['0'..'9', 'A'..'F', 'a'..'f'] 16 進数の文字だけの入力を許可


以下がソースコードです．
TEdit も TMemo も Windows のエディットコントロールを使用しています．単一行 (シングルライン) の入力用コンポーネントにしたのが TEdit, 複数行 (マルチライン) の入力用のコンポーネントにしたのが TMemo です．

コード内のコメントでは「描画領域」となっていますが，いわゆる「編集領域」のことです．
EM_SETRECT あるいは EM_SETRECTNP を使用すると，エディットコントロールの「編集領域」を設定できます．このことを利用しています．これらの関数は，マルチラインにしたエディットコントロールでないと機能しません．

そこで，CreateParams でマルチラインに設定しています．マルチラインにすると，改行が可能となってしまいますから，その対策をしています．また，パスワード文字の代わりに表示する文字の設定も無効になってしまいます．その対策のためのコードも追加しています．
つまり，TMemo を 1 行入力用としているのと同じですが，継承元を TEdit としています．



リスト2
上下方向と左右方向の表示位置が指定可能な TEdit		 
unit plEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics;

type
  TplVertAlignment = (tvaTop, tvaCenter, tvaBottom);

  TplEdit = class(TEdit)
  private
    FLeftIndent     : Integer;
    FRightIndent    : Integer;
    FVertAlignment  : TplVertAlignment;
    FAlignment      : TAlignment;
    FPermitChars    : TSysCharSet;
    FDefPermitChars : TSysCharSet;
    procedure SetIndentAndVertAlignment;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure SetLeftIndent(const Value: Integer);
    procedure SetRightIndent(const Value: Integer);
    procedure SetVertAlignment(const Value: TplVertAlignment);
    procedure SetAlignment(const Value: TAlignment);
    function GetText: TCaption;
    procedure SetTextBuff(const Value: TCaption);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CMFontchanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CreateWnd; override;
    procedure KeyPress(var Key: Char); override;
    procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
  public
    constructor Create(AOwner: TComponent); override;
    property LeftIndent  : Integer     read FLeftIndent  write SetLeftIndent;
    property RightIndent : Integer     read FRightIndent write SetRightIndent;
    property PermitChars : TSysCharSet read FPermitChars write FPermitChars;
  published
    property Text : TCaption read GetText write SetTextBuff;
    property Alignment : TAlignment
      read FAlignment write SetAlignment default taLeftJustify;
    property VertAlignment : TplVertAlignment
      read FVertAlignment write SetVertAlignment default tvaTop;
  end;

procedure Register;

implementation

uses
  Clipbrd;

{ TplEdit }

//-----------------------------------------------------------------------------
//  Create処理
//-----------------------------------------------------------------------------
constructor TplEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FLeftIndent     := 0;
  FRightIndent    := 0;
  FVertAlignment  := tvaTop;
  //$08はVK_BACK, $1BはVK_ESCAPE
  FDefPermitChars := [#$08, #$1B, ^C, ^V, ^X];

end;

//-----------------------------------------------------------------------------
//  CreateParams処理
//  EM_SETRECTメッセージはマルチラインでないと機能しない
//  マルチラインにして単一行入力用とするための設定
//
//  xor ES_WANTRETURN  : Enterキーでは改行させない
//                       これだけだと[Alt] + [Enter]でスクロールしてしまう
//  xor ES_AUTOVSCROLL : 縦方向にスクロールさせない
//-----------------------------------------------------------------------------
procedure TplEdit.CreateParams(var Params: TCreateParams);
const
  Alignments: array[TAlignment]of Word = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignment];
  Params.Style := Params.Style xor ES_WANTRETURN xor ES_AUTOVSCROLL;
end;

//-----------------------------------------------------------------------------
//  CreateWndメソッド処理
//  ウィンドウが生成される時に自動的に実行されるメソッド
//  Alignmentプロパティの値が変更されるとRecreateWndが実行される
//  この処理がないと縦方向と左右のインデントが初期化されたままになる
//
//  ES_MULTILINEにしたためパスワード設定機能が無効になってまった
//  パスワードの設定が有効になるための対策コードを追加
//-----------------------------------------------------------------------------
procedure TplEdit.CreateWnd;
begin
  inherited;
  SetIndentAndVertAlignment;

  if PasswordChar <> #0 then begin
    SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(PasswordChar), 0);
  end;
end;

//-----------------------------------------------------------------------------
//  Alignmentプロパティの設定用メソッド
//  AlignmentプロパティはDelphi 2009以降では標準実装
//-----------------------------------------------------------------------------
procedure TplEdit.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
    RecreateWnd;
  end;
end;

//-----------------------------------------------------------------------------
//  左側のインデントの設定用メソッド
//-----------------------------------------------------------------------------
procedure TplEdit.SetLeftIndent(const Value: Integer);
begin
  if FLeftIndent <> Value then begin
    FLeftIndent := Value;
    SetIndentAndVertAlignment;
  end;
end;

//-----------------------------------------------------------------------------
//  右側のインデントの設定用メソッド
//-----------------------------------------------------------------------------
procedure TplEdit.SetRightIndent(const Value: Integer);
begin
  if FRightIndent <> Value then begin
    FRightIndent := Value;
    SetIndentAndVertAlignment;
  end;
end;

//-----------------------------------------------------------------------------
//  縦方向のアライメントの設定用メソッド
//-----------------------------------------------------------------------------
procedure TplEdit.SetVertAlignment(const Value: TplVertAlignment);
begin
  if FVertAlignment <> Value then begin
    FVertAlignment := Value;
    RecreateWnd;
  end;
end;

//-----------------------------------------------------------------------------
//  エディットコントロール(自分自身)にEM_SETRECTメッセージを送信する処理
//-----------------------------------------------------------------------------
procedure TplEdit.SetIndentAndVertAlignment;
var
  LRect        : TRect;
  LCellHeight  : Integer;
  LDevieceC    : HDC;
  LCanvas      : TCanvas;
  LTextHeight  : Integer;
  LTopIndent   : Integer;
  L3DDefault   : Integer;
begin
  //エディットコントロールのクライアント領域の幅と高さ
  LRect       := ClientRect;
  LCellHeight := LRect.Bottom - LRect.Top;

  //デバイスコンテキストからTCanvasを生成して，文字列の高さを計算
  LDevieceC := GetDC(Handle);
  try
    LCanvas := TControlCanvas.Create;
    try
      LCanvas.Handle := LDevieceC;
      LCanvas.Lock;
      LCanvas.Font.Assign(Font);
      LTextHeight := LCanvas.TextHeight('Hg');
    finally
      LCanvas.Unlock;
      FreeAndNil(LCanvas);
    end;
  finally
    ReleaseDC(Handle, LDevieceC);
  end;

  //縦方向のアライメントの設定
  //実際には文字列の描画開始の上端座標値の計算
  if Ctl3D then begin
     L3DDefault := 1;
  end else begin
    L3DDefault := 2;
  end;

  LTopIndent := L3DDefault;
  if FVertAlignment = tvaCenter then begin
    LTopIndent := LRect.Top + (LCellHeight - LTextHeight) div 2;
  end else
  if FVertAlignment = tvaBottom then begin
    LTopIndent := LRect.Top + LCellHeight - LTextHeight - L3DDefault;
  end;

  //描画の矩形領域を設定
  SetRect(LRect, LRect.Left + FLeftIndent + L3DDefault,
                 LTopIndent,
                 LRect.Right - FRightIndent - L3DDefault,
                 LTopIndent + LTextHeight);
  //自分自身にEM_SETRECTメッセージを送信
  SendMessage(Handle, EM_SETRECT, 0, LPARAM(@LRect));
end;

//-----------------------------------------------------------------------------
//  WM_SIZEメッセージ処理
//  エディットコントロールのサイズが変更されたら描画領域を再設定
//-----------------------------------------------------------------------------
procedure TplEdit.WMSize(var Message: TWMSize);
begin
  inherited;
  SetIndentAndVertAlignment;
end;

//-----------------------------------------------------------------------------
//  CM_FONTCHANGEDメッセージ処理
//  フォントが変更されたら描画領域を再設定
//-----------------------------------------------------------------------------
procedure TplEdit.CMFontchanged(var Message: TMessage);
begin
  inherited;
  SetIndentAndVertAlignment;
end;

//-----------------------------------------------------------------------------
//  ES_MULTILINEにしてしまったので，本来TEditで使える[Ctrl]+[A]が無効になった
//  [Ctrl]+[A]を有効にする処理を追加
//  TMemoでは[Ctrl]+[A]の機能は使えない．このコードを追加すれば可能となる
//
//  特定の文字だけを入力可能にする処理も追加
//-----------------------------------------------------------------------------
procedure TplEdit.KeyPress(var Key: Char);
var
  IsPermit : Boolean;
begin
  inherited KeyPress(key);

  if key=^A then begin
    SelectAll;
    Key := #$00;
  end else
  if FPermitChars <> [] then begin
    IsPermit := CharInSet(Key, FPermitChars) or CharInSet(Key, FDefPermitChars);
    if not IsPermit then begin
      Key := #$00;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  Textプロパティの取得用メソッド
//-----------------------------------------------------------------------------
function TplEdit.GetText: TCaption;
var
  Len : Integer;
begin
  Len := GetTextLen;
  SetString(Result, PChar(nil), Len);
  if Len <> 0 then begin
    GetTextBuf(PChar(Result), Len + 1);
  end;
end;

//-----------------------------------------------------------------------------
//  Textプロパティの設定用メソッド
//-----------------------------------------------------------------------------
procedure TplEdit.SetTextBuff(const Value: TCaption);
var
  LValue   : String;
  TheText  : String;
  i        : Integer;
begin
  LValue := String(Value);
  if FPermitChars = [] then begin
    TheText := LValue;
  end else begin
    TheText := '';
    for i := 1 to Length(LValue) do begin
      if CharInSet(LValue[i], FPermitChars) then begin
        TheText := TheText + LValue[i];
      end;
    end;
  end;

  Perform(WM_SETTEXT, 0, PChar(TheText));
  Perform(CM_TEXTCHANGED, 0, 0);
end;

//-----------------------------------------------------------------------------
//  WM_PASTEメッセージ処理
//  [貼り付け]動作の処理
//  PermitCharsが設定されている時は，Textプロパティ設定用のメソッドを使用
//-----------------------------------------------------------------------------
procedure TplEdit.WMPaste(var Message: TWMPaste);
begin
  if FPermitChars = [] then begin
    inherited;
  end else begin
    if Clipboard.HasFormat(CF_TEXT) then begin
      Text := Clipboard.AsText;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  コンポーネント登録情報
//-----------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents('plXRAY', [TplEdit]);
end;

end.



03_上下方向のアライメント機能付きの TMaskEdit


TMaskEdit コンポーネントも上下のアライメントの設定を可能にしてみました．
TMaskEdit には EditMask プロパティがありますから，入力文字を制限する PermitChars は実装していません．
EditMask プロパティを設定していると，Text プロパティあるいは，[貼り付け] 操作では，無効な値はセットできません．したがって，それらの処理コードもありません．

このコンポーネントは編集範囲を設定することにより，表示位置を設定しています．このため，左寄せ表示以外ではこの範囲を超えた入力ができない場合があります．この現象を避けるには，TMaskEdit をそのまま使用した方が無難なようです．
例えば，TShape、TPanel、TBevel 等の上に TMaskEdit を配置します．
TMaskEdit の AutoSize を True にして BorderStyle は bsNone とします．そして TMaskEdit の位置を調整するという方法も考えられます．TMaskEdit の枠に相当する部分は，TPanel 等のプロパティで調整することになります．

もっとも，左右の中央寄せ，あるいは，右寄せ表示の設定で，入力欄を超えた範囲の値を表示することに意味があるとは思えません．EditMask プロパティを設定している場合，おそらく入力位置を全て表示するのが普通だと思われます．したがって，この現象を気にする必要はないでしょう．



リスト3
上下方向と左右方向の表示位置が指定可能な TMaskEdit		 
unit plMaskEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics, Mask;

type
  TplMaskVertAlignment = (mtvaTop, mtvaCenter, mtvaBottom);

  TplMaskEdit = class(TMaskEdit)
  private
    FLeftIndent     : Integer;
    FRightIndent    : Integer;
    FAlignment      : TAlignment;
    FVertAlignment  : TplMaskVertAlignment;
    procedure SetIndentAndVertAlignment;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure SetLeftIndent(const Value: Integer);
    procedure SetRightIndent(const Value: Integer);
    procedure SetVertAlignment(const Value: TplMaskVertAlignment);
    procedure SetAlignment(const Value: TAlignment);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CMFontchanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CreateWnd; override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor Create(AOwner: TComponent); override;
    property LeftIndent  : Integer read FLeftIndent  write SetLeftIndent;
    property RightIndent : Integer read FRightIndent write SetRightIndent;
  published
    property Alignment : TAlignment
      read FAlignment write SetAlignment default taLeftJustify;
    property VertAlignment : TplMaskVertAlignment
      read FVertAlignment write SetVertAlignment default mtvaTop;
  end;

procedure Register;

implementation

{ TplMaskEdit }

//-----------------------------------------------------------------------------
//  Create処理
//-----------------------------------------------------------------------------
constructor TplMaskEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FLeftIndent    := 0;
  FRightIndent   := 0;
  FAlignment     := taLeftJustify;
  FVertAlignment := mtvaTop;
end;

//-----------------------------------------------------------------------------
//  CreateParams処理
//  EM_SETRECTメッセージはマルチラインでないと機能しない
//  マルチラインにして単一行入力用とするための設定
//
//  xor ES_WANTRETURN  : Enterキーでは改行させない
//                       これだけだと[Alt] + [Enter]でスクロールしてしまう
//  xor ES_AUTOVSCROLL : 縦方向にスクロールさせない
//-----------------------------------------------------------------------------
procedure TplMaskEdit.CreateParams(var Params: TCreateParams);
const
  Alignments: array[TAlignment]of Word = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignment];;
  Params.Style := Params.Style xor ES_WANTRETURN xor ES_AUTOVSCROLL;
end;

//-----------------------------------------------------------------------------
//  CreateWndメソッド処理
//  ウィンドウが生成される時に自動的に実行されるメソッド
//  Alignmentプロパティの値が変更されるとRecreateWndが実行される
//  この処理がないと縦方向と左右のインデントが初期化されたままになる
//
//  ES_MULTILINEにしたためパスワード設定機能が無効になってまった
//  パスワードの設定が有効になるための対策コードを追加
//-----------------------------------------------------------------------------
procedure TplMaskEdit.CreateWnd;
begin
  inherited;
  SetIndentAndVertAlignment;

  if PasswordChar <> #0 then begin
    SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(PasswordChar), 0);
  end;
end;

//-----------------------------------------------------------------------------
//  Alignmentプロパティの設定用メソッド
//  AlignmentプロパティはDelphi 2009以降では標準実装
//-----------------------------------------------------------------------------
procedure TplMaskEdit.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
    RecreateWnd;
  end;
end;

//-----------------------------------------------------------------------------
//  左側のインデントの設定用メソッド
//-----------------------------------------------------------------------------
procedure TplMaskEdit.SetLeftIndent(const Value: Integer);
begin
  if FLeftIndent <> Value then begin
    FLeftIndent := Value;
    SetIndentAndVertAlignment;
  end;
end;

//-----------------------------------------------------------------------------
//  右側のインデントの設定用メソッド
//-----------------------------------------------------------------------------
procedure TplMaskEdit.SetRightIndent(const Value: Integer);
begin
  if FRightIndent <> Value then begin
    FRightIndent := Value;
    SetIndentAndVertAlignment;
  end;
end;

//-----------------------------------------------------------------------------
//  縦方向のアライメントの設定用メソッド
//-----------------------------------------------------------------------------
procedure TplMaskEdit.SetVertAlignment(const Value: TplMaskVertAlignment);
begin
  if FVertAlignment <> Value then begin
    FVertAlignment := Value;
    RecreateWnd;
  end;
end;

//-----------------------------------------------------------------------------
//  エディットコントロール(自分自身)にEM_SETRECTメッセージを送信する処理
//-----------------------------------------------------------------------------
procedure TplMaskEdit.SetIndentAndVertAlignment;
var
  LRect       : TRect;
  LCellHeight : Integer;
  LDevieceC   : HDC;
  LCanvas     : TCanvas;
  LTextHeight : Integer;
  LTopIndent  : Integer;
  L3DDefault  : Integer;
begin
  //エディットコントロールのクライアント領域の幅と高さ
  LRect       := ClientRect;
  LCellHeight := LRect.Bottom - LRect.Top;

  //デバイスコンテキストからTCanvasを生成して，文字列の高さを計算
  LDevieceC := GetDC(Handle);
  try
    LCanvas := TControlCanvas.Create;
    try
      LCanvas.Handle := LDevieceC;
      LCanvas.Lock;
      LCanvas.Font.Assign(Font);
      LTextHeight := LCanvas.TextHeight('Hg');
    finally
      LCanvas.Unlock;
      FreeAndNil(LCanvas);
    end;
  finally
    ReleaseDC(Handle, LDevieceC);
  end;

  //縦方向のアライメントの設定
  //実際には文字列の描画開始の上端座標値の計算
  if Ctl3D then L3DDefault := 1 else L3DDefault := 2;
  LTopIndent := L3DDefault;
  if FVertAlignment = mtvaCenter then begin
    LTopIndent := LRect.Top + (LCellHeight - LTextHeight) div 2;
  end else
  if FVertAlignment = mtvaBottom then begin
    LTopIndent := LRect.Top + LCellHeight - LTextHeight - L3DDefault;
  end;

  //描画の矩形領域を設定
  SetRect(LRect, LRect.Left + FLeftIndent + L3DDefault,
                 LTopIndent,
                 LRect.Right - FRightIndent - L3DDefault,
                 LTopIndent + LTextHeight);

  //自分自身にEM_SETRECTメッセージを送信
  SendMessage(Handle, EM_SETRECT, 0, LPARAM(@LRect));
end;

//-----------------------------------------------------------------------------
//  WM_SIZEメッセージ処理
//  エディットコントロールのサイズが変更されたら描画領域を再設定
//-----------------------------------------------------------------------------
procedure TplMaskEdit.WMSize(var Message: TWMSize);
begin
  inherited;
  SetIndentAndVertAlignment;
end;

//-----------------------------------------------------------------------------
//  CM_FONTCHANGEDメッセージ処理
//  フォントが変更されたら描画領域を再設定
//-----------------------------------------------------------------------------
procedure TplMaskEdit.CMFontchanged(var Message: TMessage);
begin
  inherited;
  SetIndentAndVertAlignment;
end;

//-----------------------------------------------------------------------------
//  ES_MULTILINEにしてしまったので，本来TEditで使える[Ctrl]+[A]が無効になった
//  [Ctrl]+[A]を有効にする処理を追加
//  EditMastが設定されている時は，元々[Ctrl]+[A}は無効
//-----------------------------------------------------------------------------
procedure TplMaskEdit.KeyPress(var Key: Char);
begin
  inherited KeyPress(key);

  if key=^A then begin
    SelectAll;
    Key := #$00;
  end;
end;

//-----------------------------------------------------------------------------
//  コンポーネント登録情報
//-----------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents('plXRAY', [TplMaskEdit]);
end;

end.




04_パスワードのマスク文字


パスワードのマスク文字は，Windows XP までは * (アスタリスク) がシステムのデフォルトの文字でした．Windows Vista では大きな黒丸，● がシステムのデフォルトになっています．
標準の TEdit では * を設定しても，自動的にこの ● になるようになっています．しかし，本ページのコンポーネントは，そのまま * となってしまいます．直接文字を指定してください．
本サンプルは，このことを確認するテスト用のプログラムです．



図8
Windows XP までのパスワードのマスク文字
図9
Windwos Vista ではこの文字に変更となった
図10
この文字もたまに見かける

リスト4
パスワードのマスク文字のテスト		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plEdit, Buttons;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    plEdit1: TplEdit;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  plEdit1.Font.Name := 'ＭＳ Ｐゴシック';
  plEdit1.Font.Size := 10;
end;

//=============================================================================
//  Windows XPまでのデフォルトのパスワードのマスク文字
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  plEdit1.PasswordChar := '*';
end;

//=============================================================================
//  Windows Vista以降のデフォルトのパスワードのマスク文字
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  plEdit1.PasswordChar := #$25CF;
  //以下でも同じ
  //plEdit1.PasswordChar := #9679;
end;

//=============================================================================
//  こんなのも使われているようである
//  ただし書体によっては無効となる場合がある
//=============================================================================
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  plEdit1.PasswordChar := #7;
end;

//=============================================================================
//  パスワードのマスク文字なし
//=============================================================================
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  plEdit1.PasswordChar := #0;
end;

end.



05_Paint メソッドを実装する方法


TEdit, TMaskEdit は TCanvas を実装していません．また Print メソッドもありません．テキストの描画は Windows のエディットコントロールに対するメッセージ処理で行います．
本ページのコンポーネントでは，このエディットコントロールに対して，編集領域を設定することにより上下左右の入力位置を設定しています．

Delphi には，このように TCanvas を持たないコントロールにも Paint メソッドと同じ機能を実装する機能が用意されています．WM_PAINT メッセージを受信し，PaintWindow メソッドをオーバライドして実装します．この PaintWindow の引数のデバイスコンテキストと TCanvas を結びつけます．下のコードはその簡単な実装例です．

Paint メソッドの機能を実装すると，描画のカスタマイズが可能です．本サンプルのように，TEdit の背景に画像を表示することもできます．ただし，全て自前で描画処理を行わなければなりません．
Enabled プロパティが変更になったら，文字列の色も変える必要があります．文字列が選択されたらその背景と文字の色も変えなければなりません．
文字列の右寄せ，左寄せ等の表示位置を変更すると，キャレットの位置も変更する必要があります．この時，システムのキャレットでは制御が困難です．専用のキャレットを CreateCaret で生成することになるでしょう．

必要があれば挑戦してみてください．おそらく相当の「気合」が必要でしょう．
TEdit の背景を画像にするという目的であれば，以下のリンクの記事のように，WM_ERASEBKGNDメッセージで処理できます．



図11
TEdit に Paint メソッドを実装
  • Paint メソッド内で画像を描画
図12
TEdit に Paint メソッドを実装
  • Paint メソッド内で画像を描画
  • TEdit に文字列を入力中の状態

リスト5
TEdit に Paint メソッドを実装して，カスタム描画		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMyEdit = class(TEdit)
  private
    FCanvas : TCanvas;
  protected
    procedure Paint; virtual;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure PaintWindow(DC: HDC); override;
    property Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DefaultHandler(var Message); override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    MyEdit : TMyEdit;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  MyEdit := TMyEdit.Create(Self);
  MyEdit.Parent    := Self;
  MyEdit.AutoSize  := False;
  MyEdit.Left      := Button1.Left;
  MyEdit.Top       := Button1.Top + Button1.Height + 10;
  MyEdit.Height    := 100;
  MyEdit.Width     := 250;
  MyEdit.Font.Size := 20;

  ActiveControl := MyEdit;
end;

{ TMyEdit }

//-----------------------------------------------------------------------------
//  コンストラクタ
//  描画用のTCanvasを生成
//-----------------------------------------------------------------------------
constructor TMyEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
end;

//-----------------------------------------------------------------------------
//  Destroy処理
//-----------------------------------------------------------------------------
destructor TMyEdit.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end;

//-----------------------------------------------------------------------------
//   WM_PAINTメッセージ処理
//   このメッセージの処理でPaintメソッドの実装が可能になる
//-----------------------------------------------------------------------------
procedure TMyEdit.WMPaint(var Message: TWMPaint);
begin
  ControlState := ControlState + [csCustomPaint];
  inherited;
  ControlState := ControlState - [csCustomPaint];
end;

//-----------------------------------------------------------------------------
//  PaintWindowメソッド
//  ここでTCanvasをデバイスコンテキストに結ぶ付けている
//-----------------------------------------------------------------------------
procedure TMyEdit.PaintWindow(DC: HDC);
begin
  FCanvas.Lock;
  try
   FCanvas.Handle := DC;
   try
     TControlCanvas(FCanvas).UpdateTextFlags;
     Paint;
   finally
     FCanvas.Handle := 0;
   end;
  finally
   FCanvas.Unlock;
  end;
end;

//-----------------------------------------------------------------------------
//  各種メッセージの応答用
//  以下のコードの処理をしないと，フォーカスがない時も描画を実行してしまう
//-----------------------------------------------------------------------------
procedure TMyEdit.DefaultHandler(var Message);
begin
  inherited;

  case TMessage(Message).Msg of
    WM_LBUTTONDOWN,
    WM_NCLBUTTONDOWN,
    WM_MBUTTONDOWN,
    WM_NCMBUTTONDOWN,
    WM_RBUTTONDOWN,
    WM_NCRBUTTONDOWN:
    begin
      if not (csDesigning in ComponentState) and not Focused then begin
        Windows.SetFocus(Handle);
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  実装したPaintメソッド
//-----------------------------------------------------------------------------
procedure TMyEdit.Paint;
var
  LRect    : TRect;
  LBitmap  : TBitmap;
  LImgFile : String;
  LFlags   : Cardinal;
begin
  inherited;

  LRect  := ClientRect;
  FCanvas.FillRect(LRect);
  FCanvas.Brush.Assign(Self.Brush);
  FCanvas.Font.Assign(Self.Font);

  LBitmap := TBitmap.Create;
  try
    LImgFile := 'kobito_b.bmp';
    if FileExists(LImgFile) then begin
      LBitmap.LoadFromFile(LImgFile);
      FCanvas.StretchDraw(FCanvas.ClipRect, LBitmap);
    end;
  finally
    FreeAndNil(LBitmap);
  end;

  FCanvas.Brush.Style := bsClear;

  LFlags := DT_SINGLELINE or DT_LEFT or DT_NOPREFIX;
  DrawText(FCanvas.Handle, PChar(Text), -1, LRect, LFlags);
end;

end.


同じビットマップ画像を，TCanvas.Brush.Bitmap のビットマップとして使用した場合です．



図13
TEdit に Paint メソッドを実装
  • Paint メソッド内で画像を描画
  • TBrush.Bitmap をビットマップ画像にした場合

リスト6
ビットマップ画像を TCanvas.Brush.Bitmap のビットマップとして使用する		 
//-----------------------------------------------------------------------------
//  実装したPaintメソッド
//-----------------------------------------------------------------------------
procedure TMyEdit.Paint;
var
  LRect    : TRect;
  LBitmap  : TBitmap;
  LImgFile : String;
  LFlags   : Cardinal;
begin
  inherited;

  LRect  := ClientRect;
  FCanvas.FillRect(LRect);
  FCanvas.Brush.Assign(Self.Brush);
  FCanvas.Font.Assign(Self.Font);

  LBitmap := TBitmap.Create;
  try
    LImgFile := 'kobito_b.bmp';
    if FileExists(LImgFile) then begin
      LBitmap.LoadFromFile(LImgFile);
      FCanvas.Brush.Bitmap := LBitmap;
      FCanvas.FillRect(FCanvas.ClipRect);
    end;
  finally
    FreeAndNil(LBitmap);
  end;

  FCanvas.Brush.Style := bsClear;

  LFlags := DT_SINGLELINE or DT_LEFT or DT_NOPREFIX;
  DrawText(FCanvas.Handle, PChar(Text), -1, LRect, LFlags);
end;



06_数値入力用の TEdit としての使用例


本ページのコンポーネント TplEdit には，入力文字を制限するプロパティがあります (TplMaskEdit にはありません)．
このプロパティを使用して，正の整数値だけを入力できるようにしたたサンプルです．
コンポーネントの OnChange イベント内で，3 桁ごとにカンマを表示するようにしてみました．

負の値を入力するには，'-' (マイナス) 記号を入力することになりますが，先頭にしか入力できないようにした方がいいかも知れません．固定小数点形式の入力の場合も，'.' を入力したら，それ以降は入力できない等の処理にした方がいいかも知れません．
あるいは，OnExit イベント等でチェックすることも考えられます．

いずれにしても，コンピュータで扱える数値の桁数には制限があります．入力桁数の制限は必要です．本サンプルでは 10 桁に制限しています．カンマの分がありますから，TEdit.MaxLength プロパティではなく，イベント内で入力した桁数を判定しています．



[備考]
数学的な整数とは「正の整数，負の整数，および 0」です．したがって，本サンプルは，負でない整数，自然数の入力専用ということになります．
Delphi の TEdit には数値入力だけを許可する NumbersOnly プロパティがあります．




図14
実行中の画面
  • 正の整数値だけが入力可能
  • 自動で 3 桁ごとにカンマを表示
  • 金額の入力用として利用可能
図15
最後の桁の値を [BACK] で削除
  • 自動的にカンマの表示位置が変わる


リスト7
自動で 3 桁ごとにカンマ表示する，正の整数値入力用のサンプル
OnChange イベント内の Value の値が結果の整数値 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plEdit;

type
  TForm1 = class(TForm)
    plEdit1: TplEdit;
    procedure FormCreate(Sender: TObject);
    procedure plEdit1Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  plEdit1.Font.Name   := 'ＭＳ ゴシック';
  plEdit1.Font.Size   := 10;
  plEdit1.Alignment   := taRightJustify;
  plEdit1.PermitChars := ['0'..'9', ','];
  plEdit1.Text        := '';
end;

{ TMyEdit }

//=============================================================================
//  TplEditのOnChangeイベント処理
//  入力値を整数に変換して，3桁ごとにカンマを付けてリアルタイムで表示
//  キャレットの位置設定は検討の余地あり
//=============================================================================
procedure TForm1.plEdit1Change(Sender: TObject);
var
  LEdit    : TplEdit;
  Value    : Integer;
  TheText  : String;
  SetText  : String;
  CaretPos : Integer;
begin
  LEdit := TplEdit(Sender);
  if LEdit.Text <> '' then begin
    CaretPos := LEdit.SelStart;
    TheText  := StringReplace(LEdit.Text, ',', '', [rfReplaceAll]);

    if Length(TheText) > 10 then begin
      TheText := Copy(TheText, 1, 10);
      MessageBox(Handle, '10 桁以上は入力不可．', '桁数オーバ', MB_ICONINFORMATION);
    end;
    try
      Value   := StrToInt(TheText);
      SetText := FormatFloat('#,##0', Value);
      //Textプロパティに直接値をセットしない
      //Textプロパティに直接値を代入すると例外が発生する
      LEdit.Perform(WM_SETTEXT, 0, PChar(SetText));
    except
      MessageBox(Handle, '整数に変換できません．', '誤入力', MB_ICONINFORMATION);
    end;
    if CaretPos >= Length(TheText)  then begin
      LEdit.SelStart := CaretPos + 1;
    end else begin
      LEdit.SelStart := CaretPos;
    end;
  end;
end;

end.


浮動小数点形式での入力もテストしてみました．
こちらは，他のコントロールにフォーカスが移動した時に入力をチェックしています．OnExit イベント内で処理しています．
入力中は入力文字等のチェックをしていません．必要であれば OnChange イベント内で処理することになります．上のサンプル同様，OnChange イベント内では Text プロパティには値を代入しないようにします．エディットコントロールに対して WM_SETTEXT メッセージを使用します．



図16
Double 型に変換可能な文字列の場合
図17
Double 型で扱える値を超えた場合


リスト8
浮動小数点形式での数値入力用のサンプル
入力中に，カンマや指数部の入力等の制御はしていない		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plEdit, ExtCtrls;

type
  TForm1 = class(TForm)
    plEdit1: TplEdit;
    Edit1: TEdit;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure plEdit1Exit(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  plEdit1.Font.Name   := 'ＭＳ ゴシック';
  plEdit1.Font.Size   := 10;
  plEdit1.Alignment   := taRightJustify;
  plEdit1.PermitChars := ['0'..'9', '-', '+', '.', 'E', 'e'];
  plEdit1.Text        := '';
end;

{ TMyEdit }

//=============================================================================
//  TplEditのOnExitイベント処理
//  フォーカスを失ったら入力した値をチェック
//=============================================================================
procedure TForm1.plEdit1Exit(Sender: TObject);
var
  TheValue : Double;
  TheText  : String;
begin
  if plEdit1.Text <> '' then begin
    try
      TheValue := StrToFloat(plEdit1.Text);
      TheText  := FormatFloat('0.00000E+00', TheValue);
      Panel1.Font.Color := clBlack;
      Panel1.Caption := TheText;
    except
      on E: EConvertError do begin
        Panel1.Font.Color := clRed;
        Panel1.Caption := '実数に変換できません';
      end;
      on E: EOverflow do begin
        Panel1.Font.Color := clRed;
        Panel1.Caption := '値が大きすぎます';
      end;
    end;
  end;
end;

end.



07_整数値入力専用のコンポーネントの作成


上でテストしたサンプルをコンポーネントにしてみます．
コンポーネントにした方が使い勝手はよくなります．次のコードは，OnChange イベントに相当するメソッドの Change メソッドをオーバライドして TplEdit の継承コンポーネントを作成しています．
入力した整数値のプロパティを IntValue という名前にしています．



[備考]　負の値の入力
サンプルでは先頭に - を入力したら，それ以後は - を入力できないようにしています．
もし，途中で入力を忘れたのに気付いた場合，その時点で - を入力すれば自動で先頭に追加するという方法も考えられます．入力キャレットを矢印キーで移動して入力可能にするような仕様も考えられますが，その後の入力キャレットの制御に注意が必要です．
一般に，数値の入力は，電卓の場合のように，末尾が入力位置と考えるのが妥当です．任意の位置にキャレットが移動可能な状態にすると，誤操作の可能性も考えられます．



リスト9
TplEdit を継承した，整数値入力専用のコンポーネント		 
unit plIntegerEdit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, plEdit;

type
  TplIntegerEdit = class(TplEdit)
  private
    procedure SetIntValue(const Value: Integer);
    function GetIntValue: Integer;
  protected
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
    property IntValue : Integer read GetIntValue write SetIntValue;
  end;

procedure Register;

implementation

{ TplIntegerEdit }

//-----------------------------------------------------------------------------
//  整数値入力専用エディットコンポーネントのCreateメソッド
//-----------------------------------------------------------------------------
constructor TplIntegerEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  text          := '';
  Alignment     := taRightJustify;
  VertAlignment := tvaCenter;
  PermitChars   := ['0'..'9', ',', '-'];
end;

//-----------------------------------------------------------------------------
//  IntValueプロパティの設定用メソッド
//-----------------------------------------------------------------------------
procedure TplIntegerEdit.SetIntValue(const Value: Integer);
begin
  if Value > 0 then begin
    Text := IntToStr(Value);
  end;
end;

//-----------------------------------------------------------------------------
//  IntValueプロパティの取得用メソッド
//-----------------------------------------------------------------------------
function TplIntegerEdit.GetIntValue: Integer;
var
  TheText : String;
begin
  TheText  := StringReplace(Text, ',', '', [rfReplaceAll]);
  if TheText = '' then begin
    Result := 0;
  end else begin
    Result := StrToInt(TheText);
  end;
end;

//-----------------------------------------------------------------------------
//  Changeメソッド
//  Textプロパティの値が変わると自動的に実行されるメソッド
//  警告はダイアログではなく，ヒントウィンドウの方がいいかも知れない
//-----------------------------------------------------------------------------
procedure TplIntegerEdit.Change;
var
  TheText  : String;
  SetText  : String;
  CaretPos : Integer;
  LValue   : Integer;
begin
  inherited;

  if Text = '' then begin
    PermitChars := ['0'..'9', '-'];
  end else
  if Text = '-' then begin
    PermitChars := ['0'..'9', ','];
  end else begin
    CaretPos    := SelStart;
    PermitChars := ['0'..'9', ','];
    TheText     := StringReplace(Text, ',', '', [rfReplaceAll]);

    if ((TheText[1] = '-') and (Length(TheText) > 11))
      or ((TheText[1] <> '-') and (Length(TheText) > 10)) then begin
      TheText := Copy(TheText, 1, Length(TheText) - 1);
      MessageBox(Handle, '10 桁以上は入力不可．', '桁数オーバ', MB_ICONINFORMATION);
    end;
    try
      LValue  := StrToInt(TheText);
      SetText := FormatFloat('#,##0', LValue);
      if (TheText[1] = '-') and (LValue = 0) then begin
        SetText := '-0';
      end;
      //Textプロパティに直接値をセットしない
      //Textプロパティに直接値を代入すると例外が発生する
      Perform(WM_SETTEXT, 0, PChar(SetText));
    except
      MessageBox(Handle, '整数に変換できません．', '誤入力', MB_ICONINFORMATION);
    end;
    if CaretPos >= Length(TheText)  then begin
      SelStart := CaretPos + 1;
    end else begin
      SelStart := CaretPos;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  コンポーネント登録情報
//-----------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents('plXRAY', [TplIntegerEdit]);
end;

end.


作成したコンポーネントのテストプログラムと，その実行結果です．
ここでは，コンポーネントを実行時に生成してテストしています．



図18
整数値入力専用エディットコンポのテスト
  • - (マイナス記号) は最初だけ入力できる仕様になっている
  • 数値の符号を変更するという意味では，いつでも入力可能にしてもいいかも知れない

リスト10
整数値入力専用エディットコンポーネンのテストプログラム		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plIntegerEdit;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    plEdit : TplIntegerEdit;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  整数値入力専用エディットコンポーネントの実行時生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  plEdit := TplIntegerEdit.Create(Self);
  plEdit.Parent := Self;
  plEdit.Left   := Button1.Left;
  plEdit.Top    := Button1.Top + Button1.Height + 10;
  plEdit.Font.Name := 'ＭＳ ゴシック';
  plEdit.Font.Size := 10;
  plEdit.IntValue  := 100;
  plEdit.SelStart  := Length(plEdit.Text);

  ActiveControl := plEdit;
end;

//=============================================================================
//  現在の入力値を表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  TheText : String;
begin
  TheText := 'Value : ' + IntToStr(plEdit.IntValue) + sLineBreak
             + 'Text : ' + plEdit.Text;
  MessageBox(Handle, PChar(TheText), '結果', MB_ICONINFORMATION);
  plEdit.SetFocus;
end;

end.



08_数値入力専用の TSaNumEdit コンポーネント


数値入力専用の TSaNumEdit (SaNumEdit) というコンポーネントがあります．
このコンポーネントは，Delphi 4 までの対応ですが，Delphi 5 以降でも利用可能です．今回，以下の修正をしてテストしてみました．
まず，Delphi 4 以上で利用と仮定した修正をします．例えば SaNumEdit.pas 内のバージョン分岐の以下の 2 行を削除します．Delpi 4 以降には，これらのプロパティが実装されています．無効にする必要はありません． 




//{$IFDEF D4VCL}  // Delphi4 or C++Builder4  削除
    property Anchors;
    property Constraints;
    property DragKind;
//{$ENDIF}  削除


Delphi のバージョンによっては，PostMessage の 第 3 引数の型が NativeUint になっている場合があります．すると，以下の WM_NEXTDLGCTL メッセージ処理の部分で「定数式が範囲を超えました (定数式が範囲を越えました)」のエラーが発生します．
その場合は，以下のように修正して下さい．
WM_NEXTDLGCTL の wParam の値は論理型ですが，Windows API 関数の説明では False は 0, True は 0 以外の数値となっています．一般的には True を 1, False を 0 にしておけば無難でしょう．
どうしても負の数値を使用したい場合は，符号なし整数型でキャストします． 



          //PostMessage( ParentForm.Handle, WM_NEXTDLGCTL, -1, 0 );
          //以下に変更
          PostMessage( ParentForm.Handle, WM_NEXTDLGCTL, 1, 0 );


次に，以下のように，Windows XP 以降のテーマに対応したコードを追加します．



リスト11
TSaNumEdit (SaNumEdit) コンポーネントをテーマ対応にするために追加したメソッド
WM_NCPAINT メッセージをオーバライドして実装する
uses に Themes, UxTheme が必要		 
procedure TSaNumEdit.WMNCPaint(var Message: TWMNCPaint);
var
  LRect   : TRect;
  Details : TThemedElementDetails;
  DC      : HDC;
  XEdge   : Integer;
  YEdge   : Integer;
begin
  inherited;
  if (ThemeServices.ThemesEnabled) and Ctl3D then
  begin
    LRect := Rect(0, 0, Width, Height);
    DC    := GetWindowDC(Handle);
    XEdge := GetSystemMetrics(SM_CXEDGE);
    YEdge := GetSystemMetrics(SM_CYEDGE);
    ExcludeClipRect(DC, XEdge, YEdge, Width - XEdge, Height - YEdge);
    try
      Details := ThemeServices.GetElementDetails(teEditRoot);
      ThemeServices.DrawParentBackground(Handle, DC, @Details, True);
      ThemeServices.DrawElement(DC, Details, LRect);
    finally
      ReleaseDC(Handle, DC);
    end;
  end;
end;


下図は，上記の修正をした後，TSaNumEdit コンポに添付されている D4Sample.dpr を Delphi XE(UP1) Pro でコンパイルして実行した結果です．この図は，バージョン 1.20 に添付のサンプルです．

TSaNumEdit コンポーネントは，以下の，佐藤充男さんのサイトから入手できます．佐藤充男さんのサイトにあるバージョンは 1.20 です．
本ページのサンプルのダウンロードファイルには，最新のバージョン 1.40 を同梱しています．
これは Delphian World というサイトに登録されていたファイルです．Delphian World は，国内最大の Delphi 関係コンポーネントの登録サイトでしたが，2014年12月19日現在存在しません．



図19
添付のサンプルを実行
  • 左上が TSaNumEdit コンポ
  • Delphi XE(UP1) Pro でコンパイルして実行した結果