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

LCL: TComboBox: clean up and added TCustomComboBox.UTF8KeyPress override for lower/uppercase, LCL: nicer parameter names

Browse Source 
git-svn-id: trunk@16462 -
This commit is contained in:
mattias 2008-09-07 11:09:00 +00:00
parent 45780ee1aa
commit 2b3fb23528
3 changed files with 76 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
lcl/include/customcombobox.inc
View File

@ -486,76 +486,88 @@ var
iSelStart: Integer; // byte position iSelStart: Integer; // byte position
sCompleteText, sPrefixText, sResultText: string; sCompleteText, sPrefixText, sResultText: string;
begin begin
inherited KeyUp(Key, Shift); inherited KeyUp(Key, Shift);
if ((cbactEnabled in FAutoCompleteText) and (Style <> csDropDownList)) then //SelectAll when hitting return key for AutoSelect feature
if (Key = VK_RETURN) then
begin begin
//Only happens with alpha-numeric keys and return key and editable Style if ((cbactEnabled in FAutoCompleteText) and (Style <> csDropDownList)) then
if (IsEditableTextKey(Key) or (Key = VK_RETURN) or (ssShift in Shift)) then begin
begin // Only happens with alpha-numeric keys and return key and editable Style
if (Key = VK_RETURN) then SelectAll;
SelectAll end;
else begin if FAutoSelect then
iSelStart := SelStart;//Capture original cursor position
//End of line completion
if ((iSelStart < Length(Text))
and (cbactEndOfLineComplete in FAutoCompleteText)) then
Exit;
sPrefixText := LeftStr(Text, iSelStart);
sCompleteText := GetCompleteText(Text, iSelStart,
(cbactSearchCaseSensitive in FAutoCompleteText),
(cbactSearchAscending in FAutoCompleteText), Items);
if not (sCompleteText = Text) then
begin
sResultText := sCompleteText;
if ((cbactEndOfLineComplete in FAutoCompleteText) and
(cbactRetainPrefixCase in FAutoCompleteText)) then
begin//Retain Prefix Character cases
Delete(sResultText, 1, iSelStart);
Insert(sPrefixText, sResultText, 1);
end;//End if ((cbactEndOfLineComplete in FAutoCompleteText) and....
Text := sResultText;
SelStart := iSelStart;
SelLength := Length(Text);
end;//End if not (sCompleteText = Text)
end;//End if (Key = VK_RETURN)
end;//End if (IsEditableTextKey(Key) or (Key = VK_RETURN) or (ssShift in Shift))
end;//End if ((cbactEnabled in FAutoCompleteText) and (Style = csDropDown))
//SelectAll when hitting return key for AutoSelect feature
if (Key = VK_RETURN) then
begin
if FAutoSelect then
begin begin
SelectAll; SelectAll;
if (SelText = Text) then FAutoSelected := True; if (SelText = Text) then FAutoSelected := True;
end;//End if FAutoSelect end;
end;//End if (Key = VK_RETURN) end
else if ((cbactEnabled in FAutoCompleteText) and (Style <> csDropDownList))
then begin
//Only happens with alpha-numeric keys and return key and editable Style
//DebugLn(['TCustomComboBox.KeyUp ',Key,' ',IsEditableTextKey(Key)]);
if IsEditableTextKey(Key) then
begin
iSelStart := SelStart;//Capture original cursor position
//DebugLn(['TCustomComboBox.UTF8KeyPress SelStart=',SelStart,' Text=',Text]);
//End of line completion
if ((iSelStart < Length(Text))
and (cbactEndOfLineComplete in FAutoCompleteText)) then
Exit;
sPrefixText := LeftStr(Text, iSelStart);
sCompleteText := GetCompleteText(Text, iSelStart,
(cbactSearchCaseSensitive in FAutoCompleteText),
(cbactSearchAscending in FAutoCompleteText), Items);
//DebugLn(['TCustomComboBox.UTF8KeyPress sCompleteText=',sCompleteText,' Text=',Text]);
if (sCompleteText <> Text) then
begin
sResultText := sCompleteText;
if ((cbactEndOfLineComplete in FAutoCompleteText) and
(cbactRetainPrefixCase in FAutoCompleteText)) then
begin//Retain Prefix Character cases
Delete(sResultText, 1, iSelStart);
Insert(sPrefixText, sResultText, 1);
end;
Text := sResultText;
SelStart := iSelStart;
SelLength := Length(Text);
end;
end;
end;
end; end;
procedure TCustomComboBox.KeyPress(var Key: char); procedure TCustomComboBox.KeyPress(var Key: char);
begin begin
//Convert character cases if FCharCase is not ecNormalCase //Convert character cases if FCharCase is not ecNormalCase
case FCharCase of case FCharCase of
ecLowerCase: Key := lowerCase(Key); ecLowerCase: Key := lowerCase(Key);
ecUpperCase: Key := upCase(Key); ecUpperCase: Key := upCase(Key);
end;//End case end;
inherited KeyPress(Key); inherited KeyPress(Key);
end;
procedure TCustomComboBox.UTF8KeyPress(var UTF8Key: TUTF8Char);
begin
//Convert character cases if FCharCase is not ecNormalCase
case FCharCase of
ecLowerCase: UTF8Key := AnsiLowerCase(UTF8Key);
ecUpperCase: UTF8Key := AnsiUpperCase(UTF8Key);
end;
inherited UTF8KeyPress(UTF8Key);
end; end;
procedure TCustomComboBox.MouseUp(Button: TMouseButton; Shift:TShiftState; procedure TCustomComboBox.MouseUp(Button: TMouseButton; Shift:TShiftState;
X, Y: Integer); X, Y: Integer);
begin begin
inherited MouseUp(Button, Shift, X, Y); inherited MouseUp(Button, Shift, X, Y);
//AutoSelect when left mouse is clicked for the 1st time after having focus //AutoSelect when left mouse is clicked for the 1st time after having focus
if (Button = mbLeft) then if (Button = mbLeft) then
begin begin
if (FAutoSelect and not FAutoSelected) then if (FAutoSelect and not FAutoSelected) then
begin begin
SelectAll; SelectAll;
if (SelText = Text) then FAutoSelected := True; if (SelText = Text) then FAutoSelected := True;
end;//End if (FAutoSelect and not FAutoSelected) end;
end;//End if (Button = mbLeft) end;
//if (Style = csDropDownList) then
// DroppedDown := not DroppedDown;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------

25
lcl/lclproc.pas
View File

@ -294,9 +294,9 @@ function UTF8ToDoubleByte(UTF8Str: PChar; Len: integer; DBStr: PByte): integer;
function UTF8FindNearestCharStart(UTF8Str: PChar; Len: integer; function UTF8FindNearestCharStart(UTF8Str: PChar; Len: integer;
BytePos: integer): integer; BytePos: integer): integer;
// find the n-th UTF8 character, ignoring BIDI // find the n-th UTF8 character, ignoring BIDI
function UTF8CharStart(UTF8Str: PChar; Len, Index: integer): PChar; function UTF8CharStart(UTF8Str: PChar; Len, CharIndex: integer): PChar;
// find the byte index of the n-th UTF8 character, ignoring BIDI (byte len of substr) // find the byte index of the n-th UTF8 character, ignoring BIDI (byte len of substr)
function UTF8CharToByteIndex(UTF8Str: PChar; Len, Index: integer): Integer; function UTF8CharToByteIndex(UTF8Str: PChar; Len, CharIndex: integer): Integer;
procedure UTF8FixBroken(P: PChar); procedure UTF8FixBroken(P: PChar);
function UTF8CharacterStrictLength(P: PChar): integer; function UTF8CharacterStrictLength(P: PChar): integer;
function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: SizeInt) : string; function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: SizeInt) : string;
@ -542,12 +542,13 @@ function GetCompleteText(sText: string; iSelStart: Integer;
begin begin
ResultText := sCompareText; ResultText := sCompareText;
Result := True; Result := True;
end;//End if (sTempText = sPrefix) end;
end;//End function IsSamePrefix end;
var i: Integer; var i: Integer;
sPrefixText: string; sPrefixText: string;
begin begin
//DebugLn(['GetCompleteText sText=',sText,' iSelStart=',iSelStart,' bCaseSensitive=',bCaseSensitive,' bSearchAscending=',bSearchAscending,' slTextList.Count=',slTextList.Count]);
Result := sText;//Default to return original text if no identical text are found Result := sText;//Default to return original text if no identical text are found
if (sText = '') then Exit;//Everything is compatible with nothing, Exit. if (sText = '') then Exit;//Everything is compatible with nothing, Exit.
if (iSelStart = 0) then Exit;//Cursor at beginning if (iSelStart = 0) then Exit;//Cursor at beginning
@ -563,7 +564,7 @@ begin
begin begin
for i:=slTextList.Count-1 downto 0 do for i:=slTextList.Count-1 downto 0 do
if IsSamePrefix(slTextList[i], sPrefixText, iSelStart, Result) then Break; if IsSamePrefix(slTextList[i], sPrefixText, iSelStart, Result) then Break;
end;//End if bSearchAscending end;
end; end;
function IsEditableTextKey(Key: Word): Boolean; function IsEditableTextKey(Key: Word): Boolean;
@ -2475,32 +2476,32 @@ begin
end; end;
{ Len is the length in bytes of UTF8Str { Len is the length in bytes of UTF8Str
Index is the position of the desired char, in chars CharIndex is the position of the desired char, in chars
This function is similar to UTF8FindNearestCharStart This function is similar to UTF8FindNearestCharStart
} }
function UTF8CharStart(UTF8Str: PChar; Len, Index: integer): PChar; function UTF8CharStart(UTF8Str: PChar; Len, CharIndex: integer): PChar;
var var
CharLen: LongInt; CharLen: LongInt;
begin begin
Result:=UTF8Str; Result:=UTF8Str;
if Result<>nil then begin if Result<>nil then begin
while (Index>0) and (Len>0) do begin while (CharIndex>0) and (Len>0) do begin
CharLen:=UTF8CharacterLength(Result); CharLen:=UTF8CharacterLength(Result);
dec(Len,CharLen); dec(Len,CharLen);
dec(Index); dec(CharIndex);
inc(Result,CharLen); inc(Result,CharLen);
end; end;
if (Index>0) or (Len<0) then if (CharIndex>0) or (Len<0) then
Result:=nil; Result:=nil;
end; end;
end; end;
function UTF8CharToByteIndex(UTF8Str : PChar; Len, Index : integer) : Integer; function UTF8CharToByteIndex(UTF8Str : PChar; Len, CharIndex : integer) : Integer;
var var
p: PChar; p: PChar;
begin begin
p := UTF8CharStart(UTF8Str, Len, Index); p := UTF8CharStart(UTF8Str, Len, CharIndex);
if p = nil if p = nil
then Result := -1 then Result := -1
else Result := p - UTF8Str; else Result := p - UTF8Str;

1
lcl/stdctrls.pp
View File

@ -331,6 +331,7 @@ type
procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override; procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: char); override; procedure KeyPress(var Key: char); override;
procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override;
function SelectItem(const AnItem: String): Boolean; function SelectItem(const AnItem: String): Boolean;