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 80 by tony, Mon Jan 1 11:31:07 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, 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;
57      procedure RecordChanged(Field: TField); override;
58      procedure UpdateData; override;
59    public
60      constructor Create(AOwner: TIBLookupComboEditBox);
61    end;
62  
63 +  { TIBLookupControlLink }
64 +
65 +  TIBLookupControlLink = class(TIBControlLink)
66 +  private
67 +    FOwner: TIBLookupComboEditBox;
68 +  protected
69 +    procedure UpdateSQL(Sender: TObject); override;
70 +  public
71 +    constructor Create(AOwner: TIBLookupComboEditBox);
72 +  end;
73 +
74  
75    { TIBLookupComboEditBox }
76  
# Line 69 | Line 79 | type
79      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      procedure DoActiveChanged(Data: PtrInt);
100      function GetAutoCompleteText: TComboBoxAutoCompleteText;
101      function GetListSource: TDataSource;
102      function GetRelationNameQualifier: string;
103      procedure HandleTimer(Sender: TObject);
104 +    procedure IBControlLinkChanged;
105      procedure ResetParser;
106      procedure RecordChanged(Sender: TObject; aField: TField);
107      procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText);
# Line 102 | Line 117 | type
117      procedure DoEnter; override;
118      procedure DoExit; override;
119      procedure KeyUp(var Key: Word; Shift: TShiftState); override;
120 +    procedure Loaded; override;
121 +    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
122      procedure SetItemIndex(const Val: integer); override;
123 +    function SQLSafe(aText: string): string;
124      procedure UpdateShowing; override;
125 +
126    public
127      { Public declarations }
128      constructor Create(TheComponent: TComponent); override;
# Line 118 | Line 137 | type
137      property ItemHeight;
138      property ItemWidth;
139      property ListSource: TDataSource read GetListSource write SetListSource;
140 <    property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500;
140 >    property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200;
141      property RelationName: string read FRelationName write FRelationName;
142      property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert;
143      property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert;
# Line 127 | Line 146 | type
146  
147   implementation
148  
149 < uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc;
149 > uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
150  
151 < { TIBLookupComboDataLink }
151 > { TIBLookupControlLink }
152  
153 < procedure TIBLookupComboDataLink.ActiveChanged;
153 > constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox);
154   begin
155 <  FOwner.ActiveChanged(self)
155 >  inherited Create;
156 >  FOwner := AOwner;
157   end;
158  
159 < procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
159 > procedure TIBLookupControlLink.UpdateSQL(Sender: TObject);
160   begin
161 <  {If we are not visible then avoid unnecessary work}
162 <  if not FOwner.Showing then Exit;
161 >  FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
162 > end;
163  
164 <  if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then
165 <  begin
166 <    if (DataSet is TIBDataSet) then
167 <      FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser)
168 <    else
149 <    if (DataSet is TIBQuery) then
150 <      FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser)
151 <  end
152 <  else
153 <    inherited DataEvent(Event, Info);
164 > { TIBLookupComboDataLink }
165 >
166 > procedure TIBLookupComboDataLink.ActiveChanged;
167 > begin
168 >  FOwner.ActiveChanged(self)
169   end;
170  
171   procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
# Line 179 | Line 194 | begin
194    UpdateList
195   end;
196  
197 + procedure TIBLookupComboEditBox.IBControlLinkChanged;
198 + begin
199 +  if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then
200 +    FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet)
201 +  else
202 +    FIBLookupControlLink.IBDataSet := nil;
203 + end;
204 +
205   function TIBLookupComboEditBox.GetListSource: TDataSource;
206   begin
207    Result := inherited ListSource;
# Line 196 | Line 219 | procedure TIBLookupComboEditBox.ActiveCh
219   begin
220    if not FInserting and not FUpdating then
221       Application.QueueAsyncCall(@DoActiveChanged,0);
222 +  IBControlLinkChanged;
223   end;
224  
225   procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt);
# Line 237 | Line 261 | begin
261   end;
262  
263   procedure TIBLookupComboEditBox.ResetParser;
264 + var curKeyValue: variant;
265   begin
266    if FFiltered then
267    begin
268      FFiltered := false;
269 +    curKeyValue := KeyValue;
270 +    Text := ''; {Ensure full list}
271      UpdateList;
272 +    KeyValue := curKeyValue;
273      UpdateData(self); {Force Scroll}
274    end;
275   end;
# Line 276 | Line 304 | begin
304    begin
305      FDataLink.DataSource := AValue;
306      inherited ListSource := AValue;
307 +    IBControlLinkChanged;
308    end;
309   end;
310  
# Line 287 | Line 316 | procedure TIBLookupComboEditBox.UpdateLi
316   var
317    iSelStart: Integer; // char position
318    sCompleteText, sPrefixText, sResultText: string;
290  curText: string;
319   begin
320    if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
321       and ListSource.DataSet.Active then
322    begin
323 +    FCurText := Text;
324      FUpdating := true;
325      try
326           iSelStart := SelStart;//Capture original cursor position
327           if ((iSelStart < UTF8Length(Text)) and
328             (cbactEndOfLineComplete in AutoCompleteText)) then
329                  Exit;
301         curText := Text;
330           sPrefixText := UTF8Copy(Text, 1, iSelStart);
331           ListSource.DataSet.Active := false;
332           ListSource.DataSet.Active :=  true;
333 <         Text := curText;
334 <         if not FExiting and Focused and (Text <> '')then
333 >         Text := FCurText;
334 >         if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
335           begin
336             if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
337             begin
338               sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
339 <             if (sCompleteText <> Text) then
339 >             if (sCompleteText <> FCurText) then
340               begin
341                 sResultText := sCompleteText;
342                 if ((cbactEndOfLineComplete in AutoCompleteText) and
# Line 321 | Line 349 | begin
349                 SelStart := iSelStart;
350                 SelLength := UTF8Length(Text);
351               end;
352 +             KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
353 +           end
354 +           else
355 +           begin
356 +             SelStart := iSelStart;
357 +             SelLength := 0;
358             end;
359           end;
360      finally
# Line 332 | Line 366 | end;
366   procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
367    Parser: TSelectSQLParser);
368   var FieldPosition: integer;
369 +    FilterText: string;
370   begin
371    if FFiltered then
372    begin
373 +    if FUpdating then
374 +      FilterText := FCurText
375 +    else
376 +      FilterText := Text;
377      if cbactSearchCaseSensitive in AutoCompleteText then
378 <      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''')
378 >      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
379 >                                  SQLSafe(FilterText) + '%''')
380      else
381 <      Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')');
381 >      Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
382 >                                  SQLSafe(FilterText) + '%'')');
383  
384 <  end;
385 <  if cbactSearchAscending in AutoCompleteText then
386 <  begin
387 <    FieldPosition := Parser.GetFieldPosition(ListField);
347 <    if FieldPosition = 0 then Exit;
384 >    if cbactSearchAscending in AutoCompleteText then
385 >    begin
386 >      FieldPosition := Parser.GetFieldPosition(ListField);
387 >      if FieldPosition = 0 then Exit;
388  
389 <    Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
389 >      Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
390 >    end;
391    end;
392   end;
393  
394   procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
395   begin
396 <  SelectAll
396 >  if AppDestroying in Application.Flags then Exit;
397 >   SelectAll
398   end;
399  
400   procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
# Line 365 | Line 407 | procedure TIBLookupComboEditBox.CheckAnd
407   var Accept: boolean;
408      NewKeyValue: variant;
409   begin
410 <  if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
411 <     and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
410 >  if FInCheckAndInsert then Exit;
411 >  FInCheckAndInsert := true;
412    try
413 <    {Is it OK to insert a new list member?}
414 <    Accept := true;
415 <    if assigned(FOnCanAutoInsert) then
416 <       OnCanAutoInsert(self,Text,Accept);
417 <    if not Accept then
418 <    begin
419 <      ResetParser;
420 <      Text := FOriginalTextValue;
421 <      SelectAll;
422 <      Exit;
423 <    end;
413 >       if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
414 >          and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
415 >       try
416 >         {Is it OK to insert a new list member?}
417 >         Accept := true;
418 >         if assigned(FOnCanAutoInsert) then
419 >            OnCanAutoInsert(self,Text,Accept);
420 >         if not Accept then
421 >         begin
422 >           ResetParser;
423 >           Text := FOriginalTextValue;
424 >           SelectAll;
425 >           Exit;
426 >         end;
427  
428 <    FInserting := true;
429 <    try
430 <      {New Value}
431 <      FFiltered := false;
432 <      if assigned(FOnAutoInsert) then
433 <      begin
434 <        {In an OnAutoInsert handler, the client is expected to insert the new
435 <         row into the List DataSet and to set the KeyValue property to the
436 <         value of the primary key of the new row.}
437 <        OnAutoInsert(self,Text,NewKeyValue);
438 <      end
439 <      else
440 <      begin
441 <        ListSource.DataSet.Append;
442 <        {The new KeyValue should be determined by an external generator or
443 <         in the "OnInsert" handler. If it is the same as the ListField, then
444 <         it will be set from the UpdateLinkData method}
445 <        try
446 <          ListSource.DataSet.Post;
447 <        except
448 <          ListSource.DataSet.Cancel;
449 <          raise;
450 <        end;
451 <        NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
452 <      end;
453 <      Text := ''; {Ensure full list}
454 <      UpdateList;
455 <      KeyValue := NewKeyValue;
456 <      UpdateData(nil); {Force sync with DataField}
457 <    finally
458 <      FInserting := false
459 <    end;
460 <  except
461 <    Text := FOriginalTextValue;
462 <    ResetParser;
463 <    raise;
428 >         FInserting := true;
429 >         try
430 >           {New Value}
431 >           FFiltered := false;
432 >           if assigned(FOnAutoInsert) then
433 >           begin
434 >             {In an OnAutoInsert handler, the client is expected to insert the new
435 >              row into the List DataSet and to set the KeyValue property to the
436 >              value of the primary key of the new row.}
437 >             OnAutoInsert(self,Text,NewKeyValue);
438 >           end
439 >           else
440 >           begin
441 >             ListSource.DataSet.Append;
442 >             {The new KeyValue should be determined by an external generator or
443 >              in the "OnInsert" handler. If it is the same as the ListField, then
444 >              it will be set from the UpdateLinkData method}
445 >             try
446 >               ListSource.DataSet.Post;
447 >             except
448 >               ListSource.DataSet.Cancel;
449 >               raise;
450 >             end;
451 >             NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
452 >           end;
453 >           Text := ''; {Ensure full list}
454 >           UpdateList;
455 >           KeyValue := NewKeyValue;
456 >           UpdateData(nil); {Force sync with DataField}
457 >         finally
458 >           FInserting := false
459 >         end;
460 >       except
461 >         Text := FOriginalTextValue;
462 >         ResetParser;
463 >         raise;
464 >       end;
465 >  finally
466 >    FInCheckAndInsert := false
467    end;
468   end;
469  
# Line 429 | Line 477 | end;
477  
478   procedure TIBLookupComboEditBox.DoExit;
479   begin
480 +  if FTimer.Interval <> 0 then
481 +    HandleTimer(nil);
482    FExiting := true;
483    try
484      CheckAndInsert;
# Line 454 | Line 504 | begin
504      SelectAll;
505    end
506    else
507 <  if (IsEditableTextKey(Key) or (Key = VK_BACK))
508 <     and AutoComplete and (Style <> csDropDownList) and
509 <     (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
510 <    FTimer.Interval := FKeyPressInterval
511 <  else
512 <    FTimer.Interval := 0
507 >  begin
508 >    FTimer.Interval := 0;
509 >    if (IsEditableTextKey(Key) or (Key = VK_BACK))
510 >       and AutoComplete and (Style <> csDropDownList) and
511 >       (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
512 >      FTimer.Interval := FKeyPressInterval;
513 >  end;
514 > end;
515 >
516 > procedure TIBLookupComboEditBox.Loaded;
517 > begin
518 >  inherited Loaded;
519 >  IBControlLinkChanged;
520 > end;
521 >
522 > procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
523 >  Operation: TOperation);
524 > begin
525 >  inherited Notification(AComponent, Operation);
526 >  if (Operation = opRemove) and (AComponent = DataSource) then
527 >    ListSource := nil;
528   end;
529  
530   procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
# Line 468 | Line 533 | begin
533    FLastKeyValue := KeyValue;
534   end;
535  
536 + function TIBLookupComboEditBox.SQLSafe(aText: string): string;
537 + var I: integer;
538 + begin
539 +  Result := '';
540 +  for I := 1 to length(aText) do
541 +    if aText[I] = '''' then
542 +      Result := Result + ''''''
543 +    else
544 +      Result := Result + aText[I];
545 + end;
546 +
547   procedure TIBLookupComboEditBox.UpdateShowing;
548   begin
549    inherited UpdateShowing;
# Line 479 | Line 555 | constructor TIBLookupComboEditBox.Create
555   begin
556    inherited Create(TheComponent);
557    FDataLink := TIBLookupComboDataLink.Create(self);
558 <  FKeyPressInterval := 500;
558 >  FIBLookupControlLink := TIBLookupControlLink.Create(self);
559 >  FKeyPressInterval := 200;
560    FAutoComplete := true;
561    FTimer := TTimer.Create(nil);
562    FTimer.Interval := 0;
# Line 490 | Line 567 | end;
567   destructor TIBLookupComboEditBox.Destroy;
568   begin
569    if assigned(FDataLink) then FDataLink.Free;
570 +  if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
571    if assigned(FTimer) then FTimer.Free;
572 +  Application.RemoveAsyncCalls(self);
573    inherited Destroy;
574   end;
575  
576   procedure TIBLookupComboEditBox.EditingDone;
577   begin
578 +  FForceAutoComplete := true;
579 +  try
580 +  if FTimer.Interval <> 0 then
581 +    HandleTimer(nil);
582 +  finally
583 +    FForceAutoComplete := false;
584 +  end;
585    CheckAndInsert;
586    inherited EditingDone;
587   end;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines