Chip 2002 October/Chip_2002-10_cd1.bin/zkuste/delphi/kolekce/d56/FLEXCEL.ZIP/XLSAdapter/XLSAdapter.pas

Pascal/Delphi Source File | 2002-07-02 | 15KB | 493 lines

unit XLSAdapter;

//Note: Excel uses 1-Based arrays, and that's the interface we present to our users.
// but, TExcelWorkbook uses 0-Based arrays, to be consistent with the file format (made in C)
//So here we have to add and substract 1 everywere to be consistent.

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UExcelAdapter, TemplateStore, UFlxMessages, UExcelRecords, XlsMessages,
  ActiveX, ComObj, UXlsOLEDoc, AXCtrls, UFlxRowComments,
  {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
  UXlsSheet;

type
  TXLSAdapter = class(TExcelAdapter)
  private
    FTemplateStore: TXlsTemplateStore;
    procedure SetTemplateStore(const Value: TXLSTemplateStore);
    { Private declarations }
  protected
    { Protected declarations }
  public
    constructor Create(AOwner:TComponent);override;
    function GetWorkbook: TExcelFile;override;
    { Public declarations }
  published
    property TemplateStore: TXLSTemplateStore read FTemplateStore write SetTemplateStore;
    { Published declarations }
  end;

  TXLSFile = class(TExcelFile)
  private
    FAdapter: TXLSAdapter;
    FActiveSheet: integer;

    FWorkbook: TWorkbook;
    FTemplate: TXlsStorageList;
    FTmpTemplate: TXlsStorageList;

    FirstColumn,LastColumn: integer;

    RowPictures: TRowComments;
    procedure ParsePictures;

  protected
    function GetActiveSheet: byte; override;
    procedure SetActiveSheet(const Value: byte); override;
    function GetActiveSheetName: WideString; override;
    procedure SetActiveSheetName(const Value: WideString); override;
  public
    constructor Create(const aAdapter: TXLSAdapter );
    destructor Destroy; override;

    procedure Connect;override;
    procedure Disconnect;override;

    procedure OpenFile(const FileName: TFileName);override;
    procedure CloseFile; override;

    procedure InsertAndCopySheets (const CopyFrom, InsertBefore, SheetCount: byte);override;
    function SheetCount: byte;override;
    procedure SelectSheet(const SheetNo:integer); override;

    procedure DeleteMarkedRows(const Mark: widestring);override;
    procedure RefreshPivotTables;override;

    procedure Save(const AutoClose: boolean; const FileName: string; const OnGetFileName: TOnGetFileNameEvent);override;

    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const OnlyFormulas: boolean);override;
    procedure DeleteRows(const aRow, aCount: word);override;

    procedure BeginSheet;override;
    procedure EndSheet(const RowOffset: integer);override;

    function CanOptimizeRead: boolean; override;


    function GetCommentsCount(Row: integer): integer; override;
    function GetCommentText(Row, aPos: integer): widestring; override;
    function GetPictureName(Row, aPos: integer): widestring;  override;
    function GetPicturesCount(Row: integer): integer;  override;

    function GetExcelNameCount: integer;  override;
    function GetRangeName(index: integer): widestring;  override;
    function GetRangeR1(index: integer): integer; override;
    function GetRangeR2(index: integer): integer; override;
    function GetRangeC1(index: integer): integer; override;
    function GetRangeC2(index: integer): integer; override;
    function GetRangeSheet(index: integer): integer; override;
    procedure AssignPicture(const Row, aPos: integer; const Pic: string; const PicType: TXlsImgTypes); override;
    procedure AssignComment(const Row, aPos: integer; const Comment: widestring); override;

    function CellCount(const aRow: integer): integer;override;
    function GetCellData(const aRow, aColOffset: integer): variant;override;
    function GetCellDataX(const aRow, aColOffset: integer): TXlsCellValue;override;
    procedure AssignCellData(const aRow, aColOffset: integer; const Value: variant);override;
    procedure AssignCellDataX(const aRow, aColOffset: integer; const Value: TXlsCellValue);override;
    function MaxRow: integer; override;
    function IsEmptyRow(const aRow: integer): boolean; override;
    function GetCellValue(aRow, aCol: integer): Variant; override;
    procedure SetCellValue(aRow, aCol: integer; const Value: Variant); override;

    procedure SetBounds(const aRangePos: integer);override;

    procedure PrepareBlockData(const R1,C1,R2,C2: integer);override;
    procedure AssignBlockData(const Row,Col: integer; const v: variant);override;
    procedure PasteBlockData;override;
  end;


procedure Register;

implementation
{$R IXLSAdapter.res}
procedure Register;
begin
  RegisterComponents('FlexCel', [TXLSAdapter]);
end;

{ TXLSAdapter }

constructor TXLSAdapter.Create(AOwner: TComponent);
begin
  inherited;
end;

function TXLSAdapter.GetWorkbook: TExcelFile;
begin
  Result:= TXLSFile.Create(Self);
end;

procedure TXLSAdapter.SetTemplateStore(const Value: TXLSTemplateStore);
begin
  FTemplateStore := Value;
end;

{ TXLSFile }

procedure TXLSFile.AssignCellData(const aRow, aColOffset: integer; const Value: variant);
var
  V: TXlsCellValue;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  if aRow-1<FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Count then
  begin
    V.Value:=Value; V.XF:=-1;
    FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[aRow-1, FirstColumn + aColOffset]:=V;
  end;
end;

procedure TXLSFile.AssignCellDataX(const aRow, aColOffset: integer; const Value: TXlsCellValue);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  if aRow-1<FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Count then
    FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[aRow-1, FirstColumn + aColOffset]:=Value;
end;

procedure TXLSFile.AssignComment(const Row, aPos: integer;
  const Comment: widestring);
begin
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
  begin
    if Comment='' then FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1].Delete(aPos) else
    FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1][aPos].Text:= Comment;
  end;
end;

procedure TXLSFile.AssignPicture(const Row, aPos: integer; const Pic: string; const PicType: TXlsImgTypes);
begin
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
    FWorkbook.WorkSheets[ActiveSheet-1].AssignDrawing(RowPictures[Row][aPos], Pic, PicType);
end;

procedure TXLSFile.ParsePictures;
var
  i:integer;

begin
  FreeAndNil(RowPictures);
  RowPictures:= TRowComments.Create;
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
    for i:=0 to FWorkbook.WorkSheets[ActiveSheet-1].DrawingCount-1 do
      RowPictures.Add(FWorkbook.WorkSheets[ActiveSheet-1].DrawingRow[i]+1, i);
end;


procedure TXLSFile.BeginSheet;
begin
  ParsePictures;
end;

function TXLSFile.CellCount(const aRow: integer): integer;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=0; exit; end;
  if aRow-1<FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Count then
    Result:=LastColumn-FirstColumn+1
  else Result:=0;
end;

procedure TXLSFile.CloseFile;
begin
  //Nothing
end;

procedure TXLSFile.Connect;
begin
  FWorkbook:= TWorkbook.Create;
end;

constructor TXLSFile.Create(const aAdapter: TXLSAdapter);
begin
  inherited Create;
  FAdapter:= aAdapter;
end;

procedure TXLSFile.DeleteMarkedRows(const Mark: widestring);
var
  i:integer;
  s: widestring;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  for i:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Count -1 downto 0 do
  try
    s:= FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[i,0].Value;
    if (s=Mark) then
      FWorkbook.DeleteRows(FActiveSheet-1, i, 1);
  except
    //nothing
  end;//except
end;

procedure TXLSFile.DeleteRows(const aRow, aCount: word);
begin
  FWorkbook.DeleteRows(FActiveSheet-1, aRow-1, aCount);
end;

destructor TXLSFile.Destroy;
begin
  FreeAndNil(RowPictures);
  FreeAndNil(FTmpTemplate);
  inherited;
end;

procedure TXLSFile.Disconnect;
begin
  FreeAndNil(FWorkbook);
end;

procedure TXLSFile.EndSheet(const RowOffset: integer);
begin
  //Nothing
end;

function TXLSFile.GetActiveSheet: byte;
begin
  Result:= FActiveSheet;
end;

function TXLSFile.GetActiveSheetName: WideString;
begin
  Result:= FWorkbook.Globals.SheetName[FActiveSheet-1];
end;

function TXLSFile.GetCellData(const aRow, aColOffset: integer): variant;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=unassigned; exit; end;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[aRow-1,FirstColumn+aColOffset].Value;
end;

function TXLSFile.GetCellDataX(const aRow, aColOffset: integer): TXlsCellValue;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result.Value:=unassigned; Result.XF:=-1; exit; end;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[aRow-1,FirstColumn+aColOffset];
end;

function TXLSFile.GetCommentsCount(Row: integer): integer;
begin
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
    if Row-1<FWorkbook.WorkSheets[ActiveSheet-1].Notes.Count then
      Result:=FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1].Count
    else
      Result:=0
  else
    Result:=0;
end;

function TXLSFile.GetCommentText(Row, aPos: integer): widestring;
begin
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
    Result:=FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1][aPos].Text
  else
    Result:='';
end;

function TXLSFile.GetExcelNameCount: integer;
begin
  Result:=FWorkbook.Globals.Names.Count;
end;

function TXLSFile.GetPictureName(Row, aPos: integer): widestring;
begin
  Result:= '';
  if not FWorkbook.IsWorksheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].DrawingName[RowPictures[Row][aPos]];
end;

function TXLSFile.GetPicturesCount(Row: integer): integer;
begin
  Result:=RowPictures[Row].Count;
end;

function TXLSFile.GetRangeName(index: integer): widestring;
begin
  Result:= FWorkbook.Globals.Names[index-1].Name;
end;

function TXLSFile.GetRangeR1(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].R1+1;
end;

function TXLSFile.GetRangeR2(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].R2+1;
end;

function TXLSFile.GetRangeC1(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].C1+1;
end;

function TXLSFile.GetRangeC2(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].C2+1;
end;

function TXLSFile.GetRangeSheet(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].RefersToSheet(FWorkbook.Globals.References.GetSheet)+1;
end;

procedure TXLSFile.InsertAndCopyRows(const FirstRow, LastRow, DestRow,
  aCount: integer; const OnlyFormulas: boolean);
begin
  FWorkbook.InsertAndCopyRows(FActiveSheet-1, FirstRow-1, LastRow-1, DestRow-1, aCount, OnlyFormulas)
end;

procedure TXLSFile.InsertAndCopySheets(const CopyFrom, InsertBefore,
  SheetCount: byte);
begin
  FWorkbook.InsertSheets(CopyFrom-1, InsertBefore-1, SheetCount);
end;

procedure TXLSFile.OpenFile(const FileName: TFileName);
var
  WorkbookStr: widestring;
begin
  WorkbookStr:=WorkbookStrS;
  FTemplate:=nil;
  FreeAndNil(FTmpTemplate);

  if FAdapter.TemplateStore<>nil then
    FTemplate:=FAdapter.TemplateStore.Storages[FileName]
  else
  begin
    FTmpTemplate:=TXlsStorageList.Create;
    FTmpTemplate.LoadFrom(SearchPathStr(FileName));
    FTemplate:=FTmpTemplate;
  end;

  FWorkbook.LoadFromStream(FTemplate.Stream[WorkbookStr]);
  FActiveSheet:=FWorkbook.ActiveSheet+1;
end;


procedure TXLSFile.RefreshPivotTables;
begin
  //Nothing
end;



procedure TXLSFile.Save(const AutoClose: boolean; const FileName: string;
  const OnGetFileName: TOnGetFileNameEvent);
var
  aFileName: TFileName;
  OutputFileName: WideString;
  WorkbookStr: widestring;

  i:integer;
  DocOUT: IStorage;
  StreamOUT: IStream;
  DataStream: TOleStream;
begin
  WorkbookStr:=WorkbookStrS;
  aFileName:=Filename;
  if Assigned (OnGetFileName) then OnGetFileName(Self,0,aFilename);
  OutputFileName:= aFileName;

  if FileExists(FileName) then raise Exception.CreateFmt(ErrCantWriteToFile, [FileName]);  //this is to avoid a criptic ole xxxx error...

  //Create output file
  OleCheck(StgCreateDocFile(PWideChar(OutputFileName), OptionsWrite, 0, DocOUT));
  for i:=0 to FTemplate.Count-1 do
    if FTemplate[i].Name<>WorkbookStr then
    begin
      FTemplate[i].SaveToDoc(DocOUT);
    end;

  OleCheck(DocOUT.CreateStream(PWideChar(WorkbookStr), OptionsWrite, 0, 0, StreamOUT));
  DataStream:=TOleStream.Create(StreamOUT);
  try
    FWorkbook.SaveToStream(DataStream);
  finally
    FreeAndNil(DataStream);
  end; //Finally
end;

procedure TXLSFile.SelectSheet(const SheetNo:integer);
begin
  FWorkbook.ActiveSheet:=SheetNo-1;
end;

procedure TXLSFile.SetActiveSheet(const Value: byte);
begin
  FActiveSheet:=Value;
end;

procedure TXLSFile.SetActiveSheetName(const Value: WideString);
begin
  FWorkbook.Globals.SheetName[FActiveSheet-1]:= Value;
end;

procedure TXLSFile.SetBounds(const aRangePos: integer);
begin
  FirstColumn:=FWorkbook.Globals.Names[aRangePos-1].C1;
  LastColumn:=FWorkbook.Globals.Names[aRangePos-1].C2;
end;

function TXLSFile.SheetCount: byte;
begin
  Result:=FWorkbook.Globals.SheetCount;
end;

procedure TXLSFile.AssignBlockData(const Row, Col: integer; const v: variant);
begin
  AssignCellData(Row, Col, v);
end;

procedure TXLSFile.PasteBlockData;
begin
  // Nothing
end;

procedure TXLSFile.PrepareBlockData(const R1, C1, R2, C2: integer);
begin
  // Nothing
end;

function TXLSFile.MaxRow: integer;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=0;exit;end;
  Result:= FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Count;
end;

function TXLSFile.GetCellValue(aRow, aCol: integer): Variant;
begin
  Result:= GetCellData(aRow, aCol-FirstColumn-1);
end;

procedure TXLSFile.SetCellValue(aRow, aCol: integer; const Value: Variant);
begin
  AssignCellData(aRow, aCol-FirstColumn-1, Value);
end;

function TXLSFile.IsEmptyRow(const aRow: integer): boolean;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=true;exit;end;
  Result:=
    (aRow-1<0) or (aRow-1>= MaxRow) or
    not FWorkbook.WorkSheets[FActiveSheet-1].Cells.RowList.HasRow(aRow-1);
end;


function TXLSFile.CanOptimizeRead: boolean;
begin
  Result:=true;
end;

end.