CueText equivalent for a TMemo

Question

I have this Delphi code to set the cue text of a control on my form:

procedure TfrmMain.SetCueText(edt: TWinControl; cueText: string);
const
  ECM_FIRST = $1500;
  EM_SETCUEBANNER = ECM_FIRST + 1;
begin
  SendMessage(edt.Handle,EM_SETCUEBANNER,0,
    LParam(PWideChar(WideString(cueText))));
end;

I want the same effect on a TMemo, but the MSDN document says:

You cannot set a cue banner on a multiline edit control or on a rich edit control.

Is there a standard way to have a cuetext effect on a TMemo, or do I have to fiddle with the OnEnter/OnExit events and roll my own?

Answer 1

You can hack the TMemo Control

TMemo With TextHint Single Line Version

type
    TMemo = class(StdCtrls.TMemo)
    private
     FTextHint: string;
     FTextHintFont: TFont;
    protected
     FCanvas : TCanvas;
     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    public
     constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
    published
     property TextHint: string read FTextHint write FTextHint;
     property TextHintFont: TFont read FTextHintFont write FTextHintFont;
    end;

  TForm1 = class(TForm)
    Memo1: TMemo;
  private
  public
  end;


constructor TMemo.Create(AOwner: TComponent);
begin
  inherited;
  FCanvas               := TControlCanvas.Create;
  FTextHintFont         := TFont.Create;
  FTextHintFont.Color   := clGrayText;
  TControlCanvas(FCanvas).Control := Self;
end;

destructor TMemo.Destroy;
begin
  FreeAndNil(FTextHintFont);
  FreeAndNil(FCanvas);
  inherited;
end;

procedure TMemo.WMPaint(var Message: TWMPaint);
begin
  inherited;
  if  (Text = '') and (not Focused) then
  begin
  FCanvas.Font := FTextHintFont;
  FCanvas.TextOut(1, 1, FTextHint); //Note : is not multiline
  end;
end;

To set the TextHint property

Memo1.TextHint:='Enter your comments here';

TMemo With TextHint MultiLine Version

type
    TMemo = class(StdCtrls.TMemo)
    private
     FTextHint: TStrings;
     FTextHintFont: TFont;
    protected
     FCanvas : TCanvas;
     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    public
     constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
    published
     property TextHint: TStrings read FTextHint write FTextHint;
     property TextHintFont: TFont read FTextHintFont write FTextHintFont;
    end;


constructor TMemo.Create(AOwner: TComponent);
begin
  inherited;
  FTextHint             := TStringList.Create;
  FCanvas               := TControlCanvas.Create;
  FTextHintFont         := TFont.Create;
  FTextHintFont.Color   := clGrayText;
  TControlCanvas(FCanvas).Control := Self;
end;

destructor TMemo.Destroy;
begin
  FreeAndNil(FTextHintFont);
  FreeAndNil(FCanvas);
  FTextHint.Clear;
  FreeAndNil(FTextHint);
 inherited;
end;

procedure TMemo.WMPaint(var Message: TWMPaint);
Var
i            : integer;
TextHeight   : Integer;
begin
  inherited;
  if  (Text = '') and (not Focused) then
  begin
  FCanvas.Font := FTextHintFont;
  TextHeight:=FCanvas.TextHeight('MLZ'); //Dummy Text to determine Height
    for i := 0 to FTextHint.Count - 1 do
    FCanvas.TextOut(1, 1+(i*TextHeight), FTextHint[i]);
  end;
end;

Memo1.TextHint.Add('Enter your comments here Line 1');
Memo1.TextHint.Add('Enter your comments here Line 2');
Memo1.TextHint.Add('Enter your comments here Line 3');

Bye.

Answer 2

Thanks RRuz this code saved my life!