How to create a TMemo with alternating colours to paint the lines #87

Question

I'm trying to change the font of the first line of a TMemo. Is it possible and if so, what functions do I override to accomplish it?

It is possible, but I would advise you to use a font that has the same height as the original font that is used in the memo (to avoid problems with the scollbars). You have to override the WMPaint method (i.e. respond to the WM_Paint message). The following example shows an owner-drawn memo in which I alternate the colours used to paint the lines, but you can modify it to change the font for the first line only, of course:

unit Todrmemo;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TOwnerDrawMemo = class(TMemo)
  private
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  end;

procedure Register;

implementation

procedure TOwnerDrawMemo.WMPaint(var Message: TWMPaint);
var
  Buffer: Array[0..255] of Char;
  PS: TPaintStruct;
  DC: HDC;
  i: Integer;
  X, Y, Z: Word;
  OldColor: LongInt;
begin
  DC := Message.DC;
  if DC = 0 then
    DC := BeginPaint(Handle, PS);
  try
    X := 1;
    Y := 1;
    SetBkColor(DC, Color);
    SetBkMode(DC, Transparent);
    OldColor := Font.Color;
    for i:=0 to Pred(Lines.Count) do
    begin
      { this is your place to set/reset the font... }
      if odd(i) then
        SetTextColor(DC, clRed)
      else
        SetTextColor(DC, OldColor);
      Z := Length(Lines[i]);
      StrPCopy(Buffer, Lines[i]);
      Buffer[Z] := #0;  { not really needed }
      TextOut(DC, X, Y, Buffer, Z);
      Inc(Y, abs(Font.Height));
    end;
  finally
    if Message.DC = 0 then
      EndPaint(Handle, PS);
  end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TOwnerDrawMemo]);
end;

end.

Demo code

A ready made project containing this demo code is available. View the project.

This demo uses the owner draw memo presented above and creates it dynamically, to save having to install the component. We display four lines of text to demonstrate the component. Proceed as follows:

Start a new Delphi VCL application.
Create a copy of the Todrmemo unit presented above, save it as Todrmemo.pas and add it to the project.
Name the project's main form "Form1" and create an OnCreate event handler for TForm1. Save the form unit as Unit1.pas.
Code Unit1.pas as follows:

unit Unit1;

interface

uses
  Forms, Todrmemo;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    fODM: TOwnerDrawMemo;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  fODM := TOwnerDrawMemo.Create(Self);
  fODM.Parent := Self;
  fODM.Top := 20;
  fODM.Left := 20;
  fODM.Lines.Text :=
    'Line 1'#13#10'Line 2'#13#10'Line 3'#13#10'Line 4';
end;

end.

When you run the program you will see the memo with alternating red and grey font colours. Do note though that if you select any text the control will become a mess – the coloured fonts will be lost.

Demo by Peter Johnson

Original resource:	The Delphi Pool
Author:	Unknown
Added:	2009/08/28
Last updated:	2010/03/16