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

Pascal/Delphi Source File | 2002-07-02 | 20KB | 620 lines

unit OLEAdapter;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, UFlxMessages,
  {$IFDEF Excel97} Excel97,{$ELSE} Excel2000,{$ENDIF}
  {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
  UExcelAdapter, OleServer, UFlxRowComments;

type
  //We need 2 sets, It's too big for one
  TExcelSaveFormatBasic= (
    saCSV, saCSVMSDOS, saCSVWindows, saCSVMac,
    saDBF4, saDIF,
    saCurrentPlatformText, saTextMSDOS, saTextWindows, saTextMac,
    saExcel5, saExcel7, saExcel9795,
    saWorkbookNormal, saSYLK, saTemplate
    {$IFNDEF Excel97}
      , saUnicodeText, saHtml
    {$ENDIF}
    );

  TExcelSaveFormatExtended= (
    saExcel2, saExcel2FarEast, saExcel3, saExcel4,
    saDBF2, saDBF3,
    saExcel4Workbook, saIntlAddIn, saIntlMacro, saTextPrinter,
    saWJ2WD1, saWK1, saWK1ALL, saWK1FMT, saWK3, saWK4, saWK3FM3, saWKS, saWorks2FarEast,
    saWQ1, saWJ3, saWJ3FJ3);

  TSetOfExcelSaveFormatBasic = Set Of TExcelSaveFormatBasic;
  TSetOfExcelSaveFormatExtended = Set Of TExcelSaveFormatExtended;

type
  TOLEAdapter = class(TExcelAdapter)
  private
    FDisplayAlerts: boolean;
    FBlockSize: integer;
    FSaveFormatBasic: TSetOfExcelSaveFormatBasic;
    FSaveFormatExtended: TSetOfExcelSaveFormatExtended;
    { Private declarations }
  protected
    { Protected declarations }
  public
    constructor Create(AOwner:TComponent);override;
    function GetWorkbook: TExcelFile;override;
    { Public declarations }
  published
    property BlockSize: integer read FBlockSize write FBlockSize default 100;
    property DisplayAlerts: boolean read FDisplayAlerts write FDisplayAlerts default true;
    property SaveFormatBasic: TSetOfExcelSaveFormatBasic read FSaveFormatBasic write FSaveFormatBasic default [saExcel9795];
    property SaveFormatExtended: TSetOfExcelSaveFormatExtended read FSaveFormatExtended write FSaveFormatExtended;
    { Published declarations }
  end;

  TOLEFile = class(TExcelFile)
  private
    FExcelApplication : TExcelApplication;
    FExcelWorkbook : TExcelWorkbook;
    FExcelWorksheet : TExcelWorksheet;

    FAdapter: TOleAdapter;
    FLCID: integer;

    RowComments: TRowComments;

    FActiveSheet: integer;

    FirstColumn, LastColumn: integer;
    WorkRange: Range;
    OldCellData, NewCellData, BlockData: Variant;
    NewDataOffset, OldDataOffset: integer;

    procedure ParseComments;
  protected
    function GetActiveSheet: byte; override;
    procedure SetActiveSheet(const Value: byte); override;
    function GetActiveSheetName: WideString; override;
    procedure SetActiveSheetName(const Value: WideString); override;
  public
    property ExcelApplication : TExcelApplication read FExcelApplication;
    property ExcelWorkbook : TExcelWorkbook read FExcelWorkbook;
    property ExcelWorksheet : TExcelWorksheet read FExcelWorksheet;
    property LCID:integer read FLCID;

    constructor Create(const aAdapter: TOleAdapter );
    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 IOLEAdapter}
const
  SaveFormatBasicConvert: Array[TExcelSaveFormatBasic] of integer= (
    xlCSV, xlCSVMSDOS, xlCSVWindows, xlCSVMac,
    xlDBF4, xlDIF,
    integer(xlCurrentPlatformText), xlTextMSDOS, xlTextWindows, xlTextMac,
    xlExcel5, xlExcel7, xlExcel9795,
    integer(xlWorkbookNormal), xlSYLK, xlTemplate
    {$IFNDEF Excel97}
      , xlUnicodeText, xlHtml
    {$ENDIF}
    );

  SaveFormatExtendedConvert: Array[TExcelSaveFormatExtended] of integer= (
    xlExcel2, xlExcel2FarEast, xlExcel3, xlExcel4,
    xlDBF2, xlDBF3,
    xlExcel4Workbook, xlIntlAddIn, xlIntlMacro, xlTextPrinter,
    xlWJ2WD1, xlWK1, xlWK1ALL, xlWK1FMT, xlWK3, xlWK4, xlWK3FM3, xlWKS, xlWorks2FarEast,
    xlWQ1, xlWJ3, xlWJ3FJ3);

procedure Register;
begin
  RegisterComponents('FlexCel', [TOLEAdapter]);
end;

{ TOLEAdapter }

constructor TOLEAdapter.Create(AOwner: TComponent);
begin
  inherited;
  FDisplayAlerts:=true;
  FSaveFormatBasic:=[saExcel9795];
  FSaveFormatExtended:=[];
  FBlockSize:=100;
end;

function TOLEAdapter.GetWorkbook: TExcelFile;
begin
  Result:= TOLEFile.Create(Self);
end;

{ TOLEFile }

constructor TOLEFile.Create(const aAdapter: TOleAdapter);
begin
  inherited Create;
  FExcelApplication := TExcelApplication.Create(nil);
  FExcelWorkbook := TExcelWorkbook.Create(nil);
  FExcelWorksheet := TExcelWorksheet.Create(nil);

  FAdapter:= aAdapter;

  FLCID :=   LOCALE_USER_DEFAULT;
end;

destructor TOLEFile.Destroy;
begin
  FreeAndNil(RowComments);
  FreeAndNil(FExcelApplication);
  FreeAndNil(FExcelWorkbook);
  FreeAndNil(FExcelWorksheet);
  inherited;
end;

procedure TOLEFile.Connect;
begin
  // Try to connect to Excel and create new Worksheet
  FExcelApplication.ConnectKind := ckRunningOrNew;
  FExcelApplication.Connect;

  FExcelApplication.DisplayAlerts[FLCID] := FAdapter.DisplayAlerts;
  FExcelApplication.Visible[FLCID]:=false;
  FExcelApplication.ScreenUpdating[FLCID] := false;

end;

procedure TOLEFile.Disconnect;
begin
  FExcelApplication.ScreenUpdating[FLCID] := true;
  FExcelApplication.Visible[FLCID]:=true;

  FExcelWorksheet.Disconnect;
  FExcelWorkbook.Disconnect;
  FExcelApplication.Disconnect;
end;

procedure TOLEFile.CloseFile;
begin
  FExcelWorkbook.Close(False);
end;

procedure TOLEFile.OpenFile(const FileName: TFileName);
begin
  FExcelWorkbook.ConnectTo(FExcelApplication.Workbooks.Add(SearchPathStr(FileName), FLCID));
end;

procedure TOLEFile.InsertAndCopySheets(const CopyFrom, InsertBefore,
  SheetCount: byte);
var
  Ws: _Worksheet;
  WsDest: _Worksheet;
  i: integer;
begin
  Ws:=(FExcelWorkbook.Worksheets[CopyFrom] as _Worksheet);
  if InsertBefore< FExcelWorkbook.Worksheets.Count then
  begin
    WsDest:=(FExcelWorkbook.Worksheets[InsertBefore] as _Worksheet);
    for i:=0 to SheetCount-1 do Ws.Copy(WsDest, EmptyParam,FLCID);
  end else
  begin
    WsDest:=(FExcelWorkbook.Worksheets[InsertBefore-1] as _Worksheet);
    for i:=0 to SheetCount-1 do Ws.Copy(EmptyParam,WsDest,FLCID);
  end;
end;

function TOLEFile.SheetCount: byte;
begin
  Result:=FExcelWorkbook.Worksheets.Count;
end;

procedure TOLEFile.DeleteMarkedRows(const Mark: widestring);
var
  r: OleVariant;
  Empty: boolean;
begin
  repeat
    r := FExcelWorksheet.UsedRange[FLCID].Resize[EmptyParam,1];
   // We dont use early binding in 'Find' method because incompatibilities between d5 & d6 & excel97 & excel2000...
    r :=r.Find(Mark, EmptyParam, integer(xlValues), xlWhole, EmptyParam, xlNext, true, EmptyParam);
    // This is VarIsEmpty... If it just worked in D6...
    Empty:= ((TVarData(r).VType = varDispatch) or (TVarData(r).VType = varUnknown)) and (TVarData(r).VDispatch = nil);
    if not Empty then r.EntireRow.Delete(Integer(xlShiftUp));
  until Empty;
end;

procedure TOLEFile.RefreshPivotTables;
var
  k, l, m: integer;
  Pvts, Pvt, PvtField, PvtItem: OleVariant;
begin
  Pvts:=FExcelWorksheet.PivotTables;
  for k:=1 to Pvts.Count do
  begin
    Pvt:= FExcelWorksheet.PivotTables(k, FLCID);
    FExcelApplication.DisplayAlerts[FLCID]:=False; //Here there is a warning we dont want...
    try
      Pvt.PivotCache.Refresh;
    except
      //Nothing, probably there are no rows
    end; //Except
    FExcelApplication.DisplayAlerts[FLCID]:=FAdapter.DisplayAlerts;

    for l:=1 to Pvt.PivotFields.Count do
      begin
        PvtField:= Pvt.PivotFields(l);
        for m:=PvtField.PivotItems.Count downto 1 do
        begin
          try
            PvtItem:=PvtField.PivotItems(m);
            if (PvtItem.RecordCount = 0) and not (PvtItem.IsCalculated) then PvtItem.Delete;
          except
            //Nothing
          end; //except
        end;
      end;
  end;
end;

function TOLEFile.GetActiveSheetName: WideString;
begin
  Result:= FExcelWorksheet.Name;
end;

procedure TOLEFile.SetActiveSheetName(const Value: WideString);
begin
  FExcelWorksheet.Name:= Value;
end;

function TOLEFile.GetActiveSheet: byte;
begin
  if FActiveSheet=0 then FActiveSheet:=(FExcelWorkbook.ActiveSheet as _WorkSheet).Index[FLCID]; //First time
  Result:=FActiveSheet;
end;

procedure TOLEFile.SetActiveSheet(const Value: byte);
begin
  FExcelWorksheet.ConnectTo(FExcelWorkbook.Worksheets[Value] as _Worksheet);
  FActiveSheet:=Value;
end;

procedure TOLEFile.SelectSheet(const SheetNo:integer);
begin
  (FExcelWorkbook.Worksheets.Item [SheetNo] as _Worksheet).Activate(FLCID);
  ActiveSheet:= SheetNo;
end;

procedure TOLEFile.Save(const AutoClose: boolean; const FileName: string; const OnGetFileName: TOnGetFileNameEvent);
var
  SaveFB: TExcelSaveFormatBasic;
  SaveFE: TExcelSaveFormatExtended;
  aFileName: TFileName;
begin
  if (AutoClose) then
  begin
    for SaveFB:= Low(TExcelSaveFormatBasic) to High(TExcelSaveFormatBasic) do
      if SaveFB in FAdapter.SaveFormatBasic then
      begin
        aFileName:=Filename;
        if Assigned (OnGetFileName) then OnGetFileName(Self,SaveFormatBasicConvert[SaveFB],aFilename);
        FExcelWorkbook.SaveAs(aFileName,SaveFormatBasicConvert[SaveFB],EmptyParam,EmptyParam,EmptyParam,EmptyParam,xlExclusive,EmptyParam,EmptyParam,EmptyParam,EmptyParam,FLCID);
      end;
    for SaveFE:= Low(TExcelSaveFormatExtended) to High(TExcelSaveFormatExtended) do
      if SaveFE in FAdapter.SaveFormatExtended then
      begin
        aFileName:=Filename;
        if Assigned (OnGetFileName) then OnGetFileName(Self,SaveFormatExtendedConvert[SaveFE],aFilename);
        FExcelWorkbook.SaveAs(aFileName, SaveFormatExtendedConvert[SaveFE], EmptyParam, EmptyParam, EmptyParam, EmptyParam, xlExclusive, EmptyParam, EmptyParam, EmptyParam, EmptyParam, FLCID);
      end;
  end

end;

procedure TOLEFile.DeleteRows(const aRow, aCount: word);
var
  NewRange: Range;
begin
  NewRange:=FExcelWorksheet.Range['A'+IntToStr(aRow), 'A'+IntToStr(aRow+aCount-1)].EntireRow;
  NewRange.Delete(Integer(xlShiftUp));
end;

procedure TOLEFile.InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const OnlyFormulas: boolean);
var
  OldRange, NewRange: Range;
begin
  NewRange:=FExcelWorksheet.Range['A'+IntToStr(DestRow), 'A'+IntToStr(DestRow+aCount*(LastRow-FirstRow+1)-1)].EntireRow;
  NewRange.Insert( integer(xlDown));
  NewRange := NewRange.Offset[-(aCount*(LastRow-FirstRow+1)),0];
  OldRange := FExcelWorksheet.Range['A'+IntToStr(FirstRow), 'A'+IntToStr(LastRow)].EntireRow; //We need the entire row to copy row height!
  OldRange.Copy (NewRange);
end;

procedure TOLEFile.AssignComment(const Row, aPos: integer;
  const Comment: Widestring);
begin
  if Comment='' then
  begin
    FExcelWorksheet.Comments[RowComments[Row][aPos]].Delete;
    RowComments.Delete(Row,aPos);
  end else
  FExcelWorksheet.Comments[RowComments[Row][aPos]].Text(Comment, EmptyParam, EmptyParam);
end;

procedure TOLEFile.AssignPicture(const Row, aPos: integer;
  const Pic: string; const PicType: TXlsImgTypes);
begin
  //Not implemented
end;

procedure TOLEFile.ParseComments;
var
  i:integer;
begin
  FreeAndNil(RowComments);
  RowComments:= TRowComments.Create;
  for i:=1 to FExcelWorksheet.Comments.Count do
    RowComments.Add(FExcelWorksheet.Comments[i].Shape.TopLeftCell.Row, i);
end;

procedure TOLEFile.BeginSheet;
begin
  //Parse comments into corresponding rows
  ParseComments;

  //Prepare Matrix to handle Data Transfer
  NewCellData:=VarArrayCreate([1,FAdapter.BlockSize,FirstColumn,LastColumn],varVariant);
  WorkRange:=FExcelWorksheet.Range[
    FExcelWorksheet.Cells.Item[1, FirstColumn],
    FExcelWorksheet.Cells.Item[1+FAdapter.BlockSize-1, LastColumn]
    ];
  OldCellData:=Unassigned;
  OldDataOffset:=-1;

end;

procedure TOLEFile.EndSheet(const RowOffset: integer);
var
  Size:integer;
begin
  try
    //Flush final data
    Size:=RowOffset-1-NewDataOffset;
    if Size<0 then exit;
    WorkRange:=FExcelWorksheet.Range[
      FExcelWorksheet.Cells.Item[1, FirstColumn],
      FExcelWorksheet.Cells.Item[1+Size, LastColumn]
      ];
    WorkRange.Offset[NewDataOffset,0].FormulaLocal:=NewCellData;
  finally
    WorkRange:=nil; //This is needed so we don't keep any reference to Excel.
  end; //finally
end;

function TOLEFile.GetCommentsCount(Row: integer): integer;
begin
  Result:=RowComments[Row].Count;
end;

function TOLEFile.GetCommentText(Row, aPos: integer): Widestring;
begin
  Result:=FExcelWorksheet.Comments[RowComments[Row][aPos]].Text(EmptyParam, EmptyParam, EmptyParam);
end;

function TOLEFile.GetExcelNameCount: integer;
begin
  Result:=FExcelWorkbook.Names.Count;
end;

function TOLEFile.GetPictureName(Row, aPos: integer): Widestring;
begin
   Result:=''; //Not implemented
end;

function TOLEFile.GetPicturesCount(Row: integer): integer;
begin
  Result:=0; //Not implemented
end;

function TOLEFile.GetRangeName(index: integer): Widestring;
begin
  Result:=FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).Name_;
end;

function TOLEFile.GetRangeR1(index: integer): integer;
begin
  Result:=FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).RefersToRange.Row;
end;

function TOLEFile.GetRangeR2(index: integer): integer;
begin
  Result:=GetRangeR1(Index)+FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).RefersToRange.Rows.Count-1;
end;

function TOLEFile.GetRangeC1(index: integer): integer;
begin
  Result:=FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).RefersToRange.Column;
end;

function TOLEFile.GetRangeC2(index: integer): integer;
begin
  Result:=GetRangeC1(Index)+FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).RefersToRange.Columns.Count-1;
end;

function TOLEFile.GetRangeSheet(index: integer): integer;
var
  w:OleVariant; //Cant get to use _Worksheet
begin
  try
    w:=FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).RefersToRange.Worksheet;
    result:=w.Index;
  except //Err in range
    result:=-1;
  end; //Except
end;

procedure TOLEFile.AssignCellData(const aRow, aColOffset: integer; const Value: variant);
var
  i,j:integer;
begin
  if aRow-NewDataOffset > FAdapter.BlockSize then
  begin
    //Flush Data
    WorkRange.Offset[NewDataOffset,0].FormulaLocal:=NewCellData;
    NewDataOffset:=aRow-1;
    for i:=VarArrayLowBound(NewCellData,1) to VarArrayHighBound(NewCellData,1) do
      for j:=VarArrayLowBound(NewCellData,2) to VarArrayHighBound(NewCellData,2) do
        NewCellData[i,j]:=unassigned;
  end;
  NewCellData[aRow-NewDataOffset,aColOffset+FirstColumn]:=Value;
end;

procedure TOLEFile.AssignCellDataX(const aRow, aColOffset: integer; const Value: TXlsCellValue);
begin
  AssignCellData(aRow, aColOffset, Value.Value);
end;

function TOLEFile.CellCount(const aRow: integer): integer;
begin
  Result:= LastColumn-FirstColumn+1;
end;

function TOLEFile.GetCellData(const aRow, aColOffset: integer): variant;
begin
  if (OldDataOffset<0)or (aRow-OldDataOffset>FAdapter.BlockSize) then
  begin
    OldDataOffset:=aRow-1;
    OldCellData:= WorkRange.Offset[OldDataOffset,0].FormulaLocal;
  end;
  GetCellData:=OldCellData[aRow-OldDataOffset,aColOffset+1];
end;

function TOLEFile.GetCellDataX(const aRow, aColOffset: integer): TXlsCellValue;
begin
  Result.Value:=GetCellData(aRow,aColOffset);
  Result.Xf:=-1; //Not implemented
  Result.IsFormula:=false; //not implemented
end;

procedure TOLEFile.SetBounds(const aRangePos: integer);
var
  CellRange: Range;
begin
  CellRange:=FExcelWorkbook.Names.Item(aRangePos, EmptyParam, EmptyParam).RefersToRange;
  FirstColumn:=CellRange.Column;
  LastColumn:=CellRange.Column+CellRange.Columns.Count-1;
  NewDataOffset:=CellRange.Row-1;
end;

procedure TOLEFile.AssignBlockData(const Row, Col: integer; const v: variant);
begin
  BlockData[Row,FirstColumn+Col]:=v;
end;

procedure TOLEFile.PasteBlockData;
var
  R1, R2, C1, C2: integer;
begin
  R1:=VarArrayLowBound(BlockData,1);
  R2:=VarArrayHighBound(BlockData,1);
  C1:=VarArrayLowBound(BlockData,2);
  C2:=VarArrayHighBound(BlockData,2);
  FExcelWorksheet.Range[
      FExcelWorksheet.Cells.Item[R1, C1],
      FExcelWorksheet.Cells.Item[R2, C2]
      ].FormulaLocal:=BlockData;
  BlockData:=unassigned;
end;

procedure TOLEFile.PrepareBlockData(const R1, C1, R2, C2: integer);
begin
  BlockData:= VarArrayCreate([R1,R2,FirstColumn+C1,FirstColumn+C2],varVariant);
end;

function TOLEFile.MaxRow: integer;
begin
  Result:= FExcelWorksheet.UsedRange[FLCID].Row-1 + FExcelWorksheet.UsedRange[FLCID].Rows.Count;
end;

function TOLEFile.GetCellValue(aRow, aCol: integer): Variant;
begin
  Result:=FExcelWorksheet.Cells.Item[aRow, aCol].Value;

end;

procedure TOLEFile.SetCellValue(aRow, aCol: integer; const Value: Variant);
begin
  FExcelWorksheet.Cells.Item[aRow, aCol]:= Value;
end;

function TOLEFile.IsEmptyRow(const aRow: integer): boolean;
begin
  Result:=(aRow<1) or (aRow>MaxRow);
end;

function TOLEFile.CanOptimizeRead: boolean;
begin
  Result:=false;
end;


end.