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