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.

0 komentarzy