Lazarus 控制OpenOffice 电子表格的类

qiaoqia6448

//这个类如果还需要增加功能，请参考OOoAPI接口说明。




unit UOffice;


{$mode objfpc}{$H+}


interface


uses
   Classes, SysUtils, Windows, Variants, ComObj, ActiveX, Controls,
  Graphics,ExtCtrls, ComCtrls, StdCtrls, db, Dialogs,forms;




  type


  TOOo=class(TObject)
  private
  //  fOpenOffice->fDesktop->fDocument->fSheets->fCells
    fOpenOffice : Variant;
    fDocument : Variant;
    fConnected : boolean;
    fDocumentOpened : boolean;
    fDesktop : Variant;


    function MakePropertyValue(PropName:string; PropValue:variant):variant;
  public
     IsNeedToANSI:boolean;
     Constructor Create;
     destructor Destroy; override;
     function Connect : boolean;
     procedure Disconnect;


     function OpenDocument(Filename:string):boolean;
     procedure SaveToPDF(FileName:string);
     procedure CloseDocument;
     function Create_NewCalcDoc:boolean;


     procedure output_ListView_to_Calc(ls:TListView);
     procedure output_DataSet_to_Calc(ls:TDataSet);
  end;
//这个类想按照原来的delphi代码写的，没有成功呢，正在努力。
  TMSoffice=class(TObject)
  private


  public
     procedure output_listView_to_Excel(ls:TListView);
  end;








implementation
{ TMSoffice }


procedure TMSoffice.output_listView_to_Excel(ls:TListView);
var
  ExcelApp,workbook,sheet: Variant;
  i,k:integer;
  FileName:string;
  DlgSave:TsaveDialog;
begin
  DlgSave:=TsaveDialog.Create(nil);
  DlgSave.Filter:='*.xls|*.xls';
  if DlgSave.Execute then
  Begin
         ExcelApp := CreateOleObject( 'Excel.Application' );
         excelapp.visible:=false;
         workbook:=excelapp.workbooks.add;
         workbook.active;
         sheet:=workbook.worksheets.add('mysheet');
         ExcelApp.Quit;
         ExcelApp:=Unassigned;
         DlgSave.Destroy;
  end;
end;










{ TOOo }


procedure TOOo.CloseDocument;
begin
    if fDocumentOpened then
    begin
       fDocument.Close(false);


       fDocumentOpened := false;
       fDocument := Unassigned;


       fDesktop.Terminate;
       fDesktop := UnAssigned;
    end;
end;


function TOOo.Connect: boolean;
begin
    if  VarIsEmpty(fOpenOffice) then
        fOpenOffice := CreateOleObject('com.sun.star.ServiceManager');


    fConnected := not (VarIsEmpty(fOpenOffice) or VarIsNull(fOpenOffice));
    Result := fConnected;
end;


constructor TOOo.Create;
begin
  inherited;
  isNeedtoANSI:=true;
  CoInitialize(nil);
end;


destructor TOOo.Destroy;
begin
  CoUninitialize;
  inherited;
end;


procedure TOOo.Disconnect;
begin
   // if fDocumentOpened then
   //    CloseDocument;


    fConnected := false;
    fOpenOffice := Unassigned;
end;


function TOOo.MakePropertyValue(PropName: string;
  PropValue: variant): variant;
var
   Struct: variant;
begin
    Struct := fOpenOffice.Bridge_GetStruct('com.sun.star.beans.PropertyValue');
    Struct.Name := PropName;
    Struct.Value := PropValue;
    Result := Struct;
end;


function TOOo.Create_NewCalcDoc: boolean;
var
   wProperties : Variant;
   wViewSettings : Variant;
   wController : Variant;
begin
   if not fConnected then
      abort;


   fDesktop := fOpenOffice.createInstance('com.sun.star.frame.Desktop');


   wProperties := VarArrayCreate([0, 0], varVariant);
   wProperties[0] := MakePropertyValue('Hidden', True);


   fDocument := fDesktop.loadComponentFromURL('private:factory/scalc' , '_blank', 0, wProperties);


   fDocumentOpened := not (VarIsEmpty(fDocument) or VarIsNull(fDocument));
   result := fDocumentOpened;
end;


function TOOo.OpenDocument(Filename: string): boolean;
var
   wProperties : Variant;
   wViewSettings : Variant;
   wController : Variant;
begin
   if not fConnected then
      abort;


   fDesktop := fOpenOffice.createInstance('com.sun.star.frame.Desktop');


   wProperties := VarArrayCreate([0, 0], varVariant);
   wProperties[0] := MakePropertyValue('Hidden', True);


   fDocument := fDesktop.loadComponentFromURL('file:///'+ StringReplace(FileName, '\', '/', [rfIgnoreCase, rfReplaceAll]) , '_blank', 0, wProperties);


   fDocumentOpened := not (VarIsEmpty(fDocument) or VarIsNull(fDocument));
   result := fDocumentOpened;
end;
procedure TOOo.output_ListView_to_Calc(ls:TListView);
var
   oSheet,oCell,tshs:variant;
   i,j,k:integer;
begin
  if fDocumentOpened then
  begin
      tshs:=fDocument.getSheets;
      tshs.insertNewByName('MySheet',0);
      oSheet:=tshs.getByName('MySheet');


     for i:=0 to ls.Columns.Count-1 do
      begin
          oCell:=oSheet.getCellByPosition (i,0);
          if isNeedtoANSI then oCell.setstring(UTF8decode(ls.Columns.Caption))
          else oCell.setstring(ls.Columns.Caption);
      end;
      j:=1;
      for k:=0 to ls.Items.Count-1 do
      begin
          i:=0;
          oCell:=oSheet.getCellByPosition (i,j);
          if isNeedtoANSI then oCell.setstring(UTF8decode(ls.Items[k].Caption))
          else oCell.setstring(ls.Items[k].Caption);
          for i:=1 to ls.Items[k].SubItems.Count do
          begin
              oCell:=oSheet.getCellByPosition (i,j);
              if isNeedtoANSI then  oCell.setstring(UTF8decode(ls.Items[k].SubItems[i-1]))
              else oCell.setstring(ls.Items[k].SubItems[i-1]);
          end;
          inc(j);
      end;
      oCell:=Unassigned;
      oSheet:=Unassigned;
  end;
end;


procedure TOOo.output_DataSet_to_Calc(ls:TDataSet);
var
   oSheet,oCell,tshs:variant;
   i,j,k:integer;
begin
  if fDocumentOpened then
  begin
      tshs:=fDocument.getSheets;
      tshs.insertNewByName('MySheet',0);
      oSheet:=tshs.getByName('MySheet');


     for i:=0 to ls.Fields.Count-1 do
      begin
          oCell:=oSheet.getCellByPosition (i,0);
          if  isNeedtoANSI then oCell.setstring(UTF8decode(ANSItoUTF8(ls.Fields.FieldName)))
          else oCell.setstring(ls.Fields.FieldName);
      end;
      j:=1; ls.First;
      for k:=0 to ls.RecordCount-1 do
      begin
          for i:=0 to ls.Fields.Count-1 do
          begin
              oCell:=oSheet.getCellByPosition (i,j);
              if  isNeedtoANSI then  oCell.setstring(UTF8decode(ANSItoUTF8(ls.Fields.DisplayText)))
              else oCell.setstring(ls.Fields.DisplayText);
          end;
          inc(j); ls.Next;
      end;
      oCell:=Unassigned;
      oSheet:=Unassigned;
  end;
end;










procedure TOOo.SaveToPDF(FileName: string);
var
   wProperties: variant;


begin
   if not (fConnected and fDocumentOpened) then
      abort;


   wProperties := VarArrayCreate([0, 3], varVariant);
   wProperties[0] := MakePropertyValue('FilterName', 'writer_pdf_Export');


   wProperties[1] := MakePropertyValue('CompressionMode', '1');
   wProperties[2] := MakePropertyValue(&#39ages', 'All');
   wProperties[3] := MakePropertyValue('Overwrite', TRUE);


   fDocument.StoreToURL('file:///'+ StringReplace(FileName, '\', '/', [rfIgnoreCase, rfReplaceAll]), wProperties);
end;


end.
                          

马可de菠萝

能在linux等平台用吗？

qiaoqia6448

没玩过linux，基于win的COM，linux应该是不可以的。