CueText equivalent for a TMemo - delphi

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.