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 35 by tony, Tue Jan 26 14:38:47 2016 UTC vs.
Revision 263 by tony, Thu Dec 6 15:55:01 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 >= 2000000}
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 +    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
128 +    {$ifend}
129      procedure KeyUp(var Key: Word; Shift: TShiftState); override;
130      procedure Loaded; override;
131      procedure Notification(AComponent: TComponent; Operation: TOperation); override;
132      procedure SetItemIndex(const Val: integer); override;
133      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 145 | Line 156 | type
156  
157   implementation
158  
159 < uses IBQuery, LCLType, Variants, LCLProc;
159 > uses Variants, LCLProc, LazUTF8;
160  
161   { TIBLookupControlLink }
162  
# Line 167 | Line 178 | begin
178    FOwner.ActiveChanged(self)
179   end;
180  
181 + procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
182 + begin
183 +  inherited DataEvent(Event, Info);
184 +  if Event = deLayoutChange then
185 +   FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
186 + end;
187 +
188   procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
189   begin
190    FOwner.RecordChanged(self,Field);
# Line 186 | Line 204 | end;
204   { TIBLookupComboEditBox }
205  
206   procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
189 – var ActiveState: boolean;
207   begin
208    FTimer.Interval := 0;
209    FFiltered := Text <> '';
# Line 315 | Line 332 | procedure TIBLookupComboEditBox.UpdateLi
332   var
333    iSelStart: Integer; // char position
334    sCompleteText, sPrefixText, sResultText: string;
318 –  curText: string;
335   begin
336    if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
337       and ListSource.DataSet.Active then
338    begin
339 +    FCurText := Text;
340      FUpdating := true;
341      try
342           iSelStart := SelStart;//Capture original cursor position
343           if ((iSelStart < UTF8Length(Text)) and
344             (cbactEndOfLineComplete in AutoCompleteText)) then
345                  Exit;
329 –         curText := Text;
346           sPrefixText := UTF8Copy(Text, 1, iSelStart);
347           ListSource.DataSet.Active := false;
348           ListSource.DataSet.Active :=  true;
349 <         Text := curText;
350 <         if not FExiting and (FForceAutoComplete or Focused) and (Text <> '')then
349 >         Text := FCurText;
350 >         if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
351           begin
352             if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
353             begin
354               sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
355 <             if (sCompleteText <> Text) then
355 >             if (sCompleteText <> FCurText) then
356               begin
357 +               KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
358                 sResultText := sCompleteText;
359                 if ((cbactEndOfLineComplete in AutoCompleteText) and
360                           (cbactRetainPrefixCase in AutoCompleteText)) then
# Line 347 | Line 364 | begin
364                 end;
365                 Text := sResultText;
366                 SelStart := iSelStart;
367 <               SelLength := UTF8Length(Text);
367 >               SelLength := UTF8Length(Text) - iSelStart;
368               end;
369 <             KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
369 >           end
370 >           else
371 >           begin
372 >             SelStart := iSelStart;
373 >             SelLength := 0;
374             end;
375           end;
376      finally
377        FUpdating := false
378      end;
379 +    FModified := true;
380    end;
381   end;
382  
383   procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
384    Parser: TSelectSQLParser);
385   var FieldPosition: integer;
386 +    FilterText: string;
387   begin
388    if FFiltered then
389    begin
390 +    if FUpdating then
391 +      FilterText := FCurText
392 +    else
393 +      FilterText := Text;
394      if cbactSearchCaseSensitive in AutoCompleteText then
395        Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
396 <                                  SQLSafe(Text) + '%''')
396 >                                  SQLSafe(FilterText) + '%''')
397      else
398 <      Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' +
399 <                                  SQLSafe(Text) + '%'')');
398 >      Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
399 >                                  SQLSafe(FilterText) + '%'')');
400  
401 <  end;
402 <  if cbactSearchAscending in AutoCompleteText then
403 <  begin
404 <    FieldPosition := Parser.GetFieldPosition(ListField);
378 <    if FieldPosition = 0 then Exit;
401 >    if cbactSearchAscending in AutoCompleteText then
402 >    begin
403 >      FieldPosition := Parser.GetFieldPosition(ListField);
404 >      if FieldPosition = 0 then Exit;
405  
406 <    Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
406 >      Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
407 >    end;
408    end;
409   end;
410  
# Line 483 | Line 510 | end;
510   procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
511   begin
512    inherited KeyUp(Key, Shift);
486 –  if Key = VK_RETURN then
487 –     EditingDone
488 –  else
513    if Key = VK_ESCAPE then
514    begin
515      SelStart := UTF8Length(Text);      {Ensure end of line selection}
# Line 494 | Line 518 | begin
518      SelectAll;
519    end
520    else
521 +  if AutoComplete and (Style <> csDropDownList) then
522    begin
523 <    FTimer.Interval := 0;
524 <    if (IsEditableTextKey(Key) or (Key = VK_BACK))
525 <       and AutoComplete and (Style <> csDropDownList) and
526 <       (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
523 >    if (Key = VK_BACK) or (Key = VK_DELETE) then
524 >    begin
525 >      if SelStart = 0 then
526 >      begin
527 >        SelStart := UTF8Length(Text);
528 >        SelLength := 0;
529 >      end;
530 >      FTimer.Interval := 0;
531 >    end
532 >    else
533 >    if IsEditableTextKey(Key) and
534 >     (not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
535 >    begin
536 >      FTimer.Interval := 0;
537        FTimer.Interval := FKeyPressInterval;
538 +    end;
539    end;
540   end;
541  
# Line 519 | Line 555 | end;
555  
556   procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
557   begin
558 +  if Val > 0 then
559 +    FCurText := '';
560    inherited SetItemIndex(Val);
561    FLastKeyValue := KeyValue;
562   end;
# Line 541 | Line 579 | begin
579      ActiveChanged(nil);
580   end;
581  
582 + procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
583 + begin
584 +  inherited UpdateData(Sender);
585 +  if FCurText <> '' then
586 +    Text := FCurText + Text;
587 +  FModified := false;
588 + end;
589 +
590 + {$if lcl_fullversion >= 2000000}
591 + type
592 +
593 +  { THackedCustomComboBox }
594 +
595 +  THackedCustomComboBox = class(TCustomComboBox)
596 +  private
597 +    procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char);
598 +    procedure CallChange;
599 +  end;
600 +
601 + { THackedCustomComboBox }
602 +
603 + procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char);
604 + begin
605 +  inherited UTF8KeyPress(UTF8Key);
606 + end;
607 +
608 + procedure THackedCustomComboBox.CallChange;
609 + begin
610 +  inherited Change;
611 + end;
612 +
613 + procedure TIBLookupComboEditBox.UTF8KeyPress(var UTF8Key: TUTF8Char);
614 + begin
615 +  {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;
621 + end;
622 +
623 + procedure TIBLookupComboEditBox.Change;
624 + begin
625 +  THackedCustomComboBox(self).CallChange;
626 + end;
627 +
628 + procedure TIBLookupComboEditBox.CloseUp;
629 + begin
630 +  inherited CloseUp;
631 +  inherited DoEdit;
632 + end;
633 +
634 + procedure TIBLookupComboEditBox.Select;
635 + begin
636 +  inherited Select;
637 +  inherited DoEdit;
638 + end;
639 +
640 + function TIBLookupComboEditBox.DoEdit: boolean;
641 + begin
642 +  {DoEdit will swallow characters if no editable Field. Hence, to enabled
643 +   writing we must avoid calling the inherited method.}
644 +  if ((DataSource = nil) or (Field = nil)) and not ReadOnly then
645 +    Result := true
646 +  else
647 +    Result := inherited DoEdit;
648 + end;
649 + {$ifend}
650 +
651   constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
652   begin
653    inherited Create(TheComponent);
# Line 559 | Line 666 | begin
666    if assigned(FDataLink) then FDataLink.Free;
667    if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
668    if assigned(FTimer) then FTimer.Free;
669 +  Application.RemoveAsyncCalls(self);
670    inherited Destroy;
671   end;
672  
# Line 572 | Line 680 | begin
680      FForceAutoComplete := false;
681    end;
682    CheckAndInsert;
683 +  FCurText := '';
684 +  if FModified then
685 +    Change; {ensure Update}
686    inherited EditingDone;
687   end;
688  

Diff Legend

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