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 41 by tony, Sat Jul 16 12:25:48 2016 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC

# Line 30 | Line 30 | unit IBLookupComboEditBox;
30   interface
31  
32   uses
33 <  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
33 >  Classes, SysUtils, LCLType, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
34    ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet, LCLVersion;
35  
36   type
# 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 76 | Line 79 | type
79  
80    TIBLookupComboEditBox = class(TDBLookupComboBox)
81    private
79 –    FCanAutoInsert: TCanAutoInsert;
82      { Private declarations }
83      FDataLink: TIBLookupComboDataLink;
84      FIBLookupControlLink: TIBLookupControlLink;
# Line 95 | Line 97 | type
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;
# Line 109 | 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 >= 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;
122 –    function SQLSafe(aText: string): string;
138      procedure UpdateShowing; override;
139 <
139 >    procedure UpdateData(Sender: TObject); override;
140    public
141      { Public declarations }
142      constructor Create(TheComponent: TComponent); override;
# Line 145 | Line 160 | type
160  
161   implementation
162  
163 < uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
163 > uses Variants, LCLProc, LazUTF8, IBUtils, IBMessages;
164  
165   { TIBLookupControlLink }
166  
# Line 167 | 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
196    FOwner.RecordChanged(self,Field);
# Line 186 | Line 210 | end;
210   { TIBLookupComboEditBox }
211  
212   procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
189 – var ActiveState: boolean;
213   begin
214    FTimer.Interval := 0;
215    FFiltered := Text <> '';
# Line 229 | 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 315 | Line 339 | procedure TIBLookupComboEditBox.UpdateLi
339   var
340    iSelStart: Integer; // char position
341    sCompleteText, sPrefixText, sResultText: string;
318 –  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;
329 –         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 (FForceAutoComplete or 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
# Line 347 | Line 371 | begin
371                 end;
372                 Text := sResultText;
373                 SelStart := iSelStart;
374 <               SelLength := UTF8Length(Text);
374 >               SelLength := UTF8Length(Text) - iSelStart;
375               end;
376 <             KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
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 ''' +
410 <                                  SQLSafe(Text) + '%''')
409 >      Parser.Add2WhereClause(GetRelationNameQualifier + QuoteIdentifierIfNeeded(SQLDialect,ListField) + ' Like ''' +
410 >                                  SQLSafeString(FilterText) + '%''')
411      else
412 <      Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
413 <                                  SQLSafe(Text) + '%'')');
412 >      Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + QuoteIdentifierIfNeeded(SQLDialect,ListField) + ') Like Upper(''' +
413 >                                  SQLSafeString(FilterText) + '%'')');
414  
415      if cbactSearchAscending in AutoCompleteText then
416      begin
# Line 393 | 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 483 | Line 550 | end;
550   procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
551   begin
552    inherited KeyUp(Key, Shift);
486 –  if Key = VK_RETURN then
487 –     EditingDone
488 –  else
553    if Key = VK_ESCAPE then
554    begin
555      SelStart := UTF8Length(Text);      {Ensure end of line selection}
# Line 494 | Line 558 | begin
558      SelectAll;
559    end
560    else
561 +  if AutoComplete and (Style <> csDropDownList) then
562    begin
563 <    FTimer.Interval := 0;
564 <    if (IsEditableTextKey(Key) or (Key = VK_BACK))
565 <       and AutoComplete and (Style <> csDropDownList) and
566 <       (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
563 >    if (Key = VK_BACK) or (Key = VK_DELETE) then
564 >    begin
565 >      if SelStart = 0 then
566 >      begin
567 >        SelStart := UTF8Length(Text);
568 >        SelLength := 0;
569 >      end;
570 >      FTimer.Interval := 0;
571 >    end
572 >    else
573 >    if IsEditableTextKey(Key) and
574 >     (not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
575 >    begin
576 >      FTimer.Interval := 0;
577        FTimer.Interval := FKeyPressInterval;
578 +    end;
579    end;
580   end;
581  
# Line 519 | Line 595 | end;
595  
596   procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
597   begin
598 +  if Val > 0 then
599 +    FCurText := '';
600    inherited SetItemIndex(Val);
601    FLastKeyValue := KeyValue;
602   end;
603  
526 – function TIBLookupComboEditBox.SQLSafe(aText: string): string;
527 – var I: integer;
528 – begin
529 –  Result := '';
530 –  for I := 1 to length(aText) do
531 –    if aText[I] = '''' then
532 –      Result := Result + ''''''
533 –    else
534 –      Result := Result + aText[I];
535 – end;
536 –
604   procedure TIBLookupComboEditBox.UpdateShowing;
605   begin
606    inherited UpdateShowing;
# Line 541 | Line 608 | begin
608      ActiveChanged(nil);
609   end;
610  
611 + procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
612 + begin
613 +  inherited UpdateData(Sender);
614 +  if FCurText <> '' then
615 +    Text := FCurText + Text;
616 +  FModified := false;
617 + end;
618 +
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
628 +    procedure CallChange;
629 +    procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char);
630 +  end;
631 +
632 + { THackedCustomComboBox }
633 +
634 + procedure THackedCustomComboBox.CallChange;
635 + begin
636 +  inherited Change;
637 + end;
638 +
639 + procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char);
640 + begin
641 +  inherited UTF8KeyPress(UTF8Key);
642 + end;
643 +
644 + procedure TIBLookupComboEditBox.Change;
645 + begin
646 +  if DataSource = nil then
647 +    THackedCustomComboBox(self).CallChange
648 +  else
649 +    inherited Change;
650 + end;
651 +
652 + procedure TIBLookupComboEditBox.CloseUp;
653 + begin
654 +  inherited DoEdit;
655 +  inherited CloseUp;
656 +  EditingDone;
657 + end;
658 +
659 + procedure TIBLookupComboEditBox.Select;
660 + begin
661 +  inherited Select;
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 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);
# Line 559 | Line 703 | begin
703    if assigned(FDataLink) then FDataLink.Free;
704    if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
705    if assigned(FTimer) then FTimer.Free;
706 +  Application.RemoveAsyncCalls(self);
707    inherited Destroy;
708   end;
709  
# Line 572 | Line 717 | begin
717      FForceAutoComplete := false;
718    end;
719    CheckAndInsert;
720 +  FCurText := '';
721 +  if FModified then
722 +    Change; {ensure Update}
723    inherited EditingDone;
724   end;
725  

Diff Legend

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