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,LParam(PWideChar(WideString(cueText))));
end;

我想在TMemo上使用same effect,但MSDN文档说：

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

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

解决方法

你可以破解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');

再见.

原文链接：https://www.f2er.com/delphi/239259.html

delphi – 与TMemo等效的CueText

解决方法

猜你在找的Delphi相关文章