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

Comparing ibx/trunk/runtime/nongui/IBCustomDataSet.pas (file contents):
Revision 241 by tony, Thu Oct 25 13:57:12 2018 UTC vs.
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC

# Line 54 | Line 54 | uses
54    unix,
55   {$ENDIF}
56    SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
57 <  IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, fpTimer;
58 <
59 < const
60 <  BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
61 <  UniCache           =  2;     { Uni-directional cache is 2 records big }
57 >  IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, IBTypes;
58  
59   type
60    TIBCustomDataSet = class;
# Line 88 | Line 84 | type
84      property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
85    end;
86  
91  TBlobDataArray = array[0..0] of TIBBlobStream;
92  PBlobDataArray = ^TBlobDataArray;
87    TIBArrayField = class;
88  
89    { TIBArray }
# Line 108 | Line 102 | type
102      property ArrayIntf: IArray read FArray;
103    end;
104  
111  TArrayDataArray = array [0..0] of TIBArray;
112  PArrayDataArray = ^TArrayDataArray;
113
114  { TIBCustomDataSet }
115
116  TCachedUpdateStatus = (
117                         cusUnmodified, cusModified, cusInserted,
118                         cusDeleted, cusUninserted
119                        );
120  TIBDBKey = record
121    DBKey: array[0..7] of Byte;
122  end;
123  PIBDBKey = ^TIBDBKey;
124
125  PFieldData = ^TFieldData;
126  TFieldData = record
127   fdIsNull: Boolean;
128   fdDataLength: Short;
129 end;
130
131 PColumnData = ^TColumnData;
132 TColumnData = record
133  fdDataType: Short;
134  fdDataScale: Short;
135  fdNullable: Boolean;
136  fdDataSize: Short;
137  fdDataOfs: Integer;
138  fdCodePage: TSystemCodePage;
139 end;
140
141 PFieldColumns = ^TFieldColumns;
142 TFieldColumns =  array[1..1] of TColumnData;
143
144  TRecordData = record
145    rdBookmarkFlag: TBookmarkFlag;
146    rdFieldCount: Short;
147    rdRecordNumber: Integer;
148    rdCachedUpdateStatus: TCachedUpdateStatus;
149    rdUpdateStatus: TUpdateStatus;
150    rdSavedOffset: DWORD;
151    rdDBKey: TIBDBKey;
152    rdFields: array[1..1] of TFieldData;
153  end;
154  PRecordData = ^TRecordData;
155
105    { TIBArrayField }
106  
107    TIBArrayField = class(TField)
# Line 300 | Line 249 | type
249    private
250      FDataSet: TIBCustomDataSet;
251      FDelayTimerValue: integer;
252 <    FTimer: TFPTimer;
252 >    FTimer: TIBTimerInf;
253      procedure HandleRefreshTimer(Sender: TObject);
254      procedure SetDelayTimerValue(AValue: integer);
255    protected
# Line 366 | Line 315 | type
315  
316    TIBAutoCommit = (acDisabled, acCommitRetaining);
317  
369  { TIBCustomDataSet }
370
318    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
319  
320    TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
# Line 376 | Line 323 | type
323    TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
324                                     var UpdateAction: TIBUpdateAction) of object;
325  
379  TIBUpdateRecordTypes = set of TCachedUpdateStatus;
380
326    TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
327  
328    TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
329  
330    TOnDeleteReturning = procedure (Sender: TObject; QryResults: IResults) of object;
331  
332 +  { TIBCustomDataSet }
333 +
334    TIBCustomDataSet = class(TDataset)
335    private
336 +    const
337 +      BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
338 +      UniCache           =  2;     { Uni-directional cache is 2 records big }
339 +
340 +      {Buffer cache constants for record selection}
341 +      FILE_BEGIN = 0;
342 +      FILE_CURRENT = 1;
343 +      FILE_END = 2;
344 +
345 +      {internal type declarations}
346 +    type
347 +      TArrayDataArray = array [0..0] of TIBArray;
348 +      PArrayDataArray = ^TArrayDataArray;
349 +
350 +      TBlobDataArray = array[0..0] of TIBBlobStream;
351 +      PBlobDataArray = ^TBlobDataArray;
352 +
353 +      TCachedUpdateStatus = (
354 +                         cusUnmodified, cusModified, cusInserted,
355 +                         cusDeleted, cusUninserted
356 +                        );
357 +      TIBUpdateRecordTypes = set of TCachedUpdateStatus;
358 +
359 +      PFieldData = ^TFieldData;
360 +      TFieldData = record
361 +        fdIsNull: Boolean;
362 +        fdDataLength: Short;
363 +      end;
364 +
365 +      PColumnData = ^TColumnData;
366 +      TColumnData = record
367 +        fdDataType: Short;
368 +        fdDataScale: Short;
369 +        fdNullable: Boolean;
370 +        fdDataSize: Short;
371 +        fdDataOfs: Integer;
372 +        fdCodePage: TSystemCodePage;
373 +      end;
374 +
375 +      PFieldColumns = ^TFieldColumns;
376 +      TFieldColumns =  array[1..1] of TColumnData;
377 +
378 +  protected
379 +    type
380 +      TIBDBKey = record
381 +        DBKey: array[0..7] of Byte;
382 +      end;
383 +      PIBDBKey = ^TIBDBKey;
384 +
385 +    TRecordData = record
386 +      rdBookmarkFlag: TBookmarkFlag;
387 +      rdFieldCount: Short;
388 +      rdRecordNumber: Integer;
389 +      rdCachedUpdateStatus: TCachedUpdateStatus;
390 +      rdUpdateStatus: TUpdateStatus;
391 +      rdSavedOffset: DWORD;
392 +      rdDBKey: TIBDBKey;
393 +      rdFields: array[1..1] of TFieldData;
394 +    end;
395 +    PRecordData = ^TRecordData;
396 +
397 +  private
398      FAllowAutoActivateTransaction: Boolean;
399      FArrayFieldCount: integer;
400      FArrayCacheOffset: integer;
# Line 897 | Line 906 | type
906    end;
907  
908   const
909 < DefaultFieldClasses: array[TFieldType] of TFieldClass = (
909 >  DefaultFieldClasses: array[TFieldType] of TFieldClass = (
910      nil,                { ftUnknown }
911      TIBStringField,     { ftString }
912      TIBSmallintField,   { ftSmallint }
# Line 956 | Line 965 | implementation
965  
966   uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
967  
959 const FILE_BEGIN = 0;
960      FILE_CURRENT = 1;
961      FILE_END = 2;
962
968   type
969  
970    TFieldNode = class(TObject)
# Line 1158 | Line 1163 | begin
1163         3, {Assume UNICODE_FSS is really UTF8}
1164         4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1165           if DisplayWidth = 0 then
1166 <           {$if not defined(ValidUTF8String)}
1166 >           {$if declared(Utf8EscapeControlChars)}
1167             Result := Utf8EscapeControlChars(TextToSingleLine(Result))
1168             {$else}
1169             Result := ValidUTF8String(TextToSingleLine(Result))
1170             {$endif}
1171           else
1172           if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1173 <           {$if not defined(ValidUTF8String)}
1173 >           {$if declared(Utf8EscapeControlChars)}
1174             Result := Utf8EscapeControlChars(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1175             {$else}
1176             Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
# Line 1419 | Line 1424 | constructor TIBDataLink.Create(ADataSet:
1424   begin
1425    inherited Create;
1426    FDataSet := ADataSet;
1427 <  FTimer := TFPTimer.Create(nil);
1428 <  FTimer.Enabled := false;
1429 <  FTimer.Interval := 0;
1430 <  FTimer.OnTimer := HandleRefreshTimer;
1427 >  if assigned(IBGUIInterface) then
1428 >  begin
1429 >    FTimer := IBGUIInterface.CreateTimer;
1430 >    if FTimer <> nil then
1431 >    begin
1432 >      FTimer.Enabled := false;
1433 >      FTimer.Interval := 0;
1434 >      FTimer.OnTimer := HandleRefreshTimer;
1435 >    end;
1436 >  end;
1437    FDelayTimerValue := 0;
1438   end;
1439  
1440   destructor TIBDataLink.Destroy;
1441   begin
1442    FDataSet.FDataLink := nil;
1432  if assigned(FTimer) then FTimer.Free;
1443    inherited Destroy;
1444   end;
1445  
# Line 1443 | Line 1453 | end;
1453   procedure TIBDataLink.SetDelayTimerValue(AValue: integer);
1454   begin
1455    if FDelayTimerValue = AValue then Exit;
1456 +  if assigned(FTimer) then
1457 +    FTimer.Enabled := false;
1458    FDelayTimerValue := AValue;
1447  {$IF FPC_FULLVERSION >= 30002}
1448  if (AValue > 0) and not IsMultiThread then
1449    IBError(ibxeMultiThreadRequired,['TIBQuery/TIBDataset MasterDetailDelay']);
1450  FTimer.Interval := FDelayTimerValue;
1451  {$IFEND}
1459   end;
1460  
1461   procedure TIBDataLink.ActiveChanged;
# Line 1467 | Line 1474 | procedure TIBDataLink.RecordChanged(Fiel
1474   begin
1475    if (Field = nil) and FDataSet.Active then
1476    begin
1477 <    {$IF FPC_FULLVERSION >= 30002}
1471 <    if FDelayTimerValue > 0 then
1477 >    if assigned(FTimer) and (FDelayTimerValue > 0) then
1478      with FTimer do
1479      begin
1480 <      CheckSynchronize; {Ensure not waiting on Synchronize}
1481 <      if Enabled then
1482 <      begin
1477 <        StopTimer;
1478 <        StartTimer;
1479 <      end
1480 <      else
1481 <        Enabled := true;
1480 >      FTimer.Enabled := false;
1481 >      FTimer.Interval := FDelayTimerValue;
1482 >      FTimer.Enabled := true;
1483      end
1484      else
1484    {$IFEND}
1485        FDataSet.RefreshParams;
1486    end;
1487   end;
# Line 2707 | Line 2707 | begin
2707      ActivateTransaction;
2708      FBase.CheckDatabase;
2709      FBase.CheckTransaction;
2710 <    if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2710 >    if HasParser and not FParser.NotaSelectStmt and (FParser.SQLText <> FQSelect.SQL.Text) then
2711      begin
2712        FQSelect.OnSQLChanged := nil; {Do not react to change}
2713        try
# Line 3454 | Line 3454 | procedure TIBCustomDataSet.DoBeforeOpen;
3454   var i: integer;
3455   begin
3456    if assigned(FParser) then
3457 <     FParser.Reset;
3457 >     FParser.RestoreClauseValues;
3458    for i := 0 to FIBLinks.Count - 1 do
3459      TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3460    inherited DoBeforeOpen;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines