Jump to content

SMARAM

uniGUI Subscriber
  • Posts

    50
  • Joined

  • Last visited

  • Days Won

    3

Status Updates posted by SMARAM

  1. //=============================================================================
    // TDataSet to Excel without OLE or Excel required
    // Mike Heydon Dec 2002
    
    // Adapted to Unigui with TUniDBGrid
    // Mauricio Naozuka - 26/04/2018 - naozuka@gmail.com
    //=============================================================================
    
    unit UExportExcel;
    
    //  Example
    //
    //  Add uses UExportExcel
    //
    //procedure TMainForm.UniButton1Click(Sender: TObject);
    //var url, filename, reportname : String;
    //    exportExcel: TDataSetToExcel;
    //    i: integer;
    //begin
    //	reportname := 'ExcelReport';
    //	url := UniServerModule.LocalCacheURL+name+'.xls';
    //	filename := UniServerModule.NewCacheFileUrl(false, 'xls', reportname, '', url);
    //
    //	exportExcel := TDataSetToExcel.Create;
    //  exportExcel.WriteFile(filename, UniDBGrid1);
    //  FreeAndNil(exportExcel);
    //  UniSession.SendFile(filename, reportname+'.xls');
    //end;
    
    interface
    
    uses Windows, SysUtils, DB, Math, uniBasicGrid, uniDBGrid;
    
    type
      // TDataSetToExcel
      TDataSetToExcel = class(TObject)
      protected
        procedure WriteToken(AToken: word; ALength: word);
        procedure WriteFont(const AFontName: Ansistring; AFontHeight,
          AAttribute: word);
        procedure WriteFormat(const AFormatStr: Ansistring);
      private
        FRow: word;
        FFieldCount: integer;
        FDataFile: file;
        FFileName: string;
      public
        constructor Create;
        function WriteFile(const AFileName: string; const AGrid: TUniDBGrid): boolean;
      end;
    
    //-----------------------------------------------------------------------------
    implementation
    
    const
      // XL Tokens
      XL_DIM = $00;
      XL_BOF = $09;
      XL_EOF = $0A;
      XL_DOCUMENT = $10;
      XL_FORMAT = $1E;
      XL_COLWIDTH = $24;
      XL_FONT = $31;
    
      // XL Cell Types
      XL_INTEGER = $02;
      XL_DOUBLE = $03;
      XL_STRING = $04;
    
      // XL Cell Formats
      XL_INTFORMAT = $81;
      XL_DBLFORMAT = $82;
      XL_XDTFORMAT = $83;
      XL_DTEFORMAT = $84;
      XL_TMEFORMAT = $85;
      XL_HEADBOLD = $40;
      XL_HEADSHADE = $F8;
    
      // ========================
      // Create the class
      // ========================
    
    constructor TDataSetToExcel.Create;
    begin
      FFieldCount := 0;
    end;
    
    // ====================================
    // Write a Token Descripton Header
    // ====================================
    
    procedure TDataSetToExcel.WriteToken(AToken: word; ALength: word);
    var
      aTOKBuffer: array[0..1] of word;
    begin
      aTOKBuffer[0] := AToken;
      aTOKBuffer[1] := ALength;
      Blockwrite(FDataFile, aTOKBuffer, SizeOf(aTOKBuffer));
    end;
    
    // ====================================
    // Write the font information
    // ====================================
    
    procedure TDataSetToExcel.WriteFont(const AFontName: ansistring;
      AFontHeight, AAttribute: word);
    var
      iLen: byte;
    begin
      AFontHeight := AFontHeight * 20;
      WriteToken(XL_FONT, 5 + length(AFontName));
      BlockWrite(FDataFile, AFontHeight, 2);
      BlockWrite(FDataFile, AAttribute, 2);
      iLen := length(AFontName);
      BlockWrite(FDataFile, iLen, 1);
      BlockWrite(FDataFile, AFontName[1], iLen);
    end;
    
    // ====================================
    // Write the format information
    // ====================================
    
    procedure TDataSetToExcel.WriteFormat(const AFormatStr: ansistring);
    var
      iLen: byte;
    begin
      WriteToken(XL_FORMAT, 1 + length(AFormatStr));
      iLen := length(AFormatStr);
      BlockWrite(FDataFile, iLen, 1);
      BlockWrite(FDataFile, AFormatStr[1], iLen);
    end;
    
    // ====================================
    // Write the XL file from data set
    // ====================================
    
    function TDataSetToExcel.WriteFile(const AFilename:String; const AGrid: TUniDBGrid): boolean;
    var
      bRetvar: boolean;
      aDOCBuffer: array[0..1] of word;
      aDIMBuffer: array[0..3] of word;
      aAttributes: array[0..2] of byte;
      i: integer;
      iColNum,
      iDataLen: byte;
      sStrData: string;
      fDblData: double;
      wWidth: word;
      sStrBytes: TBytes;
    begin
      if not Assigned(AGrid) then
        raise Exception.Create('There is no Grid is vinculated.');
    
      if not Assigned(AGrid.DataSource) then
        raise Exception.Create('There is no DataSource is vinculated to Grid ' + AGrid.Name);
    
      if not Assigned(AGrid.DataSource.DataSet) then
        raise Exception.Create('There is no DataSet is vinculated to DataSource ' + AGrid.DataSource.Name);
    
      bRetvar := true;
      FRow := 0;
      FillChar(aAttributes, SizeOf(aAttributes), 0);
      FFileName := ChangeFileExt(AFilename, '.xls');
      AssignFile(FDataFile, FFileName);
    
      try
        Rewrite(FDataFile, 1);
        // Beginning of File
        WriteToken(XL_BOF, 4);
        aDOCBuffer[0] := 0;
        aDOCBuffer[1] := XL_DOCUMENT;
        Blockwrite(FDataFile, aDOCBuffer, SizeOf(aDOCBuffer));
    
        // Font Table
        WriteFont('Arial', 10, 0);
        WriteFont('Arial', 10, 1);
        //WriteFont('Courier New', 11, 0);
    
        // Column widths
        iColNum := 0;
        for i := 0 to AGrid.Columns.Count-1 do
        begin
          if not AGrid.Columns[i].Visible then
            continue;
    
          if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DisplayWidth + 1 >
             Length(AGrid.Columns[i].Title.Caption) then
          begin
            wWidth := (AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DisplayWidth + 1) * 256;
          end
          else
          begin
            wWidth := (Length(AGrid.Columns[i].Title.Caption) + 1) * 256;
          end;
    
          // Limitar o tamanho da coluna
          if wWidth > 80*256 then
            wWidth := 80*256;
    
    //      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftDateTime then
    //        inc(wWidth, 100);
    //      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftDate then
    //        inc(wWidth, 1050);
    //      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftTime then
    //        inc(wWidth, 100);
    
          WriteToken(XL_COLWIDTH, 4);
    
          BlockWrite(FDataFile, iColNum, 1);
          BlockWrite(FDataFile, iColNum, 1);
          BlockWrite(FDataFile, wWidth, 2);
          Inc(iColNum);
        end;
    
        FFieldCount := iColNum;
    
        // Column Formats
        WriteFormat('Geral');
        WriteFormat('0');
        WriteFormat('#.##0,0000');
        WriteFormat('dd/mm/aaaa hh:mm:ss');
        WriteFormat('dd/mm/aaaa');
        WriteFormat('hh:mm:ss');
    
        // Dimensions
        WriteToken(XL_DIM, 8);
        aDIMBuffer[0] := 0;
        aDIMBuffer[1] := Min(AGrid.DataSource.DataSet.RecordCount, $FFFF);
        aDIMBuffer[2] := 0;
        aDIMBuffer[3] := Min(FFieldCount - 1, $FFFF);
        Blockwrite(FDataFile, aDIMBuffer, SizeOf(aDIMBuffer));
    
        // Column Headers
        iColNum := 0;
        for i := 0 to AGrid.Columns.Count-1 do
        begin
          if not AGrid.Columns[i].Visible then
            continue;
    
          //      sStrData := FDataSet.Fields[i].DisplayName;
          sStrBytes := TEncoding.ANSI.GetBytes(AGrid.Columns[i].Title.Caption);
          iDataLen := length(sStrBytes);
          WriteToken(XL_STRING, iDataLen + 8);
          WriteToken(FRow, iColNum);
          aAttributes[1] := XL_HEADBOLD;
          //aAttributes[2] := XL_HEADSHADE;
          BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
          BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
          if iDataLen > 0 then
            BlockWrite(FDataFile, sStrBytes[0], iDataLen);
          aAttributes[2] := 0;
          Inc(iColNum);
        end;
    
        try
          AGrid.DataSource.DataSet.DisableControls;
          AGrid.DataSource.DataSet.First;
    
          // Data Rows
          while not AGrid.DataSource.DataSet.Eof do
          begin
            inc(FRow);
            iColNum := 0;
    
            for i := 0 to AGrid.Columns.Count-1 do
            begin
              if not AGrid.Columns[i].Visible then
                continue;
    
              case AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType of
                  ftBoolean,
                  ftWideString,
                  ftFixedChar,
                  ftString:
                  begin
                    try
                      //              sStrData := FDataSet.Fields[i].AsString;
    
                      sStrBytes:=TEncoding.ANSI.GetBytes(AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsString);
                      iDataLen := length(sStrBytes);
                      WriteToken(XL_STRING, iDataLen + 8);
                      WriteToken(FRow, iColNum);
                      aAttributes[1] := 0;
                      BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                      BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
                      if iDataLen > 0 then
                        BlockWrite(FDataFile, sStrBytes[0], iDataLen);
                    except on E: Exception do
                      //ShowMessage(E.Message);
                      raise Exception.Create('Erro Converter: ' + E.Message);
                    end;
                  end;
    
                  ftAutoInc,
                  ftSmallInt,
                  ftInteger,
                  ftWord,
                  ftLargeInt:
                  begin
                    try
                    fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                    iDataLen := SizeOf(fDblData);
                    WriteToken(XL_DOUBLE, 15);
                    WriteToken(FRow, iColNum);
                    aAttributes[1] := XL_INTFORMAT;
                    BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                    BlockWrite(FDataFile, fDblData, iDatalen);
                    except on E: Exception do
                      //ShowMessage(E.Message);
                      raise Exception.Create('Erro Converter Inteiro: ' + E.Message);
                    end;
                  end;
    
                  ftFloat,
                  ftCurrency,
                  ftBcd,
                  ftFMTBcd:
                  begin
                    try
                    fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                    iDataLen := SizeOf(fDblData);
                    WriteToken(XL_DOUBLE, 15);
                    WriteToken(FRow, iColNum);
                    aAttributes[1] := XL_DBLFORMAT;
                    BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                    BlockWrite(FDataFile, fDblData, iDatalen);
                    except on E: Exception do
                      //ShowMessage(E.Message);
                      raise Exception.Create('Erro Converter Float: ' + E.Message);
                    end;
                  end;
    
                ftDateTime:
                  begin
                    try
                      if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
                      begin
                        fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                        iDataLen := SizeOf(fDblData);
                        WriteToken(XL_DOUBLE, 15);
                        WriteToken(FRow, iColNum);
                        aAttributes[1] := XL_XDTFORMAT;
                        BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                        BlockWrite(FDataFile, fDblData, iDatalen);
                      end;
                    except on E: Exception do
                      //ShowMessage(E.Message);
                      raise Exception.Create('Erro Converter DateTime: ' + E.Message);
                    end;
                  end;
    
                ftDate:
                  begin
                    try
                      if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
                      begin
                        fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                        iDataLen := SizeOf(fDblData);
                        WriteToken(XL_DOUBLE, 15);
                        WriteToken(FRow, iColNum);
                        aAttributes[1] := XL_DTEFORMAT;
                        BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                        BlockWrite(FDataFile, fDblData, iDatalen);
                      end;
                    except on E: Exception do
                      //ShowMessage(E.Message);
                      raise Exception.Create('Erro Converter Date: ' + E.Message);
                    end;
                  end;
    
                ftTime:
                  begin
                    try
                      if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
                      begin
                        fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                        iDataLen := SizeOf(fDblData);
                        WriteToken(XL_DOUBLE, 15);
                        WriteToken(FRow, iColNum);
                        aAttributes[1] := XL_TMEFORMAT;
                        BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                        BlockWrite(FDataFile, fDblData, iDatalen);
                      end;
                    except on E: Exception do
                      //ShowMessage(E.Message);
                      raise Exception.Create('Erro Converter Time: ' + E.Message);
                    end;
                  end;
    
                ftMemo:
                  begin
                    // Does not print memo
                  end;
    
              else raise Exception.Create('Tipo [' + AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).ClassName + '] do campo [' +
                                          AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).FieldName + '] não foi tratado.');
    
              end;
    
              Inc(iColNum);
            end; // end of for
    
            AGrid.DataSource.DataSet.Next;
          end; // end of while
    
        finally
          AGrid.DataSource.DataSet.EnableControls;
          AGrid.DataSource.DataSet.First;
        end;
    
        // End of File
        WriteToken(XL_EOF, 0);
        CloseFile(FDataFile);
      except
        bRetvar := false;
      end;
    
      Result := bRetvar;
    end;
    
    end.

     

×
×
  • Create New...