Форум: "Основная";
Текущий архив: 2005.09.25;
Скачать: [xml.tar.bz2];

Вниз

Фоновый рисунок в Memo   Найти похожие ветки 

← →
_makSim   (2005-08-29 18:38) [0]

Подскажите как можно сделать фоновый рисунок в компоненте Memo, как это, например, может иметь место в окне ввода в ICQ. Спасибо.

---

← →
DVM ©   (2005-08-30 17:18) [1]

> Подскажите как можно сделать фоновый рисунок в компоненте
> Memo

обрабатывать WM_ERASEBKGND

---

← →
Турист   (2005-08-30 22:52) [2]

Как-то много кода получилось



const
 WM_REDRAW = WM_USER + 100;

type
 TMyMemo = class(TMemo)
 protected
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMRedraw(var Message: TMessage); message WM_REDRAW;
  end;

 TMemo = class(TMyMemo);

 TForm1 = class(TForm)
   Memo1: TMemo;
   Image1: TImage;
   XPManifest1: TXPManifest;
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TMyMemo.CNCommand(var Message: TWMCommand);
begin
 case Message.NotifyCode of
   EN_UPDATE: Invalidate;
   EN_VSCROLL, EN_HSCROLL:
     begin
       SendMessage(Handle, WM_SETREDRAW, 0, 0);
       PostMessage(Handle, WM_REDRAW, 0, 0);
     end;
 else
   inherited
 end
end;

procedure TMyMemo.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
 inherited;
 SetBkMode(Message.ChildDC, TRANSPARENT)
end;

procedure TMyMemo.WMEraseBkgnd(var Message: TMessage);
begin
 Message.Result := 1
end;

procedure TMyMemo.WMPaint(var Message: TWMPaint);
var
 DC, TempDC: HDC;
 OldBmp: HBITMAP;
 PS: TPaintStruct;
 TempRect: TRect;
begin
 if Message.DC <> 0 then
   inherited
 else begin
   TempRect := ClientRect;
   BeginPaint (Handle, PS);
   DC       := GetDC(Handle);
   TempDC   := CreateCompatibleDC(DC);
   OldBmp   := SelectObject(TempDC, CreateCompatibleBitmap(DC, TempRect.Right, TempRect.Bottom));
   try
     FillRect(TempDC, ClientRect, Brush.Handle);
     Message.DC := TempDC;
     WMPaint(Message);
     Message.DC := 0;
     BitBlt(DC, 0, 0, TempRect.Right, TempRect.Bottom, TempDC, 0, 0, SRCCOPY);
   finally
     DeleteObject(SelectObject(TempDC, OldBmp))
   end;
   ReleaseDC (Handle, TempDC);
   ReleaseDC (Handle, DC);
   EndPaint (Handle, PS)
 end
end;

procedure TMyMemo.WMRedraw(var Message: TMessage);
begin
 SendMessage(Handle, WM_SETREDRAW, 1, 0);
 Invalidate
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Memo1.Brush.Bitmap := Image1.Picture.Bitmap;
end;


---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.09.25;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.035 c