Delphi: TMemo垂直滚动条自动显示

时间:2023-03-09 18:20:15
Delphi: TMemo垂直滚动条自动显示

项目中碰到此问题,之前一直没留意,研究一番用上,以做备忘。参考其它解决方法,不尽完美,自试之,达到效果。

直上代码:

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') + ;
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, );
end;
end
else if ScrollBars = ssVertical then
ScrollBars := ssNone;
end;

效果如图示:

Delphi: TMemo垂直滚动条自动显示