paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 16:37:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Update TCombobox.ItemIndex when AutoCompleteing. Issue #41358, patch by Iluha Companets.

Browse Source
This commit is contained in:
Juha 2025-01-31 02:20:42 +02:00
parent 82bf2bb2fa
commit 9f5be67e36
2 changed files with 30 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
lcl/include/customcombobox.inc
View File

@ -448,15 +448,8 @@ end;
procedure TCustomComboBox.RealSetText(const AValue: TCaption); procedure TCustomComboBox.RealSetText(const AValue: TCaption);
// If the text AValue occurs in the list of strings, then sets the itemindex, // If the text AValue occurs in the list of strings, then sets the itemindex,
// otherwise does the default action // otherwise does the default action
var
I: integer;
begin begin
// when items have same text, FItems.IndexOf(AValue) gives wrong index. Issue #28683. UpdateItemIndex(AValue);
// Items can contain an empty string, set ItemIndex in that case too. Issue #39366
I := ItemIndex;
if (I < 0) or (I >= FItems.Count) or (FItems[I] <> AValue) then
if not (csLoading in ComponentState) then
ItemIndex := MatchListItem(AValue);
if AValue<>'' then if AValue<>'' then
HideEmulatedTextHint; HideEmulatedTextHint;
inherited; inherited;
@ -631,10 +624,10 @@ end;
procedure TCustomComboBox.KeyUp(var Key: Word; Shift: TShiftState); procedure TCustomComboBox.KeyUp(var Key: Word; Shift: TShiftState);
var var
iSelStart: Integer; // char position iSelStart: Integer; // char position
sCompleteText, sPrefixText, sResultText: string; sText, sCompleteText, sPrefixText: string;
Utf8TextLen: Integer;
begin begin
inherited KeyUp(Key, Shift); inherited KeyUp(Key, Shift);
sText := Text;
//SelectAll when hitting return key for AutoSelect feature //SelectAll when hitting return key for AutoSelect feature
if (Key = VK_RETURN) then if (Key = VK_RETURN) then
begin begin
@ -646,7 +639,7 @@ begin
if FAutoSelect then if FAutoSelect then
begin begin
SelectAll; SelectAll;
if (SelText = Text) then FAutoSelected := True; if (SelText = sText) then FAutoSelected := True;
end; end;
end end
else else
@ -659,28 +652,26 @@ begin
iSelStart := SelStart;//Capture original cursor position iSelStart := SelStart;//Capture original cursor position
//DebugLn(['TCustomComboBox.UTF8KeyPress SelStart=',SelStart,' Text=',Text]); //DebugLn(['TCustomComboBox.UTF8KeyPress SelStart=',SelStart,' Text=',Text]);
//End of line completion //End of line completion
Utf8TextLen := UTF8Length(Text); if (iSelStart < UTF8Length(sText)) and (cbactEndOfLineComplete in FAutoCompleteText) then
if (iSelStart < Utf8TextLen) and (cbactEndOfLineComplete in FAutoCompleteText) then
Exit; Exit;
sPrefixText := UTF8Copy(Text, 1, iSelStart); sPrefixText := UTF8Copy(sText, 1, iSelStart);
sCompleteText := GetCompleteText(Text, iSelStart, sCompleteText := GetCompleteText(sText, iSelStart,
cbactSearchCaseSensitive in FAutoCompleteText, cbactSearchCaseSensitive in FAutoCompleteText,
cbactSearchAscending in FAutoCompleteText, Items); cbactSearchAscending in FAutoCompleteText, Items);
//DebugLn(['TCustomComboBox.UTF8KeyPress sCompleteText=',sCompleteText,' Text=',Text]); //DebugLn(['TCustomComboBox.UTF8KeyPress sCompleteText=',sCompleteText,' Text=',Text]);
if (sCompleteText <> Text) or (Utf8TextLen = 1) then // !! must check ItemIndex to be updated, see #41358
// check `Utf8TextLen = 1` is unnecessary, issue #34566 is covered
if UpdateItemIndex(sCompleteText) or (sCompleteText <> sText) then
begin begin
sResultText := sCompleteText; sText := sCompleteText;
if (cbactEndOfLineComplete in FAutoCompleteText) if [cbactEndOfLineComplete, cbactRetainPrefixCase] <= FAutoCompleteText then
and (cbactRetainPrefixCase in FAutoCompleteText) then
begin //Retain Prefix Character cases begin //Retain Prefix Character cases
UTF8Delete(sResultText, 1, iSelStart); UTF8Delete(sText, 1, iSelStart);
UTF8Insert(sPrefixText, sResultText, 1); UTF8Insert(sPrefixText, sText, 1);
end; end;
if Utf8TextLen = 1 then Text := sText;
Text := '';
Text := sResultText;
SelStart := iSelStart; SelStart := iSelStart;
SelLength := UTF8Length(Text); SelLength := UTF8Length(sText);
DoAutoCompleteSelect; DoAutoCompleteSelect;
end; end;
end; end;
@ -1210,6 +1201,19 @@ begin
FEmulatedTextHintStatus := thsHidden; FEmulatedTextHintStatus := thsHidden;
end; end;
function TCustomComboBox.UpdateItemIndex(const AValue: TCaption): Boolean;
var
I: integer;
begin
// when items have same text, FItems.IndexOf(AValue) gives wrong index. Issue #28683.
// Items can contain an empty string, set ItemIndex in that case too. Issue #39366
I := ItemIndex;
if (I < 0) or (I >= FItems.Count) or (FItems[I] <> AValue) then
if not (csLoading in ComponentState) then
ItemIndex := MatchListItem(AValue);
Result:= (I <> ItemIndex);
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
procedure TCustomComboBox.UpdateSorted; procedure TCustomComboBox.UpdateSorted;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}

1
lcl/stdctrls.pp
View File

@ -330,6 +330,7 @@ type
procedure ShowEmulatedTextHintIfYouCan; procedure ShowEmulatedTextHintIfYouCan;
procedure ShowEmulatedTextHint; procedure ShowEmulatedTextHint;
procedure HideEmulatedTextHint; procedure HideEmulatedTextHint;
function UpdateItemIndex(const AValue: TCaption): Boolean;
procedure UpdateSorted; procedure UpdateSorted;
procedure LMDrawListItem(var TheMessage: TLMDrawListItem); message LM_DrawListItem; procedure LMDrawListItem(var TheMessage: TLMDrawListItem); message LM_DrawListItem;
procedure LMMeasureItem(var TheMessage: TLMMeasureItem); message LM_MeasureItem; procedure LMMeasureItem(var TheMessage: TLMMeasureItem); message LM_MeasureItem;