項目中碰到此問題,之前一直沒留意,研究一番用上,以做備忘。參考其它解決方法,不盡完美,自試之,達到效果。
直上代碼:
type TMemo = class(StdCtrls.TMemo) protected procedure Change; override; end;
{ TMemo } procedure TMemo.Change; var lc, lh: Integer; cvs: TControlCanvas; begin inherited; cvs := TControlCanvas.Create; try cvs.Control := Self; cvs.Font.Assign(Font); lh := cvs.TextHeight('z') + 2; finally cvs.Free; end; lc := Lines.Count; if (Text <> '') and (Text[Length(Text)] = #10) then Inc(lc); if lc * lh > Height then begin if ScrollBars = ssNone then begin ScrollBars := ssVertical; Perform(WM_VSCROLL, SB_BOTTOM, 0); end; end else if ScrollBars = ssVertical then ScrollBars := ssNone; end;
效果如圖示:

