Как нарисовать что-нибудь на 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