Solved

Text completion in TMemo with TListBox

Posted on 2001-08-18
10
694 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
10 Comments
 
LVL 3

Expert Comment

by:smurff
Comment Utility
listening
0
 
LVL 10

Expert Comment

by:Jacco
Comment Utility
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
Comment Utility
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
 
LVL 3

Expert Comment

by:lopem
Comment Utility
listening...
0
 
LVL 1

Author Comment

by:rtieland
Comment Utility
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
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 
LVL 10

Expert Comment

by:Jacco
Comment Utility
I'll give it a try in a few hours

Regards Jacco
0
 
LVL 10

Expert Comment

by:Jacco
Comment Utility
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
Comment Utility
Are you still here?

Regards Jacco
0
 
LVL 10

Expert Comment

by:Jacco
Comment Utility
Guess not...

Is the component working?

Regards Jacco
0
 
LVL 10

Accepted Solution

by:
Jacco earned 100 total points
Comment Utility
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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

771 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now