15 мая 2023 года "Исходники.РУ" отмечают своё 23-летие!
Поздравляем всех причастных и неравнодушных с этим событием!
И огромное спасибо всем, кто был и остаётся с нами все эти годы!

Главная Форум Журнал Wiki DRKB Discuz!ML Помощь проекту




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