dxdatasethtml.pas

Well known and usefull component for delphi 7

unit DXDATASETHTML;

interface

uses
  DB,
  Graphics,
  Classes,
  Forms;

type
  TDXTable=class(TPersistent)
  private
     fWidthPixel:Integer;
     fWidthPercentage:Integer;
     fTitleColor:TColor;
     fCellPadding:Integer;
     fCellSpacing:Integer;
     fBorder:Integer;
     fTableColor:TColor;
     fDetailColor:TColor;
  published
     property Border:Integer read fBorder write fBorder;
     property CellPadding:Integer read fCellPadding write fCellPadding;
     property CellSpacing:Integer read fCellSpacing write fCellSpacing;
     property WidthPixels:Integer read fWidthPixel write fWidthPixel;
     property WidthPercentage:Integer read fWidthPercentage write fWidthPercentage;
     property TitleColor:TColor read fTitleColor write fTitleColor;
     property TableColor:TColor read fTableColor write fTableColor;
     property DetailColor:TColor read fDetailColor write fDetailColor;
  End;

  TDXDatasetHTML = class(TComponent)
  private
    { Private declarations }
    fDataSet:TDataSet;
    fTable:TDXTable;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure SaveTableToHTMLStream(Stream:TStream);
  published
    { Published declarations }
    property Table:TDXTable read fTable write fTable;
    property Dataset:TDataSet read fDataSet write fDataSet;
  end;

procedure Register;

implementation

Uses
   DXString,
   SysUtils;

procedure Register;
begin
  RegisterComponents('BPDX Dataset', [TDXDatasetHTML]);
end;

constructor TDXDatasetHTML.Create(AOwner:TComponent);
Begin
   inherited Create(AOwner);
   fTable:=TDXTable.Create;
   fTable.WidthPixels:=0;
   fTable.WidthPercentage:=100;
   fTable.TitleColor:=clSilver;
   fTable.CellPadding:=0;
   fTable.CellSpacing:=0;
   fTable.Border:=1;
   fTable.TableColor:=clBlack;
   fTable.DetailColor:=clWhite;
End;

destructor TDXDatasetHTML.Destroy;
Begin
   fTable.Free;
   inherited Destroy;
End;

Type
  TRGB = packed record
    rgbRed: Byte;
    rgbGreen: Byte;
    rgbBlue: Byte;
    rgbExtra:Byte;
  end;

procedure TDXDatasetHTML.SaveTableToHTMLStream(Stream:TStream);
Var
   StrList:TStringList;
   Ws1:String;
   Ws2:String;
   MaxLoop:Integer;
   Loop:Integer;
   WasOpen:Boolean;

Begin
   WasOpen:=fDataSet.Active;
   If fTable.WidthPixels>0 then Ws1:='width='+IntegerToString(fTable.WidthPixels)
   Else If fTable.WidthPercentage>0 then Ws1:='width='+IntegerToString(fTable.WidthPercentage)+'%';
   Ws2:=IntToHex(TRGB(FTable.TableColor).rgbRed,2)+
      IntToHex(TRGB(FTable.TableColor).rgbGreen,2)+
      IntToHex(TRGB(FTable.TableColor).rgbBlue,2);
   StrList:=TStringList.Create;
   StrList.Add('<table border='+IntegerToString(fTable.Border)+
      ' cellspacing='+IntegerToString(fTable.CellSpacing)+
      ' cellpadding='+IntegerToString(fTable.CellSpacing)+
      ' bgcolor=#'+Ws2+
      #32+Ws1+'>');
   If Not WasOpen then fDataSet.Open;
   MaxLoop:=fDataSet.FieldDefs.Count;
   If MaxLoop>0 then Begin
// title
      Ws2:=IntToHex(TRGB(FTable.TitleColor).rgbRed,2)+
         IntToHex(TRGB(FTable.TitleColor).rgbGreen,2)+
         IntToHex(TRGB(FTable.TitleColor).rgbBlue,2);
      StrList.Add('<tr>');
      For Loop:=1 to MaxLoop-1 do
         StrList.Add('<td bgcolor=#'+Ws2+'><b>'+fDataSet.FieldDefs.Items[Loop].Name+'</b></td>');
      StrList.Add('</tr>');
// detail
      Ws2:=IntToHex(TRGB(FTable.DetailColor).rgbRed,2)+
         IntToHex(TRGB(FTable.DetailColor).rgbGreen,2)+
         IntToHex(TRGB(FTable.DetailColor).rgbBlue,2);
      While Not fDataSet.EOF do Begin
         StrList.Add('<tr>');
         For Loop:=1 to MaxLoop-1 do
            If Not fDataSet.Fields[Loop].IsBlob then Begin
               Ws1:='';
               case fDataSet.Fields[Loop].DataType of
                  ftString,
                  ftSmallint,
                  ftInteger,
                  ftWord,
                  ftAutoinc:Ws1:=fDataSet.Fields[Loop].AsString;
                  ftBoolean:If fDataSet.Fields[Loop].AsBoolean then Ws1:='true'
                            Else Ws1:='false';
//               ftCurrency:Ws1:=fDataSet.Fields[Loop].AsCurrency;
                  ftFloat:Ws1:=FloatToStr(fDataSet.Fields[Loop].AsFloat);
                  ftDate:Ws1:=DateToStr(fDataSet.Fields[Loop].AsDateTime);
                  ftTime:Ws1:=TimeToStr(fDataSet.Fields[Loop].AsDateTime);
                  ftDateTime:Ws1:=DateTimeToStr(fDataSet.Fields[Loop].AsDateTime);
               End;
               StrList.Add('<td bgcolor=#'+Ws2+'>'+Ws1+'</td>');
            End
            Else StrList.Add('<td bgcolor=#'+Ws2+'></td>');
         StrList.Add('</tr>');
         fDataSet.Next;
      End;
   End;
   StrList.Add('</table>');
   StrList.SaveToStream(Stream);
   StrList.Free;
   If Not WasOpen then fDataSet.Close;
End;

end.