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 |
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 >= 2000000} |
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; |
133 |
– |
function SQLSafe(aText: string): string; |
138 |
|
procedure UpdateShowing; override; |
139 |
|
procedure UpdateData(Sender: TObject); override; |
140 |
|
public |
160 |
|
|
161 |
|
implementation |
162 |
|
|
163 |
< |
uses Variants, LCLProc, LazUTF8; |
163 |
> |
uses Variants, LCLProc, LazUTF8, IBUtils, IBMessages; |
164 |
|
|
165 |
|
{ TIBLookupControlLink } |
166 |
|
|
182 |
|
FOwner.ActiveChanged(self) |
183 |
|
end; |
184 |
|
|
185 |
+ |
{$if lcl_fullversion < 2000000} |
186 |
|
procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint); |
187 |
|
begin |
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 |
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 |
370 |
|
UTF8Insert(sPrefixText, sResultText, 1); |
371 |
|
end; |
372 |
|
Text := sResultText; |
366 |
– |
SelStart := iSelStart; |
367 |
– |
SelLength := UTF8Length(Text) - iSelStart; |
373 |
|
end; |
374 |
+ |
SelStart := iSelStart; |
375 |
+ |
SelLength := UTF8Length(Text) - iSelStart; |
376 |
|
end |
377 |
|
else |
378 |
|
begin |
391 |
|
Parser: TSelectSQLParser); |
392 |
|
var FieldPosition: integer; |
393 |
|
FilterText: string; |
394 |
+ |
SQLDialect: integer; |
395 |
|
begin |
396 |
|
if FFiltered then |
397 |
|
begin |
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 ''' + |
410 |
< |
SQLSafe(FilterText) + '%''') |
409 |
> |
Parser.Add2WhereClause(GetRelationNameQualifier + QuoteIdentifierIfNeeded(SQLDialect,ListField) + ' Like ''' + |
410 |
> |
SQLSafeString(FilterText) + '%''') |
411 |
|
else |
412 |
< |
Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' + ListField + '") Like Upper(''' + |
413 |
< |
SQLSafe(FilterText) + '%'')'); |
412 |
> |
Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + QuoteIdentifierIfNeeded(SQLDialect,ListField) + ') Like Upper(''' + |
413 |
> |
SQLSafeString(FilterText) + '%'')'); |
414 |
|
|
415 |
|
if cbactSearchAscending in AutoCompleteText then |
416 |
|
begin |
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; |
603 |
|
FLastKeyValue := KeyValue; |
604 |
|
end; |
605 |
|
|
564 |
– |
function TIBLookupComboEditBox.SQLSafe(aText: string): string; |
565 |
– |
var I: integer; |
566 |
– |
begin |
567 |
– |
Result := ''; |
568 |
– |
for I := 1 to length(aText) do |
569 |
– |
if aText[I] = '''' then |
570 |
– |
Result := Result + '''''' |
571 |
– |
else |
572 |
– |
Result := Result + aText[I]; |
573 |
– |
end; |
574 |
– |
|
606 |
|
procedure TIBLookupComboEditBox.UpdateShowing; |
607 |
|
begin |
608 |
|
inherited UpdateShowing; |
618 |
|
FModified := false; |
619 |
|
end; |
620 |
|
|
621 |
< |
{$if lcl_fullversion >= 2000000} |
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 |
597 |
– |
procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char); |
630 |
|
procedure CallChange; |
631 |
+ |
procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char); |
632 |
|
end; |
633 |
|
|
634 |
|
{ THackedCustomComboBox } |
635 |
|
|
603 |
– |
procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char); |
604 |
– |
begin |
605 |
– |
inherited UTF8KeyPress(UTF8Key); |
606 |
– |
end; |
607 |
– |
|
636 |
|
procedure THackedCustomComboBox.CallChange; |
637 |
|
begin |
638 |
|
inherited Change; |
639 |
|
end; |
640 |
|
|
641 |
< |
procedure TIBLookupComboEditBox.UTF8KeyPress(var UTF8Key: TUTF8Char); |
641 |
> |
procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char); |
642 |
|
begin |
643 |
< |
{TDBLookupComboBox.UTF8KeyPress will swallow the character if |
616 |
< |
the datalink is not editable. hence to enable writing we must override it} |
617 |
< |
if ((DataSource = nil) or (Field = nil)) and not ReadOnly then |
618 |
< |
THackedCustomComboBox(self).CallUTF8KeyPress(UTF8Key) |
619 |
< |
else |
620 |
< |
inherited; |
643 |
> |
inherited UTF8KeyPress(UTF8Key); |
644 |
|
end; |
645 |
|
|
646 |
|
procedure TIBLookupComboEditBox.Change; |
647 |
|
begin |
648 |
< |
THackedCustomComboBox(self).CallChange; |
648 |
> |
if DataSource = nil then |
649 |
> |
THackedCustomComboBox(self).CallChange |
650 |
> |
else |
651 |
> |
inherited Change; |
652 |
|
end; |
653 |
|
|
654 |
|
procedure TIBLookupComboEditBox.CloseUp; |
655 |
|
begin |
630 |
– |
inherited CloseUp; |
656 |
|
inherited DoEdit; |
657 |
+ |
inherited CloseUp; |
658 |
+ |
EditingDone; |
659 |
|
end; |
660 |
|
|
661 |
|
procedure TIBLookupComboEditBox.Select; |
662 |
|
begin |
663 |
|
inherited Select; |
664 |
< |
inherited DoEdit; |
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) or (Field = nil)) and not ReadOnly then |
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); |