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 277 by tony, Mon Feb 4 13:45:30 2019 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 +    {$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 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 115 | Line 119 | type
119      procedure CheckAndInsert;
120      procedure DoEnter; override;
121      procedure DoExit; override;
122 +    {$if lcl_fullversion >= 2000002}
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 +    {$if lcl_fullversion = 2000002}
131 +    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
132 +    {$ifend}
133      procedure KeyUp(var Key: Word; Shift: TShiftState); override;
134      procedure Loaded; override;
135      procedure Notification(AComponent: TComponent; Operation: TOperation); override;
136      procedure SetItemIndex(const Val: integer); override;
122    function SQLSafe(aText: string): string;
137      procedure UpdateShowing; override;
138 <
138 >    procedure UpdateData(Sender: TObject); override;
139    public
140      { Public declarations }
141      constructor Create(TheComponent: TComponent); override;
# Line 145 | Line 159 | type
159  
160   implementation
161  
162 < uses IBQuery, LCLType, Variants, LCLProc;
162 > uses Variants, LCLProc, LazUTF8, IBUtils;
163  
164   { TIBLookupControlLink }
165  
# Line 167 | Line 181 | begin
181    FOwner.ActiveChanged(self)
182   end;
183  
184 + {$if lcl_fullversion < 2000003}
185 + procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
186 + begin
187 +  inherited DataEvent(Event, Info);
188 +  if Event = deLayoutChange then
189 +   FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
190 + end;
191 + {$endif}
192 +
193   procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
194   begin
195    FOwner.RecordChanged(self,Field);
# Line 186 | Line 209 | end;
209   { TIBLookupComboEditBox }
210  
211   procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
189 var ActiveState: boolean;
212   begin
213    FTimer.Interval := 0;
214    FFiltered := Text <> '';
# Line 315 | Line 337 | procedure TIBLookupComboEditBox.UpdateLi
337   var
338    iSelStart: Integer; // char position
339    sCompleteText, sPrefixText, sResultText: string;
318  curText: string;
340   begin
341    if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
342       and ListSource.DataSet.Active then
343    begin
344 +    FCurText := Text;
345      FUpdating := true;
346      try
347           iSelStart := SelStart;//Capture original cursor position
348           if ((iSelStart < UTF8Length(Text)) and
349             (cbactEndOfLineComplete in AutoCompleteText)) then
350                  Exit;
329         curText := Text;
351           sPrefixText := UTF8Copy(Text, 1, iSelStart);
352           ListSource.DataSet.Active := false;
353           ListSource.DataSet.Active :=  true;
354 <         Text := curText;
355 <         if not FExiting and (FForceAutoComplete or Focused) and (Text <> '')then
354 >         Text := FCurText;
355 >         if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
356           begin
357             if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
358             begin
359               sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
360 <             if (sCompleteText <> Text) then
360 >             if (sCompleteText <> FCurText) then
361               begin
362 +               KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
363                 sResultText := sCompleteText;
364                 if ((cbactEndOfLineComplete in AutoCompleteText) and
365                           (cbactRetainPrefixCase in AutoCompleteText)) then
# Line 347 | Line 369 | begin
369                 end;
370                 Text := sResultText;
371                 SelStart := iSelStart;
372 <               SelLength := UTF8Length(Text);
372 >               SelLength := UTF8Length(Text) - iSelStart;
373               end;
374 <             KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
374 >           end
375 >           else
376 >           begin
377 >             SelStart := iSelStart;
378 >             SelLength := 0;
379             end;
380           end;
381      finally
382        FUpdating := false
383      end;
384 +    FModified := true;
385    end;
386   end;
387  
388   procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
389    Parser: TSelectSQLParser);
390   var FieldPosition: integer;
391 +    FilterText: string;
392   begin
393    if FFiltered then
394    begin
395 +    if FUpdating then
396 +      FilterText := FCurText
397 +    else
398 +      FilterText := Text;
399      if cbactSearchCaseSensitive in AutoCompleteText then
400        Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
401 <                                  SQLSafe(Text) + '%''')
401 >                                  SQLSafeString(FilterText) + '%''')
402      else
403 <      Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' +
404 <                                  SQLSafe(Text) + '%'')');
403 >      Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
404 >                                  SQLSafeString(FilterText) + '%'')');
405  
406 <  end;
407 <  if cbactSearchAscending in AutoCompleteText then
408 <  begin
409 <    FieldPosition := Parser.GetFieldPosition(ListField);
378 <    if FieldPosition = 0 then Exit;
406 >    if cbactSearchAscending in AutoCompleteText then
407 >    begin
408 >      FieldPosition := Parser.GetFieldPosition(ListField);
409 >      if FieldPosition = 0 then Exit;
410  
411 <    Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
411 >      Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
412 >    end;
413    end;
414   end;
415  
# Line 483 | Line 515 | end;
515   procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
516   begin
517    inherited KeyUp(Key, Shift);
486  if Key = VK_RETURN then
487     EditingDone
488  else
518    if Key = VK_ESCAPE then
519    begin
520      SelStart := UTF8Length(Text);      {Ensure end of line selection}
# Line 494 | Line 523 | begin
523      SelectAll;
524    end
525    else
526 +  if AutoComplete and (Style <> csDropDownList) then
527    begin
528 <    FTimer.Interval := 0;
529 <    if (IsEditableTextKey(Key) or (Key = VK_BACK))
530 <       and AutoComplete and (Style <> csDropDownList) and
531 <       (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
528 >    if (Key = VK_BACK) or (Key = VK_DELETE) then
529 >    begin
530 >      if SelStart = 0 then
531 >      begin
532 >        SelStart := UTF8Length(Text);
533 >        SelLength := 0;
534 >      end;
535 >      FTimer.Interval := 0;
536 >    end
537 >    else
538 >    if IsEditableTextKey(Key) and
539 >     (not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
540 >    begin
541 >      FTimer.Interval := 0;
542        FTimer.Interval := FKeyPressInterval;
543 +    end;
544    end;
545   end;
546  
# Line 519 | Line 560 | end;
560  
561   procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
562   begin
563 +  if Val > 0 then
564 +    FCurText := '';
565    inherited SetItemIndex(Val);
566    FLastKeyValue := KeyValue;
567   end;
568  
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
569   procedure TIBLookupComboEditBox.UpdateShowing;
570   begin
571    inherited UpdateShowing;
# Line 541 | Line 573 | begin
573      ActiveChanged(nil);
574   end;
575  
576 + procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
577 + begin
578 +  inherited UpdateData(Sender);
579 +  if FCurText <> '' then
580 +    Text := FCurText + Text;
581 +  FModified := false;
582 + end;
583 +
584 +
585 + {Workarounds due to bugs in various Lazarus 2.0 release candidates}
586 + {$if lcl_fullversion >= 2000002}
587 + type
588 +
589 +  { THackedCustomComboBox }
590 +
591 +  THackedCustomComboBox = class(TCustomComboBox)
592 +  private
593 +    procedure CallChange;
594 +    procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char);
595 +  end;
596 +
597 + { THackedCustomComboBox }
598 +
599 + procedure THackedCustomComboBox.CallChange;
600 + begin
601 +  inherited Change;
602 + end;
603 +
604 + procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char);
605 + begin
606 +  inherited UTF8KeyPress(UTF8Key);
607 + end;
608 +
609 + procedure TIBLookupComboEditBox.Change;
610 + begin
611 +  if DataSource = nil then
612 +    THackedCustomComboBox(self).CallChange
613 +  else
614 +    inherited Change;
615 + end;
616 +
617 + procedure TIBLookupComboEditBox.CloseUp;
618 + begin
619 +  inherited DoEdit;
620 +  inherited CloseUp;
621 +  EditingDone;
622 + end;
623 +
624 + procedure TIBLookupComboEditBox.Select;
625 + begin
626 +  inherited Select;
627 +  if DataSource = nil then
628 +    inherited DoEdit;
629 + end;
630 +
631 + function TIBLookupComboEditBox.DoEdit: boolean;
632 + begin
633 +  {DoEdit will swallow characters if no editable Field. Hence, to enabled
634 +   writing we must avoid calling the inherited method.}
635 +  if DataSource = nil then
636 +    Result := true
637 +  else
638 +    Result := inherited DoEdit;
639 + end;
640 + {$ifend}
641 +
642 + {$if lcl_fullversion = 2000002}
643 + procedure TIBLookupComboEditBox.UTF8KeyPress(var UTF8Key: TUTF8Char);
644 + begin
645 +  if DataSource = nil then
646 +    THackedCustomComboBox(self).CallUTF8KeyPress(UTF8Key)
647 +  else
648 +    inherited;
649 + end;
650 + {$ifend}
651 +
652 +
653   constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
654   begin
655    inherited Create(TheComponent);
# Line 559 | Line 668 | begin
668    if assigned(FDataLink) then FDataLink.Free;
669    if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
670    if assigned(FTimer) then FTimer.Free;
671 +  Application.RemoveAsyncCalls(self);
672    inherited Destroy;
673   end;
674  
# Line 572 | Line 682 | begin
682      FForceAutoComplete := false;
683    end;
684    CheckAndInsert;
685 +  FCurText := '';
686 +  if FModified then
687 +    Change; {ensure Update}
688    inherited EditingDone;
689   end;
690  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines