From de0f60e1a8b7765e7afbabcf1259ddb02017be74 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 4 May 2019 21:53:45 +0000 Subject: [PATCH] jvcllaz: Add LookupAutoComplete component. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6890 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/jvcllaz/design/JvCmp/jvcmpreg.pas | 3 +- .../jvcllaz/design/JvCore/JvCoreReg.pas | 2 +- .../jvcllaz/design/JvCtrls/images/images.txt | 1 + .../JvCtrls/images/tjvlookupautocomplete.bmp | Bin 0 -> 1654 bytes .../jvcllaz/design/JvCtrls/jvctrlsreg.pas | 9 +- .../JvLookupAutoCompleteDemo.lpi | 81 ++ .../JvLookupAutoCompleteDemo.lpr | 22 + .../examples/JvLookupAutoComplete/main.lfm | 140 +++ .../examples/JvLookupAutoComplete/main.pas | 47 + components/jvcllaz/packages/JvCoreLazR.lpk | 1 - components/jvcllaz/packages/jvctrlslazr.lpk | 6 +- components/jvcllaz/resource/jvctrlsreg.res | Bin 32488 -> 34200 bytes .../jvcllaz/run/JvCtrls/jvautocomplete.pas | 887 ++++++++++++++++++ 13 files changed, 1191 insertions(+), 8 deletions(-) create mode 100644 components/jvcllaz/design/JvCtrls/images/tjvlookupautocomplete.bmp create mode 100644 components/jvcllaz/examples/JvLookupAutoComplete/JvLookupAutoCompleteDemo.lpi create mode 100644 components/jvcllaz/examples/JvLookupAutoComplete/JvLookupAutoCompleteDemo.lpr create mode 100644 components/jvcllaz/examples/JvLookupAutoComplete/main.lfm create mode 100644 components/jvcllaz/examples/JvLookupAutoComplete/main.pas create mode 100644 components/jvcllaz/run/JvCtrls/jvautocomplete.pas diff --git a/components/jvcllaz/design/JvCmp/jvcmpreg.pas b/components/jvcllaz/design/JvCmp/jvcmpreg.pas index 79c753311..4cd3881d3 100644 --- a/components/jvcllaz/design/JvCmp/jvcmpreg.pas +++ b/components/jvcllaz/design/JvCmp/jvcmpreg.pas @@ -22,7 +22,8 @@ uses procedure Register; begin RegisterComponents(RsPaletteJvcl, [ - TJvStrHolder, TJvMultiStringHolder, TJvProfiler, + TJvStrHolder, TJvMultiStringHolder, + TJvProfiler, TJvSpellChecker ]); RegisterComponentEditor(TJvStrHolder, TJvStrHolderEditor); diff --git a/components/jvcllaz/design/JvCore/JvCoreReg.pas b/components/jvcllaz/design/JvCore/JvCoreReg.pas index 51aaf5523..002a4c6c3 100644 --- a/components/jvcllaz/design/JvCore/JvCoreReg.pas +++ b/components/jvcllaz/design/JvCore/JvCoreReg.pas @@ -5,7 +5,7 @@ unit JvCoreReg; interface uses - Classes, SysUtils; + SysUtils; implementation diff --git a/components/jvcllaz/design/JvCtrls/images/images.txt b/components/jvcllaz/design/JvCtrls/images/images.txt index 12de8f1cd..77cd3a466 100644 --- a/components/jvcllaz/design/JvCtrls/images/images.txt +++ b/components/jvcllaz/design/JvCtrls/images/images.txt @@ -26,3 +26,4 @@ tjvrollout.png tjvrollout_150.png tjvrollout_200.png tjvcombolistbox.bmp +tjvlookupautocomplete.bmp diff --git a/components/jvcllaz/design/JvCtrls/images/tjvlookupautocomplete.bmp b/components/jvcllaz/design/JvCtrls/images/tjvlookupautocomplete.bmp new file mode 100644 index 0000000000000000000000000000000000000000..67fac5400e66b4b1f7ac03a3494590d24055c569 GIT binary patch literal 1654 zcmaLVF|HFq41i%j6g?qv0ZNzD6r@UG(Q^l%g4#!M5pfQ8NSuMfM|d5@lV12|CgCLn z;oUFZct^9lp85Rc>!Zy0v=RBh)%&vtc{}U&M&#qWMII;(GeU$@B39y;OQ|ZUpCwN} zzKN*8!3|9mTEqkjF3b@~6k5au3Il&UkSO%|xk@%T0*OM4a4D%UI0A`6^O6FE!4XIl zT7*+tVQ>Tzg%%TDQxxNH1QLZ_pQcJSI0A`6ug^9m8ytZ|p;t>>$p%LtQRvmKP_n@h zNECXtGL>v_1QLZ_Z7wAn9Dzik=Mq>e+29By3N69+hbYFEJI0YHw1f&221g)K=(TL7 zWP>A+DD+xVSF*toNECW4HxG$0I0A`6udR?uHaG%_La%L7N;WtGi9*jU6s=@~BakSx z6yIN>FgOBA+DD>LOsbqsA zkSO%p=A~qVBarg+e3B#Mg84*F^OVzRT!CYh`1!uSirsGa^0N2(50~+q8FT(I{%~NP*SM+kVwd=Do%fmZTn3Y0&hdAB4ms|2vrZ3g z;#@!8#eR%G$5o%WJlu5WPot=hw$h(V%w8W?orlu5agU!dZq>(P(7Dk(ZoSsWTK%&= t$KTI0mUK=rpM5pYc;@Ae&hN85-gMyn=eXbA^ + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="JvCtrlsLazR"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units> + <Unit> + <Filename Value="JvLookupAutoCompleteDemo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\..\bin\JvLookupAutoCompleteDemo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/jvcllaz/examples/JvLookupAutoComplete/JvLookupAutoCompleteDemo.lpr b/components/jvcllaz/examples/JvLookupAutoComplete/JvLookupAutoCompleteDemo.lpr new file mode 100644 index 000000000..65e695869 --- /dev/null +++ b/components/jvcllaz/examples/JvLookupAutoComplete/JvLookupAutoCompleteDemo.lpr @@ -0,0 +1,22 @@ +program JvLookupAutoCompleteDemo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, main + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/jvcllaz/examples/JvLookupAutoComplete/main.lfm b/components/jvcllaz/examples/JvLookupAutoComplete/main.lfm new file mode 100644 index 000000000..ccd522e18 --- /dev/null +++ b/components/jvcllaz/examples/JvLookupAutoComplete/main.lfm @@ -0,0 +1,140 @@ +object Form1: TForm1 + Left = 326 + Height = 398 + Top = 128 + Width = 418 + AutoSize = True + Caption = 'JvLookupAutoComplete demo' + ClientHeight = 398 + ClientWidth = 418 + OnCreate = FormCreate + LCLVersion = '2.1.0.0' + object Edit1: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 23 + Top = 50 + Width = 176 + BorderSpacing.Top = 4 + TabOrder = 0 + end + object ListBox1: TListBox + AnchorSideLeft.Control = Edit1 + AnchorSideTop.Control = Edit1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Edit1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 16 + Height = 281 + Top = 81 + Width = 176 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 16 + Constraints.MinHeight = 250 + Items.Strings = ( + 'ListBox' + 'ComboBox' + 'Edit' + 'ListView' + 'TreeView' + 'ScrollBar' + 'ScrollBox' + 'StatusBar' + 'ToolBar' + 'Menu' + 'PopupMenu' + 'Button' + 'BitBtn' + 'SpeedButton' + ) + ItemHeight = 15 + Options = [] + TabOrder = 1 + end + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 15 + Top = 31 + Width = 66 + BorderSpacing.Left = 16 + BorderSpacing.Top = 4 + Caption = 'listbox items' + ParentColor = False + WordWrap = True + end + object Label2: TLabel + AnchorSideLeft.Control = Edit1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label1 + Left = 208 + Height = 15 + Top = 31 + Width = 77 + BorderSpacing.Left = 16 + Caption = 'stringlist items' + ParentColor = False + WordWrap = True + end + object Edit2: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideTop.Control = Edit1 + Left = 208 + Height = 23 + Top = 50 + Width = 168 + BorderSpacing.Right = 16 + TabOrder = 2 + end + object Label3: TLabel + AnchorSideLeft.Control = Edit2 + AnchorSideTop.Control = ListBox1 + AnchorSideRight.Control = Edit2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ListBox1 + AnchorSideBottom.Side = asrBottom + Left = 208 + Height = 281 + Top = 81 + Width = 168 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + Caption = 'Type listbox items into the edit controls and see autocompletion.' + Layout = tlCenter + ParentColor = False + WordWrap = True + end + object Label4: TLabel + AnchorSideLeft.Control = Edit1 + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Edit2 + AnchorSideRight.Side = asrBottom + Left = 16 + Height = 15 + Top = 12 + Width = 360 + Alignment = taCenter + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 12 + Caption = 'Autocompletion based on...' + ParentColor = False + end + object JvLookupAutoComplete1: TJvLookupAutoComplete + Edit = Edit1 + ListBox = ListBox1 + left = 80 + top = 304 + end + object JvLookupAutoComplete2: TJvLookupAutoComplete + Edit = Edit2 + Kind = akStrings + left = 272 + top = 304 + end +end diff --git a/components/jvcllaz/examples/JvLookupAutoComplete/main.pas b/components/jvcllaz/examples/JvLookupAutoComplete/main.pas new file mode 100644 index 000000000..38c1f8065 --- /dev/null +++ b/components/jvcllaz/examples/JvLookupAutoComplete/main.pas @@ -0,0 +1,47 @@ +unit main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, + JvAutoComplete; + +type + + { TForm1 } + + TForm1 = class(TForm) + Edit1: TEdit; + Edit2: TEdit; + JvLookupAutoComplete1: TJvLookupAutoComplete; + JvLookupAutoComplete2: TJvLookupAutoComplete; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + ListBox1: TListBox; + procedure FormCreate(Sender: TObject); + private + + public + + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +{ TForm1 } + +procedure TForm1.FormCreate(Sender: TObject); +begin + JvLookupAutoComplete2.Strings.Assign(ListBox1.Items); +end; + +end. + diff --git a/components/jvcllaz/packages/JvCoreLazR.lpk b/components/jvcllaz/packages/JvCoreLazR.lpk index 881facc5c..f56a03915 100644 --- a/components/jvcllaz/packages/JvCoreLazR.lpk +++ b/components/jvcllaz/packages/JvCoreLazR.lpk @@ -75,7 +75,6 @@ </UsageOptions> <PublishOptions> <Version Value="2"/> - <IgnoreBinaries Value="False"/> </PublishOptions> <CustomOptions Items="ExternHelp" Version="2"> <_ExternHelp Items="Count"/> diff --git a/components/jvcllaz/packages/jvctrlslazr.lpk b/components/jvcllaz/packages/jvctrlslazr.lpk index 7d1a53d1d..ef818ab44 100644 --- a/components/jvcllaz/packages/jvctrlslazr.lpk +++ b/components/jvcllaz/packages/jvctrlslazr.lpk @@ -17,7 +17,7 @@ Movable bevel and panel, ruler, exandable panel (RollOut), group header, hyperte "/> <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/> <Version Major="1" Release="4"/> - <Files Count="7"> + <Files Count="8"> <Item1> <Filename Value="..\run\JvCtrls\jvhint.pas"/> <UnitName Value="JvHint"/> @@ -46,6 +46,10 @@ Movable bevel and panel, ruler, exandable panel (RollOut), group header, hyperte <Filename Value="..\run\JvCtrls\jvcombolistbox.pas"/> <UnitName Value="JvComboListBox"/> </Item7> + <Item8> + <Filename Value="..\run\JvCtrls\jvautocomplete.pas"/> + <UnitName Value="JvAutoComplete"/> + </Item8> </Files> <RequiredPkgs Count="2"> <Item1> diff --git a/components/jvcllaz/resource/jvctrlsreg.res b/components/jvcllaz/resource/jvctrlsreg.res index bb17378834458f830e0ab10729c79c6bc9c50965..58fdc1a082669dfd098993d0839876c009f201c8 100644 GIT binary patch delta 651 zcmaKpu};G<5QhIoRu&`{7~mP$kWeSbs!$~aMKBbep(|UbhP`7J9>8Ko;vpD$jlKax zMa+L^w{ZyKkA1ekJD=^#=6m$AF5Wh)i$w`s0SKYM9M^cn40rr)@PK<vXy;sAvfpw& z!<6f3^K^XFJTFfU&kq3U7)gJBT^6SPs4`h=+cJvOe`O-yZs`&Z6GCdHElJs&ax>&^ z7jIOWU*er(9#cn3+jE3Y|8ibP6LsOCP5R9>#9OPJ?~kg}m>hnfN;V{AmEzR(>a#Bu zIe!nee;ERSkDSM`a^j;Qu9JgPI!MKcqqpG?uJKu-E<UEv)3ZEs=<Z7CLSqk{rT1rp Nuf~HaC}=)cr$6}}6=DDY delta 9 QcmbQy&Gh0g<AxV?02qn|A^-pY diff --git a/components/jvcllaz/run/JvCtrls/jvautocomplete.pas b/components/jvcllaz/run/JvCtrls/jvautocomplete.pas new file mode 100644 index 000000000..a4118ea24 --- /dev/null +++ b/components/jvcllaz/run/JvCtrls/jvautocomplete.pas @@ -0,0 +1,887 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvAutoComplete.pas, released on 2004-09-04. + +The Initial Developer of the Original Code is Andreas Hausladen [Andreas dott Hausdaden att gmx dott de] +Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen. +All Rights Reserved. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvAutoComplete; + +{$mode objfpc}{$H+} + +interface + +uses + LCLIntf, LCLType, LMessages, + SysUtils, Classes, Controls, StdCtrls; + +type + TJvGetSearchItemPrefixEvent = procedure(Sender: TObject; var Prefix: string) of object; + + { TControlAutoComplete implements an autocomplete code for controls. It is an + abstract base class. After you have created an instance of a derived class + you must either assign the AutoCompleteEvent to the OnKeyPress event of the + control or you must call the AutoComplete method in a KeyPress event handler. + + (ahuser) 2005-01-31: changed from TObject to TComponent due to Notification() + Do not register this component it is more a "TObject" than a TComponent. } + TJvControlAutoComplete = class(TComponent) + private + FFilter: string; + FLastTime: Cardinal; + FMaxFilterTime: Cardinal; + FListSearch: Boolean; + FActive: Boolean; + FOnDropDown: TNotifyEvent; + FOnValidateItems: TNotifyEvent; + FOnChange: TNotifyEvent; + FOnValueChange: TNotifyEvent; + FOnGetSearchItemPrefix: TJvGetSearchItemPrefixEvent; + protected + function GetText: TCaption; virtual; abstract; + procedure SetText(const Value: TCaption); virtual; abstract; + procedure GetEditSel(out StartPos, EndPos: Integer); virtual; abstract; + procedure SetEditSel(StartPos, EndPos: Integer); virtual; abstract; + procedure SetItemIndex(Index: Integer); virtual; abstract; + function GetItemIndex: Integer; virtual; abstract; + function FindItemPrefix(IndexStart: Integer; const Prefix: string): Integer; virtual; abstract; + function GetItemAt(Index: Integer): string; virtual; abstract; + function GetEditHandle: THandle; virtual; abstract; + + function GetActive: Boolean; virtual; + procedure SetFilter(const Value: string); + + procedure DoDropDown; dynamic; + procedure DoValidateItems; dynamic; + procedure DoChange; dynamic; + procedure DoValueChange; dynamic; + procedure GetSearchItemPrefix(var Prefix: string); dynamic; + public + constructor Create; reintroduce; + procedure AutoCompleteEvent(Sender: TObject; var Key: Char); + procedure AutoComplete(var Key: Char); virtual; + + property ListSearch: Boolean read FListSearch write FListSearch; // no edit possible + property MaxFilterTime: Cardinal read FMaxFilterTime write FMaxFilterTime; // only with ListSearch + + property Active: Boolean read GetActive write FActive; + property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown; + property OnValidateItems: TNotifyEvent read FOnValidateItems write FOnValidateItems; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnValueChange: TNotifyEvent read FOnValueChange write FOnValueChange; + property OnGetSearchItemPrefix: TJvGetSearchItemPrefixEvent read FOnGetSearchItemPrefix write FOnGetSearchItemPrefix; + end; + + TJvBaseEditListAutoComplete = class(TJvControlAutoComplete) + private + FEditCtrl: TCustomEdit; + FList: TStrings; + procedure SetEditCtrl(Value: TCustomEdit); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + function GetText: TCaption; override; + procedure SetText(const Value: TCaption); override; + procedure GetEditSel(out StartPos, EndPos: Integer); override; + procedure SetEditSel(StartPos, EndPos: Integer); override; + function FindItemPrefix(IndexStart: Integer; const Prefix: string): Integer; override; + function GetItemAt(Index: Integer): string; override; + function GetEditHandle: THandle; override; + function GetActive: Boolean; override; + property List: TStrings read FList write FList; + public + constructor Create(AEditCtrl: TCustomEdit; AList: TStrings); + destructor Destroy; override; + property EditCtrl: TCustomEdit read FEditCtrl write SetEditCtrl; + end; + + { TEditListAutoComplete implements an autocomplete code for a Edit/TStrings + pair. After you have created an instance of this class you must either + assign the AutoCompleteEvent to the OnKeyPress event of the edit control + or you must call the AutoComplete method in a KeyPress event handler. } + TJvEditListAutoComplete = class(TJvBaseEditListAutoComplete) + private + FOnItemIndexChange: TNotifyEvent; + FOnValidateItemIndex: TNotifyEvent; + public + FItemIndex: Integer; + function GetList: TStrings; + procedure SetList(Value: TStrings); + procedure SetInternalItemIndex(Value: Integer); + protected + procedure SetItemIndex(Index: Integer); override; + function GetItemIndex: Integer; override; + public + constructor Create(AEditCtrl: TCustomEdit; AList: TStrings); + property ItemIndex: Integer read FItemIndex write SetInternalItemIndex; + property List: TStrings read GetList write SetList; + property OnItemIndexChange: TNotifyEvent read FOnItemIndexChange write FOnItemIndexChange; + property OnValidateItemIndex: TNotifyEvent read FOnValidateItemIndex write FOnValidateItemIndex; + end; + + { TEditListBoxAutoComplete implements an autocomplete code for a Edit/ListBox + pair. After you have created an instance of this class you must either + assign the AutoCompleteEvent to the OnKeyPress event of the edit control + or you must call the AutoComplete method in a KeyPress event handler. } + TJvEditListBoxAutoComplete = class(TJvBaseEditListAutoComplete) + private + FListBox: TCustomListBox; + procedure SetListBox(Value: TCustomListBox); + protected + procedure SetItemIndex(Index: Integer); override; + function GetItemIndex: Integer; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + public + constructor Create(AEditCtrl: TCustomEdit; AListBox: TCustomListBox); + destructor Destroy; override; + property ListBox: TCustomListBox read FListBox write SetListBox; + end; + + { TComboBoxAutoComplete implements an autocomplete code for a ComboBox. + After you have created an instance of this class you must either assign the + AutoCompleteEvent to the OnKeyPress event of the edit control or you must + call the AutoComplete method in a KeyPress event handler. } + TJvComboBoxAutoComplete = class(TJvControlAutoComplete) + private + FComboBox: TCustomComboBox; + procedure SetComboBox(Value: TCustomComboBox); + protected + function GetText: TCaption; override; + procedure SetText(const Value: TCaption); override; + procedure GetEditSel(out StartPos, EndPos: Integer); override; + procedure SetEditSel(StartPos, EndPos: Integer); override; + procedure SetItemIndex(Index: Integer); override; + function GetItemIndex: Integer; override; + function FindItemPrefix(IndexStart: Integer; const Prefix: string): Integer; override; + function GetItemAt(Index: Integer): string; override; + function GetEditHandle: THandle; override; + function GetActive: Boolean; override; + public + constructor Create(AComboBox: TCustomComboBox); + property ComboBox: TCustomComboBox read FComboBox write SetComboBox; + end; + + TJvLookupAutoCompleteKind = (akListBox, akStrings); + + TJvLookupAutoComplete = class(TComponent) + private + FAutoComplete: TJvEditListAutoComplete; + FListBox: TCustomListBox; + FStrings: TStrings; + FKind: TJvLookupAutoCompleteKind; + FOrgKeyPress: TKeyPressEvent; + FOnChange: TNotifyEvent; + FOnValidateStrings: TNotifyEvent; + FOnDropDown: TNotifyEvent; + FOnValueChange: TNotifyEvent; + function GetEdit: TCustomEdit; + function GetItemIndex: Integer; + function GetListSearch: Boolean; + procedure SetEdit(Value: TCustomEdit); + procedure SetItemIndex(Value: Integer); + procedure SetKind(Value: TJvLookupAutoCompleteKind); + procedure SetListBox(Value: TCustomListBox); + procedure SetListSearch(Value: Boolean); + procedure SetStrings(Value: TStrings); + function GetActive: Boolean; + procedure SetActive(const Value: Boolean); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure EvKeyPress(Sender: TObject; var Key: Char); dynamic; + procedure EvDropDown(Sender: TObject); dynamic; + procedure EvValidateStrings(Sender: TObject); dynamic; + procedure EvChange(Sender: TObject); dynamic; + procedure EvValueChange(Sender: TObject); dynamic; + procedure EvItemIndexChange(Sender: TObject); dynamic; + procedure EvValidateItemIndex(Sender: TObject); dynamic; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property ItemIndex: Integer read GetItemIndex write SetItemIndex; + published + property Active: Boolean read GetActive write SetActive default True; + property Edit: TCustomEdit read GetEdit write SetEdit; + property ListBox: TCustomListBox read FListBox write SetListBox; + property Strings: TStrings read FStrings write SetStrings; + property Kind: TJvLookupAutoCompleteKind read FKind write SetKind default akListBox; + property ListSearch: Boolean read GetListSearch write SetListSearch default False; + property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown; + property OnValidateStrings: TNotifyEvent read FOnValidateStrings write FOnValidateStrings; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnValueChange: TNotifyEvent read FOnValueChange write FOnValueChange; + end; + + +implementation + +uses + StrUtils, + JvConsts, JvJVCLUtils; + + +//=== { TJvControlAutoComplete } ============================================= + +constructor TJvControlAutoComplete.Create; +begin + inherited Create(nil); + FActive := True; + FMaxFilterTime := 500; +end; + +function TJvControlAutoComplete.GetActive: Boolean; +begin + Result := FActive; +end; + +procedure TJvControlAutoComplete.SetFilter(const Value: string); +begin + FFilter := Value; +end; + +procedure TJvControlAutoComplete.DoValidateItems; +begin + if Assigned(FOnValidateItems) then + FOnValidateItems(Self); +end; + +procedure TJvControlAutoComplete.DoChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TJvControlAutoComplete.DoDropDown; +begin + if Assigned(FOnDropDown) then + FOnDropDown(Self); +end; + +procedure TJvControlAutoComplete.DoValueChange; +begin + if Assigned(FOnValueChange) then + FOnValueChange(Self); +end; + +procedure TJvControlAutoComplete.GetSearchItemPrefix(var Prefix: string); +begin + if Assigned(FOnGetSearchItemPrefix) then + FOnGetSearchItemPrefix(Self, Prefix); +end; + +procedure TJvControlAutoComplete.AutoCompleteEvent(Sender: TObject; var Key: Char); +begin + AutoComplete(Key); +end; + +procedure TJvControlAutoComplete.AutoComplete(var Key: Char); +var + StartPos, EndPos: Integer; + SaveText, OldText: TCaption; + LastByte: Integer; + LT: Int64; + Msg: TMsg; + + function HasSelectedText(var StartPos, EndPos: Integer): Boolean; + begin + GetEditSel(StartPos, EndPos); + Result := EndPos > StartPos; + end; + + procedure DeleteSelectedText; + var + StartPos, EndPos: Integer; + OldText: string; + begin + OldText := GetText; + GetEditSel(StartPos, EndPos); + Delete(OldText, StartPos + 1, EndPos - StartPos); + SetItemIndex(-1); + SetText(OldText); + SetEditSel(StartPos, StartPos); + end; + + function SelectItem(const AnItem: string): Boolean; + var + Idx: Integer; + ValueChange: Boolean; + PartToFind: string; + begin + Result := False; + PartToFind := AnItem; + GetSearchItemPrefix(PartToFind); + if PartToFind = '' then + begin + SetItemIndex(-1); + DoChange; + Exit; + end; + Idx := FindItemPrefix(-1, PartToFind); + if Idx < 0 then + Exit; + Result := True; + ValueChange := Idx <> GetItemIndex; + SetItemIndex(Idx); + if ListSearch then + begin + SetItemIndex(Idx); + FFilter := PartToFind; + end + else + begin + SetText(AnItem + Copy(GetItemAt(Idx), Length(PartToFind) + 1, MaxInt)); + SetEditSel(Length(AnItem), Length(GetText)); + end; + if ValueChange then + DoValueChange; + end; + +begin + if not Active then + Exit; + + if ListSearch then + begin + LT := GetTickCount; + if FLastTime > LT then + LT := $100000000 + LT; // double limit. + if LT - FLastTime >= MaxFilterTime then + FFilter := ''; + FLastTime := GetTickCount; + end + else + FFilter := GetText; + + case Key of + Esc {VK_ESCAPE}: + Exit; + Tab {VK_TAB}: + begin + DoValidateItems; + DoDropDown; + end; + BackSpace {VK_BACK}: + begin + DoValidateItems; + if HasSelectedText(StartPos, EndPos) then + DeleteSelectedText + else + if not ListSearch and (GetText <> '') then + begin + SaveText := GetText; + LastByte := StartPos; + while ByteType(SaveText, LastByte) = mbTrailByte do + Dec(LastByte); + OldText := Copy(SaveText, 1, LastByte - 1); + SetItemIndex(-1); + SetText(OldText + Copy(SaveText, EndPos + 1, MaxInt)); + SetEditSel(LastByte - 1, LastByte - 1); + FFilter := GetText; + end + else + begin + while ByteType(FFilter, Length(FFilter)) = mbTrailByte do + Delete(FFilter, Length(FFilter), 1); + Delete(FFilter, Length(FFilter), 1); + end; + Key := #0; + DoChange; + end; + else + DoValidateItems; + DoDropDown; + + if HasSelectedText(StartPos, EndPos) then + SaveText := Copy(FFilter, 1, StartPos) + Key + else + SaveText := FFilter + Key; + + if CharInSet(Key, LeadBytes) then + begin + if PeekMessage(Msg, GetEditHandle, 0, 0, PM_NOREMOVE) and (Msg.Message = LM_CHAR) then + begin + if SelectItem(SaveText + Char(Msg.WParam)) then + begin + PeekMessage(Msg, GetEditHandle, 0, 0, PM_REMOVE); + Key := #0; + end; + end; + end + else + if SelectItem(SaveText) then + Key := #0; + end; +end; + +//=== { TJvBaseEditListAutoComplete } ======================================== + +constructor TJvBaseEditListAutoComplete.Create(AEditCtrl: TCustomEdit; + AList: TStrings); +begin + inherited Create; + FList := AList; + EditCtrl := AEditCtrl; +end; + +destructor TJvBaseEditListAutoComplete.Destroy; +begin + EditCtrl := nil; + inherited Destroy; +end; + +procedure TJvBaseEditListAutoComplete.Notification(AComponent: TComponent; + Operation: TOperation); +begin + if (Operation = opRemove) and (AComponent = FEditCtrl) then + begin + FEditCtrl := nil; + SetFilter(''); + end; + inherited Notification(AComponent, Operation); +end; + +procedure TJvBaseEditListAutoComplete.SetEditCtrl(Value: TCustomEdit); +begin + ReplaceComponentReference(Self, Value, TComponent(FEditCtrl)); + + if FEditCtrl <> nil then + SetFilter(FEditCtrl.Text) + else + SetFilter(''); +end; + +type + TCustomEditAccess = class(TCustomEdit); + +function TJvBaseEditListAutoComplete.GetText: TCaption; +begin + Result := EditCtrl.Text; +end; + +procedure TJvBaseEditListAutoComplete.SetText(const Value: TCaption); +begin + EditCtrl.Text := Value; +end; + +procedure TJvBaseEditListAutoComplete.GetEditSel(out StartPos, EndPos: Integer); +begin +// SendMessage(EditCtrl.Handle, EM_GETSEL, WPARAM(@StartPos), LPARAM(@EndPos)); + StartPos := EditCtrl.SelStart; + EndPos := StartPos + EditCtrl.SelLength; +end; + +procedure TJvBaseEditListAutoComplete.SetEditSel(StartPos, EndPos: Integer); +begin + EditCtrl.SelStart := StartPos; + EditCtrl.SelLength := EndPos - StartPos; +end; + +function TJvBaseEditListAutoComplete.FindItemPrefix(IndexStart: Integer; const Prefix: string): Integer; +begin + if List <> nil then + begin + for Result := IndexStart + 1 to List.Count - 1 do + if AnsiStartsText(Prefix, List[Result]) then + Exit; + for Result := 0 to IndexStart do + if AnsiStartsText(Prefix, List[Result]) then + Exit; + end; + Result := -1; +end; + +function TJvBaseEditListAutoComplete.GetItemAt(Index: Integer): string; +begin + Result := List[Index]; +end; + + +function TJvBaseEditListAutoComplete.GetEditHandle: THandle; +begin + Result := FEditCtrl.Handle; +end; + + +function TJvBaseEditListAutoComplete.GetActive: Boolean; +begin + Result := inherited GetActive and (EditCtrl <> nil) and (List <> nil) and + not TCustomEditAccess(EditCtrl).ReadOnly; +end; + +//=== { TJvEditListAutoComplete } ============================================ + +constructor TJvEditListAutoComplete.Create(AEditCtrl: TCustomEdit; + AList: TStrings); +begin + inherited Create(AEditCtrl, AList); + FItemIndex := -1; +end; + +procedure TJvEditListAutoComplete.SetInternalItemIndex(Value: Integer); +begin + if (Value < 0) or (List = nil) then + Value := -1; + FItemIndex := Value; + if (List <> nil) and (FItemIndex >= List.Count) then + FItemIndex := List.Count - 1; +end; + +function TJvEditListAutoComplete.GetList: TStrings; +begin + Result := FList; +end; + +procedure TJvEditListAutoComplete.SetList(Value: TStrings); +begin + FItemIndex := -1; + FList := Value; +end; + +procedure TJvEditListAutoComplete.SetItemIndex(Index: Integer); +begin + FItemIndex := Index; + if Assigned(FOnItemIndexChange) then + FOnItemIndexChange(Self); +end; + +function TJvEditListAutoComplete.GetItemIndex: Integer; +begin + if Assigned(FOnValidateItemIndex) then + FOnValidateItemIndex(Self); + Result := FItemIndex; +end; + +//=== { TJvEditListBoxAutoComplete } ========================================= + +constructor TJvEditListBoxAutoComplete.Create(AEditCtrl: TCustomEdit; AListBox: TCustomListBox); +begin + if AListBox = nil then + inherited Create(AEditCtrl, nil) + else + inherited Create(AEditCtrl, AListBox.Items); + ListBox := AListBox; +end; + +destructor TJvEditListBoxAutoComplete.Destroy; +begin + ListBox := nil; + inherited Destroy; +end; + +procedure TJvEditListBoxAutoComplete.Notification(AComponent: TComponent; Operation: TOperation); +begin + if (Operation = opRemove) and (AComponent = FListBox) then + begin + FListBox := nil; + List := nil; + end; + inherited Notification(AComponent, Operation); +end; + +procedure TJvEditListBoxAutoComplete.SetListBox(Value: TCustomListBox); +begin + ReplaceComponentReference(Self, Value, TComponent(FListBox)); + + if FListBox <> nil then + List := FListBox.Items + else + List := nil; +end; + +procedure TJvEditListBoxAutoComplete.SetItemIndex(Index: Integer); +begin + ListBox.ItemIndex := Index; +end; + +function TJvEditListBoxAutoComplete.GetItemIndex: Integer; +begin + Result := ListBox.ItemIndex; +end; + +//=== { TJvComboBoxAutoComplete } ============================================ + +constructor TJvComboBoxAutoComplete.Create(AComboBox: TCustomComboBox); +begin + inherited Create; + FComboBox := AComboBox; +end; + +type + TCustomComboBoxAccess = class(TCustomComboBox); + +function TJvComboBoxAutoComplete.GetActive: Boolean; +begin + Result := inherited GetActive and (ComboBox <> nil); + if ComboBox <> nil then + FListSearch := not (TCustomComboBoxAccess(ComboBox).Style in [csDropDown , csSimple ]); +end; + +function TJvComboBoxAutoComplete.GetEditHandle: THandle; +begin + Result := ComboBox.Handle; +end; + +procedure TJvComboBoxAutoComplete.GetEditSel(out StartPos, EndPos: Integer); +begin +// SendMessage(ComboBox.Handle, CB_GETEDITSEL, WPARAM(@StartPos), LPARAM(@EndPos)); + StartPos := ComboBox.SelStart; + EndPos := StartPos + ComboBox.SelLength; +end; + +procedure TJvComboBoxAutoComplete.SetEditSel(StartPos, EndPos: Integer); +begin + ComboBox.SelStart := StartPos; + ComboBox.SelLength := EndPos - StartPos; +end; + +function TJvComboBoxAutoComplete.FindItemPrefix(IndexStart: Integer; + const Prefix: string): Integer; +begin + for Result := IndexStart + 1 to ComboBox.Items.Count - 1 do + if AnsiStartsText(Prefix, ComboBox.Items[Result]) then + Exit; + for Result := 0 to IndexStart do + if AnsiStartsText(Prefix, ComboBox.Items[Result]) then + Exit; + Result := -1; +end; + +procedure TJvComboBoxAutoComplete.SetItemIndex(Index: Integer); +begin + ComboBox.ItemIndex := Index; +end; + +function TJvComboBoxAutoComplete.GetItemIndex: Integer; +begin + Result := ComboBox.ItemIndex; +end; + +function TJvComboBoxAutoComplete.GetItemAt(Index: Integer): string; +begin + Result := ComboBox.Items[Index]; +end; + +function TJvComboBoxAutoComplete.GetText: TCaption; +begin + Result := TCustomComboBoxAccess(ComboBox).Text; +end; + +procedure TJvComboBoxAutoComplete.SetText(const Value: TCaption); +begin + TCustomComboBoxAccess(ComboBox).Text := Value; +end; + +procedure TJvComboBoxAutoComplete.SetComboBox(Value: TCustomComboBox); +begin + FComboBox := Value; + if FComboBox <> nil then + SetFilter(GetText) + else + SetFilter(''); +end; + +//=== { TJvLookupAutoComplete } ============================================== + +constructor TJvLookupAutoComplete.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FAutoComplete := TJvEditListAutoComplete.Create(nil, nil); + FAutoComplete.OnDropDown := @EvDropDown; + FAutoComplete.OnValidateItems := @EvValidateStrings; + FAutoComplete.OnChange := @EvChange; + FAutoComplete.OnValueChange := @EvValueChange; + FAutoComplete.OnItemIndexChange := @EvItemIndexChange; + FAutoComplete.OnValidateItemIndex := @EvValidateItemIndex; + + FStrings := TStringList.Create; +end; + +destructor TJvLookupAutoComplete.Destroy; +begin + SetEdit(nil); // SetEdit accesses FAutoComplete + FAutoComplete.Free; + SetListBox(nil); + FStrings.Free; + inherited Destroy; +end; + +procedure TJvLookupAutoComplete.EvChange(Sender: TObject); +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TJvLookupAutoComplete.EvDropDown(Sender: TObject); +begin + if Assigned(FOnDropDown) then + FOnDropDown(Self); +end; + +procedure TJvLookupAutoComplete.EvItemIndexChange(Sender: TObject); +begin + ItemIndex := FAutoComplete.ItemIndex; +end; + +procedure TJvLookupAutoComplete.EvKeyPress(Sender: TObject; var Key: Char); +begin + { Make sure to use the current Items of the ListBox } + if FKind = akListBox then SetKind(FKind); + + if Assigned(FOrgKeyPress) then + FOrgKeyPress(Sender, Key); + FAutoComplete.AutoComplete(Key); +end; + +procedure TJvLookupAutoComplete.EvValidateItemIndex(Sender: TObject); +begin + FAutoComplete.ItemIndex := ItemIndex; +end; + +procedure TJvLookupAutoComplete.EvValidateStrings(Sender: TObject); +begin + if Assigned(FOnValidateStrings) then + FOnValidateStrings(Self); +end; + +procedure TJvLookupAutoComplete.EvValueChange(Sender: TObject); +begin + if Assigned(FOnValueChange) then + FOnValueChange(Self); +end; + +function TJvLookupAutoComplete.GetActive: Boolean; +begin + Result := FAutoComplete.Active; +end; + +function TJvLookupAutoComplete.GetEdit: TCustomEdit; +begin + Result := FAutoComplete.EditCtrl; +end; + +function TJvLookupAutoComplete.GetItemIndex: Integer; +begin + Result := -1; + case Kind of + akListBox: + if ListBox <> nil then + Result := ListBox.ItemIndex; + akStrings: + Result := FAutoComplete.ItemIndex; + end; +end; + +function TJvLookupAutoComplete.GetListSearch: Boolean; +begin + Result := FAutoComplete.ListSearch; +end; + +procedure TJvLookupAutoComplete.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if Operation = opRemove then + begin + if AComponent = Edit then + Edit := nil + else + if AComponent = ListBox then + ListBox := nil; + end; +end; + +procedure TJvLookupAutoComplete.SetActive(const Value: Boolean); +begin + FAutoComplete.Active := Value; +end; + +procedure TJvLookupAutoComplete.SetEdit(Value: TCustomEdit); +begin + if Value <> Edit then + begin + if Edit <> nil then + begin + TCustomEditAccess(Edit).OnKeyPress := FOrgKeyPress; + Edit.RemoveFreeNotification(Self); + end; + FAutoComplete.EditCtrl := Value; + if Edit <> nil then + begin + Edit.FreeNotification(Self); + FOrgKeyPress := TCustomEditAccess(Edit).OnKeyPress; + TCustomEditAccess(Edit).OnKeyPress := @EvKeyPress; + end; + end; +end; + +procedure TJvLookupAutoComplete.SetItemIndex(Value: Integer); +begin + case Kind of + akListBox: + if ListBox <> nil then + ListBox.ItemIndex := Value; + akStrings: + FAutoComplete.ItemIndex := Value; + end; +end; + +procedure TJvLookupAutoComplete.SetKind(Value: TJvLookupAutoCompleteKind); +begin + FKind := Value; + case FKind of + akListBox: + if ListBox <> nil then + FAutoComplete.List := ListBox.Items + else + FAutoComplete.List := nil; + akStrings: + FAutoComplete.List := FStrings; + end; +end; + +procedure TJvLookupAutoComplete.SetListBox(Value: TCustomListBox); +begin + if Value <> FListBox then + begin + ReplaceComponentReference(Self, Value, TComponent(FListBox)); + if Kind = akListBox then + begin + if FListBox <> nil then + FAutoComplete.List := FListBox.Items + else + FAutoComplete.List := nil; + end; + end; +end; + +procedure TJvLookupAutoComplete.SetListSearch(Value: Boolean); +begin + FAutoComplete.ListSearch := Value; +end; + +procedure TJvLookupAutoComplete.SetStrings(Value: TStrings); +begin + if Value <> FStrings then + begin + FStrings.Assign(Value); + if Kind = akStrings then + FAutoComplete.List := FStrings; + end; +end; + + +end.