Jak malować tło w TMemo
reichel
Komponent
unit BKMemo;
interface
uses
SysUtils, Classes, Controls, StdCtrls, Messages, Types, Graphics, Windows;
type
TBKMemo = class(TMemo)
private
{ Private declarations }
protected
{ Protected declarations }
procedure OnEraseBkgnd(var message: TWMEraseBkgnd);message WM_ERASEBKGND;
public
{ Public declarations }
published
{ Published declarations }
end;
procedure Register;
implementation
procedure TBKMemo.OnEraseBkgnd(var message: TWMEraseBkgnd);
var
my: TRect;
begin
inherited;
//Tu mozna wepchnac rozne malunki
Brush.Color:= clAqua;
FillRect(Message.DC, ClientRect, Brush.Handle);
Ellipse(Message.DC, ClientRect.Left, ClientRect.Top,ClientRect.Right,ClientRect.Bottom);
end;
procedure Register;
begin
RegisterComponents('Samples', [TBKMemo]);
end;
end.
i formularz
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, BKMemo;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
BKBrush:HBRUSH;
//moze mozna doalaczyc do komponentu ---- na pewno mozna :)
procedure OnCTLColorEdit(var Msg: TMessage); message WM_CTLCOLOREDIT;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.OnCTLColorEdit(var Msg: TMessage);
begin
SetTextColor(Msg.wParam, clBlack);
SetBkMode(Msg.wParam, TRANSPARENT);
Msg.Result := BKBrush;//niekoniecznie jak erasebk
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
BKBrush := CreateSolidBrush(clRed);
with TBKMemo.Create(self) do
begin
parent := form1;
top := 10;
left := 0;
width := 300;
height := 300;
visible := true;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(BKBrush);
end;
end.