pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Fix usage of utf8 in JvDBLookup controls. Based on patch by Michal Gawrycki. Issue #38494.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7972 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-02-15 21:35:31 +00:00
parent b84c87da3c
commit d8500d93ae
2 changed files with 43 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files

83
components/jvcllaz/run/JvDB/jvdblookup.pas
View File

@ -39,7 +39,6 @@ unit JvDBLookup;
interface
uses
//{$IFDEF WINDOWS}Windows,{$ENDIF}
Variants, Classes, Graphics, Controls, Forms, DB, DBCtrls,
LMessages, LCLType, LCLIntf, LCLProc, Themes,
JvThemes, JvDBUtils;
@ -142,7 +141,7 @@ type
function LocateDisplay: Boolean;
function ValueIsEmpty(const S: string): Boolean;
function StoreEmpty: Boolean;
procedure ProcessSearchKey(Key: Char);
procedure ProcessSearchKey(Key: TUTF8Char);
procedure UpdateKeyValue;
procedure SelectKeyValue(const Value: string);
procedure SetDataFieldName(const Value: string);
@ -267,7 +266,7 @@ type
procedure ListLinkActiveChanged; override;
procedure ListLinkDataChanged; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure UTF8KeyPress(var Key: TUTF8Char); override;
procedure Loaded; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
@ -368,7 +367,7 @@ type
procedure CMHintShow(var Msg: TLMessage); message CM_HINTSHOW;
protected
procedure Click; override;
procedure KeyPress(var Key: Char); override;
procedure UTF8KeyPress(var Key: TUTF8Char); override;
public
constructor Create(AOwner: TComponent); override;
end;
@ -382,7 +381,7 @@ type
FCombo: TJvLookupControl;
FList: TJvPopupDataList;
procedure Deactivate; override;
procedure KeyPress(var Key: char); override;
procedure UTF8KeyPress(var Key: TUTF8Char); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure DoShow; override;
procedure DoClose(var CloseAction: TCloseAction); override;
@ -474,7 +473,7 @@ type
procedure DataLinkUpdateData; override;
procedure Paint; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure UTF8KeyPress(var Key: TUTF8Char); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
@ -725,7 +724,7 @@ type
implementation
uses
DBConst, SysUtils, Math, {MultiMon,}
DBConst, SysUtils, Math, LazUTF8, {MultiMon,}
{JclSysInfo,}
JvJCLUtils, JvJVCLUtils, JvTypes, JvConsts, JvResources{, JclSysUtils};
@ -1205,35 +1204,39 @@ begin
end;
end;
procedure TJvLookupControl.ProcessSearchKey(Key: Char);
procedure TJvLookupControl.ProcessSearchKey(Key: TUTF8Char);
var
TickCount: Int64;
S: string;
L: Integer;
begin
S := '';
if (FDisplayField <> nil) then
case Key of
Tab, Esc:
FSearchText := '';
Backspace, #32..High(Char):
if CanModify then
begin
if not FPopup then
begin
TickCount := GetTickCount64;
if TickCount - SearchTickCount > 2000 then
FSearchText := '';
SearchTickCount := TickCount;
end;
if Key = Backspace then
S := Copy(FSearchText, 1, Length(FSearchText) - 1)
else
if Length(FSearchText) < 32 then
S := FSearchText + Key;
if SearchText(S) or (S = '') then
FSearchText := S;
end;
begin
L := Length(Key);
if (L = 1) and (Key[1] in [Tab, Esc]) then
FSearchText := ''
else if (L = 1) and (Key[1] < #32) and (Key[1] <> Backspace) then
exit
else
if CanModify then
begin
if not FPopup then
begin
TickCount := GetTickCount64;
if TickCount - SearchTickCount > 2000 then
FSearchText := '';
SearchTickCount := TickCount;
end;
if Key = Backspace then
S := UTF8Copy(FSearchText, 1, UTF8Length(FSearchText)-1)
else
if Length(FSearchText) < 32 then
S := FSearchText + Key;
if SearchText(S) or (S = '') then
FSearchText := S;
end;
end;
end;
procedure TJvLookupControl.ResetField;
@ -1799,9 +1802,9 @@ begin
end;
end;
procedure TJvDBLookupList.KeyPress(var Key: Char);
procedure TJvDBLookupList.UTF8KeyPress(var Key: TUTF8Char);
begin
inherited KeyPress(Key);
inherited UTF8KeyPress(Key);
ProcessSearchKey(Key);
end;
@ -2477,21 +2480,21 @@ begin
TJvDBLookupCombo(FCombo).InvalidateText;
end;
procedure TJvPopupDataList.KeyPress(var Key: Char);
procedure TJvPopupDataList.UTF8KeyPress(var Key: TUTF8Char);
begin
inherited KeyPress(Key);
inherited UTF8KeyPress(Key);
if Assigned(FCombo) and TJvDBLookupCombo(FCombo).FListVisible then
TJvDBLookupCombo(FCombo).InvalidateText;
end;
{ TJvPopupDataListForm }
procedure TJvPopupDataListForm.KeyPress(var Key: char);
procedure TJvPopupDataListForm.UTF8KeyPress(var Key: TUTF8Char);
begin
inherited KeyPress(Key);
inherited UTF8KeyPress(Key);
if Assigned(FCombo) then
begin
TJvDBLookupCombo(FCombo).KeyPress(Key);
TJvDBLookupCombo(FCombo).UTF8KeyPress(Key);
if TJvDBLookupCombo(FCombo).FListVisible then
TJvDBLookupCombo(FCombo).InvalidateText;
end;
@ -2989,9 +2992,9 @@ begin
FDataListForm.FList.KeyDown(Key, Shift);
end;
procedure TJvDBLookupCombo.KeyPress(var Key: Char);
procedure TJvDBLookupCombo.UTF8KeyPress(var Key: TUTF8Char);
begin
inherited KeyPress(Key);
inherited UTF8KeyPress(Key);
if FListVisible then
begin
if TabSelects and IsDropDown and (Key = Tab) then
@ -3003,7 +3006,7 @@ begin
Key := #0;
end
else
FDataListForm.FList.KeyPress(Key)
FDataListForm.FList.UTF8KeyPress(Key)
end
else
begin
@ -3011,7 +3014,7 @@ begin
begin
DropDown;
if FListVisible then
FDataListForm.FList.KeyPress(Key);
FDataListForm.FList.UTF8KeyPress(Key);
end
else
if (Key = Esc) and FEscapeKeyReset then