Вопрос [14 июл 2006]:
Как показать полосы прокрутки в TMemo в зависимости от объёма текста?
Ответ 2:
Чтобы скрыть полосы прокрутки, когда объём текста небольшой и показать, когда текст занимает несколько строк, вызывайте функцию SetScrolls на событие onChange.
// кол-во видимых строк в Memo
function LinesVisible(Memo: TMemo): integer;
var
OldFont: HFont;
Hand: THandle;
TM: TTextMetric;
Rect: TRect;
tempint: integer;
begin
Hand:= GetDC(Memo.Handle);
try
OldFont:= SelectObject(Hand, Memo.Font.Handle);
try
GetTextMetrics(Hand, TM);
Memo.Perform(EM_GETRECT, 0, longint(@Rect));
tempint:= (Rect.Bottom - Rect.Top) div
(TM.tmHeight + TM.tmExternalLeading);
finally
SelectObject(Hand, OldFont);
end;
finally
ReleaseDC(Memo.Handle, Hand);
end;
Result:= tempint;
end;
// включить/ выключить скроллы
в зависимости от объёма текста
procedure SetScrolls(var Memo: TMemo);
var
x, y: integer;
begin
x:= Length(Memo.Text);
// Кол-во строк в Memo (не линий Lines)
y:= SendMessage(Memo.Handle, EM_LINEFROMCHAR, x, 0) + 1;
x:= LinesVisible(Memo);
if y>x then
Memo.ScrollBars:= ssVertical
else
Memo.ScrollBars:= ssNone;
end;
procedure TfmInfo.memFondNameChange(Sender: TObject);
begin
SetScrolls(memFondName);
end;
|