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

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 21 by tony, Thu Feb 26 10:33:34 2015 UTC vs.
Revision 23 by tony, Fri Mar 13 10:26:52 2015 UTC

# Line 27 | Line 27
27   {    IBX For Lazarus (Firebird Express)                                  }
28   {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29   {    Portions created by MWA Software are copyright McCallum Whyman      }
30 < {    Associates Ltd 2011                                                 }
30 > {    Associates Ltd 2011 - 2015                                                }
31   {                                                                        }
32   {************************************************************************}
33  
# Line 187 | Line 187 | type
187      property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
188    end;
189  
190 +  TIBAutoCommit = (acDisabled, acCommitRetaining);
191 +
192    { TIBCustomDataSet }
193    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
194  
# Line 200 | Line 202 | type
202  
203    TIBCustomDataSet = class(TDataset)
204    private
205 +    FAutoCommit: TIBAutoCommit;
206      FGenerateParamNames: Boolean;
207      FGeneratorField: TIBGenerator;
208      FNeedsRefresh: Boolean;
# Line 362 | Line 365 | type
365      procedure ClearCalcFields(Buffer: PChar); override;
366      function AllocRecordBuffer: PChar; override;
367      procedure DoBeforeDelete; override;
368 +    procedure DoAfterDelete; override;
369      procedure DoBeforeEdit; override;
370      procedure DoBeforeInsert; override;
371      procedure DoAfterInsert; override;
372      procedure DoBeforeOpen; override;
373      procedure DoBeforePost; override;
374 +    procedure DoAfterPost; override;
375      procedure FreeRecordBuffer(var Buffer: PChar); override;
376      procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
377      function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
# Line 380 | Line 385 | type
385                         DoCheck: Boolean): TGetResult; override;
386      function GetRecordCount: Integer; override;
387      function GetRecordSize: Word; override;
388 +    procedure InternalAutoCommit;
389      procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
390      procedure InternalCancel; override;
391      procedure InternalClose; override;
# Line 411 | Line 417 | type
417  
418    protected
419      {Likely to be made public by descendant classes}
420 +    property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
421      property SQLParams: TIBXSQLDA read GetSQLParams;
422      property Params: TIBXSQLDA read GetSQLParams;
423      property InternalPrepared: Boolean read FInternalPrepared;
# Line 561 | Line 568 | type
568  
569    published
570      { TIBCustomDataSet }
571 +    property AutoCommit;
572      property BufferChunks;
573      property CachedUpdates;
574      property DeleteSQL;
# Line 888 | Line 896 | begin
896    FParamCheck := True;
897    FGenerateParamNames := False;
898    FForcedRefresh := False;
899 +  FAutoCommit:= acDisabled;
900    {Bookmark Size is Integer for IBX}
901    BookmarkSize := SizeOf(Integer);
902    FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
# Line 1398 | Line 1407 | var
1407    LocalData: Pointer;
1408    LocalDate, LocalDouble: Double;
1409    LocalInt: Integer;
1410 +  LocalBool: wordBool;
1411    LocalInt64: Int64;
1412    LocalCurrency: Currency;
1413    FieldsLoaded: Integer;
# Line 1542 | Line 1552 | begin
1552              end;
1553            end;
1554          end;
1555 +        SQL_BOOLEAN:
1556 +        begin
1557 +          LocalBool:= false;
1558 +          rdFields[j].fdDataSize := SizeOf(wordBool);
1559 +          if RecordNumber >= 0 then
1560 +            LocalBool := Qry.Current[i].AsBoolean;
1561 +          LocalData := PChar(@LocalBool);
1562 +        end;
1563          else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1564          begin
1565            rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
# Line 1817 | Line 1835 | var
1835    ofs: DWORD;
1836    Qry: TIBSQL;
1837   begin
1838 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1838 >  if Assigned(Database) and not Database.SQLHourGlass then
1839 >     SetCursor := False
1840 >  else
1841 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1842    if SetCursor then
1843      Screen.Cursor := crHourGlass;
1844    try
# Line 1941 | Line 1962 | begin
1962    if FInternalPrepared then
1963      Exit;
1964    DidActivate := False;
1965 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1965 >  if Assigned(Database) and not Database.SQLHourGlass then
1966 >    SetCursor := False
1967 >  else
1968 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1969    if SetCursor then
1970      Screen.Cursor := crHourGlass;
1971    try
# Line 2171 | Line 2195 | begin
2195              SQL_TIMESTAMP:
2196                Qry.Params[i].AsDateTime :=
2197                         TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2198 +            SQL_BOOLEAN:
2199 +              Qry.Params[i].AsBoolean := PWordBool(data)^;
2200            end;
2201          end;
2202        end;
# Line 2524 | Line 2550 | begin
2550    inherited DoBeforeDelete;
2551   end;
2552  
2553 + procedure TIBCustomDataSet.DoAfterDelete;
2554 + begin
2555 +  inherited DoAfterDelete;
2556 +  InternalAutoCommit;
2557 + end;
2558 +
2559   procedure TIBCustomDataSet.DoBeforeEdit;
2560   var
2561    Buff: PRecordData;
# Line 2569 | Line 2601 | begin
2601       GeneratorField.Apply
2602   end;
2603  
2604 + procedure TIBCustomDataSet.DoAfterPost;
2605 + begin
2606 +  inherited DoAfterPost;
2607 +  InternalAutoCommit;
2608 + end;
2609 +
2610   procedure TIBCustomDataSet.FetchAll;
2611   var
2612    SetCursor: Boolean;
# Line 2578 | Line 2616 | var
2616    CurBookmark: string;
2617    {$ENDIF}
2618   begin
2619 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2619 >  if Assigned(Database) and not Database.SQLHourGlass then
2620 >    SetCursor := False
2621 >  else
2622 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2623    if SetCursor then
2624      Screen.Cursor := crHourGlass;
2625    try
# Line 2843 | Line 2884 | begin
2884    result := FRecordBufferSize;
2885   end;
2886  
2887 + procedure TIBCustomDataSet.InternalAutoCommit;
2888 + begin
2889 +  with Transaction do
2890 +    if InTransaction and (FAutoCommit = acCommitRetaining) then
2891 +    begin
2892 +      if CachedUpdates then ApplyUpdates;
2893 +      CommitRetaining;
2894 +    end;
2895 + end;
2896 +
2897   procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
2898   begin
2899    CheckEditState;
# Line 2922 | Line 2973 | var
2973    Buff: PChar;
2974    SetCursor: Boolean;
2975   begin
2976 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2976 >  if Assigned(Database) and not Database.SQLHourGlass then
2977 >    SetCursor := False
2978 >  else
2979 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2980    if SetCursor then
2981      Screen.Cursor := crHourGlass;
2982    try
# Line 3195 | Line 3249 | begin
3249              FieldSize := sizeof (TISC_QUAD);
3250              FieldType := ftUnknown;
3251            end;
3252 +          SQL_BOOLEAN:
3253 +             FieldType:= ftBoolean;
3254            else
3255              FieldType := ftUnknown;
3256          end;
# Line 3291 | Line 3347 | begin
3347          else case cur_field.DataType of
3348            ftString:
3349              cur_param.AsString := cur_field.AsString;
3350 <          ftBoolean, ftSmallint, ftWord:
3350 >          ftBoolean:
3351 >            cur_param.AsBoolean := cur_field.AsBoolean;
3352 >          ftSmallint, ftWord:
3353              cur_param.AsShort := cur_field.AsInteger;
3354            ftInteger:
3355              cur_param.AsLong := cur_field.AsInteger;
# Line 3353 | Line 3411 | var
3411    end;
3412  
3413   begin
3414 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3414 >  if Assigned(Database) and not Database.SQLHourGlass then
3415 >    SetCursor := False
3416 >  else
3417 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3418    if SetCursor then
3419      Screen.Cursor := crHourGlass;
3420    try
# Line 3428 | Line 3489 | var
3489    SetCursor: Boolean;
3490    bInserting: Boolean;
3491   begin
3492 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3492 >  if Assigned(Database) and not Database.SQLHourGlass then
3493 >    SetCursor := False
3494 >  else
3495 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3496    if SetCursor then
3497      Screen.Cursor := crHourGlass;
3498    try
# Line 3716 | Line 3780 | var
3780    SetCursor: Boolean;
3781   begin
3782    DidActivate := False;
3783 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3783 >  if Assigned(Database) and not Database.SQLHourGlass then
3784 >    SetCursor := False
3785 >  else
3786 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3787    if SetCursor then
3788      Screen.Cursor := crHourGlass;
3789    try
# Line 4181 | Line 4248 | begin
4248      Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4249   end;
4250  
4251 < end.
4251 > end.

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines