paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 17:19:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL/TCustomComboBox: CaseSensitive supported in RealSetText()

Browse Source
This commit is contained in:
rich2014 2023-06-14 23:43:42 +08:00
parent 062bacda7a
commit 6d9db64d24
2 changed files with 45 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
lcl/include/customcombobox.inc
View File

@ -456,12 +456,55 @@ begin
I := ItemIndex; I := ItemIndex;
if (I < 0) or (I >= FItems.Count) or (FItems[I] <> AValue) then if (I < 0) or (I >= FItems.Count) or (FItems[I] <> AValue) then
if not (csLoading in ComponentState) then if not (csLoading in ComponentState) then
ItemIndex := FItems.IndexOf(AValue); ItemIndex := MatchListItem(AValue);
if AValue<>'' then if AValue<>'' then
HideEmulatedTextHint; HideEmulatedTextHint;
inherited; inherited;
end; end;
function TCustomComboBox.MatchListItem(const AValue: TCaption): Integer;
function match(matchText:String; itemText:String; caseSensitive:Boolean): Boolean;
begin
if caseSensitive then
itemText := UTF8UpperCase(itemText);
Result:= (matchText=itemText);
end;
var
matchText: String;
caseSensitive: Boolean;
i: Integer;
begin
Result:= -1;
if AValue='' then Exit;
if FItems.Count=0 then Exit;
caseSensitive:= cbactSearchCaseSensitive in AutoCompleteText;
if caseSensitive then
matchText:= AValue
else
matchText := UTF8UpperCase(AValue);
if cbactSearchAscending in AutoCompleteText then
begin
for i := 0 to FItems.Count - 1 do
begin
if match(matchText, FItems[i], caseSensitive) then
begin
Result:= i;
break;
end;
end;
end else
begin
for i := FItems.Count - 1 downto 0 do
begin
if match(matchText, FItems[i], caseSensitive) then
begin
Result:= i;
break;
end;
end;
end;
end;
procedure TCustomComboBox.SetArrowKeysTraverseList(Value : Boolean); procedure TCustomComboBox.SetArrowKeysTraverseList(Value : Boolean);
begin begin
if Value <> FArrowKeysTraverseList then if Value <> FArrowKeysTraverseList then

1
lcl/stdctrls.pp
View File

@ -409,6 +409,7 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure IntfGetItems; procedure IntfGetItems;
procedure AddItem(const Item: String; AnObject: TObject); virtual; procedure AddItem(const Item: String; AnObject: TObject); virtual;
function MatchListItem(const AValue: TCaption): Integer;
procedure AddHistoryItem(const Item: string; MaxHistoryCount: integer; procedure AddHistoryItem(const Item: string; MaxHistoryCount: integer;
SetAsText, CaseSensitive: boolean); SetAsText, CaseSensitive: boolean);
procedure AddHistoryItem(const Item: string; AnObject: TObject; procedure AddHistoryItem(const Item: string; AnObject: TObject;