ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/ibcontrols/IBLookupComboEditBox.pas
(Generate patch)

Comparing ibx/trunk/ibcontrols/IBLookupComboEditBox.pas (file contents):
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC

# Line 54 | Line 54 | type
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
# Line 111 | Line 113 | type
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
# Line 156 | Line 160 | type
160  
161   implementation
162  
163 < uses Variants, LCLProc, LazUTF8;
163 > uses Variants, LCLProc, LazUTF8, IBUtils, IBMessages;
164  
165   { TIBLookupControlLink }
166  
# Line 178 | Line 182 | begin
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
# Line 246 | Line 252 | 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
# Line 384 | Line 391 | procedure TIBLookupComboEditBox.UpdateSQ
391    Parser: TSelectSQLParser);
392   var FieldPosition: integer;
393      FilterText: string;
394 +    SQLDialect: integer;
395   begin
396    if FFiltered then
397    begin
# Line 391 | Line 399 | 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
# Line 420 | Line 434 | 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) then Exit;
444 +  SQLDialect := (ListSource.DataSet as TIBCustomDataSet).Database.SQLDialect;
445 +  FieldNames := TStringList.Create;
446 +  try
447 +    FieldNames.CaseSensitive := true;
448 +    FieldNames.Sorted := true;
449 +    FieldNames.Duplicates := dupError;
450 +    ListSource.DataSet.GetFieldNames(FieldNames);
451 +    if FieldNames.IndexOf(ListField) = -1 then {not found}
452 +    begin
453 +      if (SQLDialect = 3) and (FieldNames.IndexOf(AnsiUpperCase(ListField)) <> - 1) then {normalise to upper case}
454 +        ListField := AnsiUpperCase(ListField)
455 +      else
456 +        IBError(ibxeListFieldNotFound,[ListField])
457 +    end;
458 +  finally
459 +    FieldNames.Free;
460 +  end;
461 + end;
462 +
463   procedure TIBLookupComboEditBox.CheckAndInsert;
464   var Accept: boolean;
465      NewKeyValue: variant;
# Line 561 | Line 601 | begin
601    FLastKeyValue := KeyValue;
602   end;
603  
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 –
604   procedure TIBLookupComboEditBox.UpdateShowing;
605   begin
606    inherited UpdateShowing;
# Line 587 | Line 616 | begin
616    FModified := false;
617   end;
618  
619 < {$if lcl_fullversion >= 2000000}
619 >
620 > {Workarounds due to bugs in various Lazarus 2.0 release candidates}
621 > {$if lcl_fullversion >= 2000002}
622   type
623  
624    { THackedCustomComboBox }
625  
626    THackedCustomComboBox = class(TCustomComboBox)
627    private
597 –    procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char);
628      procedure CallChange;
629 +    procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char);
630    end;
631  
632   { THackedCustomComboBox }
633  
603 – procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char);
604 – begin
605 –  inherited UTF8KeyPress(UTF8Key);
606 – end;
607 –
634   procedure THackedCustomComboBox.CallChange;
635   begin
636    inherited Change;
637   end;
638  
639 < procedure TIBLookupComboEditBox.UTF8KeyPress(var UTF8Key: TUTF8Char);
639 > procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char);
640   begin
641 <  {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;
641 >  inherited UTF8KeyPress(UTF8Key);
642   end;
643  
644   procedure TIBLookupComboEditBox.Change;
645   begin
646 <  THackedCustomComboBox(self).CallChange;
646 >  if DataSource = nil then
647 >    THackedCustomComboBox(self).CallChange
648 >  else
649 >    inherited Change;
650   end;
651  
652   procedure TIBLookupComboEditBox.CloseUp;
653   begin
630 –  inherited CloseUp;
654    inherited DoEdit;
655 +  inherited CloseUp;
656 +  EditingDone;
657   end;
658  
659   procedure TIBLookupComboEditBox.Select;
660   begin
661    inherited Select;
662 <  inherited DoEdit;
662 >  if DataSource = nil then
663 >    inherited DoEdit;
664   end;
665  
666   function TIBLookupComboEditBox.DoEdit: boolean;
667   begin
668    {DoEdit will swallow characters if no editable Field. Hence, to enabled
669     writing we must avoid calling the inherited method.}
670 <  if ((DataSource = nil) or (Field = nil)) and not ReadOnly then
670 >  if DataSource = nil then
671      Result := true
672    else
673      Result := inherited DoEdit;
674   end;
675   {$ifend}
676  
677 + {$if lcl_fullversion = 2000002}
678 + procedure TIBLookupComboEditBox.UTF8KeyPress(var UTF8Key: TUTF8Char);
679 + begin
680 +  if DataSource = nil then
681 +    THackedCustomComboBox(self).CallUTF8KeyPress(UTF8Key)
682 +  else
683 +    inherited;
684 + end;
685 + {$ifend}
686 +
687 +
688   constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
689   begin
690    inherited Create(TheComponent);

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines