Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 31-07-2007
emilioeduardob emilioeduardob is offline
Registrado
 
Registrado: jul 2007
Posts: 4
Poder: 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
  #2  
Antiguo 01-08-2007
Avatar de papulo
papulo papulo is offline
Miembro
 
Registrado: ago 2005
Ubicación: Lleida - Cataluña - España -Europa - Planeta tierra - Sistema solar - Via Lactea ...
Posts: 542
Poder: 19
papulo Va por buen camino
1000 gracias, era algo que esperaba con ganas desde hace tiempo. Lástima ahora no pueda ponerme con ello ya que ando con PHP y demás sufriendo, pero al menos está la posibilidad de usarlo mas adelante.
Responder Con Cita
  #3  
Antiguo 19-01-2012
Avatar de edgwin
edgwin edgwin is offline
Miembro
 
Registrado: abr 2006
Ubicación: Guadalajara Jal. Mex
Posts: 163
Poder: 18
edgwin Va por buen camino
Estimado Elimio.

Gracias por el aporte, pero tendras un ejemplo de utilizacion de la unidad?

saludos!
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 14:08:28.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi