Как нарисовать что-нибудь на TMemo?
Материал из DRKB
Как нарисовать что-нибудь на TMemo?[править | править код]
Для рисования на поверхности TMemo необходимо создать создать собственный компонент, наследованный от TMemo и переопределить в нём рисование. Примерно так:
type
TMyMemo = class(TMemo)
protected
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
end;
А теперь добавьте реализацию этой процедуры:
procedure TMyMemo.WMPaint(var Message: TWMPaint);
var
MCanvas: TControlCanvas;
DrawBounds: TRect;
begin
inherited;
MCanvas:=TControlCanvas.Create;
DrawBounds := ClientRect; // Работаем с временной записью TRect.
try
MCanvas.Control := Self;
with MCanvas do
begin
Brush.Color := clBtnFace;
FrameRect(DrawBounds);
InflateRect(DrawBounds, -1, -1);
FrameRect(DrawBounds);
FillRect(DrawBounds);
MoveTo(33, 0);
Brush.Color := clWhite;
LineTo(33, ClientHeight);
PaintImages;
end;
finally
MCanvas.Free;
end;
end;
Процедура PaintImages рисует картинки на канвасе Memo.
procedure TMyMemo.PaintImages;
var
MCanvas: TControlCanvas;
DrawBounds: TRect;
i, j: Integer;
OriginalRegion: HRGN;
ControlDC: HDC;
begin
MCanvas := TControlCanvas.Create;
DrawBounds := ClientRect; // Работаем с временной записью TRect.
try
MCanvas.Control := Self;
ControlDC := GetDC(Handle);
MCanvas.Draw(0, 1, Application.Icon);
finally
MCanvas.Free;
end;
end;
Теперь мы имеем собственноручно нарисованный memo.
Source: Взято из http://forum.sources.ru
ID: 00554