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 21 by tony, Thu Feb 26 10:33:34 2015 UTC vs.
Revision 64 by tony, Thu Jun 29 11:11:22 2017 UTC

# Line 15 | Line 15
15   *
16   *  The Initial Developer of the Original Code is Tony Whyman.
17   *
18 < *  The Original Code is (C) 2011 Tony Whyman, MWA Software
18 > *  The Original Code is (C) 2015 Tony Whyman, MWA Software
19   *  (http://www.mwasoftware.co.uk).
20   *
21   *  All Rights Reserved.
# 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           end;
355      finally
# Line 332 | Line 361 | end;
361   procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
362    Parser: TSelectSQLParser);
363   var FieldPosition: integer;
364 +    FilterText: string;
365   begin
366    if FFiltered then
367    begin
368 +    if FUpdating then
369 +      FilterText := FCurText
370 +    else
371 +      FilterText := Text;
372      if cbactSearchCaseSensitive in AutoCompleteText then
373 <      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''')
373 >      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
374 >                                  SQLSafe(FilterText) + '%''')
375      else
376 <      Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')');
376 >      Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
377 >                                  SQLSafe(FilterText) + '%'')');
378  
379 <  end;
380 <  if cbactSearchAscending in AutoCompleteText then
381 <  begin
382 <    FieldPosition := Parser.GetFieldPosition(ListField);
347 <    if FieldPosition = 0 then Exit;
379 >    if cbactSearchAscending in AutoCompleteText then
380 >    begin
381 >      FieldPosition := Parser.GetFieldPosition(ListField);
382 >      if FieldPosition = 0 then Exit;
383  
384 <    Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
384 >      Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
385 >    end;
386    end;
387   end;
388  
389   procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
390   begin
391 <  SelectAll
391 >  if AppDestroying in Application.Flags then Exit;
392 >   SelectAll
393   end;
394  
395   procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
# Line 365 | Line 402 | procedure TIBLookupComboEditBox.CheckAnd
402   var Accept: boolean;
403      NewKeyValue: variant;
404   begin
405 <  if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
406 <     and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
405 >  if FInCheckAndInsert then Exit;
406 >  FInCheckAndInsert := true;
407    try
408 <    {Is it OK to insert a new list member?}
409 <    Accept := true;
410 <    if assigned(FOnCanAutoInsert) then
411 <       OnCanAutoInsert(self,Text,Accept);
412 <    if not Accept then
413 <    begin
414 <      ResetParser;
415 <      Text := FOriginalTextValue;
416 <      SelectAll;
417 <      Exit;
418 <    end;
408 >       if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
409 >          and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
410 >       try
411 >         {Is it OK to insert a new list member?}
412 >         Accept := true;
413 >         if assigned(FOnCanAutoInsert) then
414 >            OnCanAutoInsert(self,Text,Accept);
415 >         if not Accept then
416 >         begin
417 >           ResetParser;
418 >           Text := FOriginalTextValue;
419 >           SelectAll;
420 >           Exit;
421 >         end;
422  
423 <    FInserting := true;
424 <    try
425 <      {New Value}
426 <      FFiltered := false;
427 <      if assigned(FOnAutoInsert) then
428 <      begin
429 <        {In an OnAutoInsert handler, the client is expected to insert the new
430 <         row into the List DataSet and to set the KeyValue property to the
431 <         value of the primary key of the new row.}
432 <        OnAutoInsert(self,Text,NewKeyValue);
433 <      end
434 <      else
435 <      begin
436 <        ListSource.DataSet.Append;
437 <        {The new KeyValue should be determined by an external generator or
438 <         in the "OnInsert" handler. If it is the same as the ListField, then
439 <         it will be set from the UpdateLinkData method}
440 <        try
441 <          ListSource.DataSet.Post;
442 <        except
443 <          ListSource.DataSet.Cancel;
444 <          raise;
445 <        end;
446 <        NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
447 <      end;
448 <      UpdateList;
449 <      KeyValue := NewKeyValue;
450 <      UpdateData(nil); {Force sync with DataField}
451 <    finally
452 <      FInserting := false
453 <    end;
454 <  except
455 <    Text := FOriginalTextValue;
456 <    ResetParser;
457 <    raise;
423 >         FInserting := true;
424 >         try
425 >           {New Value}
426 >           FFiltered := false;
427 >           if assigned(FOnAutoInsert) then
428 >           begin
429 >             {In an OnAutoInsert handler, the client is expected to insert the new
430 >              row into the List DataSet and to set the KeyValue property to the
431 >              value of the primary key of the new row.}
432 >             OnAutoInsert(self,Text,NewKeyValue);
433 >           end
434 >           else
435 >           begin
436 >             ListSource.DataSet.Append;
437 >             {The new KeyValue should be determined by an external generator or
438 >              in the "OnInsert" handler. If it is the same as the ListField, then
439 >              it will be set from the UpdateLinkData method}
440 >             try
441 >               ListSource.DataSet.Post;
442 >             except
443 >               ListSource.DataSet.Cancel;
444 >               raise;
445 >             end;
446 >             NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
447 >           end;
448 >           Text := ''; {Ensure full list}
449 >           UpdateList;
450 >           KeyValue := NewKeyValue;
451 >           UpdateData(nil); {Force sync with DataField}
452 >         finally
453 >           FInserting := false
454 >         end;
455 >       except
456 >         Text := FOriginalTextValue;
457 >         ResetParser;
458 >         raise;
459 >       end;
460 >  finally
461 >    FInCheckAndInsert := false
462    end;
463   end;
464  
# Line 428 | Line 472 | end;
472  
473   procedure TIBLookupComboEditBox.DoExit;
474   begin
475 +  if FTimer.Interval <> 0 then
476 +    HandleTimer(nil);
477    FExiting := true;
478    try
479      CheckAndInsert;
# Line 453 | Line 499 | begin
499      SelectAll;
500    end
501    else
502 <  if (IsEditableTextKey(Key) or (Key = VK_BACK))
503 <     and AutoComplete and (Style <> csDropDownList) and
504 <     (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
505 <    FTimer.Interval := FKeyPressInterval
506 <  else
507 <    FTimer.Interval := 0
502 >  begin
503 >    FTimer.Interval := 0;
504 >    if (IsEditableTextKey(Key) or (Key = VK_BACK))
505 >       and AutoComplete and (Style <> csDropDownList) and
506 >       (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
507 >      FTimer.Interval := FKeyPressInterval;
508 >  end;
509 > end;
510 >
511 > procedure TIBLookupComboEditBox.Loaded;
512 > begin
513 >  inherited Loaded;
514 >  IBControlLinkChanged;
515 > end;
516 >
517 > procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
518 >  Operation: TOperation);
519 > begin
520 >  inherited Notification(AComponent, Operation);
521 >  if (Operation = opRemove) and (AComponent = DataSource) then
522 >    ListSource := nil;
523   end;
524  
525   procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
# Line 467 | Line 528 | begin
528    FLastKeyValue := KeyValue;
529   end;
530  
531 + function TIBLookupComboEditBox.SQLSafe(aText: string): string;
532 + var I: integer;
533 + begin
534 +  Result := '';
535 +  for I := 1 to length(aText) do
536 +    if aText[I] = '''' then
537 +      Result := Result + ''''''
538 +    else
539 +      Result := Result + aText[I];
540 + end;
541 +
542   procedure TIBLookupComboEditBox.UpdateShowing;
543   begin
544    inherited UpdateShowing;
# Line 478 | Line 550 | constructor TIBLookupComboEditBox.Create
550   begin
551    inherited Create(TheComponent);
552    FDataLink := TIBLookupComboDataLink.Create(self);
553 <  FKeyPressInterval := 500;
553 >  FIBLookupControlLink := TIBLookupControlLink.Create(self);
554 >  FKeyPressInterval := 200;
555    FAutoComplete := true;
556    FTimer := TTimer.Create(nil);
557    FTimer.Interval := 0;
# Line 489 | Line 562 | end;
562   destructor TIBLookupComboEditBox.Destroy;
563   begin
564    if assigned(FDataLink) then FDataLink.Free;
565 +  if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
566    if assigned(FTimer) then FTimer.Free;
567    inherited Destroy;
568   end;
569  
570   procedure TIBLookupComboEditBox.EditingDone;
571   begin
572 +  FForceAutoComplete := true;
573 +  try
574 +  if FTimer.Interval <> 0 then
575 +    HandleTimer(nil);
576 +  finally
577 +    FForceAutoComplete := false;
578 +  end;
579    CheckAndInsert;
580    inherited EditingDone;
581   end;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines