Jak malować tło w TMemo

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.
 
 

Kategoria: Delphi » Gotowce
Facebook
4programmers.net