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 64 by tony, Thu Jun 29 11:11:22 2017 UTC vs.
Revision 272 by tony, Mon Feb 4 13:34:37 2019 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 < 2000003}
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 96 | Line 98 | type
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 116 | Line 119 | type
119      procedure CheckAndInsert;
120      procedure DoEnter; override;
121      procedure DoExit; override;
122 +    {$if lcl_fullversion >= 2000003}
123 +    {Deferred update changes in Lazarus 2.0 stop the combo box working when
124 +     the datasource is nil. We thus have to reverse out the changes :(}
125 +    function DoEdit: boolean; override;
126 +    procedure Change; override;
127 +    procedure CloseUp; override;
128 +    procedure Select; override;
129 +    {$ifend}
130      procedure KeyUp(var Key: Word; Shift: TShiftState); override;
131      procedure Loaded; override;
132      procedure Notification(AComponent: TComponent; Operation: TOperation); override;
133      procedure SetItemIndex(const Val: integer); override;
123 –    function SQLSafe(aText: string): string;
134      procedure UpdateShowing; override;
135 <
135 >    procedure UpdateData(Sender: TObject); override;
136    public
137      { Public declarations }
138      constructor Create(TheComponent: TComponent); override;
# Line 146 | Line 156 | type
156  
157   implementation
158  
159 < uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
159 > uses Variants, LCLProc, LazUTF8, IBUtils;
160  
161   { TIBLookupControlLink }
162  
# Line 168 | Line 178 | begin
178    FOwner.ActiveChanged(self)
179   end;
180  
181 + {$if lcl_fullversion < 2000003}
182 + procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
183 + begin
184 +  inherited DataEvent(Event, Info);
185 +  if Event = deLayoutChange then
186 +   FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
187 + end;
188 + {$endif}
189 +
190   procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
191   begin
192    FOwner.RecordChanged(self,Field);
# Line 187 | Line 206 | end;
206   { TIBLookupComboEditBox }
207  
208   procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
190 – var ActiveState: boolean;
209   begin
210    FTimer.Interval := 0;
211    FFiltered := Text <> '';
# Line 338 | Line 356 | begin
356               sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
357               if (sCompleteText <> FCurText) then
358               begin
359 +               KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
360                 sResultText := sCompleteText;
361                 if ((cbactEndOfLineComplete in AutoCompleteText) and
362                           (cbactRetainPrefixCase in AutoCompleteText)) then
# Line 347 | Line 366 | begin
366                 end;
367                 Text := sResultText;
368                 SelStart := iSelStart;
369 <               SelLength := UTF8Length(Text);
369 >               SelLength := UTF8Length(Text) - iSelStart;
370               end;
371 <             KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
371 >           end
372 >           else
373 >           begin
374 >             SelStart := iSelStart;
375 >             SelLength := 0;
376             end;
377           end;
378      finally
379        FUpdating := false
380      end;
381 +    FModified := true;
382    end;
383   end;
384  
# Line 371 | Line 395 | begin
395        FilterText := Text;
396      if cbactSearchCaseSensitive in AutoCompleteText then
397        Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
398 <                                  SQLSafe(FilterText) + '%''')
398 >                                  SQLSafeString(FilterText) + '%''')
399      else
400        Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
401 <                                  SQLSafe(FilterText) + '%'')');
401 >                                  SQLSafeString(FilterText) + '%'')');
402  
403      if cbactSearchAscending in AutoCompleteText then
404      begin
# Line 488 | Line 512 | end;
512   procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
513   begin
514    inherited KeyUp(Key, Shift);
491 –  if Key = VK_RETURN then
492 –     EditingDone
493 –  else
515    if Key = VK_ESCAPE then
516    begin
517      SelStart := UTF8Length(Text);      {Ensure end of line selection}
# Line 499 | Line 520 | begin
520      SelectAll;
521    end
522    else
523 +  if AutoComplete and (Style <> csDropDownList) then
524    begin
525 <    FTimer.Interval := 0;
526 <    if (IsEditableTextKey(Key) or (Key = VK_BACK))
527 <       and AutoComplete and (Style <> csDropDownList) and
528 <       (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
525 >    if (Key = VK_BACK) or (Key = VK_DELETE) then
526 >    begin
527 >      if SelStart = 0 then
528 >      begin
529 >        SelStart := UTF8Length(Text);
530 >        SelLength := 0;
531 >      end;
532 >      FTimer.Interval := 0;
533 >    end
534 >    else
535 >    if IsEditableTextKey(Key) and
536 >     (not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
537 >    begin
538 >      FTimer.Interval := 0;
539        FTimer.Interval := FKeyPressInterval;
540 +    end;
541    end;
542   end;
543  
# Line 524 | Line 557 | end;
557  
558   procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
559   begin
560 +  if Val > 0 then
561 +    FCurText := '';
562    inherited SetItemIndex(Val);
563    FLastKeyValue := KeyValue;
564   end;
565  
531 – function TIBLookupComboEditBox.SQLSafe(aText: string): string;
532 – var I: integer;
533 – begin
534 –  Result := '';
535 –  for I := 1 to length(aText) do
536 –    if aText[I] = '''' then
537 –      Result := Result + ''''''
538 –    else
539 –      Result := Result + aText[I];
540 – end;
541 –
566   procedure TIBLookupComboEditBox.UpdateShowing;
567   begin
568    inherited UpdateShowing;
# Line 546 | Line 570 | begin
570      ActiveChanged(nil);
571   end;
572  
573 + procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
574 + begin
575 +  inherited UpdateData(Sender);
576 +  if FCurText <> '' then
577 +    Text := FCurText + Text;
578 +  FModified := false;
579 + end;
580 +
581 + {$if lcl_fullversion >= 2000003}
582 + type
583 +
584 +  { THackedCustomComboBox }
585 +
586 +  THackedCustomComboBox = class(TCustomComboBox)
587 +  private
588 +    procedure CallChange;
589 +  end;
590 +
591 + { THackedCustomComboBox }
592 +
593 + procedure THackedCustomComboBox.CallChange;
594 + begin
595 +  inherited Change;
596 + end;
597 +
598 + procedure TIBLookupComboEditBox.Change;
599 + begin
600 +  if IsUnbound then
601 +    THackedCustomComboBox(self).CallChange
602 +  else
603 +    inherited Change;
604 + end;
605 +
606 + procedure TIBLookupComboEditBox.CloseUp;
607 + begin
608 +  inherited DoEdit;
609 +  inherited CloseUp;
610 +  EditingDone;
611 + end;
612 +
613 + procedure TIBLookupComboEditBox.Select;
614 + begin
615 +  inherited Select;
616 +  if IsUnbound then
617 +    inherited DoEdit;
618 + end;
619 +
620 + function TIBLookupComboEditBox.DoEdit: boolean;
621 + begin
622 +  {DoEdit will swallow characters if no editable Field. Hence, to enabled
623 +   writing we must avoid calling the inherited method.}
624 +  if IsUnbound then
625 +    Result := true
626 +  else
627 +    Result := inherited DoEdit;
628 + end;
629 + {$ifend}
630 +
631   constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
632   begin
633    inherited Create(TheComponent);
# Line 564 | Line 646 | begin
646    if assigned(FDataLink) then FDataLink.Free;
647    if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
648    if assigned(FTimer) then FTimer.Free;
649 +  Application.RemoveAsyncCalls(self);
650    inherited Destroy;
651   end;
652  
# Line 577 | Line 660 | begin
660      FForceAutoComplete := false;
661    end;
662    CheckAndInsert;
663 +  FCurText := '';
664 +  if FModified then
665 +    Change; {ensure Update}
666    inherited EditingDone;
667   end;
668  

Diff Legend

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