Ver Mensaje Individual
  #1  
Antiguo 31-07-2007
emilioeduardob emilioeduardob is offline
Registrado
 
Registrado: jul 2007
Posts: 4
Reputación: 0
emilioeduardob Va por buen camino
OpenOffice Calc desde Delphi

aquí les pongo un intento de objeto para manejar abrir y modificar planillas en OpenOffice desde Delphi.
Cualquier consulta o sugerencia estoy a las ordenes.

Código Delphi [-]
unit OOApi;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, COMObj, StrUtils, variants, DB;

const
  OOo_LongDate = 36;

type



  TCell = class(TObject)
  private
    obj:     variant;
    Celda:   variant;
    FSelSht: integer;
    FSelCol: integer;
    FSelRow: integer;
    function GetValue: variant;
    procedure SetValue(const Valor: variant);
    procedure SetSelSht(const Value: integer);
    procedure SetCell(Row, Col: integer);
    function GetAsString: string;
  public
    property Value: variant Read GetValue Write SetValue;
    property AsString: string Read GetAsString;
  end;

  TWorksheet = class(TCollectionItem)
  private
    FCel:    TCell;
    FName:   string;
    FSelSht: integer;
    procedure SetName(const Value: string);
    procedure SetSelSht(const Value: integer);
    property SelSht: integer Read FSelSht Write SetSelSht;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
    property Name: string Read FName Write SetName;
    function Cells(Row, Col: integer): TCell;
    procedure InsertRows(Idx: integer; Count: integer);
    procedure Activate;
    procedure SetColumnFormat(ColN: integer; Format: integer);
  end;

  TWorksheets = class(TCollection)
  private
    Selsht: integer; //Hoja en el cache
    function GetWorksheet(Index: integer): TWorksheet;
  public
    constructor Create(ItemClass: TCollectionItemClass);
    function Add: TWorksheet; overload;
    function Add(Name: string): TWorksheet; overload;
    property Items[Index: integer]: TWorksheet Read GetWorksheet; default;
  end;

  TWorkbook = class(TObject)
  private
    HuboError: boolean;
    mvarWorksheets: TWorksheets;
    FOpened: boolean;
    procedure Cargar(Obj: variant);
    function ooCreateValue(ooName: string; ooData: variant): variant;
  public
    constructor Create();
    destructor Destroy(); override;
    function New: boolean;
    procedure Close;
    function Open(path: string; Pass: string = ''): boolean;
    property Worksheets: TWorksheets Read mvarWorksheets;
    property Opened: boolean Read FOpened;
    procedure LoadTitlesFromDataset(Dataset: TDataset; FilaDest: integer = 1;
      ColDest: integer = 1);
    procedure LoadFromDataset(Dataset: TDataset; FilaDest: integer = 1;
      ColDest: integer = 1);
  end;


procedure Register;

implementation

uses
  Activex;

var
  objDocument, objDesktop, objCoreReflection, objServiceManager: variant;

procedure Register;
begin
end;

{
********************************** TWorksheet **********************************
}
procedure TWorksheet.Activate;
begin
end;

  {
********************************** TWorkbook ***********************************
}
function TWorkbook.ooCreateValue(ooName: string; ooData: variant): variant;
begin
  objCoreReflection.forName('com.sun.star.beans.PropertyValue').createObject(Result);
  Result.Name  := ooName;
  Result.Value := ooData;
end;

procedure TWorkbook.Cargar(Obj: variant);
var
  lugar:  integer;
  objTmp: variant;
  oSheet: TWorkSheet;
begin

  for Lugar := 0 to obj.sheets.getcount - 1 do
  begin

    oSheet      := mvarWorksheets.Add;
    objTmp      := obj.sheets.getbyindex(Lugar);
    oSheet.Name := objTmp.Name;

  end;

end;

//Cerrar la planilla actual si es que está abierta
procedure TWorkbook.Close;
begin

  try
    if FOpened then
    begin
      FOpened := False;
      objDocument.Close(True);
    end;
  except
    //ERROR ES NORMAL ACÁ
    //objDocument.dispose
  end;

end;

//Constructor de la Clase WorkBook
constructor TWorkbook.Create;
const
  CLSID_OpenOffice: TGUID = '{82154420-0FBD-11D4-8313-005004526AB4}';
var
  hr:      HRESULT;
  classID: TCLSID;
  id:      IDispatch;
begin
  //Establecer como Objeto Cerrado
  FOpened := False;
  //Crear Memoria
  mvarWorksheets := TWorksheets.Create(TWorksheet);
  try
    //'If there is no office running then an office is started up

    //  ClassID := ProgIDToClassID(ClassName);
    //  OleCheck(CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
    //    CLSCTX_LOCAL_SERVER, IDispatch, Result));

    ClassID := ProgIDToClassID('com.sun.star.ServiceManager');
    hr      := CoCreateInstance(ClassID, nil, CLSCTX_LOCAL_SERVER, IDispatch, id);
    if Succeeded(hr) then
    begin
      objServiceManager := id;
      //      objServiceManager := CreateOleObject('com.sun.star.ServiceManager');
      //'Create the CoreReflection service that is later used to create structs
      objCoreReflection := objServiceManager.createInstance(
        'com.sun.star.reflection.CoreReflection');
      //'Create the Desktop
      objDesktop := objServiceManager.createInstance('com.sun.star.frame.Desktop');
    end;
  except
    on e: EOleSysError do
    begin
      ShowMessage('Usted no tiene una versión de StarOffice u OpenOffice' +
        #13 + 'compatible con este sistema.' + #13 + e.Message);
      HuboError := True;
    end;
  end;

end;

//Destroy: Destructor de la Clase WorkBook
destructor TWorkbook.Destroy;
begin
  //Cerrar la planilla
  //Deshabilitado por mejor opcion  Close;
  //Liberar Memoria
  FreeAndNil(mvarWorksheets);
  //Establecer variables estaticas como No asignadas
  objServiceManager := Unassigned;
  objCoreReflection := Unassigned;
  inherited;
end;


procedure TWorkbook.LoadFromDataset(Dataset: TDataset; FilaDest, ColDest: integer);
var
  i: integer;
  Columna: TField;
  fecha: Tdate;
begin
  Dataset.First;
  while not Dataset.EOF do
  begin

    //tira los datos
    for i := 1 to Dataset.Fields.Count do
    begin
      Columna := Dataset.Fields[i - 1];
      Application.ProcessMessages;

      //si es un numero sacar simbolos raros
      if Columna.DataType = ftCurrency  then
      begin

        try
          Worksheets[0].Cells(FilaDest, i).Value := TCurrencyField(Columna).value;
        except
          Worksheets[0].Cells(FilaDest, i).Value := 'error';
        end;

      end
      else if Columna.DataType = ftDate  then
      begin
        if trim(Columna.AsString) <> '' then
        begin
          fecha := strtodate(Columna.AsString);
          Worksheets[0].Cells(FilaDest, i).Value := fecha;
        end;
      end
      else
        Worksheets[0].Cells(FilaDest, i).Value :=
          Columna.AsString;

    end;
    inc(FilaDest);
    Dataset.Next;
  end; //for each linea

end;

procedure TWorkbook.LoadTitlesFromDataset(Dataset: TDataset;
  FilaDest, ColDest: integer);
var
  i: integer;
begin
  //CREAR LAS COLUMNAS titulos
  for i := 1 to Dataset.fields.Count do
    Worksheets[0].Cells(FilaDest, ColDest+i-1).Value := Dataset.Fields[i - 1].DisplayLabel;

end;

 //New: Crea un nuevo Libro
 //Resultado:
 //Devuelve FALSO si no se pudo crear, sino devuelve VERDADERO
function TWorkbook.New: boolean;
begin
  //Si no hubo error
  if not HuboError then
  begin
    objDocument := objDesktop.loadComponentFromURL('private:factory/scalc',
      '_blank', 0, VarArrayCreate([0, -1], varVariant));
    Cargar(objDocument);
    //Establecer como abierto
    FOpened := True;
  end;

  Result := not HuboError;
end;

 //Open: Abre un libro ya existente
 //Parametros:
 //  Path: Cadena que tiene la ruta absoluta al archivo
 //Resultado:
 //Devuelve FALSO si no se logra abrir
function TWorkbook.Open(path: string; pass: string): boolean;
var
  prop: variant;
begin
  // Si no hubo error
  if not HuboError then
  begin
    //Formatear la cadena con la ruta para formato OpenOffice
    path := AnsiReplaceStr(path, ':', '|');
    path := AnsiReplaceStr(path, '\', '/');
    //Abrir el documento

    try
      if pass = '' then
        objDocument := objDesktop.loadComponentFromURL('file:///' +
          path, '_blank', 0, VarArrayCreate([0, -1], varVariant))
      else
      begin
        prop    := VarArrayCreate([0, 0], varVariant);
        prop[0] := ooCreateValue('Password', Pass);
        objDocument := objDesktop.loadComponentFromURL('file:///' +
          path, '_blank', 0, prop);
      end;
      //Leer la información de las hojas de esa planilla
      Cargar(objDocument);
      //Setear como ya abierto
      FOpened := True;
    except
      if Pass = '' then
        MessageDlg('No se pudo abrir el archivo, verifique si tiene contraseña.',
          mtWarning, [mbOK], 0)
      else
        MessageDlg(
          'Error al abrir la planilla. Puede que este dañada o hay un problema con OpenOffice',
          mtError, [mbOK], 0);
    end;

  end;

  //Resultado
  Result := not HuboError;

end;


 { TCell }
 //GetValue: Devuelve el valor de la celda actual
function TCell.GetAsString: string;
var
  valor: string;
begin
  celda := obj.getCellByPosition(FSelCol - 1, FSelRow - 1);
  if (celda.geterror = 0) then
    Valor := celda.getstring;
  Result := Valor;

end;

function TCell.GetValue: variant;
var
  valor: variant;
begin
  celda := obj.getCellByPosition(FSelCol - 1, FSelRow - 1);
  if (celda.geterror = 0) then
  begin
    Valor := celda.getformula;

    if AnsiMidStr(Valor, 1, 1) = '=' then
      Valor := celda.getvalue;

    //Si tiene un ' delante le saca ese valor antes de devolver el resultado
    if AnsiMidStr(Valor, 1, 1) = #39 then
      Valor := AnsiMidStr(Valor, 2, Length(Valor) - 1);

  end
  else
    Valor := celda.getValue;

  Valor  := AnsiReplaceStr(Valor, #160, #32); //Convirte caracter raro
  Result := Valor;

end;

procedure TCell.SetCell(Row, Col: integer);
begin
  FSelRow := Row;
  FSelCol := Col;
  celda   := obj.getCellByPosition(Col - 1, Row - 1);
end;

procedure TCell.SetSelSht(const Value: integer);
begin
  FSelSht := Value;
  obj     := objDocument.sheets.getbyindex(FSelSht);
end;

procedure TCell.SetValue(const Valor: variant);
begin
  if VarIsNumeric(Valor) then
  begin
    celda.SetValue(valor);
  end
  else
  begin

    if VarIsNull(Valor) then
    begin
      celda.setValue('');
    end
    else
    begin
      celda.SetFormula(Valor);
    end;
  end;

end;

function TWorksheet.Cells(Row, Col: integer): TCell;
begin
  FCel.SetCell(Row, Col);
  Result := FCel;
end;



{ TWorksheets }

function TWorksheets.Add: TWorksheet;
var
  Nuevo: TWorksheet;
begin
  Nuevo := TWorksheet(inherited Add);
  Nuevo.Create;
  Result := Nuevo;
end;


function TWorksheets.Add(Name: string): TWorksheet;
var
  Nuevo:  TWorksheet;
  NewIdx: integer;
begin
  Nuevo := TWorksheet(inherited Add);
  NewIdx := objDocument.Sheets.getcount;
  objDocument.Sheets.insertNewByName(Name, NewIdx);
  Nuevo.Name := Name;
  Nuevo.SelSht := NewIdx;
  Result := Nuevo;
end;

constructor TWorksheets.Create(ItemClass: TCollectionItemClass);
begin
  SelSht := -1;
  inherited Create(ItemClass);
end;

function TWorksheets.GetWorksheet(Index: integer): TWorksheet;
begin
  Result := TWorksheet(inherited Items[Index]);

  //Si es que no esta en el cache
  if SelSht <> Index then
    Result.SelSht := Index;

  //Establecer Cache
  SelSht := Index;

end;

constructor TWorksheet.Create;
begin
  FCel := TCell.Create;
  Fcel.FSelCol := 1;
  FCel.FSelRow := 1;
end;

destructor TWorksheet.Destroy;
begin
  FreeAndNil(FCel);
  inherited;
end;

procedure TWorksheet.InsertRows(Idx, Count: integer);
var
  Hoja: variant;
begin
  Hoja := objDocument.sheets.getByIndex(Self.SelSht);
  Hoja.GetRows.insertByIndex(Idx, Count);
end;

procedure TWorksheet.SetColumnFormat(ColN, Format: integer);
var
  oCols: variant;
begin
  oCols := FCel.obj.GetColumns;
  oCols.getByIndex(ColN).NumberFormat := Format;
end;

procedure TWorksheet.SetName(const Value: string);
var
  Hoja: variant;
begin
  Hoja      := objDocument.sheets.getByIndex(Self.SelSht);
  Hoja.Name := Value;
  FName     := Value;
end;

procedure TWorksheet.SetSelSht(const Value: integer);
begin
  FSelSht := Value;
  FCel.SetSelSht(Value);
end;



end.
Responder Con Cita