jvcllaz: Add LookupAutoComplete component.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6890 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-05-04 21:53:45 +00:00
parent 2e29cc575c
commit de0f60e1a8
13 changed files with 1191 additions and 8 deletions

View File

@ -22,7 +22,8 @@ uses
procedure Register; procedure Register;
begin begin
RegisterComponents(RsPaletteJvcl, [ RegisterComponents(RsPaletteJvcl, [
TJvStrHolder, TJvMultiStringHolder, TJvProfiler, TJvStrHolder, TJvMultiStringHolder,
TJvProfiler,
TJvSpellChecker TJvSpellChecker
]); ]);
RegisterComponentEditor(TJvStrHolder, TJvStrHolderEditor); RegisterComponentEditor(TJvStrHolder, TJvStrHolderEditor);

View File

@ -5,7 +5,7 @@ unit JvCoreReg;
interface interface
uses uses
Classes, SysUtils; SysUtils;
implementation implementation

View File

@ -26,3 +26,4 @@ tjvrollout.png
tjvrollout_150.png tjvrollout_150.png
tjvrollout_200.png tjvrollout_200.png
tjvcombolistbox.bmp tjvcombolistbox.bmp
tjvlookupautocomplete.bmp

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.6 KiB

View File

@ -14,16 +14,17 @@ implementation
{$R ../../resource/jvctrlsreg.res} {$R ../../resource/jvctrlsreg.res}
uses uses
Classes, ActnList, JvDsgnConsts, Classes, Controls, ActnList, PropEdits, JvDsgnConsts,
JvMovableBevel, JvRuler, JvGroupHeader, JvRollOut, JvMovableBevel, JvRuler, JvGroupHeader, JvRollOut,
JvHtControls, {JvDBHTLabel,} JvHint, JvHTHintForm, JvComboListBox, JvHtControls, JvHint, JvHTHintForm, JvComboListBox,
PropEdits, Controls; JvAutoComplete; // original JVCL has this in package JvCore
procedure Register; procedure Register;
begin begin
RegisterComponents(RsPaletteJvcl, [ RegisterComponents(RsPaletteJvcl, [
TJvMovableBevel, TJvMovablePanel, TJvRuler, TJvGroupHeader, TJvRollOut, TJvMovableBevel, TJvMovablePanel, TJvRuler, TJvGroupHeader, TJvRollOut,
TJvHint, TJvHTLabel, TJvHTListbox, TJvHTCombobox, TJvComboListBox TJvHint, TJvHTLabel, TJvHTListbox, TJvHTCombobox, TJvComboListBox,
TJvLookupAutoComplete
]); ]);
RegisterPropertyEditor(TypeInfo(TCaption), TJvHTLabel, 'Caption', TJvHintProperty); RegisterPropertyEditor(TypeInfo(TCaption), TJvHTLabel, 'Caption', TJvHintProperty);
RegisterActions(RsJVCLActionsCategory, [TJvRollOutAction], nil); RegisterActions(RsJVCLActionsCategory, [TJvRollOutAction], nil);

View File

@ -0,0 +1,81 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="JvLookupAutoCompleteDemo"/>
<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>

View File

@ -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.

View File

@ -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

View File

@ -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.

View File

@ -75,7 +75,6 @@
</UsageOptions> </UsageOptions>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions> </PublishOptions>
<CustomOptions Items="ExternHelp" Version="2"> <CustomOptions Items="ExternHelp" Version="2">
<_ExternHelp Items="Count"/> <_ExternHelp Items="Count"/>

View File

@ -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. "/> <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"/> <Version Major="1" Release="4"/>
<Files Count="7"> <Files Count="8">
<Item1> <Item1>
<Filename Value="..\run\JvCtrls\jvhint.pas"/> <Filename Value="..\run\JvCtrls\jvhint.pas"/>
<UnitName Value="JvHint"/> <UnitName Value="JvHint"/>
@ -46,6 +46,10 @@ Movable bevel and panel, ruler, exandable panel (RollOut), group header, hyperte
<Filename Value="..\run\JvCtrls\jvcombolistbox.pas"/> <Filename Value="..\run\JvCtrls\jvcombolistbox.pas"/>
<UnitName Value="JvComboListBox"/> <UnitName Value="JvComboListBox"/>
</Item7> </Item7>
<Item8>
<Filename Value="..\run\JvCtrls\jvautocomplete.pas"/>
<UnitName Value="JvAutoComplete"/>
</Item8>
</Files> </Files>
<RequiredPkgs Count="2"> <RequiredPkgs Count="2">
<Item1> <Item1>

View File

@ -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.