delphi - 等同于TMemo的CueText

我有以下Delphi代码可在表单上设置控件的cue text：

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上使用same effect，但是MSDN文档中说：


  您不能在
  多行编辑控件或富
  编辑控件。


是否有在TMemo上产生提示文字效果的标准方法，还是我必须摆弄OnEnter / OnExit事件并自行滚动？

最佳答案

您可以破解TMemo控件

TMemo与TextHint单行版本

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

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

再见

关于delphi - 等同于TMemo的CueText，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/1465845/