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

Comparing ibx/trunk/ibcontrols/IBLookupComboEditBox.pas (file contents):
Revision 35 by tony, Tue Jan 26 14:38:47 2016 UTC vs.
Revision 268 by tony, Fri Dec 28 11:36:35 2018 UTC

# Line 30 | Line 30 | unit IBLookupComboEditBox;
30   interface
31  
32   uses
33 <  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
34 <  ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet;
33 >  Classes, SysUtils, LCLType, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
34 >  ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet, LCLVersion;
35  
36   type
37  
# Line 54 | Line 54 | type
54      FOwner: TIBLookupComboEditBox;
55    protected
56      procedure ActiveChanged; override;
57 +    procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
58      procedure RecordChanged(Field: TField); override;
59      procedure UpdateData; override;
60    public
# Line 76 | Line 77 | type
77  
78    TIBLookupComboEditBox = class(TDBLookupComboBox)
79    private
79    FCanAutoInsert: TCanAutoInsert;
80      { Private declarations }
81      FDataLink: TIBLookupComboDataLink;
82      FIBLookupControlLink: TIBLookupControlLink;
# Line 95 | Line 95 | type
95      FForceAutoComplete: boolean;
96      FInCheckAndInsert: boolean;
97      FLastKeyValue: variant;
98 +    FCurText: string;
99 +    FModified: boolean;
100      procedure DoActiveChanged(Data: PtrInt);
101      function GetAutoCompleteText: TComboBoxAutoCompleteText;
102      function GetListSource: TDataSource;
# Line 115 | Line 117 | type
117      procedure CheckAndInsert;
118      procedure DoEnter; override;
119      procedure DoExit; override;
120 +    {$if lcl_fullversion >= 2000003}
121 +    {Deferred update changes in Lazarus 2.0 stop the combo box working when
122 +     the datasource is nil. We thus have to reverse out the changes :(}
123 +    function DoEdit: boolean; override;
124 +    procedure Change; override;
125 +    procedure CloseUp; override;
126 +    procedure Select; override;
127 +    {$ifend}
128      procedure KeyUp(var Key: Word; Shift: TShiftState); override;
129      procedure Loaded; override;
130      procedure Notification(AComponent: TComponent; Operation: TOperation); override;
131      procedure SetItemIndex(const Val: integer); override;
132      function SQLSafe(aText: string): string;
133      procedure UpdateShowing; override;
134 <
134 >    procedure UpdateData(Sender: TObject); override;
135    public
136      { Public declarations }
137      constructor Create(TheComponent: TComponent); override;
# Line 145 | Line 155 | type
155  
156   implementation
157  
158 < uses IBQuery, LCLType, Variants, LCLProc;
158 > uses Variants, LCLProc, LazUTF8;
159  
160   { TIBLookupControlLink }
161  
# Line 167 | Line 177 | begin
177    FOwner.ActiveChanged(self)
178   end;
179  
180 + procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
181 + begin
182 +  inherited DataEvent(Event, Info);
183 +  if Event = deLayoutChange then
184 +   FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
185 + end;
186 +
187   procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
188   begin
189    FOwner.RecordChanged(self,Field);
# Line 186 | Line 203 | end;
203   { TIBLookupComboEditBox }
204  
205   procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
189 var ActiveState: boolean;
206   begin
207    FTimer.Interval := 0;
208    FFiltered := Text <> '';
# Line 315 | Line 331 | procedure TIBLookupComboEditBox.UpdateLi
331   var
332    iSelStart: Integer; // char position
333    sCompleteText, sPrefixText, sResultText: string;
318  curText: string;
334   begin
335    if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
336       and ListSource.DataSet.Active then
337    begin
338 +    FCurText := Text;
339      FUpdating := true;
340      try
341           iSelStart := SelStart;//Capture original cursor position
342           if ((iSelStart < UTF8Length(Text)) and
343             (cbactEndOfLineComplete in AutoCompleteText)) then
344                  Exit;
329         curText := Text;
345           sPrefixText := UTF8Copy(Text, 1, iSelStart);
346           ListSource.DataSet.Active := false;
347           ListSource.DataSet.Active :=  true;
348 <         Text := curText;
349 <         if not FExiting and (FForceAutoComplete or Focused) and (Text <> '')then
348 >         Text := FCurText;
349 >         if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
350           begin
351             if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
352             begin
353               sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
354 <             if (sCompleteText <> Text) then
354 >             if (sCompleteText <> FCurText) then
355               begin
356 +               KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
357                 sResultText := sCompleteText;
358                 if ((cbactEndOfLineComplete in AutoCompleteText) and
359                           (cbactRetainPrefixCase in AutoCompleteText)) then
# Line 347 | Line 363 | begin
363                 end;
364                 Text := sResultText;
365                 SelStart := iSelStart;
366 <               SelLength := UTF8Length(Text);
366 >               SelLength := UTF8Length(Text) - iSelStart;
367               end;
368 <             KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
368 >           end
369 >           else
370 >           begin
371 >             SelStart := iSelStart;
372 >             SelLength := 0;
373             end;
374           end;
375      finally
376        FUpdating := false
377      end;
378 +    FModified := true;
379    end;
380   end;
381  
382   procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
383    Parser: TSelectSQLParser);
384   var FieldPosition: integer;
385 +    FilterText: string;
386   begin
387    if FFiltered then
388    begin
389 +    if FUpdating then
390 +      FilterText := FCurText
391 +    else
392 +      FilterText := Text;
393      if cbactSearchCaseSensitive in AutoCompleteText then
394        Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
395 <                                  SQLSafe(Text) + '%''')
395 >                                  SQLSafe(FilterText) + '%''')
396      else
397 <      Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' +
398 <                                  SQLSafe(Text) + '%'')');
397 >      Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
398 >                                  SQLSafe(FilterText) + '%'')');
399  
400 <  end;
401 <  if cbactSearchAscending in AutoCompleteText then
402 <  begin
403 <    FieldPosition := Parser.GetFieldPosition(ListField);
378 <    if FieldPosition = 0 then Exit;
400 >    if cbactSearchAscending in AutoCompleteText then
401 >    begin
402 >      FieldPosition := Parser.GetFieldPosition(ListField);
403 >      if FieldPosition = 0 then Exit;
404  
405 <    Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
405 >      Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
406 >    end;
407    end;
408   end;
409  
# Line 483 | Line 509 | end;
509   procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
510   begin
511    inherited KeyUp(Key, Shift);
486  if Key = VK_RETURN then
487     EditingDone
488  else
512    if Key = VK_ESCAPE then
513    begin
514      SelStart := UTF8Length(Text);      {Ensure end of line selection}
# Line 494 | Line 517 | begin
517      SelectAll;
518    end
519    else
520 +  if AutoComplete and (Style <> csDropDownList) then
521    begin
522 <    FTimer.Interval := 0;
523 <    if (IsEditableTextKey(Key) or (Key = VK_BACK))
524 <       and AutoComplete and (Style <> csDropDownList) and
525 <       (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
522 >    if (Key = VK_BACK) or (Key = VK_DELETE) then
523 >    begin
524 >      if SelStart = 0 then
525 >      begin
526 >        SelStart := UTF8Length(Text);
527 >        SelLength := 0;
528 >      end;
529 >      FTimer.Interval := 0;
530 >    end
531 >    else
532 >    if IsEditableTextKey(Key) and
533 >     (not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
534 >    begin
535 >      FTimer.Interval := 0;
536        FTimer.Interval := FKeyPressInterval;
537 +    end;
538    end;
539   end;
540  
# Line 519 | Line 554 | end;
554  
555   procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
556   begin
557 +  if Val > 0 then
558 +    FCurText := '';
559    inherited SetItemIndex(Val);
560    FLastKeyValue := KeyValue;
561   end;
# Line 541 | Line 578 | begin
578      ActiveChanged(nil);
579   end;
580  
581 + procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
582 + begin
583 +  inherited UpdateData(Sender);
584 +  if FCurText <> '' then
585 +    Text := FCurText + Text;
586 +  FModified := false;
587 + end;
588 +
589 + {$if lcl_fullversion >= 2000003}
590 + type
591 +
592 +  { THackedCustomComboBox }
593 +
594 +  THackedCustomComboBox = class(TCustomComboBox)
595 +  private
596 +    procedure CallChange;
597 +  end;
598 +
599 + { THackedCustomComboBox }
600 +
601 + procedure THackedCustomComboBox.CallChange;
602 + begin
603 +  inherited Change;
604 + end;
605 +
606 + procedure TIBLookupComboEditBox.Change;
607 + begin
608 +  THackedCustomComboBox(self).CallChange;
609 + end;
610 +
611 + procedure TIBLookupComboEditBox.CloseUp;
612 + begin
613 +  inherited CloseUp;
614 +  inherited DoEdit;
615 + end;
616 +
617 + procedure TIBLookupComboEditBox.Select;
618 + begin
619 +  inherited Select;
620 +  inherited DoEdit;
621 + end;
622 +
623 + function TIBLookupComboEditBox.DoEdit: boolean;
624 + begin
625 +  {DoEdit will swallow characters if no editable Field. Hence, to enabled
626 +   writing we must avoid calling the inherited method.}
627 +  if IsUnbound then
628 +    Result := true
629 +  else
630 +    Result := inherited DoEdit;
631 + end;
632 + {$ifend}
633 +
634   constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
635   begin
636    inherited Create(TheComponent);
# Line 559 | Line 649 | begin
649    if assigned(FDataLink) then FDataLink.Free;
650    if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
651    if assigned(FTimer) then FTimer.Free;
652 +  Application.RemoveAsyncCalls(self);
653    inherited Destroy;
654   end;
655  
# Line 572 | Line 663 | begin
663      FForceAutoComplete := false;
664    end;
665    CheckAndInsert;
666 +  FCurText := '';
667 +  if FModified then
668 +    Change; {ensure Update}
669    inherited EditingDone;
670   end;
671  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines