
30.11.2010, 19:48
|
 |
Продвинутый
|
|
Регистрация: 07.09.2010
Сообщения: 726
Репутация: 26711
|
|
Только так:
http://www.sql.ru/Forum/actualfile.aspx?id=3889623
Код:
TForm1 = class(TForm)
Memo1: TMemo;
Memo2: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
procedure MemoWndProc(var Message: TMessage);
public
{ Public declarations }
end;
var
Form1 : TForm1;
Bmp : TBitmap;
FMemoInstance : Pointer;
FPrevMemoProc : Pointer;
implementation
{$R *.DFM}
procedure TForm1.MemoWndProc(var Message: TMessage);
var
PS : TPaintStruct;
DC : HDC;
I, Y : Integer;
begin
with Message do
case Msg of
WM_PAINT :
begin
DC := BeginPaint(Memo1.Handle, PS);
SetBkMode(DC, TRANSPARENT);
SelectObject(DC, Memo1.Font.Handle);
StretchBlt(DC, 0, 0, Memo1.Width, Memo1.Height, Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, SRCCOPY);
Y := 1;
for I := 0 to Memo1.Lines.Count - 1 do
begin
TextOut(DC, 1, Y, PChar(Memo1.Lines[i]), Length(Memo1.Lines[i]));
inc(Y, abs(Memo1.Font.Height) + 2);
end;
DeleteObject(Memo1.Font.Handle);
EndPaint(Memo1.Handle, PS);
end;
else
Result := CallWindowProc(FPrevMemoProc, Form1.Memo1.Handle, Msg, wParam, lParam);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Bmp := TBitmap.Create;
Bmp.LoadFromResourceName(hInstance, 'ICE');
FMemoInstance := MakeObjectInstance(MemoWndProc);
FPrevMemoProc := Pointer(GetWindowLong(Memo1.Handle, GWL_WNDPROC));
SetWindowLong(Memo1.Handle, GWL_WNDPROC, Longint(FMemoInstance));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Memo1.HandleAllocated then
SetWindowLong(Memo1.Handle, GWL_WNDPROC, Longint(FPrevMemoProc));
Bmp.Free;
end;
Или используй другой компонент, хоть тот же TRichView.
__________________
Помогаю за Спасибо
|