Solved

Text completion in TMemo with TListBox

Posted on 2001-08-18
10
721 Views
Last Modified: 2010-05-18
Hi,

i want to make some kind of text completion in a TMemo component with a TListBox as the values possible for completion. Just like the Delphi code completion.
(if you press Ctrl + Space)

so the ListBox must be visible at the posistion where you are typing a word and give some possibilities to complete the word.

please post some Code Examples

TIA,
ruben
0
Comment
Question by:rtieland
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
10 Comments
 
LVL 3

Expert Comment

by:smurff
ID: 6402683
listening
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6403092
Hi ruben,

I found you request interesting and started coding. The options are invoked automatically if the are options available. The options only show when an OnChange occurs. Manually you can invoke the options with <CTRL-SPACE>. The capitalization of initial chars is respected. Also when typing more lines the the height of the memo expects the options listbox appears on the correct position. Navigating the options only with UP and DOWN arrows. Accepts with return. ESCAPE hide the options.

If you need any adjustment please ley me know ;)

Regards Jacco

P.S. There might still be a problem is the lines of the memo have a larger width than the memo. The position then is not calculated correctly. Also the font of the memo and of the form must be the same. (I measure the text using the font of the form).

*** START OF FORM ***
object Form1: TForm1
  Left = 192
  Top = 107
  Width = 696
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object memText: TMemo
    Left = 8
    Top = 8
    Width = 369
    Height = 201
    TabOrder = 0
    OnChange = memTextChange
    OnKeyDown = memTextKeyDown
    OnKeyPress = memTextKeyPress
  end
  object lbWords: TListBox
    Left = 384
    Top = 8
    Width = 121
    Height = 97
    ItemHeight = 13
    Items.Strings = (
      'difference'
      'different'
      'difficult')
    TabOrder = 1
  end
  object lbOptions: TListBox
    Left = 384
    Top = 112
    Width = 121
    Height = 97
    ItemHeight = 13
    TabOrder = 2
  end
end
*** END OF FORM ***

*** START OF CODE ***
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    memText: TMemo;
    lbWords: TListBox;
    lbOptions: TListBox;
    Label1: TLabel;
    procedure memTextChange(Sender: TObject);
    procedure memTextKeyPress(Sender: TObject; var Key: Char);
    procedure memTextKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
    OptionsVisible: Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.memTextChange(Sender: TObject);
var
  lsCurrentLine: string;
  lsCurrentWord: string;
  liLen, liPos, liItem: Integer;
  liFirstVisible: LongInt;
const
  liMinLen = 3;
begin
  // get the currently edited line
  lsCurrentLine := memText.Lines[memText.CaretPos.y];
  // set the complete listbox to not visible
  lbOptions.Visible := False;
  lbOptions.Items.Clear;
  OptionsVisible := False;
  if (memText.CaretPos.x > 0) and (lsCurrentLine[memText.CaretPos.x] <> ' ') then
  begin
    // find the currently edited word
    liPos := memText.CaretPos.x;
    while lsCurrentLine[liPos] <> ' ' do Dec(liPos);
    Inc(liPos);
    lsCurrentWord := Copy(lsCurrentLine, liPos, memText.CaretPos.x);
    // fill list of options
    liLen := Length(lsCurrentWord);
    if  liLen >= liMinLen then
    begin
      for liItem := 0 to lbWords.Items.Count-1 do
        if Length(lbWords.Items[liItem]) > liLen then
          if AnsiCompareText(Copy(lbWords.Items[liItem], 1, liLen), lsCurrentWord) = 0 then
             lbOptions.Items.Add(lbWords.Items[liItem]);
    end;
  end;
  if lbOptions.Items.Count > 0 then
  begin
    // show options at correct position
    lbOptions.Visible   := True;
    OptionsVisible      := True;
    lbOptions.ItemIndex := 0;
    // retrieve the first visible line
    liFirstVisible := SendMessage(memText.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
    lbOptions.Left      := memText.Left + Canvas.TextWidth(Copy(lsCurrentLine, 1, memText.CaretPos.x));
    lbOptions.Top       := memText.Top  + (memText.CaretPos.y - liFirstVisible + 1) * Canvas.TextHeight('pl') + 2;
  end;
end;

var
  ManualInvoke: Boolean = False;

procedure TForm1.memTextKeyPress(Sender: TObject; var Key: Char);
var
  liPos: Integer;
  lsCurrentLine, lsCurrentWord: string;
begin
  if OptionsVisible then
  begin
    if Key = #13 then
    begin
      // select the option
      // get the currently edited line
      lsCurrentLine := memText.Lines[memText.CaretPos.y];
      if (memText.CaretPos.x > 0) and (lsCurrentLine[memText.CaretPos.x] <> ' ') then
      begin
        // find the currently edited word
        liPos := memText.CaretPos.x;
        while lsCurrentLine[liPos] <> ' ' do Dec(liPos);
        Inc(liPos);
        lsCurrentWord := Copy(lsCurrentLine, liPos, memText.CaretPos.x);
      end;
      // replace the currently edited word with the selected option
      memText.SelStart  := memText.SelStart - Length(lsCurrentWord);
      memText.SelLength := Length(lsCurrentWord);
      memText.SelText   := memText.SelText + Copy(lbOptions.Items[lbOptions.ItemIndex], Length(memText.SelText) + 1, 255);
      // prevent the key from appearing in the memo
      Key := #0;
    end;
  end;
  if ManualInvoke then
  begin
    // prevent space when manually invoking options
    ManualInvoke := False;
    Key := #0;
  end;
end;

procedure TForm1.memTextKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if OptionsVisible then
  begin
    if Key in [VK_DOWN, VK_UP, VK_ESCAPE] then
    begin
      // navigate the options
      if (Key = VK_DOWN) and (lbOptions.ItemIndex < lbOptions.Items.Count) then
        lbOptions.ItemIndex := lbOptions.ItemIndex + 1;
      if (Key = VK_UP) and (lbOptions.ItemIndex > 0) then
        lbOptions.ItemIndex := lbOptions.ItemIndex - 1;
      // close the options listbox
      if Key = VK_ESCAPE then
      begin
        lbOptions.Visible := False;
        OptionsVisible    := False;
      end;
      Key := 0;
    end;
  end else
    // invoke options manually
    if (ssCtrl in Shift) and (Key = VK_SPACE) then
    begin
      // this will activate the options (if any)
      memTextChange(memText);
      // set a flag for the KeyPress event
      ManualInvoke := True;
      Key := 0;
    end;
end;

end.
*** END OF CODE ***
0
 
LVL 3

Expert Comment

by:karouri
ID: 6403936
May be the following PAQ is of interest to you:
http://www.experts-exchange.com/jsp/qShow.jsp?ta=delphi&qid=20113707

It is about making instant help like in delphi. By pressing the dot you have options. There you will find working code
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 3

Expert Comment

by:lopem
ID: 6404893
listening...
0
 
LVL 1

Author Comment

by:rtieland
ID: 6410171
Hi,

Jacco your code works perfectly, thanks.
i will give you the points.
i have some question's so i don't close this thread now.

i created a component of the code but the ManualInvoke and the positioning of the ListBox don't work.
could you please help me with this.

the code of my component:

======Start of Code=====
unit ExtMemo;

interface

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

type
  TExtMemo = class(TCustomMemo)
  private
    { Private declarations }
    FManualInvoke : Boolean;
    FAutoComplete : Boolean;
    FMinLength : Integer;
    FOptions : TStringList;
    FOptionsListBox : TListBox;
  protected
    { Protected declarations }
    function CurrentWord:String;
    procedure Change; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Options : TStringList read FOptions write FOptions;
  published
    { Published declarations }
    property AutoComplete : Boolean read FAutoComplete write FAutoComplete;
    property AutoCompLength : Integer read FMinLength write FMinLength;
    //property's of TMemo
    property Align;
    property Alignment;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property Lines;
    property MaxLength;
    property OEMConvert;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ScrollBars;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property WantReturns;
    property WantTabs;
    property WordWrap;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

procedure Register;

implementation

procedure TExtMemo.Change;
var
  i     : Integer;
  {FPos  : Integer; //Position of Char    }
  FWord : String;  //Current Word
  FFirstVisible : LongInt;
  TextSize : TSize;
begin
  inherited;
  FOptionsListBox.Visible := False;
  FOptionsListBox.Clear;
  if (CaretPos.x > 0) and not (Lines[CaretPos.y][CaretPos.x] in [' ','.',',']) then
  begin
    FWord := CurrentWord;
    if (FAutoComplete and (Length(FWord) >= FMinLength)) or FManualInvoke then
    begin
     for i := 0 to FOptions.Count - 1 do
       if Length(FOptions.Strings[i]) > Length(FWord) then
         if AnsiCompareText(Copy(FOptions.Strings[i], 1, Length(FWord)), FWord) = 0 then
           FOptionsListBox.Items.Add(FOptions.Strings[i]);
    end;
    if FManualInvoke then FManualInvoke := False;
  end;
  if FOptionsListBox.Items.Count > 0 then
  begin
   FOptionsListBox.Visible := True;
   FOptionsListBox.ItemIndex := 0;
   FFirstVisible := SendMessage(Self.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
   Windows.GetTextExtentPoint32(Self.Handle, PChar(Copy(Lines[CaretPos.y], 1, CaretPos.x)), Length(Copy(Lines[CaretPos.y], 1, CaretPos.x)), TextSize);
   FOptionsListBox.Left := Left + TextSize.cx;
   FOptionsListBox.Top := Top + (CaretPos.y - FFirstVisible + 1) * TextSize.cy;
  end;
end;

procedure TExtMemo.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if FOptionsListBox.Visible and (Key in [VK_DOWN, VK_UP, VK_ESCAPE]) then
  begin
    case Key of
      VK_DOWN   : if FOptionsListBox.ItemIndex < FOptionsListBox.Items.Count then
                    FOptionsListBox.ItemIndex := FOptionsListBox.ItemIndex + 1;
      VK_UP     : if FOptionsListBox.ItemIndex > 0 then
                    FOptionsListBox.ItemIndex := FOptionsListBox.ItemIndex - 1;
      VK_ESCAPE : FOptionsListBox.Visible := False;
    end;
    Key := 0;
  end else
    if (ssCtrl in Shift) and (Key = VK_SPACE) then
    begin
      FManualInvoke := True;
    end;
end;

procedure TExtMemo.KeyPress(var Key: Char);
var
  FWord : String;  //Current Word
begin
  inherited;
  if FOptionsListBox.Visible and (Key = #13) then
  begin
    if (CaretPos.x > 0) and (Lines[CaretPos.y][CaretPos.x] <> ' ') then
      FWord := CurrentWord;
    SelStart := SelStart - Length(FWord);
    SelLength := Length(FWord);
    SelText := FOptionsListBox.Items[FOptionsListBox.itemindex];
    //SelText := SelText + Copy(FOptionsListBox.Items[FOptionsListBox.itemindex], Length(SelText) + 1, 255);
    Key := #0;
  end;
  if FManualInvoke then Key := #0;
end;

constructor TExtMemo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMinLength := 2;
  FAutoComplete := True;
  FOptions := TStringList.Create;
  FOptionsListBox := TListBox.Create(AOwner);
  FOptionsListBox.Parent := Self;
  FOptionsListBox.Visible := False;
end;

destructor TExtMemo.Destroy;
begin
  FOptions.Free;
  FOptionsListBox.Free;
  inherited Destroy;
end;

procedure Register;
begin
  RegisterComponents('SoSsA', [TExtMemo]);
end;

function TExtMemo.CurrentWord: String;
Var
 FPos : Integer;
begin
 FPos := CaretPos.x;
 While Lines[CaretPos.y][FPos] <> ' ' do Dec(FPos);
 Inc(FPos);
 Result := Copy(Lines[CaretPos.y], FPos, CaretPos.x);
end;

end.
===End of Code===

TIA,
ruben
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6410449
I'll give it a try in a few hours

Regards Jacco
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6410918
Hi there,

I have spent another hour or two on your sources. I have made quit some changes positioning and manual invoke work now. There is still a lot to do before this is a commercially attractive component. Shifting focus to another control and closing up when losing focus are things to be covered still.

I also found out how to retrieve the position of a horizontal ScrollBar so that works too. Your 100 pts are definately finished now, but if you have any new question please ask.

Regards Jacco

*** start of code ***
unit ExtMemo;

interface

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

type
 TExtMemo = class(TCustomMemo)
 private
   { Private declarations }
   FManualInvoke : Boolean;
   FPopup: Boolean; (* changes *)
   FAutoComplete : Boolean;
   FMinLength : Integer;
   FOptions : TStringList;
   FOptionsListBox : TListBox;
 protected
   { Protected declarations }
   function CurrentWord:String;
   procedure Change; override;
   procedure KeyDown(var Key: Word; Shift: TShiftState); override;
   procedure KeyPress(var Key: Char); override;
   procedure SetParent(AParent: TWinControl); override;
 public
   { Public declarations }
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   property Options : TStringList read FOptions write FOptions;
 published
   { Published declarations }
   property AutoComplete : Boolean read FAutoComplete write FAutoComplete;
   property AutoCompLength : Integer read FMinLength write FMinLength;
   //property's of TMemo
   property Align;
   property Alignment;
   property Anchors;
   property BiDiMode;
   property BorderStyle;
   property Color;
   property Constraints;
   property Ctl3D;
   property DragCursor;
   property DragKind;
   property DragMode;
   property Enabled;
   property Font;
   property HideSelection;
   property ImeMode;
   property ImeName;
   property Lines;
   property MaxLength;
   property OEMConvert;
   property ParentBiDiMode;
   property ParentColor;
   property ParentCtl3D;
   property ParentFont;
   property ParentShowHint;
   property PopupMenu;
   property ReadOnly;
   property ScrollBars;
   property ShowHint;
   property TabOrder;
   property TabStop;
   property Visible;
   property WantReturns;
   property WantTabs;
   property WordWrap;
   property OnChange;
   property OnClick;
   property OnContextPopup;
   property OnDblClick;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnEnter;
   property OnExit;
   property OnKeyDown;
   property OnKeyPress;
   property OnKeyUp;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnStartDock;
   property OnStartDrag;
 end;

procedure Register;

implementation

function TExtMemo.CurrentWord: String;
var
  FPos : Integer;
begin
  FPos := CaretPos.x;
  while Lines[CaretPos.y][FPos] <> ' ' do Dec(FPos);
  Inc(FPos);
  Result := Copy(Lines[CaretPos.y], FPos, CaretPos.x - FPos + 1); (* changes *)
end;

procedure TExtMemo.SetParent(AParent: TWinControl); (* changes *)
begin
  inherited SetParent(AParent);
  FOptionsListBox.Parent := AParent;
end;

procedure TExtMemo.Change; (* changes *)
var
 i     : Integer;
 {FPos  : Integer; //Position of Char    }
 FWord : String;  //Current Word
 FFirstVisible : LongInt;
 TextSize : TSize;
 FCanvas: TCanvas;
 FOrigin: TPoint;
 lScrollInfo: TScrollInfo;
begin
 inherited;
 FOptionsListBox.Visible := False;
 FOptionsListBox.Clear;
 if (CaretPos.x > 0) and not (Lines[CaretPos.y][CaretPos.x] in [' ','.',',']) then
 begin
   FWord := CurrentWord;
   if (FAutoComplete and (Length(FWord) >= FMinLength)) or FPopup then
   begin
    for i := 0 to FOptions.Count - 1 do
      if Length(FOptions.Strings[i]) > Length(FWord) then
        if AnsiCompareText(Copy(FOptions.Strings[i], 1, Length(FWord)), FWord) = 0 then
          FOptionsListBox.Items.Add(FOptions.Strings[i]);
   end;
 end;
 if FPopup then FPopup := False;
 if FOptionsListBox.Items.Count > 0 then
 begin
  FOptionsListBox.Visible := True;
  FOptionsListBox.ItemIndex := 0;
  FFirstVisible := SendMessage(Self.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
  FCanvas := TCanvas.Create;
  try
    FCanvas.Handle := GetDC(Self.Handle);
    TextSize.cx := FCanvas.TextWidth(Copy(Lines[CaretPos.y], 1, CaretPos.x));
    TextSize.cy := FCanvas.TextHeight('lp');
    lScrollInfo.cbSize := SizeOf(TScrollInfo);
    lScrollInfo.fMask := SIF_POS;
    GetScrollInfo(Handle, SB_HORZ, lScrollInfo);
    FOrigin.x := lScrollInfo.nPos;
  finally
    FCanvas.Free;
  end;
  // Windows.GetTextExtentPoint32(Self.Handle, PChar(Copy(Lines[CaretPos.y], 1, CaretPos.x)), Length(Copy(Lines[CaretPos.y], 1, CaretPos.x)), TextSize);
  FOptionsListBox.Left := Left - FOrigin.x + TextSize.cx + 2; (* changes *)
  FOptionsListBox.Top  := Top + (CaretPos.y - FFirstVisible + 1) * TextSize.cy; (* changes *)
 end;
end;

procedure TExtMemo.KeyDown(var Key: Word; Shift: TShiftState);
begin
 inherited;
 if FOptionsListBox.Visible and (Key in [VK_DOWN, VK_UP, VK_ESCAPE]) then
 begin
   case Key of
     VK_DOWN   : if FOptionsListBox.ItemIndex < FOptionsListBox.Items.Count then
                   FOptionsListBox.ItemIndex := FOptionsListBox.ItemIndex + 1;
     VK_UP     : if FOptionsListBox.ItemIndex > 0 then
                   FOptionsListBox.ItemIndex := FOptionsListBox.ItemIndex - 1;
     VK_ESCAPE : FOptionsListBox.Visible := False;
   end;
   Key := 0;
 end else
   if (ssCtrl in Shift) and (Key = VK_SPACE) then
   begin
     FManualInvoke := True;
     FPopup := True; (* changes *)
     Key := 0;
     Change; (* changes *)
   end;
end;

procedure TExtMemo.KeyPress(var Key: Char);
var
 FWord : String;  //Current Word
begin
 inherited;
 if FOptionsListBox.Visible and (Key = #13) then
 begin
   if (CaretPos.x > 0) and (Lines[CaretPos.y][CaretPos.x] <> ' ') then
     FWord := CurrentWord;
   SelStart := SelStart - Length(FWord);
   SelLength := Length(FWord);
   SelText := FOptionsListBox.Items[FOptionsListBox.itemindex];
   // !!! JACCO: This was intended to keep capitalisation as user typed
   //SelText := SelText + Copy(FOptionsListBox.Items[FOptionsListBox.itemindex], Length(SelText) + 1, 255);
   Key := #0;
 end;
 if FManualInvoke then
 begin
   Key := #0;
   FManualInvoke := False; (* changes *)
 end;
end;

constructor TExtMemo.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FMinLength := 2;
 FAutoComplete := True;
 FOptions := TStringList.Create;
 FOptionsListBox := TListBox.Create(Self); (* changes *)
 FOptionsListBox.Parent := Self;
 FOptionsListBox.Visible := False;
end;

destructor TExtMemo.Destroy;
begin
 FOptions.Free;
 FOptionsListBox.Free;
 inherited Destroy;
end;

procedure Register;
begin
 RegisterComponents('SoSsA', [TExtMemo]);
end;

end.
*** end of code ***
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6426033
Are you still here?

Regards Jacco
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6440501
Guess not...

Is the component working?

Regards Jacco
0
 
LVL 10

Accepted Solution

by:
Jacco earned 100 total points
ID: 6441944
Hi,

Since no one is responding, ruben already promised me the points and my proposed solution should work, I am committing my previous comment as an answer...

Over&Out Jacco

*** start of code ***
unit ExtMemo;

interface

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

type
TExtMemo = class(TCustomMemo)
private
  { Private declarations }
  FManualInvoke : Boolean;
  FPopup: Boolean; (* changes *)
  FAutoComplete : Boolean;
  FMinLength : Integer;
  FOptions : TStringList;
  FOptionsListBox : TListBox;
protected
  { Protected declarations }
  function CurrentWord:String;
  procedure Change; override;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure KeyPress(var Key: Char); override;
  procedure SetParent(AParent: TWinControl); override;
public
  { Public declarations }
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  property Options : TStringList read FOptions write FOptions;
published
  { Published declarations }
  property AutoComplete : Boolean read FAutoComplete write FAutoComplete;
  property AutoCompLength : Integer read FMinLength write FMinLength;
  //property's of TMemo
  property Align;
  property Alignment;
  property Anchors;
  property BiDiMode;
  property BorderStyle;
  property Color;
  property Constraints;
  property Ctl3D;
  property DragCursor;
  property DragKind;
  property DragMode;
  property Enabled;
  property Font;
  property HideSelection;
  property ImeMode;
  property ImeName;
  property Lines;
  property MaxLength;
  property OEMConvert;
  property ParentBiDiMode;
  property ParentColor;
  property ParentCtl3D;
  property ParentFont;
  property ParentShowHint;
  property PopupMenu;
  property ReadOnly;
  property ScrollBars;
  property ShowHint;
  property TabOrder;
  property TabStop;
  property Visible;
  property WantReturns;
  property WantTabs;
  property WordWrap;
  property OnChange;
  property OnClick;
  property OnContextPopup;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnEndDock;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnKeyDown;
  property OnKeyPress;
  property OnKeyUp;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseUp;
  property OnStartDock;
  property OnStartDrag;
end;

procedure Register;

implementation

function TExtMemo.CurrentWord: String;
var
 FPos : Integer;
begin
 FPos := CaretPos.x;
 while Lines[CaretPos.y][FPos] <> ' ' do Dec(FPos);
 Inc(FPos);
 Result := Copy(Lines[CaretPos.y], FPos, CaretPos.x - FPos + 1); (* changes *)
end;

procedure TExtMemo.SetParent(AParent: TWinControl); (* changes *)
begin
 inherited SetParent(AParent);
 FOptionsListBox.Parent := AParent;
end;

procedure TExtMemo.Change; (* changes *)
var
i     : Integer;
{FPos  : Integer; //Position of Char    }
FWord : String;  //Current Word
FFirstVisible : LongInt;
TextSize : TSize;
FCanvas: TCanvas;
FOrigin: TPoint;
lScrollInfo: TScrollInfo;
begin
inherited;
FOptionsListBox.Visible := False;
FOptionsListBox.Clear;
if (CaretPos.x > 0) and not (Lines[CaretPos.y][CaretPos.x] in [' ','.',',']) then
begin
  FWord := CurrentWord;
  if (FAutoComplete and (Length(FWord) >= FMinLength)) or FPopup then
  begin
   for i := 0 to FOptions.Count - 1 do
     if Length(FOptions.Strings[i]) > Length(FWord) then
       if AnsiCompareText(Copy(FOptions.Strings[i], 1, Length(FWord)), FWord) = 0 then
         FOptionsListBox.Items.Add(FOptions.Strings[i]);
  end;
end;
if FPopup then FPopup := False;
if FOptionsListBox.Items.Count > 0 then
begin
 FOptionsListBox.Visible := True;
 FOptionsListBox.ItemIndex := 0;
 FFirstVisible := SendMessage(Self.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
 FCanvas := TCanvas.Create;
 try
   FCanvas.Handle := GetDC(Self.Handle);
   TextSize.cx := FCanvas.TextWidth(Copy(Lines[CaretPos.y], 1, CaretPos.x));
   TextSize.cy := FCanvas.TextHeight('lp');
   lScrollInfo.cbSize := SizeOf(TScrollInfo);
   lScrollInfo.fMask := SIF_POS;
   GetScrollInfo(Handle, SB_HORZ, lScrollInfo);
   FOrigin.x := lScrollInfo.nPos;
 finally
   FCanvas.Free;
 end;
 // Windows.GetTextExtentPoint32(Self.Handle, PChar(Copy(Lines[CaretPos.y], 1, CaretPos.x)), Length(Copy(Lines[CaretPos.y],
1, CaretPos.x)), TextSize);
 FOptionsListBox.Left := Left - FOrigin.x + TextSize.cx + 2; (* changes *)
 FOptionsListBox.Top  := Top + (CaretPos.y - FFirstVisible + 1) * TextSize.cy; (* changes *)
end;
end;

procedure TExtMemo.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;
if FOptionsListBox.Visible and (Key in [VK_DOWN, VK_UP, VK_ESCAPE]) then
begin
  case Key of
    VK_DOWN   : if FOptionsListBox.ItemIndex < FOptionsListBox.Items.Count then
                  FOptionsListBox.ItemIndex := FOptionsListBox.ItemIndex + 1;
    VK_UP     : if FOptionsListBox.ItemIndex > 0 then
                  FOptionsListBox.ItemIndex := FOptionsListBox.ItemIndex - 1;
    VK_ESCAPE : FOptionsListBox.Visible := False;
  end;
  Key := 0;
end else
  if (ssCtrl in Shift) and (Key = VK_SPACE) then
  begin
    FManualInvoke := True;
    FPopup := True; (* changes *)
    Key := 0;
    Change; (* changes *)
  end;
end;

procedure TExtMemo.KeyPress(var Key: Char);
var
FWord : String;  //Current Word
begin
inherited;
if FOptionsListBox.Visible and (Key = #13) then
begin
  if (CaretPos.x > 0) and (Lines[CaretPos.y][CaretPos.x] <> ' ') then
    FWord := CurrentWord;
  SelStart := SelStart - Length(FWord);
  SelLength := Length(FWord);
  SelText := FOptionsListBox.Items[FOptionsListBox.itemindex];
  // !!! JACCO: This was intended to keep capitalisation as user typed
  //SelText := SelText + Copy(FOptionsListBox.Items[FOptionsListBox.itemindex], Length(SelText) + 1,
255);
  Key := #0;
end;
if FManualInvoke then
begin
  Key := #0;
  FManualInvoke := False; (* changes *)
end;
end;

constructor TExtMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMinLength := 2;
FAutoComplete := True;
FOptions := TStringList.Create;
FOptionsListBox := TListBox.Create(Self); (* changes *)
FOptionsListBox.Parent := Self;
FOptionsListBox.Visible := False;
end;

destructor TExtMemo.Destroy;
begin
FOptions.Free;
FOptionsListBox.Free;
inherited Destroy;
end;

procedure Register;
begin
RegisterComponents('SoSsA', [TExtMemo]);
end;

end.
*** end of code ***
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…

751 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question