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 31 by tony, Tue Jul 14 15:31:25 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, IBCustomDataSet;
34 >  ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet, LCLVersion;
35  
36   type
37  
# Line 92 | 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;
# Line 143 | Line 146 | type
146  
147   implementation
148  
149 < uses IBQuery, LCLType, Variants, LCLProc;
149 > uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
150  
151   { TIBLookupControlLink }
152  
# Line 313 | Line 316 | procedure TIBLookupComboEditBox.UpdateLi
316   var
317    iSelStart: Integer; // char position
318    sCompleteText, sPrefixText, sResultText: string;
316  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;
327         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 348 | Line 350 | begin
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 359 | 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 ''' +
379 <                                  SQLSafe(Text) + '%''')
379 >                                  SQLSafe(FilterText) + '%''')
380      else
381 <      Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' +
382 <                                  SQLSafe(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);
376 <    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  
# Line 395 | 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 486 | Line 504 | begin
504      SelectAll;
505    end
506    else
507 <  if (IsEditableTextKey(Key) or (Key = VK_BACK))
490 <     and AutoComplete and (Style <> csDropDownList) and
491 <     (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
492 <    FTimer.Interval := FKeyPressInterval
493 <  else
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;
# Line 550 | Line 569 | 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