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; 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;
procedure TWorksheet.Activate;
begin
end;
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;
procedure TWorkbook.Close;
begin
try
if FOpened then
begin
FOpened := False;
objDocument.Close(True);
end;
except
end;
end;
constructor TWorkbook.Create;
const
CLSID_OpenOffice: TGUID = '{82154420-0FBD-11D4-8313-005004526AB4}';
var
hr: HRESULT;
classID: TCLSID;
id: IDispatch;
begin
FOpened := False;
mvarWorksheets := TWorksheets.Create(TWorksheet);
try
ClassID := ProgIDToClassID('com.sun.star.ServiceManager');
hr := CoCreateInstance(ClassID, nil, CLSCTX_LOCAL_SERVER, IDispatch, id);
if Succeeded(hr) then
begin
objServiceManager := id;
objCoreReflection := objServiceManager.createInstance(
'com.sun.star.reflection.CoreReflection');
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;
destructor TWorkbook.Destroy;
begin
FreeAndNil(mvarWorksheets);
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
for i := 1 to Dataset.Fields.Count do
begin
Columna := Dataset.Fields[i - 1];
Application.ProcessMessages;
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;
end;
procedure TWorkbook.LoadTitlesFromDataset(Dataset: TDataset;
FilaDest, ColDest: integer);
var
i: integer;
begin
for i := 1 to Dataset.fields.Count do
Worksheets[0].Cells(FilaDest, ColDest+i-1).Value := Dataset.Fields[i - 1].DisplayLabel;
end;
function TWorkbook.New: boolean;
begin
if not HuboError then
begin
objDocument := objDesktop.loadComponentFromURL('private:factory/scalc',
'_blank', 0, VarArrayCreate([0, -1], varVariant));
Cargar(objDocument);
FOpened := True;
end;
Result := not HuboError;
end;
function TWorkbook.Open(path: string; pass: string): boolean;
var
prop: variant;
begin
if not HuboError then
begin
path := AnsiReplaceStr(path, ':', '|');
path := AnsiReplaceStr(path, '\', '/');
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;
Cargar(objDocument);
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;
Result := not HuboError;
end;
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;
if AnsiMidStr(Valor, 1, 1) = #39 then
Valor := AnsiMidStr(Valor, 2, Length(Valor) - 1);
end
else
Valor := celda.getValue;
Valor := AnsiReplaceStr(Valor, #160, #32); 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;
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]);
if SelSht <> Index then
Result.SelSht := Index;
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.