| Вопрос [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; |