15 |
|
* |
16 |
|
* The Initial Developer of the Original Code is Tony Whyman. |
17 |
|
* |
18 |
< |
* The Original Code is (C) 2011 Tony Whyman, MWA Software |
18 |
> |
* The Original Code is (C) 2015 Tony Whyman, MWA Software |
19 |
|
* (http://www.mwasoftware.co.uk). |
20 |
|
* |
21 |
|
* All Rights Reserved. |
30 |
|
interface |
31 |
|
|
32 |
|
uses |
33 |
< |
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls, |
34 |
< |
ExtCtrls, IBSQLParser, DB, StdCtrls; |
33 |
> |
Classes, SysUtils, LCLType, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls, |
34 |
> |
ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet, LCLVersion; |
35 |
|
|
36 |
|
type |
37 |
|
|
54 |
|
FOwner: TIBLookupComboEditBox; |
55 |
|
protected |
56 |
|
procedure ActiveChanged; override; |
57 |
+ |
{$if lcl_fullversion < 2000000} |
58 |
|
procedure DataEvent(Event: TDataEvent; Info: Ptrint); override; |
59 |
+ |
{$endif} |
60 |
|
procedure RecordChanged(Field: TField); override; |
61 |
|
procedure UpdateData; override; |
62 |
|
public |
63 |
|
constructor Create(AOwner: TIBLookupComboEditBox); |
64 |
|
end; |
65 |
|
|
66 |
+ |
{ TIBLookupControlLink } |
67 |
+ |
|
68 |
+ |
TIBLookupControlLink = class(TIBControlLink) |
69 |
+ |
private |
70 |
+ |
FOwner: TIBLookupComboEditBox; |
71 |
+ |
protected |
72 |
+ |
procedure UpdateSQL(Sender: TObject); override; |
73 |
+ |
public |
74 |
+ |
constructor Create(AOwner: TIBLookupComboEditBox); |
75 |
+ |
end; |
76 |
+ |
|
77 |
|
|
78 |
|
{ TIBLookupComboEditBox } |
79 |
|
|
80 |
|
TIBLookupComboEditBox = class(TDBLookupComboBox) |
81 |
|
private |
69 |
– |
FCanAutoInsert: TCanAutoInsert; |
82 |
|
{ Private declarations } |
83 |
|
FDataLink: TIBLookupComboDataLink; |
84 |
+ |
FIBLookupControlLink: TIBLookupControlLink; |
85 |
|
FAutoComplete: boolean; |
86 |
|
FAutoInsert: boolean; |
87 |
|
FKeyPressInterval: integer; |
94 |
|
FUpdating: boolean; |
95 |
|
FInserting: boolean; |
96 |
|
FExiting: boolean; |
97 |
+ |
FForceAutoComplete: boolean; |
98 |
+ |
FInCheckAndInsert: boolean; |
99 |
|
FLastKeyValue: variant; |
100 |
+ |
FCurText: string; |
101 |
+ |
FModified: boolean; |
102 |
|
procedure DoActiveChanged(Data: PtrInt); |
103 |
|
function GetAutoCompleteText: TComboBoxAutoCompleteText; |
104 |
|
function GetListSource: TDataSource; |
105 |
|
function GetRelationNameQualifier: string; |
106 |
|
procedure HandleTimer(Sender: TObject); |
107 |
+ |
procedure IBControlLinkChanged; |
108 |
|
procedure ResetParser; |
109 |
|
procedure RecordChanged(Sender: TObject; aField: TField); |
110 |
|
procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText); |
113 |
|
procedure UpdateSQL(Sender: TObject; Parser: TSelectSQLParser); |
114 |
|
procedure HandleEnter(Data: PtrInt); |
115 |
|
procedure UpdateLinkData(Sender: TObject); |
116 |
+ |
procedure ValidateListField; |
117 |
|
protected |
118 |
|
{ Protected declarations } |
119 |
|
procedure ActiveChanged(Sender: TObject); |
120 |
|
procedure CheckAndInsert; |
121 |
|
procedure DoEnter; override; |
122 |
|
procedure DoExit; override; |
123 |
+ |
{$if lcl_fullversion >= 2000002} |
124 |
+ |
{Deferred update changes in Lazarus 2.0 stop the combo box working when |
125 |
+ |
the datasource is nil. We thus have to reverse out the changes :(} |
126 |
+ |
function DoEdit: boolean; override; |
127 |
+ |
procedure Change; override; |
128 |
+ |
procedure CloseUp; override; |
129 |
+ |
procedure Select; override; |
130 |
+ |
{$ifend} |
131 |
+ |
{$if lcl_fullversion = 2000002} |
132 |
+ |
procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override; |
133 |
+ |
{$ifend} |
134 |
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override; |
135 |
+ |
procedure Loaded; override; |
136 |
+ |
procedure Notification(AComponent: TComponent; Operation: TOperation); override; |
137 |
|
procedure SetItemIndex(const Val: integer); override; |
138 |
|
procedure UpdateShowing; override; |
139 |
+ |
procedure UpdateData(Sender: TObject); override; |
140 |
|
public |
141 |
|
{ Public declarations } |
142 |
|
constructor Create(TheComponent: TComponent); override; |
151 |
|
property ItemHeight; |
152 |
|
property ItemWidth; |
153 |
|
property ListSource: TDataSource read GetListSource write SetListSource; |
154 |
< |
property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500; |
154 |
> |
property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200; |
155 |
|
property RelationName: string read FRelationName write FRelationName; |
156 |
|
property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert; |
157 |
|
property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert; |
160 |
|
|
161 |
|
implementation |
162 |
|
|
163 |
< |
uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc; |
163 |
> |
uses Variants, LCLProc, LazUTF8, IBUtils, IBMessages; |
164 |
> |
|
165 |
> |
{ TIBLookupControlLink } |
166 |
> |
|
167 |
> |
constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox); |
168 |
> |
begin |
169 |
> |
inherited Create; |
170 |
> |
FOwner := AOwner; |
171 |
> |
end; |
172 |
> |
|
173 |
> |
procedure TIBLookupControlLink.UpdateSQL(Sender: TObject); |
174 |
> |
begin |
175 |
> |
FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser) |
176 |
> |
end; |
177 |
|
|
178 |
|
{ TIBLookupComboDataLink } |
179 |
|
|
182 |
|
FOwner.ActiveChanged(self) |
183 |
|
end; |
184 |
|
|
185 |
+ |
{$if lcl_fullversion < 2000000} |
186 |
|
procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint); |
187 |
|
begin |
188 |
< |
{If we are not visible then avoid unnecessary work} |
189 |
< |
if not FOwner.Showing then Exit; |
190 |
< |
|
144 |
< |
if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then |
145 |
< |
begin |
146 |
< |
if (DataSet is TIBDataSet) then |
147 |
< |
FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser) |
148 |
< |
else |
149 |
< |
if (DataSet is TIBQuery) then |
150 |
< |
FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser) |
151 |
< |
end |
152 |
< |
else |
153 |
< |
inherited DataEvent(Event, Info); |
188 |
> |
inherited DataEvent(Event, Info); |
189 |
> |
if Event = deLayoutChange then |
190 |
> |
FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup} |
191 |
|
end; |
192 |
+ |
{$endif} |
193 |
|
|
194 |
|
procedure TIBLookupComboDataLink.RecordChanged(Field: TField); |
195 |
|
begin |
210 |
|
{ TIBLookupComboEditBox } |
211 |
|
|
212 |
|
procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject); |
175 |
– |
var ActiveState: boolean; |
213 |
|
begin |
214 |
|
FTimer.Interval := 0; |
215 |
|
FFiltered := Text <> ''; |
216 |
|
UpdateList |
217 |
|
end; |
218 |
|
|
219 |
+ |
procedure TIBLookupComboEditBox.IBControlLinkChanged; |
220 |
+ |
begin |
221 |
+ |
if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then |
222 |
+ |
FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet) |
223 |
+ |
else |
224 |
+ |
FIBLookupControlLink.IBDataSet := nil; |
225 |
+ |
end; |
226 |
+ |
|
227 |
|
function TIBLookupComboEditBox.GetListSource: TDataSource; |
228 |
|
begin |
229 |
|
Result := inherited ListSource; |
241 |
|
begin |
242 |
|
if not FInserting and not FUpdating then |
243 |
|
Application.QueueAsyncCall(@DoActiveChanged,0); |
244 |
+ |
IBControlLinkChanged; |
245 |
|
end; |
246 |
|
|
247 |
|
procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt); |
252 |
|
and ListSource.DataSet.Active then |
253 |
|
begin |
254 |
|
begin |
255 |
+ |
ValidateListField; |
256 |
|
if varIsNull(FLastKeyValue) and (ItemIndex = -1) then |
257 |
|
KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant |
258 |
|
else |
284 |
|
end; |
285 |
|
|
286 |
|
procedure TIBLookupComboEditBox.ResetParser; |
287 |
+ |
var curKeyValue: variant; |
288 |
|
begin |
289 |
|
if FFiltered then |
290 |
|
begin |
291 |
|
FFiltered := false; |
292 |
+ |
curKeyValue := KeyValue; |
293 |
+ |
Text := ''; {Ensure full list} |
294 |
|
UpdateList; |
295 |
+ |
KeyValue := curKeyValue; |
296 |
|
UpdateData(self); {Force Scroll} |
297 |
|
end; |
298 |
|
end; |
327 |
|
begin |
328 |
|
FDataLink.DataSource := AValue; |
329 |
|
inherited ListSource := AValue; |
330 |
+ |
IBControlLinkChanged; |
331 |
|
end; |
332 |
|
end; |
333 |
|
|
339 |
|
var |
340 |
|
iSelStart: Integer; // char position |
341 |
|
sCompleteText, sPrefixText, sResultText: string; |
290 |
– |
curText: string; |
342 |
|
begin |
343 |
|
if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet) |
344 |
|
and ListSource.DataSet.Active then |
345 |
|
begin |
346 |
+ |
FCurText := Text; |
347 |
|
FUpdating := true; |
348 |
|
try |
349 |
|
iSelStart := SelStart;//Capture original cursor position |
350 |
|
if ((iSelStart < UTF8Length(Text)) and |
351 |
|
(cbactEndOfLineComplete in AutoCompleteText)) then |
352 |
|
Exit; |
301 |
– |
curText := Text; |
353 |
|
sPrefixText := UTF8Copy(Text, 1, iSelStart); |
354 |
|
ListSource.DataSet.Active := false; |
355 |
|
ListSource.DataSet.Active := true; |
356 |
< |
Text := curText; |
357 |
< |
if not FExiting and Focused and (Text <> '')then |
356 |
> |
Text := FCurText; |
357 |
> |
if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then |
358 |
|
begin |
359 |
|
if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then |
360 |
|
begin |
361 |
|
sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString; |
362 |
< |
if (sCompleteText <> Text) then |
362 |
> |
if (sCompleteText <> FCurText) then |
363 |
|
begin |
364 |
+ |
KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant; |
365 |
|
sResultText := sCompleteText; |
366 |
|
if ((cbactEndOfLineComplete in AutoCompleteText) and |
367 |
|
(cbactRetainPrefixCase in AutoCompleteText)) then |
370 |
|
UTF8Insert(sPrefixText, sResultText, 1); |
371 |
|
end; |
372 |
|
Text := sResultText; |
321 |
– |
SelStart := iSelStart; |
322 |
– |
SelLength := UTF8Length(Text); |
373 |
|
end; |
374 |
+ |
SelStart := iSelStart; |
375 |
+ |
SelLength := UTF8Length(Text) - iSelStart; |
376 |
+ |
end |
377 |
+ |
else |
378 |
+ |
begin |
379 |
+ |
SelStart := iSelStart; |
380 |
+ |
SelLength := 0; |
381 |
|
end; |
382 |
|
end; |
383 |
|
finally |
384 |
|
FUpdating := false |
385 |
|
end; |
386 |
+ |
FModified := true; |
387 |
|
end; |
388 |
|
end; |
389 |
|
|
390 |
|
procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject; |
391 |
|
Parser: TSelectSQLParser); |
392 |
|
var FieldPosition: integer; |
393 |
+ |
FilterText: string; |
394 |
+ |
SQLDialect: integer; |
395 |
|
begin |
396 |
|
if FFiltered then |
397 |
|
begin |
398 |
+ |
if FUpdating then |
399 |
+ |
FilterText := FCurText |
400 |
+ |
else |
401 |
+ |
FilterText := Text; |
402 |
+ |
|
403 |
+ |
if Parser.DataSet <> nil then |
404 |
+ |
SQLDialect := (Parser.DataSet as TIBCustomDataSet).Database.SQLDialect |
405 |
+ |
else |
406 |
+ |
SQLDialect := 1; |
407 |
+ |
|
408 |
|
if cbactSearchCaseSensitive in AutoCompleteText then |
409 |
< |
Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''') |
409 |
> |
Parser.Add2WhereClause(GetRelationNameQualifier + QuoteIdentifierIfNeeded(SQLDialect,ListField) + ' Like ''' + |
410 |
> |
SQLSafeString(FilterText) + '%''') |
411 |
|
else |
412 |
< |
Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')'); |
412 |
> |
Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + QuoteIdentifierIfNeeded(SQLDialect,ListField) + ') Like Upper(''' + |
413 |
> |
SQLSafeString(FilterText) + '%'')'); |
414 |
|
|
415 |
< |
end; |
416 |
< |
if cbactSearchAscending in AutoCompleteText then |
417 |
< |
begin |
418 |
< |
FieldPosition := Parser.GetFieldPosition(ListField); |
347 |
< |
if FieldPosition = 0 then Exit; |
415 |
> |
if cbactSearchAscending in AutoCompleteText then |
416 |
> |
begin |
417 |
> |
FieldPosition := Parser.GetFieldPosition(ListField); |
418 |
> |
if FieldPosition = 0 then Exit; |
419 |
|
|
420 |
< |
Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending'; |
420 |
> |
Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending'; |
421 |
> |
end; |
422 |
|
end; |
423 |
|
end; |
424 |
|
|
425 |
|
procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt); |
426 |
|
begin |
427 |
< |
SelectAll |
427 |
> |
if AppDestroying in Application.Flags then Exit; |
428 |
> |
SelectAll |
429 |
|
end; |
430 |
|
|
431 |
|
procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject); |
434 |
|
ListSource.DataSet.FieldByName(ListField).AsString := Text |
435 |
|
end; |
436 |
|
|
437 |
+ |
{Check to ensure that ListField exists and convert to upper case if necessary} |
438 |
+ |
|
439 |
+ |
procedure TIBLookupComboEditBox.ValidateListField; |
440 |
+ |
var SQLDialect: integer; |
441 |
+ |
FieldNames: TStringList; |
442 |
+ |
begin |
443 |
+ |
if (ListSource = nil) or (ListSource.DataSet = nil) or |
444 |
+ |
not (ListSource.DataSet is TIBCustomDataSet) or |
445 |
+ |
((ListSource.DataSet as TIBCustomDataSet).Database = nil) then Exit; |
446 |
+ |
SQLDialect := (ListSource.DataSet as TIBCustomDataSet).Database.SQLDialect; |
447 |
+ |
FieldNames := TStringList.Create; |
448 |
+ |
try |
449 |
+ |
FieldNames.CaseSensitive := true; |
450 |
+ |
FieldNames.Sorted := true; |
451 |
+ |
FieldNames.Duplicates := dupError; |
452 |
+ |
ListSource.DataSet.GetFieldNames(FieldNames); |
453 |
+ |
if FieldNames.IndexOf(ListField) = -1 then {not found} |
454 |
+ |
begin |
455 |
+ |
if (SQLDialect = 3) and (FieldNames.IndexOf(AnsiUpperCase(ListField)) <> - 1) then {normalise to upper case} |
456 |
+ |
ListField := AnsiUpperCase(ListField) |
457 |
+ |
else |
458 |
+ |
IBError(ibxeListFieldNotFound,[ListField]) |
459 |
+ |
end; |
460 |
+ |
finally |
461 |
+ |
FieldNames.Free; |
462 |
+ |
end; |
463 |
+ |
end; |
464 |
+ |
|
465 |
|
procedure TIBLookupComboEditBox.CheckAndInsert; |
466 |
|
var Accept: boolean; |
467 |
|
NewKeyValue: variant; |
468 |
|
begin |
469 |
< |
if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet) |
470 |
< |
and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then |
469 |
> |
if FInCheckAndInsert then Exit; |
470 |
> |
FInCheckAndInsert := true; |
471 |
|
try |
472 |
< |
{Is it OK to insert a new list member?} |
473 |
< |
Accept := true; |
474 |
< |
if assigned(FOnCanAutoInsert) then |
475 |
< |
OnCanAutoInsert(self,Text,Accept); |
476 |
< |
if not Accept then |
477 |
< |
begin |
478 |
< |
ResetParser; |
479 |
< |
Text := FOriginalTextValue; |
480 |
< |
SelectAll; |
481 |
< |
Exit; |
482 |
< |
end; |
472 |
> |
if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet) |
473 |
> |
and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then |
474 |
> |
try |
475 |
> |
{Is it OK to insert a new list member?} |
476 |
> |
Accept := true; |
477 |
> |
if assigned(FOnCanAutoInsert) then |
478 |
> |
OnCanAutoInsert(self,Text,Accept); |
479 |
> |
if not Accept then |
480 |
> |
begin |
481 |
> |
ResetParser; |
482 |
> |
Text := FOriginalTextValue; |
483 |
> |
SelectAll; |
484 |
> |
Exit; |
485 |
> |
end; |
486 |
|
|
487 |
< |
FInserting := true; |
488 |
< |
try |
489 |
< |
{New Value} |
490 |
< |
FFiltered := false; |
491 |
< |
if assigned(FOnAutoInsert) then |
492 |
< |
begin |
493 |
< |
{In an OnAutoInsert handler, the client is expected to insert the new |
494 |
< |
row into the List DataSet and to set the KeyValue property to the |
495 |
< |
value of the primary key of the new row.} |
496 |
< |
OnAutoInsert(self,Text,NewKeyValue); |
497 |
< |
end |
498 |
< |
else |
499 |
< |
begin |
500 |
< |
ListSource.DataSet.Append; |
501 |
< |
{The new KeyValue should be determined by an external generator or |
502 |
< |
in the "OnInsert" handler. If it is the same as the ListField, then |
503 |
< |
it will be set from the UpdateLinkData method} |
504 |
< |
try |
505 |
< |
ListSource.DataSet.Post; |
506 |
< |
except |
507 |
< |
ListSource.DataSet.Cancel; |
508 |
< |
raise; |
509 |
< |
end; |
510 |
< |
NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant; |
511 |
< |
end; |
512 |
< |
UpdateList; |
513 |
< |
KeyValue := NewKeyValue; |
514 |
< |
UpdateData(nil); {Force sync with DataField} |
515 |
< |
finally |
516 |
< |
FInserting := false |
517 |
< |
end; |
518 |
< |
except |
519 |
< |
Text := FOriginalTextValue; |
520 |
< |
ResetParser; |
521 |
< |
raise; |
487 |
> |
FInserting := true; |
488 |
> |
try |
489 |
> |
{New Value} |
490 |
> |
FFiltered := false; |
491 |
> |
if assigned(FOnAutoInsert) then |
492 |
> |
begin |
493 |
> |
{In an OnAutoInsert handler, the client is expected to insert the new |
494 |
> |
row into the List DataSet and to set the KeyValue property to the |
495 |
> |
value of the primary key of the new row.} |
496 |
> |
OnAutoInsert(self,Text,NewKeyValue); |
497 |
> |
end |
498 |
> |
else |
499 |
> |
begin |
500 |
> |
ListSource.DataSet.Append; |
501 |
> |
{The new KeyValue should be determined by an external generator or |
502 |
> |
in the "OnInsert" handler. If it is the same as the ListField, then |
503 |
> |
it will be set from the UpdateLinkData method} |
504 |
> |
try |
505 |
> |
ListSource.DataSet.Post; |
506 |
> |
except |
507 |
> |
ListSource.DataSet.Cancel; |
508 |
> |
raise; |
509 |
> |
end; |
510 |
> |
NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant; |
511 |
> |
end; |
512 |
> |
Text := ''; {Ensure full list} |
513 |
> |
UpdateList; |
514 |
> |
KeyValue := NewKeyValue; |
515 |
> |
UpdateData(nil); {Force sync with DataField} |
516 |
> |
finally |
517 |
> |
FInserting := false |
518 |
> |
end; |
519 |
> |
except |
520 |
> |
Text := FOriginalTextValue; |
521 |
> |
ResetParser; |
522 |
> |
raise; |
523 |
> |
end; |
524 |
> |
finally |
525 |
> |
FInCheckAndInsert := false |
526 |
|
end; |
527 |
|
end; |
528 |
|
|
536 |
|
|
537 |
|
procedure TIBLookupComboEditBox.DoExit; |
538 |
|
begin |
539 |
+ |
if FTimer.Interval <> 0 then |
540 |
+ |
HandleTimer(nil); |
541 |
|
FExiting := true; |
542 |
|
try |
543 |
|
CheckAndInsert; |
552 |
|
procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState); |
553 |
|
begin |
554 |
|
inherited KeyUp(Key, Shift); |
445 |
– |
if Key = VK_RETURN then |
446 |
– |
EditingDone |
447 |
– |
else |
555 |
|
if Key = VK_ESCAPE then |
556 |
|
begin |
557 |
|
SelStart := UTF8Length(Text); {Ensure end of line selection} |
560 |
|
SelectAll; |
561 |
|
end |
562 |
|
else |
563 |
< |
if (IsEditableTextKey(Key) or (Key = VK_BACK)) |
564 |
< |
and AutoComplete and (Style <> csDropDownList) and |
565 |
< |
(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then |
566 |
< |
FTimer.Interval := FKeyPressInterval |
567 |
< |
else |
568 |
< |
FTimer.Interval := 0 |
563 |
> |
if AutoComplete and (Style <> csDropDownList) then |
564 |
> |
begin |
565 |
> |
if (Key = VK_BACK) or (Key = VK_DELETE) then |
566 |
> |
begin |
567 |
> |
if SelStart = 0 then |
568 |
> |
begin |
569 |
> |
SelStart := UTF8Length(Text); |
570 |
> |
SelLength := 0; |
571 |
> |
end; |
572 |
> |
FTimer.Interval := 0; |
573 |
> |
end |
574 |
> |
else |
575 |
> |
if IsEditableTextKey(Key) and |
576 |
> |
(not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then |
577 |
> |
begin |
578 |
> |
FTimer.Interval := 0; |
579 |
> |
FTimer.Interval := FKeyPressInterval; |
580 |
> |
end; |
581 |
> |
end; |
582 |
> |
end; |
583 |
> |
|
584 |
> |
procedure TIBLookupComboEditBox.Loaded; |
585 |
> |
begin |
586 |
> |
inherited Loaded; |
587 |
> |
IBControlLinkChanged; |
588 |
> |
end; |
589 |
> |
|
590 |
> |
procedure TIBLookupComboEditBox.Notification(AComponent: TComponent; |
591 |
> |
Operation: TOperation); |
592 |
> |
begin |
593 |
> |
inherited Notification(AComponent, Operation); |
594 |
> |
if (Operation = opRemove) and (AComponent = DataSource) then |
595 |
> |
ListSource := nil; |
596 |
|
end; |
597 |
|
|
598 |
|
procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer); |
599 |
|
begin |
600 |
+ |
if Val > 0 then |
601 |
+ |
FCurText := ''; |
602 |
|
inherited SetItemIndex(Val); |
603 |
|
FLastKeyValue := KeyValue; |
604 |
|
end; |
610 |
|
ActiveChanged(nil); |
611 |
|
end; |
612 |
|
|
613 |
+ |
procedure TIBLookupComboEditBox.UpdateData(Sender: TObject); |
614 |
+ |
begin |
615 |
+ |
inherited UpdateData(Sender); |
616 |
+ |
if FCurText <> '' then |
617 |
+ |
Text := FCurText + Text; |
618 |
+ |
FModified := false; |
619 |
+ |
end; |
620 |
+ |
|
621 |
+ |
|
622 |
+ |
{Workarounds due to bugs in various Lazarus 2.0 release candidates} |
623 |
+ |
{$if lcl_fullversion >= 2000002} |
624 |
+ |
type |
625 |
+ |
|
626 |
+ |
{ THackedCustomComboBox } |
627 |
+ |
|
628 |
+ |
THackedCustomComboBox = class(TCustomComboBox) |
629 |
+ |
private |
630 |
+ |
procedure CallChange; |
631 |
+ |
procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char); |
632 |
+ |
end; |
633 |
+ |
|
634 |
+ |
{ THackedCustomComboBox } |
635 |
+ |
|
636 |
+ |
procedure THackedCustomComboBox.CallChange; |
637 |
+ |
begin |
638 |
+ |
inherited Change; |
639 |
+ |
end; |
640 |
+ |
|
641 |
+ |
procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char); |
642 |
+ |
begin |
643 |
+ |
inherited UTF8KeyPress(UTF8Key); |
644 |
+ |
end; |
645 |
+ |
|
646 |
+ |
procedure TIBLookupComboEditBox.Change; |
647 |
+ |
begin |
648 |
+ |
if DataSource = nil then |
649 |
+ |
THackedCustomComboBox(self).CallChange |
650 |
+ |
else |
651 |
+ |
inherited Change; |
652 |
+ |
end; |
653 |
+ |
|
654 |
+ |
procedure TIBLookupComboEditBox.CloseUp; |
655 |
+ |
begin |
656 |
+ |
inherited DoEdit; |
657 |
+ |
inherited CloseUp; |
658 |
+ |
EditingDone; |
659 |
+ |
end; |
660 |
+ |
|
661 |
+ |
procedure TIBLookupComboEditBox.Select; |
662 |
+ |
begin |
663 |
+ |
inherited Select; |
664 |
+ |
if DataSource = nil then |
665 |
+ |
inherited DoEdit; |
666 |
+ |
end; |
667 |
+ |
|
668 |
+ |
function TIBLookupComboEditBox.DoEdit: boolean; |
669 |
+ |
begin |
670 |
+ |
{DoEdit will swallow characters if no editable Field. Hence, to enabled |
671 |
+ |
writing we must avoid calling the inherited method.} |
672 |
+ |
if DataSource = nil then |
673 |
+ |
Result := true |
674 |
+ |
else |
675 |
+ |
Result := inherited DoEdit; |
676 |
+ |
end; |
677 |
+ |
{$ifend} |
678 |
+ |
|
679 |
+ |
{$if lcl_fullversion = 2000002} |
680 |
+ |
procedure TIBLookupComboEditBox.UTF8KeyPress(var UTF8Key: TUTF8Char); |
681 |
+ |
begin |
682 |
+ |
if DataSource = nil then |
683 |
+ |
THackedCustomComboBox(self).CallUTF8KeyPress(UTF8Key) |
684 |
+ |
else |
685 |
+ |
inherited; |
686 |
+ |
end; |
687 |
+ |
{$ifend} |
688 |
+ |
|
689 |
+ |
|
690 |
|
constructor TIBLookupComboEditBox.Create(TheComponent: TComponent); |
691 |
|
begin |
692 |
|
inherited Create(TheComponent); |
693 |
|
FDataLink := TIBLookupComboDataLink.Create(self); |
694 |
< |
FKeyPressInterval := 500; |
694 |
> |
FIBLookupControlLink := TIBLookupControlLink.Create(self); |
695 |
> |
FKeyPressInterval := 200; |
696 |
|
FAutoComplete := true; |
697 |
|
FTimer := TTimer.Create(nil); |
698 |
|
FTimer.Interval := 0; |
703 |
|
destructor TIBLookupComboEditBox.Destroy; |
704 |
|
begin |
705 |
|
if assigned(FDataLink) then FDataLink.Free; |
706 |
+ |
if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free; |
707 |
|
if assigned(FTimer) then FTimer.Free; |
708 |
+ |
Application.RemoveAsyncCalls(self); |
709 |
|
inherited Destroy; |
710 |
|
end; |
711 |
|
|
712 |
|
procedure TIBLookupComboEditBox.EditingDone; |
713 |
|
begin |
714 |
+ |
FForceAutoComplete := true; |
715 |
+ |
try |
716 |
+ |
if FTimer.Interval <> 0 then |
717 |
+ |
HandleTimer(nil); |
718 |
+ |
finally |
719 |
+ |
FForceAutoComplete := false; |
720 |
+ |
end; |
721 |
|
CheckAndInsert; |
722 |
+ |
FCurText := ''; |
723 |
+ |
if FModified then |
724 |
+ |
Change; {ensure Update} |
725 |
|
inherited EditingDone; |
726 |
|
end; |
727 |
|
|