xlsdbread2.pas

一个经典的读写Excel的控件

unit XLSDbRead2;

{
********************************************************************************
******* XLSReadWriteII V2.00                                             *******
*******                                                                  *******
******* Copyright(C) 1999,2004 Lars Arvidsson, Axolot Data               *******
*******                                                                  *******
******* email: [e-mail]                                     *******
******* URL:   http://www.axolot.com                                     *******
********************************************************************************
** Users of the XLSReadWriteII component must accept the following            **
** disclaimer of warranty:                                                    **
**                                                                            **
** XLSReadWriteII is supplied as is. The author disclaims all warranties,     **
** expressedor implied, including, without limitation, the warranties of      **
** merchantability and of fitness for any purpose. The author assumes no      **
** liability for damages, direct or consequential, which may result from the  **
** use of XLSReadWriteII.                                                     **
********************************************************************************
}

{$B-}

{$I XLSRWII2.inc}

interface

uses Classes, SysUtils, XLSReadWriteII2, BIFFRecsII2, CellFormats2, db,
     XLSRWIIResourceStrings2;

type TXLSDbRead2 = class(TComponent)
private
    FXLS: TXLSReadWriteII2;
    FDataSet: TDataSet;
    FCol: byte;
    FRow: word;
    FSheet: integer;
    FIncludeFieldsInx: array of boolean;
    FExcludeFieldsInx: array of boolean;
    FIncludeFields: TStrings;
    FExcludeFields: TStrings;
    FIncludeFieldnames: boolean;

    procedure SetExcludeFields(const Value: TStrings);
    procedure SetIncludeFields(const Value: TStrings);
public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Read;
published
    property Column: byte read FCol write FCol;
    property Dataset: TDataset read FDataset write FDataset;
    property ExcludeFields: TStrings read FExcludeFields write SetExcludeFields;
    property IncludeFields: TStrings read FIncludeFields write SetIncludeFields;
    property IncludeFieldnames: boolean read FIncludeFieldnames write FIncludeFieldnames;
    property Row: word read FRow write FRow;
    property Sheet: integer read FSheet write FSheet;
    property XLS: TXLSReadWriteII2 read FXLS write FXLS;
    end;

implementation

{ TXLSDbRead }

constructor TXLSDbRead2.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIncludeFieldnames := True;
  FIncludeFields := TStringList.Create;
  FExcludeFields := TStringList.Create;
end;

destructor TXLSDbRead2.Destroy;
begin
  FIncludeFields.Free;
  FExcludeFields.Free;
  inherited;
end;

procedure TXLSDbRead2.Read;
var
  i,ARow,ACol: integer;
  FmtDate,FmtTime: integer;
  Field: TField;
begin
  if FXLS = Nil then
    raise Exception.Create(ersNoTXLSReadWriteIIDefined);
  if FSheet >= FXLS.Sheets.Count then
    raise Exception.Create(ersSheetIndexOutOfRange);
  if FDataset = Nil then
    raise Exception.Create(ersNoDatasetDefined);
  SetLength(FIncludeFieldsInx,FDataset.FieldCount);
  SetLength(FExcludeFieldsInx,FDataset.FieldCount);
  for i := 0 to FDataset.FieldCount - 1 do begin
    FIncludeFieldsInx[i] := FIncludeFields.Count <= 0;
    FExcludeFieldsInx[i] := False;
  end;
  for i := 0 to FIncludeFields.Count - 1 do begin
    Field := FDataset.Fields.FindField(FIncludeFields[i]);
    if Field <> Nil then
      FIncludeFieldsInx[Field.Index] := True;
  end;
  for i := 0 to FExcludeFields.Count - 1 do begin
    Field := FDataset.Fields.FindField(FExcludeFields[i]);
    if Field <> Nil then
      FExcludeFieldsInx[Field.Index] := True;
  end;
  ARow := FRow;
  FmtDate := -1;
  FmtTime := -1;
  ACol := FCol;
  for i := 0 to FDataset.FieldCount - 1 do begin
    if FIncludeFieldsInx[i] and not FExcludeFieldsInx[i] then begin
      if FIncludeFieldnames then
        FXLS.Sheets[FSheet].AsString[ACol,ARow] := FDataset.Fields[i].DisplayName;
      if FDataset.Fields[i].DataType in [ftDate,ftDateTime] then
        FmtDate := -1;
      if FDataset.Fields[i].DataType in [ftTime] then
        FmtTime := -1;
      Inc(ACol);
    end;
  end;
  if FIncludeFieldnames then
    Inc(ARow);
  if FmtDate < 0 then begin
    FmtDate := DEFAULT_FORMAT;
//    NumberFormat := TInternalNumberFormats[NUMFORMAT_DATE];
  end;
  if FmtTime < 0 then begin
    FmtTime := DEFAULT_FORMAT;
//    NumberFormat := TInternalNumberFormats[NUMFORMAT_TIME];
  end;
  FDataset.First;
  while not FDataset.Eof do begin
    ACol := FCol;
    for i := 0 to FDataset.FieldCount - 1 do begin
      if FIncludeFieldsInx[i] and not FExcludeFieldsInx[i] then begin
        if not FDataset.Fields[i].IsNull then begin
          case FDataset.Fields[i].DataType of
            ftString,
{$ifndef ver120}
            ftVariant,
{$endif}
            ftFixedChar,
{$ifdef D6_AND_LATER}
            ftGuid:
                        FXLS.Sheets[FSheet].AsString[ACol,ARow] := FDataset.Fields[i].AsString;
{$endif}
            ftWideString:
                        FXLS.Sheets[FSheet].AsWideString[ACol,ARow] := FDataset.Fields[i].AsString;
            ftMemo,
            ftFmtMemo:
                        FXLS.Sheets[FSheet].AsString[ACol,ARow] := FDataset.Fields[i].AsString;
            ftSmallint,
            ftInteger,
            ftLargeInt,
            ftWord,
            ftCurrency,
{$ifdef D6_AND_LATER}
            ftBCD,
            ftFMTBcd,
{$endif}
            ftAutoInc,
            ftFloat:
                        FXLS.Sheets[FSheet].AsFloat[ACol,ARow] := FDataset.Fields[i].AsFloat;
            ftBoolean:
                        FXLS.Sheets[FSheet].AsBoolean[ACol,ARow] := FDataset.Fields[i].AsBoolean;
            ftGraphic: ;

            ftDate,
{$ifdef D6_AND_LATER}
            ftTimestamp,
{$endif}
            ftDateTime: FXLS.Sheets[FSheet].IntWriteNumber(ACol,ARow,FmtDate,FDataset.Fields[i].AsFloat);
            ftTime:     FXLS.Sheets[FSheet].IntWriteNumber(ACol,ARow,FmtTime,FDataset.Fields[i].AsFloat);
           end;
        end;
        Inc(ACol);
      end;
    end;
    Inc(ARow);
    if ARow >= FXLS.MaxRowCount then
      Break;
    FDataset.Next;
  end;
  FXLS.Sheets[FSheet].CalcDimensions;
end;

procedure TXLSDbRead2.SetExcludeFields(const Value: TStrings);
begin
  FExcludeFields.Assign(Value);
end;

procedure TXLSDbRead2.SetIncludeFields(const Value: TStrings);
begin
  FIncludeFields.Assign(Value);
end;

end.