首页 > 其他分享 >TmsFlexcelExports

TmsFlexcelExports

时间:2023-12-12 17:22:47浏览次数:33  
标签:XLSX begin end TmsFlexcelExports irow DataSet icol

unit TmsFlexcelExports;

interface

Uses
  Windows, System.SysUtils, System.Classes, VCL.FlexCel.Core,
  FlexCel.XlsAdapter, Data.DB;

procedure DataSetToXLS(fName: string; DataSet: TDataSet;
  WorkSheetCount: Integer = 1; ActiveSheet: Integer = 1);
procedure DataSetToCSV(fName: string; DataSet: TDataSet;
  WorkSheetCount: Integer = 1; ActiveSheet: Integer = 1);

implementation

procedure DataSetToXLS(fName: string; DataSet: TDataSet;
  WorkSheetCount: Integer = 1; ActiveSheet: Integer = 1);
var
  ioldrecno, icol, irow: Integer;
  fmt: TFlxFormat;
  fmtDateTime: Integer;
  XLSX: TExcelFile;
begin
  XLSX := TXlsFile.Create(True);
  try
    ioldrecno := DataSet.RecNo;
    if SameText(ExtractFileExt(fName), '.XLSX') then
      XLSX.SupportsXlsx := True;
    XLSX.NewFile(WorkSheetCount, TExcelFileFormat(5));
    // 4 = V2016 3 = V2013  2 = v2010, 1 = v2007, 0 = v2003
    XLSX.ActiveSheet := ActiveSheet;
    fmt := XLSX.GetDefaultFormat;
    fmt.Format := 'yyyy-mm-dd HH:MM:SS AM/PM';
    fmtDateTime := XLSX.AddFormat(fmt);
    irow := 1;
    for icol := 0 to DataSet.FieldCount - 1 do
    begin
      XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].DisplayName);
    end;
    inc(irow);
    DataSet.First;
    while Not DataSet.EOF do
    begin
      for icol := 0 to DataSet.FieldCount - 1 do
      begin
        case DataSet.Fields[icol].DataType of
          ftUnknown, ftString, ftBoolean, ftBCD, ftBytes, ftVarBytes, ftAutoInc,
            ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle,
            ftTypedBinary, ftCursor, ftFixedChar, ftWideString, ftADT, ftArray,
            ftReference, ftDataSet, ftOraBlob, ftOraClob, ftVariant,
            ftInterface, ftIDispatch, ftGuid, ftFMTBcd, ftFixedWideChar,
            ftWideMemo, ftOraInterval, ftConnection, ftParams, ftStream,
            ftTimeStampOffset, ftObject:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsString);
            end;
          ftSmallint, ftInteger, ftWord, ftLargeint, ftLongWord, ftShortint,
            ftByte, ftSingle:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsInteger);
            end;
          ftDate, ftTime, ftDateTime, ftOraTimeStamp, ftTimeStamp:
            begin
              XLSX.SetCellValue(irow, icol + 1,
                DataSet.Fields[icol].AsDateTime);
              XLSX.SetCellFormat(irow, icol + 1, fmtDateTime);
            end;
          ftExtended, ftFloat, ftCurrency:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsFloat);
            end;
        end;
      end;
      inc(irow);
      DataSet.Next;
    end;
    DataSet.RecNo := ioldrecno;
    XLSX.Save(fName);
  finally
    XLSX.Free;
  end;

end;

procedure DataSetToCSV(fName: string; DataSet: TDataSet;
  WorkSheetCount: Integer = 1; ActiveSheet: Integer = 1);
var
  ioldrecno, icol, irow: Integer;
  fmt: TFlxFormat;
  fmtDateTime: Integer;
  XLSX: TExcelFile;
begin
  XLSX := TXlsFile.Create(True);
  try
    ioldrecno := DataSet.RecNo;
    if SameText(ExtractFileExt(fName), '.XLSX') then
      XLSX.SupportsXlsx := True;
    XLSX.NewFile(WorkSheetCount, TExcelFileFormat(5));
    // 4 = V2016 3 = V2013  2 = v2010, 1 = v2007, 0 = v2003
    XLSX.ActiveSheet := ActiveSheet;
    fmt := XLSX.GetDefaultFormat;
    fmt.Format := 'yyyy-mm-dd HH:MM:SS AM/PM';
    fmtDateTime := XLSX.AddFormat(fmt);
    irow := 1;
    for icol := 0 to DataSet.FieldCount - 1 do
    begin
      XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].DisplayName);
    end;
    inc(irow);
    DataSet.First;
    while Not DataSet.EOF do
    begin
      for icol := 0 to DataSet.FieldCount - 1 do
      begin
        case DataSet.Fields[icol].DataType of
          ftUnknown, ftString, ftBoolean, ftBCD, ftBytes, ftVarBytes, ftAutoInc,
            ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle,
            ftTypedBinary, ftCursor, ftFixedChar, ftWideString, ftADT, ftArray,
            ftReference, ftDataSet, ftOraBlob, ftOraClob, ftVariant,
            ftInterface, ftIDispatch, ftGuid, ftFMTBcd, ftFixedWideChar,
            ftWideMemo, ftOraInterval, ftConnection, ftParams, ftStream,
            ftTimeStampOffset, ftObject:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsString);
            end;
          ftSmallint, ftInteger, ftWord, ftLargeint, ftLongWord, ftShortint,
            ftByte, ftSingle:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsInteger);
            end;
          ftDate, ftTime, ftDateTime, ftOraTimeStamp, ftTimeStamp:
            begin
              XLSX.SetCellValue(irow, icol + 1,
                DataSet.Fields[icol].AsDateTime);
              XLSX.SetCellFormat(irow, icol + 1, fmtDateTime);
            end;
          ftExtended, ftFloat, ftCurrency:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsFloat);
            end;
        end;
      end;
      inc(irow);
      DataSet.Next;
    end;
    DataSet.RecNo := ioldrecno;
    XLSX.Save(fName, TFileFormats.Text, ',', TEncoding.Unicode);
    // XLSX.Save(fName);
  finally
    XLSX.Free;
  end;

end;

end.

 

标签:XLSX,begin,end,TmsFlexcelExports,irow,DataSet,icol
From: https://www.cnblogs.com/kinglandsoft/p/17897362.html

相关文章