CueText相當於一個TMemo

Question

我有這樣的德爾福代碼設置我的窗體上的控制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上有一個cuetext效果，還是我不得不擺弄OnEnter/OnExit事件並自己動手？

Answer 1

你能砍的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隨着TextHint多行版本

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

再見。