How to expand a TMemo while keying in #116

unit PopupMemo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TPopupMemo = class(TMemo)
  private
    FDesigntimeHeight: Integer;
    FFocusedHeight: Integer;
    FMaximumHeight: Integer;
    FCanvas: TControlCanvas;
    procedure CMTextChanged(var msg: TMessage); message CM_TEXTCHANGED;
    procedure SetFocusedHeight(const Value: Integer);
    procedure SetMaximumHeight(const Value: Integer);
    procedure UpdateHeight;
    procedure ChangeScrollbar( value: TScrollStyle );
  protected
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure Change; override;
    procedure AdjustHeight;
    property Canvas: TControlCanvas read FCanvas;
  public
    Constructor Create( aOwner: TComponent ); override;
    Destructor Destroy; override;
    property FocusedHeight: Integer
      read FFocusedHeight write SetFocusedHeight;
  published
    property MaximumHeight: Integer
      read FMaximumHeight write SetMaximumHeight;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('PBGoodies', [TPopupMemo]);
end;

{ TPopupMemo }

procedure TPopupMemo.AdjustHeight;
const
  alignflags: Array [TAlignment] of DWORD =
    (DT_LEFT, DT_CENTER, DT_RIGHT);
var
  oldrect, newrect: TRect;
  newheight: Integer;
  S: String;
begin
  if not HandleAllocated then
    Exit;
  Perform( EM_GETRECT, 0, lparam(@oldrect));
  S:= Text;
  {DrawText discards a trailing linebreak for measurement, so if the
  user hits return in the control and the new line would require a
  larger memo we do not get the correct value back. To fix that we add
  a blank just for the measurement if the last character is a linefeed.}
  if (Length(S) > 0) and (S[Length(S)] = #10) then
    S := S + ' ';
  Canvas.Font := Font;
  newrect := oldrect;
  DrawText(
    Canvas.Handle,
    PChar(S),
    Length(S),
    newrect,
    DT_CALCRECT or DT_EDITCONTROL or DT_WORDBREAK or DT_NOPREFIX
      or DT_EXPANDTABS or alignflags[ Alignment ]
  );
  if oldrect.bottom <> newrect.bottom then
  begin
    newHeight := Height - (oldrect.bottom-oldrect.top)
      + (newrect.bottom - newrect.top );
    if newHeight > MaximumHeight then
      ChangeScrollbar( ssVertical )
    else
      ChangeScrollbar( ssNone );
    FocusedHeight := newHeight;
  end;
end;

procedure TPopupMemo.Change;
begin
  AdjustHeight;
  inherited;
end;

procedure TPopupMemo.ChangeScrollbar(value: TScrollStyle);
var
  oldpos: Integer;
begin
  if Scrollbars <> value then
  begin
    {Changing the scrollbar recreates the window and looses the
    caret position!}
    oldpos := SelStart;
    Scrollbars := value;
    SelStart := oldpos;
    Perform( EM_SCROLLCARET, 0, 0 );
  end;
end;

procedure TPopupMemo.CMTextChanged(var msg: TMessage);
begin
  AdjustHeight;
  inherited;
end;

constructor TPopupMemo.Create(aOwner: TComponent);
begin
  inherited;
  FFocusedHeight := Height;
  FMaximumHeight := 5 * Height;
  FCanvas:= TControlCanvas.Create;
  FCanvas.Control := Self;
end;

destructor TPopupMemo.Destroy;
begin
  FCanvas.Free;
  inherited;
end;

procedure TPopupMemo.DoEnter;
begin
  inherited;
  FDesigntimeHeight := Height;
  UpdateHeight;
  {Height := FFocusedHeight;}
end;

procedure TPopupMemo.DoExit;
begin
  inherited;
  Height := FDesigntimeHeight;
end;

procedure TPopupMemo.SetFocusedHeight(const Value: Integer);
begin
  if FFocusedHeight <> Value then
  begin
    if Value > MaximumHeight then
      FFocusedHeight := MaximumHeight
    else
      FFocusedHeight := value;
    if Focused then
      UpdateHeight;
  end;
end;

procedure TPopupMemo.SetMaximumHeight(const Value: Integer);
begin
  if FMaximumHeight <> Value then
  begin
    FMaximumHeight := Value;
    if Value < FocusedHeight then
      FocusedHeight := Value;
  end;
end;

procedure TPopupMemo.UpdateHeight;
var
  line: Integer;
begin
  if HandleAllocated and Focused then
  begin
    Height := FocusedHeight;
    if Scrollbars = ssNone then
    begin
      line := Perform( EM_GETFIRSTVISIBLELINE, 0, 0 );
      if line > 0 then
        Perform( EM_LINESCROLL, 0, - line );
    end;
  end;
end;

end.