Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2014年12月22日] [更新 2014年12月25日]　Delphi サンプルプログラム集
206_TEdit や TMemo の背景を画像にする
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
206_EditControl_Background.zip　[3,338 KB]　2014年12月23日版 (EXE 同梱)






エディットコントロールの背景を画像にする


TEdit や TMemo、つまりエディットコントロールの背景を画像にするサンプルです。ほとんどのサンプルは TMemo でテストしています。最後のサンプルが TEdit の例となっています。
エディットコントロールは、背景の色は指定できますが、背景を画像にする機能はありません。それを無理やり実装するわけです。本ページのサンプルでは以下の現象が発生しますが、TEdit の場合にはこれらの現象はほとんど発生しません。
  • スクロールの際にチラつく
  • テキストの編集の際、テキストや背景の画像の表示が乱れる

どの程度のチラつき、背景画像の表示の乱れを容認できるかで、実用性を検討することになると思われます。TRichEdit コントロールであれば背景の画像のチラつきほとんど発生しません。TRichEdit の PlainText の値を True にすれば、TMemo と同じように使用できます。TRichEdit の背景を画像にする例は、[207_TRichEdit の背景を画像にする] のサンプルで確認できます。

個人的には、TMemo の背景を画像にするのは、かなり無理があるように思われます。本ページのサンプルは、そのことを確認するためのサンプルでもあります。

本ページのサンプルは全て、継承クラスを実行時に生成しています。



[備考]
TEdit, TMemo に限らず、Windows 2000 以前の時代に開発されたものであれば、透明化の機能を実装したコンポーネントがネット上で入手できます。
Windows XP ではスキンというテーマが導入され、Windows Vista では描画の仕組みが大きく変わりました。そのため、Windows 2000 以前では期待通りに動作していた、背景の透明または半透明用のコンポーネント、あるいはネット上のサンプルコードの多くは、Windows XP 以降では期待通りに動作しない場合があります。
Delphi XE2 で導入された FireMonkey であれば、コントロールの透明度の設定が可能です。
VCL で開発する場合、コントロールの半透明化や透明化の実装が、本当に必要なのかを再検討する必要があるかも知れません。





01_WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC メッセージを処理


コントロールは、背景を描画する時に、親ウィンドウに WM_CTLCOLOREDIT メッセージを送信します。また、フォントやテキストを描画する際に、親ウインドウに WM_CTLCOLORSTATIC メッセージを送信します。これらのメッセージを受信したら、背景を描画します。
メッセージの戻り値をブラシのハンドルにします。戻り値を 0 にすると背景は何も描画しません。
ブラシは、ビットマップから CreatePatternBrush 関数であらかじめ作成しておきます。


図1
設計時画面
  • TMemo を配置
  • Button1 は各種のテスト用。本サンプルでは使用していない
図2
EXE の起動直後
図3
スクロールすると背景画像が乱れる

リスト1
WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC メッセージで TMemo の背景を描画する		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    FBrush : HBRUSH;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure OnMemoTextChange(Sender: TObject);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  ビットマップ画像を読み込み、そのビットマップのTBrushを生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LBitmap : TBitmap;
  i       : Integer;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile('e316.bmp');
    FBrush := 0;
    FBrush := CreatePatternBrush(LBitmap.Handle);
  finally
    FreeAndNil(LBitmap);
  end;
  Memo1.OnChange := OnMemoTextChange;

  Memo1.ScrollBars := ssVertical;
  Memo1.Font.Size  := 20;
  for i := 0 to 14 do begin
    Memo1.Lines.Add('TMemo');
  end;

  ActiveControl := Memo1;
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteObject(FBrush);
end;

//-----------------------------------------------------------------------------
//  Memo1のOnChangeイベント処理
//  この処理がないとテキストの編集が正常に行われない
//-----------------------------------------------------------------------------
procedure TForm1.OnMemoTextChange(Sender: TObject);
begin
  Memo1.Invalidate;
end;

//-----------------------------------------------------------------------------
//  フォームのWndProc処理
//  子コントロールが親ウィンドウに対して送ってくる以下のメッセージを処理
//    WM_CTLCOLOREDIT
//    WM_CTLCOLORSTATIC
//
//  Message.WParamはスクリーンのデバイスコンテキスト(=GetDC(0))
//  WM_CTLCOLOREDIT,WM_CTLCOLORSTATICメッセージを個別に処理してもよい
//-----------------------------------------------------------------------------
procedure TForm1.WndProc(var Message: TMessage);
begin
  inherited;

  case Message.Msg of
  WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC:
    begin
      if (Message.LParam = Integer(Memo1.Handle)) and (FBrush <> 0) then begin
        SetBkMode(Message.WParam, TRANSPARENT);
        Message.Result := FBrush;
      end;
    end;
  WM_MOUSEWHEEL, WM_VSCROLL, WM_HSCROLL:
    begin
      //Memo1のスクロールは、ここでは捕捉できない
      //Memo1をサブクラス化すれば捕捉可能
    end;
  end;
end;

end.



02_CN_CTLCOLOREDIT, CN_CTLCOLORSTATIC メッセージを処理


前項のサンプルでは、スクロールすると背景の画像が乱れます。この乱れを軽減するにはスクロールメッセージを受信したら再描画が必要です。
しかし、メインフォーム側では、TMemo のスクロールは、直接検出できません。サブクラスにすれば検出が可能ですが、継承クラス、つまりコンポーネント形式にした方が扱いやすくなります。以下は、そのようにしたサンプルです。
コントロールは、親ウィドウに WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC メッセージを送信すると同時に、自分自身に CN_CTLCOLOREDIT, CN_CTLCOLORSTATIC メッセージを発行します。このメッセージの処理をします。


図4
設計時画面
図5
EXE の起動直後
図6
スクロールした結果
  • スクロール中の画像の乱れは軽減されたが、クライアント領域の下端に描画されない部分がある
  • 高さを調整すれば隠すことは可能

リスト2
CN_CTLCOLOREDIT, CN_CTLCOLORSTATIC メッセージで TMemo の背景を描画する		 
unit Unit1;

interface

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

type
  TMyMemo = class(TMemo)
  private
    FBitmap : TBitmap;
    FBrush  : HBRUSH;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  TMyMemoのインスタンスを生成
//  DoubleBufferedの値については、親コントロールとの関係もあるので適時変更
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  MyMemo := TMyMemo.Create(Self);
  MyMemo.Parent    := Self;
  MyMemo.Left      := 0;
  MyMemo.Top       := Button1.Top + Button1.Height + 5;
  MyMemo.Width     := Self.ClientWidth;
  MyMemo.Height    := Self.ClientHeight - MyMemo.Top;
  MyMemo.Anchors   := [akLeft, akRight, akTop, akBottom];
  MyMemo.Font.Size := 20;

  MyMemo.ScrollBars     := ssVertical;
  MyMemo.DoubleBuffered := True;

  for i := 0 to 9 do begin
    MyMemo.Lines.Add('TMyMemo');
  end;

  ActiveControl := MyMemo;
end;

{ TMyMemo }

//-----------------------------------------------------------------------------
//  TMyMemoのコンストラクタ
//  背景画像用のビットマップを生成して、ディスクから画像を読み込む
//  そのビットマップを背景のブラシにする
//-----------------------------------------------------------------------------
constructor TMyMemo.Create(AOwner: TComponent);
begin
  inherited;

  FBitmap := TBitmap.Create;
  FBitmap.LoadFromFile('e316.bmp');
  FBrush := 0;
  FBrush := CreatePatternBrush(FBitmap.Handle);
end;

//-----------------------------------------------------------------------------
//  TMyMemoのデストラクタ
//-----------------------------------------------------------------------------
destructor TMyMemo.Destroy;
begin
  FBitmap.Free;
  DeleteObject(FBrush);

  inherited;
end;

//-----------------------------------------------------------------------------
//  TMyMemoのChangeメソッド
//  テキストが変更されると自動で発生するメソッド
//-----------------------------------------------------------------------------
procedure TMyMemo.Change;
begin
  inherited;
  if FBrush <> 0 then begin
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  WndProc処理
//  コントロールは背景描画とフォントや文字の変更があると親ウィンドウに対して
//    WM_CTLCOLOREDIT
//    WM_CTLCOLORSTATIC
//  送ると同時に自分自身にCN_CTLCOLOREDIT,CN_CTLCOLORSTATICメッセージを発行する
//  このメッセージを処理する
//-----------------------------------------------------------------------------
procedure TMyMemo.WndProc(var Message: TMessage);
begin
  inherited;

  case Message.Msg of
  CN_CTLCOLOREDIT, CN_CTLCOLORSTATIC:
    begin
      if (Message.LParam = Integer(Handle)) and (FBrush <> 0) then begin
        SetBkMode(Message.WParam, TRANSPARENT);
        Message.Result := FBrush;
      end;
    end;
  WM_MOUSEWHEEL, WM_HSCROLL, WM_VSCROLL:
    begin
      if FBrush <> 0 then begin
        InvalidateRect(Handle, nil, False);
      end;
    end;
  WM_MOUSEMOVE:
    begin
      if (FBrush <> 0) and (SelLength > 0) then begin
        if (Message.WParam and MK_LBUTTON) > 0 then begin
          InvalidateRect(Handle, nil, False);
        end;
      end;
    end;
  WM_LBUTTONUP, WM_RBUTTONUP:
    begin
      if (FBrush <> 0) then begin
        InvalidateRect(Handle, nil, False);
      end;
    end;
  end;
end;

end.



03_編集領域以外も再描画する - StretchDraw


前項のサンプルでは、クライアント領域の下端に描画されない領域があることがあります。
CN_CTLCOLOREDIT, CN_CTLCOLORSTATIC メッセージの戻り値に指定したブラシは、編集領域に対してだけ有効になるためです。
そこで、WM_ERASEBKGND メッセージ内で、コントロールの TCanvas を生成して、クライアント領域全体にビットマップ画像を表示するようにしたのが本サンプルです。クライアント領域全体に画像を描画しても、テキストの編集を開始すると、編集領域部分の画像は消えてしまいます。この編集領域は、上のサンプル同様、CN_CTLCOLOREDIT, CN_CTLCOLORSTATIC メッセージで処理します。

本サンプルでは、パターンブラシではなく、コントロールにサイズに合わせて StretchDraw で描画した画像を表示するようにしてみました。
上のサンプルのように、パターンブラシにするには、WM_ERASEBKGND メッセージ内で、TBrush.Bitmap プロパティにビットマップ画像を指定します。TBrush の使用方法は、次項のサンプルのコードを参考にしてください。



図7
設計時画面
図8
実行画面

リスト3
WM_ERASEBKGND メッセージで編集領域以外の領域も再描画する		 
unit Unit1;

interface

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

type
  TMyMemo = class (TMemo)
  private
    FBitmap : TBitmap;
    FBrush  : HBRUSH;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure Change; override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
  end;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  TMyMemoのインスタンスを生成
//  DoubleBufferedの値については、親コントロールとの関係もあるので適時変更
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  MyMemo := TMyMemo.Create(Self);
  MyMemo.Parent    := Self;
  MyMemo.Left      := 0;
  MyMemo.Top       := Button1.Top + Button1.Height + 5;
  MyMemo.Width     := Self.ClientWidth;
  MyMemo.Height    := Self.ClientHeight - MyMemo.Top;
  MyMemo.Anchors   := [akLeft, akRight, akTop, akBottom];
  MyMemo.Font.Size := 20;

  MyMemo.ScrollBars     := ssVertical;
  MyMemo.DoubleBuffered := True;

  for i := 0 to 9 do begin
    MyMemo.Lines.Add('TMyMemo');
  end;

  ActiveControl := MyMemo;
end;

{ TMyMemo }

//-----------------------------------------------------------------------------
//  TMyMemoのコンストラクタ
//  背景画像用のビットマップを生成して、ディスクから画像を読み込む
//  そのビットマップを背景のブラシにする
//-----------------------------------------------------------------------------
constructor TMyMemo.Create(AOwner : TComponent);
begin
  inherited;

  FBitmap := TBitmap.Create;
  FBitmap.LoadFromFile('e316.bmp');
  FBrush := 0;
  FBrush := CreatePatternBrush(FBitmap.Handle);
end;

//-----------------------------------------------------------------------------
//  TMyMemoのデストラクタ
//-----------------------------------------------------------------------------
destructor TMyMemo.Destroy;
begin
  DeleteObject(FBrush);
  FreeAndNil(FBitmap);

  inherited;
end;

//-----------------------------------------------------------------------------
//  TMyMemoのChangeメソッド
//  テキストが変更されると自動で発生するメソッド
//-----------------------------------------------------------------------------
procedure TMyMemo.Change;
begin
  inherited;
  if FBrush <> 0 then begin
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  TMyMemoのWM_SIZEメッセージ処理
//  TMyMemoと同じサイズのビットマップを作成し、そこに画像をStretchDra
//  WndProcで処理してもいいが、ここでは別にした
//-----------------------------------------------------------------------------
procedure TMyMemo.WMSize(var Message: TWMSize);
var
  LBitmap : TBitmap;
begin
  inherited;

  if FBrush <> 0 then begin
    LBitmap := TBitmap.Create;
    try
      FBrush := 0;
      LBitmap.SetSize(ClientWidth, ClientHeight);
      LBitmap.Canvas.StretchDraw(ClientRect, FBitmap);
      FBrush := CreatePatternBrush(LBitmap.Handle);
    finally
      FreeAndNil(LBitmap);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  WndProc処理
//  コントロールは背景描画とフォントや文字の変更があると親ウィンドウに対して
//    WM_CTLCOLOREDIT
//    WM_CTLCOLORSTATIC
//  送ると同時に自分自身にCN_CTLCOLOREDIT,CN_CTLCOLORSTATICメッセージを発行する
//  このメッセージを処理する
//-----------------------------------------------------------------------------
procedure TMyMemo.WndProc(var Message: TMessage);
begin
  inherited;

  case Message.Msg of
  CN_CTLCOLOREDIT, CN_CTLCOLORSTATIC:
    begin
      if (Message.LParam = Integer(Handle)) and (FBrush <> 0) then begin
        SetBkMode(Message.WParam, TRANSPARENT);
        Message.Result := FBrush;
      end;
    end;
  WM_MOUSEWHEEL, WM_HSCROLL, WM_VSCROLL:
    begin
      if FBrush <> 0 then begin
        InvalidateRect(Handle, nil, False);
      end;
    end;
  WM_LBUTTONUP, WM_RBUTTONUP:
    begin
      if (FBrush <> 0) then begin
        InvalidateRect(Handle, nil, False);
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  WM_ERASEBKGNDメッセージ処理
//  クライアント領域全体を描画する
//  編集を開始すると編集領域の描画は消失する
//-----------------------------------------------------------------------------
procedure TMyMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  LCanvas : TControlCanvas;
begin
  if FBrush = 0 then begin
    inherited;
  end else begin
    LCanvas := TControlCanvas.Create;
    LCanvas.Lock;
    try
      LCanvas.Brush.Style := bsClear;
      //TCanvasへの描画を可能にする
      LCanvas.Handle := Message.DC;
      LCanvas.StretchDraw(ClientRect, FBitmap);
    finally
      LCanvas.Unlock;
      LCanvas.Free;
    end;
    Message.Result := 1;
  end;
end;

end.



04_TEdit や TMemo の背景をハッチブラシにする


背景をハッチブラシにする例です。
このサンプルは、WM_ERASEBKGND メッセージの処理をしなければ、チラつきがかなり少なくなります。


図9
設計時画面
図10
実行画面

リスト4
背景をハッチブラシにしてみる
ハッチブラシは、実際にはチラついているが、気にはならない程度のようだ		 
unit Unit1;

interface

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

type
  TMyMemo = class (TMemo)
  private
    FBrush  : HBRUSH;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure Change; override;
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
  end;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  TMyMemoのインスタンスを生成
//  DoubleBufferedの値については、親コントロールとの関係もあるので適時変更
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  MyMemo := TMyMemo.Create(Self);
  MyMemo.Parent    := Self;
  MyMemo.Left      := 0;
  MyMemo.Top       := Button1.Top + Button1.Height + 5;
  MyMemo.Width     := Self.ClientWidth;
  MyMemo.Height    := Self.ClientHeight - MyMemo.Top;
  MyMemo.Anchors   := [akLeft, akRight, akTop, akBottom];
  MyMemo.Font.Size := 20;

  MyMemo.ScrollBars     := ssVertical;
  MyMemo.DoubleBuffered := True;

  for i := 0 to 9 do begin
    MyMemo.Lines.Add('TMyMemo');
  end;

  ActiveControl := MyMemo;
end;

{ TMyMemo }

//-----------------------------------------------------------------------------
//  TMyMemoのコンストラクタ
//  背景画像用のビットマップを生成して、ディスクから画像を読み込む
//  そのビットマップを背景のブラシにする
//-----------------------------------------------------------------------------
constructor TMyMemo.Create(AOwner : TComponent);
begin
  inherited;

  //ハッチブラシを生成
  FBrush := 0;
  FBrush := CreateHatchBrush(HS_CROSS, $00FFE7B5);
end;

//-----------------------------------------------------------------------------
//  TMyMemoのデストラクタ
//-----------------------------------------------------------------------------
destructor TMyMemo.Destroy;
begin
  DeleteObject(FBrush);
  inherited;
end;

//-----------------------------------------------------------------------------
//  TMyMemoのChangeメソッド
//  テキストが変更されると自動で発生するメソッド
//-----------------------------------------------------------------------------
procedure TMyMemo.Change;
begin
  inherited;
  if FBrush <> 0 then begin
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  WndProc処理
//  コントロールは背景描画とフォントや文字の変更があると親ウィンドウに対して
//    WM_CTLCOLOREDIT
//    WM_CTLCOLORSTATIC
//  送ると同時に自分自身にCN_CTLCOLOREDIT,CN_CTLCOLORSTATICメッセージを発行する
//  このメッセージを処理する
//-----------------------------------------------------------------------------
procedure TMyMemo.WndProc(var Message: TMessage);
begin
  inherited;

  case Message.Msg of
  CN_CTLCOLOREDIT, CN_CTLCOLORSTATIC:
    begin
      if (Message.LParam = Integer(Handle)) and (FBrush <> 0) then begin
        SetBkMode(Message.WParam, TRANSPARENT);
        Message.Result := FBrush;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  WM_ERASEBKGNDメッセージ処理
//  クライアント領域全体を描画する
//  編集を開始すると編集領域の描画は消失する
//
//  この処理を実行しなければチラつきはかなり軽減できる
//-----------------------------------------------------------------------------
procedure TMyMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  LCanvas   : TControlCanvas;
  LRect     : TRect;
  LContRect : TRect;
begin
  if FBrush = 0 then begin
    inherited;
  end else begin
    LCanvas := TControlCanvas.Create;
    LCanvas.Lock;
    try
      //TCanvasへの描画を可能にする
      LCanvas.Handle := Message.DC;

      //編集領域以外だけを初期化で塗り潰すようにする
      //LRectは編集領域のTRect
      SendMessage(Handle, EM_GETRECT, 0, LPARAM(@LRect));
      LContRect     := ClientRect;
      LContRect.Top := LContRect.Bottom - (LContRect.Bottom - LRect.Bottom);
      LCanvas.FillRect(LContRect);

      LCanvas.Brush.Style := bsCross;
      LCanvas.Pen.Color   := Brush.Color;
      LCanvas.Brush.Color := $00FFE7B5;
      LCanvas.Rectangle(0, 0, ClientWidth, ClientHeight);
    finally
      LCanvas.Unlock;
      LCanvas.Free;
    end;
    Message.Result := 1;
  end;
end;

end.



05_TEdit の背景を画像にする場合


TEdit の場合の例です。TEdit ではスクロール動作がないためと思われますが、背景画像の描画の乱れは全くと言っていいほど発生しません。

下のコードは、[168_上下方向のアライメント機能付きの TEdit] に掲載している TplEdit を使用した例です。TplEdit は、編集領域を設定することにより、右寄せ、左寄せ、上端、上下中央に文字列を表示する等の機能を可能にしています。そのため、編集領域以外の再描画も必要です。標準の TEdit の場合は、編集領域以外の再描画の処理は必要ありません。



図11
設計時画面
図12
実行画面

リスト5
TEdit の背景を画像にする場合。ほとんどチラつかず、背景の画像も乱れない		 
unit Unit1;

interface

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

type
  TMyEdit = class (TplEdit)
  private
    FBitmap : TBitmap;
    FBrush  : HBRUSH;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure Change; override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
  end;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  TMyEditのインスタンスを生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  MyEdit := TMyEdit.Create(Self);
  MyEdit.Parent    := Self;
  MyEdit.AutoSize  := False;
  MyEdit.Left      := 0;
  MyEdit.Top       := Button1.Top + Button1.Height + 5;
  MyEdit.Width     := Self.ClientWidth;
  MyEdit.Height    := Self.ClientHeight - MyEdit.Top;
  MyEdit.Anchors   := [akLeft, akRight, akTop, akBottom];
  MyEdit.Font.Size := 20;

  MyEdit.VertAlignment := tvaCenter;
  MyEdit.LeftIndent    := 5;

  ActiveControl := MyEdit;
end;

{ TMyEdit }

//-----------------------------------------------------------------------------
//  TMyEditのコンストラクタ
//  背景画像用のビットマップを生成して、ディスクから画像を読み込む
//  そのビットマップを背景のブラシにする
//-----------------------------------------------------------------------------
constructor TMyEdit.Create(AOwner : TComponent);
begin
  inherited;

  FBitmap := TBitmap.Create;
  FBitmap.LoadFromFile('e316.bmp');
  FBrush := 0;
  FBrush := CreatePatternBrush(FBitmap.Handle);
end;

//-----------------------------------------------------------------------------
//  TMyEditのデストラクタ
//-----------------------------------------------------------------------------
destructor TMyEdit.Destroy;
begin
  DeleteObject(FBrush);
  FreeAndNil(FBitmap);

  inherited;
end;

//-----------------------------------------------------------------------------
//  TMyEditのChangeメソッド
//  テキストが変更されると自動で発生するメソッド
//-----------------------------------------------------------------------------
procedure TMyEdit.Change;
begin
  inherited;
  if FBrush <> 0 then begin
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  TMyEditのWM_SIZEメッセージ処理
//  TMyEditと同じサイズのビットマップを作成し、そこに画像をStretchDra
//  WndProcで処理してもいいが、ここでは別にした
//-----------------------------------------------------------------------------
procedure TMyEdit.WMSize(var Message: TWMSize);
var
  LBitmap : TBitmap;
begin
  inherited;

  if FBrush <> 0 then begin
    LBitmap := TBitmap.Create;
    try
      FBrush := 0;
      LBitmap.SetSize(ClientWidth, ClientHeight);
      LBitmap.Canvas.StretchDraw(ClientRect, FBitmap);
      FBrush := CreatePatternBrush(LBitmap.Handle);
    finally
      FreeAndNil(LBitmap);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  WndProc処理
//  コントロールは背景描画とフォントや文字の変更があると親ウィンドウに対して
//    WM_CTLCOLOREDIT
//    WM_CTLCOLORSTATIC
//  送ると同時に自分自身にCN_CTLCOLOREDIT,CN_CTLCOLORSTATICメッセージを発行する
//  このメッセージを処理する
//-----------------------------------------------------------------------------
procedure TMyEdit.WndProc(var Message: TMessage);
begin
  inherited;

  case Message.Msg of
  CN_CTLCOLOREDIT, CN_CTLCOLORSTATIC:
    begin
      if (Message.LParam = Integer(Handle)) and (FBrush <> 0) then begin
        SetBkMode(Message.WParam, TRANSPARENT);
        Message.Result := FBrush;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  WM_ERASEBKGNDメッセージ処理
//  クライアント領域全体を描画する
//  編集を開始すると編集領域の描画は消失する
//  標準のTEditの場合、WM_ERASEBKGNDメッセージの処理は不要
//-----------------------------------------------------------------------------
procedure TMyEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  LCanvas : TControlCanvas;
begin
  if FBrush = 0 then begin
    inherited;
  end else begin
    LCanvas := TControlCanvas.Create;
    LCanvas.Lock;
    try
      LCanvas.Brush.Style := bsClear;
      //TCanvasへの描画を可能にする
      LCanvas.Handle := Message.DC;
      LCanvas.StretchDraw(ClientRect, FBitmap);
    finally
      LCanvas.Unlock;
      LCanvas.Free;
    end;
    Message.Result := 1;
  end;
end;

end.