CueText等效于TMemo

Question

我有这个Delphi代码来设置我的表单上的控件的提示文本:

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;

我希望TMemo 具有相同的效果,但MSDN文档说:

您无法在多行编辑控件或富编辑控件上设置提示横幅.

是否有一种标准方法可以在TMemo上产生cuetext效果,或者我是否必须摆弄OnEnter/OnExit事件并自行滚动？

Answer 1

你可以破解TMemo控件

带有TextHint单行版本的TMemo

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;

设置TextHint属性

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

TMemo与TextHint MultiLine版本

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');

再见.