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 23 by tony, Fri Mar 13 10:26:52 2015 UTC vs.
Revision 225 by tony, Tue Apr 3 09:09:05 2018 UTC

# Line 31 | Line 31 | interface
31  
32   uses
33    Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
34 <  ExtCtrls, IBSQLParser, DB, StdCtrls;
34 >  ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet;
35  
36   type
37  
# Line 61 | Line 61 | type
61      constructor Create(AOwner: TIBLookupComboEditBox);
62    end;
63  
64 +  { TIBLookupControlLink }
65 +
66 +  TIBLookupControlLink = class(TIBControlLink)
67 +  private
68 +    FOwner: TIBLookupComboEditBox;
69 +  protected
70 +    procedure UpdateSQL(Sender: TObject); override;
71 +  public
72 +    constructor Create(AOwner: TIBLookupComboEditBox);
73 +  end;
74 +
75  
76    { TIBLookupComboEditBox }
77  
78    TIBLookupComboEditBox = class(TDBLookupComboBox)
79    private
69    FCanAutoInsert: TCanAutoInsert;
80      { Private declarations }
81      FDataLink: TIBLookupComboDataLink;
82 +    FIBLookupControlLink: TIBLookupControlLink;
83      FAutoComplete: boolean;
84      FAutoInsert: boolean;
85      FKeyPressInterval: integer;
# Line 81 | Line 92 | type
92      FUpdating: boolean;
93      FInserting: boolean;
94      FExiting: boolean;
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;
103      function GetRelationNameQualifier: string;
104      procedure HandleTimer(Sender: TObject);
105 +    procedure IBControlLinkChanged;
106      procedure ResetParser;
107      procedure RecordChanged(Sender: TObject; aField: TField);
108      procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText);
# Line 102 | Line 118 | type
118      procedure DoEnter; override;
119      procedure DoExit; override;
120      procedure KeyUp(var Key: Word; Shift: TShiftState); override;
121 +    procedure Loaded; override;
122 +    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
123      procedure SetItemIndex(const Val: integer); override;
124 +    function SQLSafe(aText: string): string;
125      procedure UpdateShowing; override;
126 +    procedure UpdateData(Sender: TObject); override;
127    public
128      { Public declarations }
129      constructor Create(TheComponent: TComponent); override;
# Line 118 | Line 138 | type
138      property ItemHeight;
139      property ItemWidth;
140      property ListSource: TDataSource read GetListSource write SetListSource;
141 <    property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500;
141 >    property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200;
142      property RelationName: string read FRelationName write FRelationName;
143      property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert;
144      property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert;
# Line 127 | Line 147 | type
147  
148   implementation
149  
150 < uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc;
150 > uses LCLType, Variants, LCLProc, LazUTF8;
151 >
152 > { TIBLookupControlLink }
153 >
154 > constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox);
155 > begin
156 >  inherited Create;
157 >  FOwner := AOwner;
158 > end;
159 >
160 > procedure TIBLookupControlLink.UpdateSQL(Sender: TObject);
161 > begin
162 >  FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
163 > end;
164  
165   { TIBLookupComboDataLink }
166  
# Line 138 | Line 171 | end;
171  
172   procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
173   begin
174 <  {If we are not visible then avoid unnecessary work}
175 <  if not FOwner.Showing then Exit;
176 <
144 <  if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then
145 <  begin
146 <    if (DataSet is TIBDataSet) then
147 <      FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser)
148 <    else
149 <    if (DataSet is TIBQuery) then
150 <      FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser)
151 <  end
152 <  else
153 <    inherited DataEvent(Event, Info);
174 >  inherited DataEvent(Event, Info);
175 >  if Event = deLayoutChange then
176 >   FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
177   end;
178  
179   procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
# Line 172 | Line 195 | end;
195   { TIBLookupComboEditBox }
196  
197   procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
175 var ActiveState: boolean;
198   begin
199    FTimer.Interval := 0;
200    FFiltered := Text <> '';
201    UpdateList
202   end;
203  
204 + procedure TIBLookupComboEditBox.IBControlLinkChanged;
205 + begin
206 +  if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then
207 +    FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet)
208 +  else
209 +    FIBLookupControlLink.IBDataSet := nil;
210 + end;
211 +
212   function TIBLookupComboEditBox.GetListSource: TDataSource;
213   begin
214    Result := inherited ListSource;
# Line 196 | Line 226 | procedure TIBLookupComboEditBox.ActiveCh
226   begin
227    if not FInserting and not FUpdating then
228       Application.QueueAsyncCall(@DoActiveChanged,0);
229 +  IBControlLinkChanged;
230   end;
231  
232   procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt);
# Line 237 | Line 268 | begin
268   end;
269  
270   procedure TIBLookupComboEditBox.ResetParser;
271 + var curKeyValue: variant;
272   begin
273    if FFiltered then
274    begin
275      FFiltered := false;
276 +    curKeyValue := KeyValue;
277 +    Text := ''; {Ensure full list}
278      UpdateList;
279 +    KeyValue := curKeyValue;
280      UpdateData(self); {Force Scroll}
281    end;
282   end;
# Line 276 | Line 311 | begin
311    begin
312      FDataLink.DataSource := AValue;
313      inherited ListSource := AValue;
314 +    IBControlLinkChanged;
315    end;
316   end;
317  
# Line 287 | Line 323 | procedure TIBLookupComboEditBox.UpdateLi
323   var
324    iSelStart: Integer; // char position
325    sCompleteText, sPrefixText, sResultText: string;
290  curText: string;
326   begin
327    if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
328       and ListSource.DataSet.Active then
329    begin
330 +    FCurText := Text;
331      FUpdating := true;
332      try
333           iSelStart := SelStart;//Capture original cursor position
334           if ((iSelStart < UTF8Length(Text)) and
335             (cbactEndOfLineComplete in AutoCompleteText)) then
336                  Exit;
301         curText := Text;
337           sPrefixText := UTF8Copy(Text, 1, iSelStart);
338           ListSource.DataSet.Active := false;
339           ListSource.DataSet.Active :=  true;
340 <         Text := curText;
341 <         if not FExiting and Focused and (Text <> '')then
340 >         Text := FCurText;
341 >         if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
342           begin
343             if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
344             begin
345               sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
346 <             if (sCompleteText <> Text) then
346 >             if (sCompleteText <> FCurText) then
347               begin
348 +               KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
349                 sResultText := sCompleteText;
350                 if ((cbactEndOfLineComplete in AutoCompleteText) and
351                           (cbactRetainPrefixCase in AutoCompleteText)) then
# Line 319 | Line 355 | begin
355                 end;
356                 Text := sResultText;
357                 SelStart := iSelStart;
358 <               SelLength := UTF8Length(Text);
358 >               SelLength := UTF8Length(Text) - iSelStart;
359               end;
360 +           end
361 +           else
362 +           begin
363 +             SelStart := iSelStart;
364 +             SelLength := 0;
365             end;
366           end;
367      finally
368        FUpdating := false
369      end;
370 +    FModified := true;
371    end;
372   end;
373  
374   procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
375    Parser: TSelectSQLParser);
376   var FieldPosition: integer;
377 +    FilterText: string;
378   begin
379    if FFiltered then
380    begin
381 +    if FUpdating then
382 +      FilterText := FCurText
383 +    else
384 +      FilterText := Text;
385      if cbactSearchCaseSensitive in AutoCompleteText then
386 <      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''')
386 >      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
387 >                                  SQLSafe(FilterText) + '%''')
388      else
389 <      Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')');
389 >      Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
390 >                                  SQLSafe(FilterText) + '%'')');
391  
392 <  end;
393 <  if cbactSearchAscending in AutoCompleteText then
394 <  begin
395 <    FieldPosition := Parser.GetFieldPosition(ListField);
347 <    if FieldPosition = 0 then Exit;
392 >    if cbactSearchAscending in AutoCompleteText then
393 >    begin
394 >      FieldPosition := Parser.GetFieldPosition(ListField);
395 >      if FieldPosition = 0 then Exit;
396  
397 <    Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
397 >      Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
398 >    end;
399    end;
400   end;
401  
402   procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
403   begin
404 <  SelectAll
404 >  if AppDestroying in Application.Flags then Exit;
405 >   SelectAll
406   end;
407  
408   procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
# Line 365 | Line 415 | procedure TIBLookupComboEditBox.CheckAnd
415   var Accept: boolean;
416      NewKeyValue: variant;
417   begin
418 <  if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
419 <     and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
418 >  if FInCheckAndInsert then Exit;
419 >  FInCheckAndInsert := true;
420    try
421 <    {Is it OK to insert a new list member?}
422 <    Accept := true;
423 <    if assigned(FOnCanAutoInsert) then
424 <       OnCanAutoInsert(self,Text,Accept);
425 <    if not Accept then
426 <    begin
427 <      ResetParser;
428 <      Text := FOriginalTextValue;
429 <      SelectAll;
430 <      Exit;
431 <    end;
421 >       if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
422 >          and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
423 >       try
424 >         {Is it OK to insert a new list member?}
425 >         Accept := true;
426 >         if assigned(FOnCanAutoInsert) then
427 >            OnCanAutoInsert(self,Text,Accept);
428 >         if not Accept then
429 >         begin
430 >           ResetParser;
431 >           Text := FOriginalTextValue;
432 >           SelectAll;
433 >           Exit;
434 >         end;
435  
436 <    FInserting := true;
437 <    try
438 <      {New Value}
439 <      FFiltered := false;
440 <      if assigned(FOnAutoInsert) then
441 <      begin
442 <        {In an OnAutoInsert handler, the client is expected to insert the new
443 <         row into the List DataSet and to set the KeyValue property to the
444 <         value of the primary key of the new row.}
445 <        OnAutoInsert(self,Text,NewKeyValue);
446 <      end
447 <      else
448 <      begin
449 <        ListSource.DataSet.Append;
450 <        {The new KeyValue should be determined by an external generator or
451 <         in the "OnInsert" handler. If it is the same as the ListField, then
452 <         it will be set from the UpdateLinkData method}
453 <        try
454 <          ListSource.DataSet.Post;
455 <        except
456 <          ListSource.DataSet.Cancel;
457 <          raise;
458 <        end;
459 <        NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
460 <      end;
461 <      Text := ''; {Ensure full list}
462 <      UpdateList;
463 <      KeyValue := NewKeyValue;
464 <      UpdateData(nil); {Force sync with DataField}
465 <    finally
466 <      FInserting := false
467 <    end;
468 <  except
469 <    Text := FOriginalTextValue;
470 <    ResetParser;
471 <    raise;
436 >         FInserting := true;
437 >         try
438 >           {New Value}
439 >           FFiltered := false;
440 >           if assigned(FOnAutoInsert) then
441 >           begin
442 >             {In an OnAutoInsert handler, the client is expected to insert the new
443 >              row into the List DataSet and to set the KeyValue property to the
444 >              value of the primary key of the new row.}
445 >             OnAutoInsert(self,Text,NewKeyValue);
446 >           end
447 >           else
448 >           begin
449 >             ListSource.DataSet.Append;
450 >             {The new KeyValue should be determined by an external generator or
451 >              in the "OnInsert" handler. If it is the same as the ListField, then
452 >              it will be set from the UpdateLinkData method}
453 >             try
454 >               ListSource.DataSet.Post;
455 >             except
456 >               ListSource.DataSet.Cancel;
457 >               raise;
458 >             end;
459 >             NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
460 >           end;
461 >           Text := ''; {Ensure full list}
462 >           UpdateList;
463 >           KeyValue := NewKeyValue;
464 >           UpdateData(nil); {Force sync with DataField}
465 >         finally
466 >           FInserting := false
467 >         end;
468 >       except
469 >         Text := FOriginalTextValue;
470 >         ResetParser;
471 >         raise;
472 >       end;
473 >  finally
474 >    FInCheckAndInsert := false
475    end;
476   end;
477  
# Line 429 | Line 485 | end;
485  
486   procedure TIBLookupComboEditBox.DoExit;
487   begin
488 +  if FTimer.Interval <> 0 then
489 +    HandleTimer(nil);
490    FExiting := true;
491    try
492      CheckAndInsert;
# Line 454 | Line 512 | begin
512      SelectAll;
513    end
514    else
515 <  if (IsEditableTextKey(Key) or (Key = VK_BACK))
516 <     and AutoComplete and (Style <> csDropDownList) and
517 <     (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
518 <    FTimer.Interval := FKeyPressInterval
519 <  else
520 <    FTimer.Interval := 0
515 >  if AutoComplete and (Style <> csDropDownList) then
516 >  begin
517 >    if (Key = VK_BACK) or (Key = VK_DELETE) then
518 >    begin
519 >      if SelStart = 0 then
520 >      begin
521 >        SelStart := UTF8Length(Text);
522 >        SelLength := 0;
523 >      end;
524 >      FTimer.Interval := 0;
525 >    end
526 >    else
527 >    if IsEditableTextKey(Key) and
528 >     (not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
529 >    begin
530 >      FTimer.Interval := 0;
531 >      FTimer.Interval := FKeyPressInterval;
532 >    end;
533 >  end;
534 > end;
535 >
536 > procedure TIBLookupComboEditBox.Loaded;
537 > begin
538 >  inherited Loaded;
539 >  IBControlLinkChanged;
540 > end;
541 >
542 > procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
543 >  Operation: TOperation);
544 > begin
545 >  inherited Notification(AComponent, Operation);
546 >  if (Operation = opRemove) and (AComponent = DataSource) then
547 >    ListSource := nil;
548   end;
549  
550   procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
551   begin
552 +  if Val > 0 then
553 +    FCurText := '';
554    inherited SetItemIndex(Val);
555    FLastKeyValue := KeyValue;
556   end;
557  
558 + function TIBLookupComboEditBox.SQLSafe(aText: string): string;
559 + var I: integer;
560 + begin
561 +  Result := '';
562 +  for I := 1 to length(aText) do
563 +    if aText[I] = '''' then
564 +      Result := Result + ''''''
565 +    else
566 +      Result := Result + aText[I];
567 + end;
568 +
569   procedure TIBLookupComboEditBox.UpdateShowing;
570   begin
571    inherited UpdateShowing;
# Line 475 | 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   constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
585   begin
586    inherited Create(TheComponent);
587    FDataLink := TIBLookupComboDataLink.Create(self);
588 <  FKeyPressInterval := 500;
588 >  FIBLookupControlLink := TIBLookupControlLink.Create(self);
589 >  FKeyPressInterval := 200;
590    FAutoComplete := true;
591    FTimer := TTimer.Create(nil);
592    FTimer.Interval := 0;
# Line 490 | Line 597 | end;
597   destructor TIBLookupComboEditBox.Destroy;
598   begin
599    if assigned(FDataLink) then FDataLink.Free;
600 +  if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
601    if assigned(FTimer) then FTimer.Free;
602 +  Application.RemoveAsyncCalls(self);
603    inherited Destroy;
604   end;
605  
606   procedure TIBLookupComboEditBox.EditingDone;
607   begin
608 +  FForceAutoComplete := true;
609 +  try
610 +  if FTimer.Interval <> 0 then
611 +    HandleTimer(nil);
612 +  finally
613 +    FForceAutoComplete := false;
614 +  end;
615    CheckAndInsert;
616 +  FCurText := '';
617 +  if FModified then
618 +    Change; {ensure Update}
619    inherited EditingDone;
620   end;
621  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines