{ Spreadsheet interface unit for basic communication with Excel or
  OpenOffice.org Calc.

(C) 2009-2010 Jan Holst Jensen, jan@biochemfusion.com.

This pascal source code unit (SpreadsheetIntf.pas) is released under a BSD-style
license:

* Copyright (C) 2009, Biochemfusion (http://www.biochemfusion.com)
* All rights reserved.
*
* Redistribution and use for any purpose in source and binary forms, with or
* without modification, are permitted, subject to the following restrictions:
*
* 1. The origin of this software must not be misrepresented; you must not
*    claim that you wrote the original software. If you use this software
*    in a product, an acknowledgment in the product documentation would be
*    appreciated but is not required.
* 2. Altered source versions must be plainly marked as such, and must not be
*    misrepresented as being the original software.
* 3. This notice may not be removed or altered from any source distribution.
*
* THIS SOFTWARE IS PROVIDED BY Biochemfusion ``AS IS'' AND ANY
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL Biochemfusion BE LIABLE FOR ANY
* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

}

unit SpreadsheetIntf;

interface

type
  TSpreadsheet = class
  protected
    procedure CheckConnected;
    function  GetCell(ARow, ACol: Integer): Variant; virtual; abstract;
    procedure SetCell(ARow, ACol: Integer; const AValue: Variant); virtual; abstract;
    function  GetSheetName: String; virtual; abstract;
    procedure SetSheetName(const Value: String); virtual; abstract;
  public
    destructor Destroy; override;

    { Connect to an existing currently active sheet. }
    procedure Connect; virtual; abstract;
    { Create a new spreadsheet. }
    procedure ConnectToNew; virtual; abstract;
    { Load and connect to existing spreadsheet file. }
    procedure ConnectToExisting(const FileName: String); virtual; abstract;
    procedure Disconnect; virtual; abstract;

    function  IsConnected: Boolean; virtual; abstract;

    property SheetName: String read GetSheetName write SetSheetName;
    { Cell access is 1-based and with Row first to match Excel's VBA interface. }
    property Cells[ARow, ACol: Integer]: Variant read GetCell write SetCell;
  end;

  TSpreadsheetClass = class of TSpreadsheet;

  TOOoSpreadsheet = class(TSpreadsheet)
  protected
    ServiceManager: Variant;
    OODesktop: Variant;
    OOCalcDoc: Variant;
    ActiveSheet: Variant;
    function  GetCell(ARow, ACol: Integer): Variant; override;
    procedure SetCell(ARow, ACol: Integer; const AValue: Variant); override;
    function  GetSheetName: String; override;
    procedure SetSheetName(const Value: String); override;
  public
    procedure Connect; override;
    procedure ConnectToNew; override;
    procedure ConnectToExisting(const FileName: String); override;
    procedure Disconnect; override;

    function  IsConnected: Boolean; override;
  end;

  TExcelSpreadsheet = class(TSpreadSheet)
  protected
    Excel: Variant;
    function  GetCell(ARow, ACol: Integer): Variant; override;
    procedure SetCell(ARow, ACol: Integer; const AValue: Variant); override;
    function  GetSheetName: String; override;
    procedure SetSheetName(const Value: String); override;
  public
    procedure Connect; override;
    procedure ConnectToNew; override;
    procedure ConnectToExisting(const FileName: String); override;
    procedure Disconnect; override;

    function  IsConnected: Boolean; override;
  end;

implementation

uses
  SysUtils, Variants, ComObj;

{ TSpreadsheet }

destructor TSpreadsheet.Destroy;
begin
  Disconnect;
  inherited;
end;

procedure TSpreadsheet.CheckConnected;
begin
  if not IsConnected then
    raise Exception.Create('Not connected to a spreadsheet.');
end;

{ TOOoSpreadsheet }

procedure TOOoSpreadsheet.Connect;
var
  Dummy: Variant;
begin
  if IsConnected then
    Exit;

  ServiceManager := CreateOleObject('com.sun.star.ServiceManager');
  try
    OODesktop := ServiceManager.CreateInstance('com.sun.star.frame.Desktop');
    OOCalcDoc := OODesktop.CurrentComponent;
    if VarIsClear(OOCalcDoc) then
      raise Exception.Create('No OpenOffice documents open.');
  except
    Disconnect;
    raise;
  end;

  try
    { Don't know any other way of checking for the type of current document:
      See if it supports the .Sheets method. }
    Dummy := OOCalcDoc.Sheets;
  except
    on E: EOleError do begin
      Disconnect;
      raise Exception.Create('The current OpenOffice document is not a Spreadsheet.');
    end
    else
      raise;
  end;

  Dummy       := OOCalcDoc.GetCurrentController;
  ActiveSheet := Dummy.GetActiveSheet;
end;

procedure TOOoSpreadsheet.ConnectToExisting(const FileName: String);

  // From http://www.oooforum.org/forum/viewtopic.phtml?t=8878
  function FileName2URL(FileName: string): string;
  begin
    result:= '';
    if LowerCase(copy(FileName,1,8))<>'file:///' then
      result:= 'file:///';
    result:= result + StringReplace(FileName, '\', '/', [rfReplaceAll, rfIgnoreCase]);
  end;

  function ooCreateValue(ooName: string; ooData: variant): variant;
  var
    ooReflection: variant;
  begin
    ooReflection := ServiceManager.createInstance('com.sun.star.reflection.CoreReflection');
    ooReflection.forName('com.sun.star.beans.PropertyValue').createObject(result);
    result.Name := ooName;
    result.Value:= ooData;
  end;

var
  ooParams: Variant;
  Dummy: Variant;
begin
  ServiceManager := CreateOleObject('com.sun.star.ServiceManager');
  OODesktop := ServiceManager.CreateInstance('com.sun.star.frame.Desktop');

  ooParams    := VarArrayCreate([0, 0], varVariant);
  ooParams[0] := ooCreateValue('Hidden', false);
  OOCalcDoc   := OODesktop.LoadComponentFromURL(FileName2URL(FileName), '_blank', 0, ooParams);

  Dummy       := OOCalcDoc.GetCurrentController;
  ActiveSheet := Dummy.GetActiveSheet;
end;

procedure TOOoSpreadsheet.ConnectToNew;
var
  Dummy: Variant;
  ooParams: Variant;
begin
  if IsConnected then
    Exit;

  ooParams := VarArrayCreate([0, -1], varVariant);
  { Check http://www.oooforum.org/forum/viewtopic.phtml?p=40621#40621 to learn
    how to fill out ooParams. }
  ServiceManager := CreateOleObject('com.sun.star.ServiceManager');
  try
    OODesktop := ServiceManager.CreateInstance('com.sun.star.frame.Desktop');
    OOCalcDoc := OODesktop.LoadComponentFromURL(
      'private:factory/scalc', '_blank', 0, ooParams
    );
    if VarIsClear(OOCalcDoc) then
      raise Exception.Create('Couldn''t create a new OpenOffice Calc document.');
  except
    Disconnect;
    raise;
  end;

  Dummy       := OOCalcDoc.GetCurrentController;
  ActiveSheet := Dummy.GetActiveSheet;
end;

procedure TOOoSpreadsheet.Disconnect;
begin
  ActiveSheet    := UnAssigned;
  OOCalcDoc      := Unassigned;
  OODesktop      := UnAssigned;
  ServiceManager := UnAssigned;
end;

function TOOoSpreadsheet.IsConnected: Boolean;
begin
  Result := not VarIsClear(ServiceManager);
end;

function TOOoSpreadsheet.GetSheetName: String;
begin
  Result := ActiveSheet.getName;
end;

procedure TOOoSpreadsheet.SetSheetName(const Value: String);
var
  Sheets: Variant;
  OtherSheet: Variant;
  Controller: Variant;
begin
  if Value = GetSheetName then
    Exit;

  { Adapted from http://wiki.services.openoffice.org/wiki/Calc/API/Sheet_Operations#Retrieve_or_change_the_currently_focused_Sheet }
  Sheets   := OOCalcDoc.getSheets;
  OtherSheet := Sheets.getByName(Value);

  Controller := OOCalcDoc.getCurrentController;
  Controller.setActiveSheet(OtherSheet);

  ActiveSheet := OtherSheet;
end;

function TOOoSpreadsheet.GetCell(ARow, ACol: Integer): Variant;
begin
  CheckConnected;

  Result :=
    ActiveSheet.getCellByPosition(ACol - 1, ARow - 1).getFormula;
end;

procedure TOOoSpreadsheet.SetCell(ARow, ACol: Integer; const AValue: Variant);
begin
  CheckConnected;

  if AValue = Null then
    ActiveSheet.getCellByPosition(ACol - 1, ARow - 1).setFormula('')
  else
    ActiveSheet.getCellByPosition(ACol - 1, ARow - 1).setFormula(AValue);
end;

{ TExcelSpreadsheet }

procedure TExcelSpreadsheet.Connect;
var
  ActiveSheet: Variant;
begin
  if IsConnected then
    Exit;

  try
    Excel := GetActiveOleObject('Excel.Application');
  except
    on E: EOleSysError do
      raise Exception.Create('Excel is not running.');
  end;

  try
    ActiveSheet := Excel.ActiveSheet;
    if VarIsClear(ActiveSheet) then
      raise Exception.Create('You have no open sheets in Excel.');
  except
    Disconnect;
    raise;
  end;
end;

procedure TExcelSpreadsheet.ConnectToExisting(const FileName: String);
begin
  Excel := CreateOleObject('Excel.Application');

  Excel.Visible := true;
  Excel.Workbooks.Open(FileName);
end;

procedure TExcelSpreadsheet.ConnectToNew;
begin
  Excel := CreateOleObject('Excel.Application');

  Excel.Visible := true;
  Excel.Workbooks.Add;
end;

procedure TExcelSpreadsheet.Disconnect;
begin
  Excel := Unassigned;
end;

function TExcelSpreadsheet.IsConnected: Boolean;
begin
  Result := not VarIsClear(Excel);
end;

function TExcelSpreadsheet.GetSheetName: String;
var
  ActiveSheet: Variant;
begin
  ActiveSheet := Excel.ActiveSheet;
  Result := ActiveSheet.Name;
end;

procedure TExcelSpreadsheet.SetSheetName(const Value: String);
var
  NewSheet: Variant;
begin
  NewSheet := Excel.Sheets[Value];
  NewSheet.Select;
end;

function TExcelSpreadsheet.GetCell(ARow, ACol: Integer): Variant;
var
  TheCell: Variant;
begin
  CheckConnected;

  TheCell := Excel.Cells[ARow, ACol];
  Result  := TheCell.Value;
end;

procedure TExcelSpreadsheet.SetCell(ARow, ACol: Integer; const AValue: Variant);
var
  TheCell: Variant;
begin
  CheckConnected;

  TheCell := Excel.Cells[ARow, ACol];
  TheCell.Value := AValue;
end;

end.