ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/runtime/nongui/IBCustomDataSet.pas
(Generate patch)

Comparing ibx/trunk/runtime/nongui/IBCustomDataSet.pas (file contents):
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC vs.
Revision 308 by tony, Sat Jul 18 10:26:30 2020 UTC

# Line 441 | Line 441 | type
441      FRecordCount: Integer;
442      FRecordSize: Integer;
443      FDataSetCloseAction: TDataSetCloseAction;
444 +    FSQLFiltered: boolean;
445 +    FSQLFilterParams: TStrings;
446      FUniDirectional: Boolean;
447      FUpdateMode: TUpdateMode;
448      FUpdateObject: TIBDataSetUpdateObject;
# Line 476 | Line 478 | type
478      procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
479      function GetSelectStmtIntf: IStatement;
480      procedure SetCaseSensitiveParameterNames(AValue: boolean);
481 +    procedure SetSQLFiltered(AValue: boolean);
482 +    procedure SetSQLFilterParams(AValue: TStrings);
483      procedure SetUpdateMode(const Value: TUpdateMode);
484      procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
485  
# Line 509 | Line 513 | type
513      function GetModifySQL: TStrings;
514      function GetTransaction: TIBTransaction;
515      function GetParser: TSelectSQLParser;
516 +    procedure HandleSQLFilterParamsChanged(Sender: TObject);
517      procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
518      function InternalLocate(const KeyFields: string; const KeyValues: Variant;
519                              Options: TLocateOptions): Boolean; virtual;
# Line 668 | Line 673 | type
673      property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
674      property Parser: TSelectSQLParser read GetParser;
675      property BaseSQLSelect: TStrings read FBaseSQLSelect;
676 +    property SQLFiltered: boolean read FSQLFiltered write SetSQLFiltered;
677 +    property SQLFilterParams: TStrings read FSQLFilterParams write SetSQLFilterParams;
678  
679      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
680                                                   write FBeforeDatabaseDisconnect;
# Line 781 | Line 788 | type
788  
789    TIBParserDataSet = class(TIBCustomDataSet)
790    protected
784    procedure SetFilterText(const Value: string); override;
791      procedure DoBeforeOpen; override;
792    public
793      property Parser;
# Line 833 | Line 839 | type
839      property UniDirectional;
840      property Filtered;
841      property DataSetCloseAction;
842 +    property SQLFiltered;
843 +    property SQLFilterParams;
844  
845      property BeforeDatabaseDisconnect;
846      property AfterDatabaseDisconnect;
# Line 1037 | Line 1045 | type
1045  
1046   { TIBParserDataSet }
1047  
1040 procedure TIBParserDataSet.SetFilterText(const Value: string);
1041 begin
1042  if Filter = Value then Exit;
1043  inherited SetFilterText(Value);
1044  if Active and Filtered then {reopen dataset}
1045  begin
1046    Active := false;
1047    Active := true;
1048  end;
1049 end;
1050
1048   procedure TIBParserDataSet.DoBeforeOpen;
1049   var i: integer;
1050   begin
1051    if assigned(FParser) then
1052       FParser.RestoreClauseValues;
1053 <  if Filtered and (Filter <> '') then
1054 <    Parser.Add2WhereClause(Filter);
1053 >  if SQLFiltered then
1054 >    for i := 0 to SQLFilterParams.Count - 1 do
1055 >      Parser.Add2WhereClause(SQLFilterParams[i]);
1056    for i := 0 to FIBLinks.Count - 1 do
1057      TIBControlLink(FIBLinks[i]).UpdateSQL(self);
1058    inherited DoBeforeOpen;
# Line 1368 | Line 1366 | begin
1366        SetCodePage(s,CodePage,false);
1367        if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1368          SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1369 <      Value := s;
1369 >
1370 >      if (CodePage = CP_UTF8) and (UTF8Length(s) > Size) then
1371 >        {truncate to max. number of UTF8 characters - usually a problem with
1372 >         fixed width columns right padded with white space}
1373 >        Value := UTF8Copy(s,1,Size)
1374 >      else
1375 >        Value := s;
1376 >
1377   //      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1378        if Transliterate and (Value <> '') then
1379          DataSet.Translate(PChar(Value), PChar(Value), False);
# Line 1581 | Line 1586 | begin
1586      if AOwner is TIBTransaction then
1587        Transaction := TIBTransaction(AOwner);
1588    FBaseSQLSelect := TStringList.Create;
1589 +  FSQLFilterParams := TStringList.Create;
1590 +  TStringList(FSQLFilterParams).OnChange :=  HandleSQLFilterParamsChanged;
1591   end;
1592  
1593   destructor TIBCustomDataSet.Destroy;
# Line 1603 | Line 1610 | begin
1610    FMappedFieldPosition := nil;
1611    if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1612    if assigned(FParser) then FParser.Free;
1613 +  if assigned(FSQLFilterParams) then FSQLFilterParams.Free;
1614    inherited Destroy;
1615   end;
1616  
# Line 4791 | Line 4799 | begin
4799      FQSelect.CaseSensitiveParameterNames := AValue;
4800   end;
4801  
4802 + procedure TIBCustomDataSet.SetSQLFiltered(AValue: boolean);
4803 + begin
4804 +  if FSQLFiltered = AValue then Exit;
4805 +  FSQLFiltered := AValue;
4806 +  if Active then
4807 +  begin
4808 +    Active := false;
4809 +    Active := true;
4810 +  end;
4811 + end;
4812 +
4813 + procedure TIBCustomDataSet.SetSQLFilterParams(AValue: TStrings);
4814 + begin
4815 +  if FSQLFilterParams = AValue then Exit;
4816 +  FSQLFilterParams.Assign(AValue);
4817 + end;
4818 +
4819   procedure TIBCustomDataSet.SetMasterDetailDelay(AValue: integer);
4820   begin
4821    FDataLink.DelayTimerValue := AValue;
# Line 4803 | Line 4828 | begin
4828    Result := FParser
4829   end;
4830  
4831 + procedure TIBCustomDataSet.HandleSQLFilterParamsChanged(Sender: TObject);
4832 + begin
4833 +  Active := false;
4834 + end;
4835 +
4836   procedure TIBCustomDataSet.ResetParser;
4837   begin
4838    if assigned(FParser) then

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines