ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/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 143 by tony, Fri Feb 23 12:11:21 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 +    FModified: boolean;
100      procedure DoActiveChanged(Data: PtrInt);
101      function GetAutoCompleteText: TComboBoxAutoCompleteText;
102      function GetListSource: TDataSource;
# Line 119 | Line 123 | type
123      procedure SetItemIndex(const Val: integer); override;
124      function SQLSafe(aText: string): string;
125      procedure UpdateShowing; override;
126 <
126 >    procedure UpdateData(Sender: TObject); override;
127    public
128      { Public declarations }
129      constructor Create(TheComponent: TComponent); override;
# Line 143 | Line 147 | type
147  
148   implementation
149  
150 < uses IBQuery, LCLType, Variants, LCLProc;
150 > uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
151  
152   { TIBLookupControlLink }
153  
# Line 313 | Line 317 | procedure TIBLookupComboEditBox.UpdateLi
317   var
318    iSelStart: Integer; // char position
319    sCompleteText, sPrefixText, sResultText: string;
316  curText: string;
320   begin
321    if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
322       and ListSource.DataSet.Active then
323    begin
324 +    FCurText := Text;
325      FUpdating := true;
326      try
327           iSelStart := SelStart;//Capture original cursor position
328           if ((iSelStart < UTF8Length(Text)) and
329             (cbactEndOfLineComplete in AutoCompleteText)) then
330                  Exit;
327         curText := Text;
331           sPrefixText := UTF8Copy(Text, 1, iSelStart);
332           ListSource.DataSet.Active := false;
333           ListSource.DataSet.Active :=  true;
334 <         Text := curText;
335 <         if not FExiting and Focused and (Text <> '')then
334 >         Text := FCurText;
335 >         if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
336           begin
337             if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
338             begin
339               sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
340 <             if (sCompleteText <> Text) then
340 >             if (sCompleteText <> FCurText) then
341               begin
342                 sResultText := sCompleteText;
343                 if ((cbactEndOfLineComplete in AutoCompleteText) and
# Line 348 | Line 351 | begin
351                 SelLength := UTF8Length(Text);
352               end;
353               KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
354 +           end
355 +           else
356 +           begin
357 +             SelStart := iSelStart;
358 +             SelLength := 0;
359             end;
360           end;
361      finally
362        FUpdating := false
363      end;
364 +    FModified := true;
365    end;
366   end;
367  
368   procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
369    Parser: TSelectSQLParser);
370   var FieldPosition: integer;
371 +    FilterText: string;
372   begin
373    if FFiltered then
374    begin
375 +    if FUpdating then
376 +      FilterText := FCurText
377 +    else
378 +      FilterText := Text;
379      if cbactSearchCaseSensitive in AutoCompleteText then
380        Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
381 <                                  SQLSafe(Text) + '%''')
381 >                                  SQLSafe(FilterText) + '%''')
382      else
383 <      Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' +
384 <                                  SQLSafe(Text) + '%'')');
383 >      Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
384 >                                  SQLSafe(FilterText) + '%'')');
385  
386 <  end;
387 <  if cbactSearchAscending in AutoCompleteText then
388 <  begin
389 <    FieldPosition := Parser.GetFieldPosition(ListField);
376 <    if FieldPosition = 0 then Exit;
386 >    if cbactSearchAscending in AutoCompleteText then
387 >    begin
388 >      FieldPosition := Parser.GetFieldPosition(ListField);
389 >      if FieldPosition = 0 then Exit;
390  
391 <    Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
391 >      Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
392 >    end;
393    end;
394   end;
395  
# Line 395 | Line 409 | procedure TIBLookupComboEditBox.CheckAnd
409   var Accept: boolean;
410      NewKeyValue: variant;
411   begin
412 <  if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
413 <     and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
412 >  if FInCheckAndInsert then Exit;
413 >  FInCheckAndInsert := true;
414    try
415 <    {Is it OK to insert a new list member?}
416 <    Accept := true;
417 <    if assigned(FOnCanAutoInsert) then
418 <       OnCanAutoInsert(self,Text,Accept);
419 <    if not Accept then
420 <    begin
421 <      ResetParser;
422 <      Text := FOriginalTextValue;
423 <      SelectAll;
424 <      Exit;
425 <    end;
415 >       if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
416 >          and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
417 >       try
418 >         {Is it OK to insert a new list member?}
419 >         Accept := true;
420 >         if assigned(FOnCanAutoInsert) then
421 >            OnCanAutoInsert(self,Text,Accept);
422 >         if not Accept then
423 >         begin
424 >           ResetParser;
425 >           Text := FOriginalTextValue;
426 >           SelectAll;
427 >           Exit;
428 >         end;
429  
430 <    FInserting := true;
431 <    try
432 <      {New Value}
433 <      FFiltered := false;
434 <      if assigned(FOnAutoInsert) then
435 <      begin
436 <        {In an OnAutoInsert handler, the client is expected to insert the new
437 <         row into the List DataSet and to set the KeyValue property to the
438 <         value of the primary key of the new row.}
439 <        OnAutoInsert(self,Text,NewKeyValue);
440 <      end
441 <      else
442 <      begin
443 <        ListSource.DataSet.Append;
444 <        {The new KeyValue should be determined by an external generator or
445 <         in the "OnInsert" handler. If it is the same as the ListField, then
446 <         it will be set from the UpdateLinkData method}
447 <        try
448 <          ListSource.DataSet.Post;
449 <        except
450 <          ListSource.DataSet.Cancel;
451 <          raise;
452 <        end;
453 <        NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
454 <      end;
455 <      Text := ''; {Ensure full list}
456 <      UpdateList;
457 <      KeyValue := NewKeyValue;
458 <      UpdateData(nil); {Force sync with DataField}
459 <    finally
460 <      FInserting := false
461 <    end;
462 <  except
463 <    Text := FOriginalTextValue;
464 <    ResetParser;
465 <    raise;
430 >         FInserting := true;
431 >         try
432 >           {New Value}
433 >           FFiltered := false;
434 >           if assigned(FOnAutoInsert) then
435 >           begin
436 >             {In an OnAutoInsert handler, the client is expected to insert the new
437 >              row into the List DataSet and to set the KeyValue property to the
438 >              value of the primary key of the new row.}
439 >             OnAutoInsert(self,Text,NewKeyValue);
440 >           end
441 >           else
442 >           begin
443 >             ListSource.DataSet.Append;
444 >             {The new KeyValue should be determined by an external generator or
445 >              in the "OnInsert" handler. If it is the same as the ListField, then
446 >              it will be set from the UpdateLinkData method}
447 >             try
448 >               ListSource.DataSet.Post;
449 >             except
450 >               ListSource.DataSet.Cancel;
451 >               raise;
452 >             end;
453 >             NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
454 >           end;
455 >           Text := ''; {Ensure full list}
456 >           UpdateList;
457 >           KeyValue := NewKeyValue;
458 >           UpdateData(nil); {Force sync with DataField}
459 >         finally
460 >           FInserting := false
461 >         end;
462 >       except
463 >         Text := FOriginalTextValue;
464 >         ResetParser;
465 >         raise;
466 >       end;
467 >  finally
468 >    FInCheckAndInsert := false
469    end;
470   end;
471  
# Line 486 | Line 506 | begin
506      SelectAll;
507    end
508    else
509 <  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
509 >  begin
510      FTimer.Interval := 0;
511 +    if (IsEditableTextKey(Key) or (Key = VK_BACK))
512 +       and AutoComplete and (Style <> csDropDownList) and
513 +       (not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
514 +      FTimer.Interval := FKeyPressInterval;
515 +  end;
516   end;
517  
518   procedure TIBLookupComboEditBox.Loaded;
# Line 532 | Line 553 | begin
553      ActiveChanged(nil);
554   end;
555  
556 + procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
557 + begin
558 +  inherited UpdateData(Sender);
559 +  FModified := false;
560 + end;
561 +
562   constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
563   begin
564    inherited Create(TheComponent);
# Line 550 | Line 577 | begin
577    if assigned(FDataLink) then FDataLink.Free;
578    if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
579    if assigned(FTimer) then FTimer.Free;
580 +  Application.RemoveAsyncCalls(self);
581    inherited Destroy;
582   end;
583  
584   procedure TIBLookupComboEditBox.EditingDone;
585   begin
586 +  FForceAutoComplete := true;
587 +  try
588 +  if FTimer.Interval <> 0 then
589 +    HandleTimer(nil);
590 +  finally
591 +    FForceAutoComplete := false;
592 +  end;
593    CheckAndInsert;
594 +  if FModified then
595 +    Change; {ensure Update}
596    inherited EditingDone;
597   end;
598  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines