/components/lazreport/source/lr_dbrel.pas

http://github.com/graemeg/lazarus · Pascal · 139 lines · 103 code · 23 blank · 13 comment · 9 complexity · 55f2a252c14d91182cd510892fce201f MD5 · raw file

  1. {*****************************************}
  2. { }
  3. { FastReport v2.3 }
  4. { DB related stuff }
  5. { }
  6. { Copyright (c) 1998-99 by Tzyganenko A. }
  7. { }
  8. {*****************************************}
  9. unit LR_DBRel;
  10. interface
  11. {$I LR_Vers.inc}
  12. uses
  13. SysUtils, Classes, DB;
  14. const
  15. frEmptyBookmark = nil;
  16. type
  17. { TODO -oalexs : Remove this }
  18. TfrBookmark = TBookmark;
  19. TfrTDataSet =class(TDataSet);
  20. TfrTField = class(TField);
  21. TfrTBlobField = class(TBlobField);
  22. function frIsBlob(Field: TfrTField): Boolean;
  23. function frIsBookmarksEqual(DataSet: TfrTDataSet; b1, b2: TfrBookmark): Boolean;
  24. procedure frGetFieldNames(DataSet: TfrTDataSet; List: TStrings);
  25. function frGetBookmark(DataSet: TfrTDataSet): TfrBookmark;
  26. procedure frFreeBookmark(DataSet: TfrTDataSet; Bookmark: TfrBookmark);
  27. procedure frGotoBookmark(DataSet: TfrTDataSet; Bookmark: TfrBookmark);
  28. function frGetDataSource(Owner: TComponent; d: TDataSet): TDataSource;
  29. function lrGetFieldValue(F:TField):Variant;
  30. const
  31. TypeStringField = [ftString, ftMemo, ftFmtMemo, ftFixedChar, ftWideString,
  32. ftFixedWideChar, ftWideMemo];
  33. TypeNumericField = [ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  34. ftTimeStamp];
  35. TypeIntegerField = [ftSmallint, ftInteger, ftWord, ftAutoInc, ftLargeint];
  36. TypeBooleanField = [ftBoolean];
  37. implementation
  38. uses LR_Utils;
  39. function frIsBlob(Field: TfrTField): Boolean;
  40. begin
  41. Result := (Field <> nil) and (Field.DataType in [ftBlob..ftTypedBinary]);
  42. end;
  43. procedure frGetFieldNames(DataSet: TfrTDataSet; List: TStrings);
  44. begin
  45. if not Assigned(DataSet) then exit;
  46. if DataSet.FieldCount > 0 then
  47. DataSet.GetFieldNames(List)
  48. else
  49. begin
  50. { DataSet.Open;
  51. DataSet.GetFieldNames(List);
  52. DataSet.Close;}
  53. DataSet.FieldDefs.Update;
  54. DataSet.FieldDefs.GetItemNames(List);
  55. end;
  56. end;
  57. function frGetBookmark(DataSet: TfrTDataSet): TfrBookmark;
  58. begin
  59. Result := DataSet.GetBookmark;
  60. end;
  61. procedure frGotoBookmark(DataSet: TfrTDataSet; Bookmark: TfrBookmark);
  62. begin
  63. DataSet.GotoBookmark(BookMark);
  64. end;
  65. function frGetDataSource(Owner: TComponent; d: TDataSet): TDataSource;
  66. var
  67. i: Integer;
  68. sl: TStringList;
  69. ds: TDataSource;
  70. begin
  71. sl := TStringList.Create;
  72. Result := nil;
  73. frGetComponents(Owner, TDataSource, sl, nil);
  74. for i := 0 to sl.Count - 1 do
  75. begin
  76. ds := frFindComponent(Owner, sl[i]) as TDataSource;
  77. if (ds <> nil) and (ds.DataSet = d) then
  78. begin
  79. Result := ds;
  80. break;
  81. end;
  82. end;
  83. sl.Free;
  84. end;
  85. function lrGetFieldValue(F: TField): Variant;
  86. begin
  87. if Assigned(F) then
  88. begin
  89. if F.IsNull then
  90. begin
  91. if F.DataType in TypeStringField then
  92. Result:=''
  93. else
  94. if F.DataType in (TypeIntegerField + TypeNumericField) then
  95. Result:=0
  96. else
  97. if F.DataType in TypeBooleanField then
  98. Result:=false
  99. else
  100. Result:=null
  101. end
  102. else
  103. Result:=F.Value;
  104. end
  105. else
  106. Result:=null;
  107. end;
  108. procedure frFreeBookmark(DataSet: TfrTDataSet; Bookmark: TfrBookmark);
  109. begin
  110. DataSet.FreeBookmark(BookMark);
  111. end;
  112. function frIsBookmarksEqual(DataSet: TfrTDataSet; b1, b2: TfrBookmark): Boolean;
  113. begin
  114. Result := DataSet.CompareBookmarks(b1, b2) = 0;
  115. end;
  116. end.