delphi调用openoffice的二个单元文件

unit OOoclass;

{

WORD 使“字体的磅值=字体的实际高度（厘米）×1.073÷0.035”，即“字体的磅值=字体的实际高度（厘米）×30.657”

那么，打印出来的字体就与你期望的实际高度一致。

行高单位：磅

列宽单位：字符（12磅宋体英文或数字的宽度）

其实EXCEL的行高单位和WORD里字号单位中的磅是一致的，在WORD里用于表示字号大小的单位有两个一是号数（这是中国人的习惯），

一是磅数（这是西方人的习惯），比如：平时书刊中最常见的5号字对应的磅数为10.5磅。

而列宽的单位则是标准字符，也同样和WORD的标尺有相通之处，在WORD里当标尺单位采用字符为单位的时候，其依据是常用5号字汉字的宽度，

而EXCEL里则以12磅的宋体数字和字母宽度为单位。（注有此西文字体的字母宽度是不一致的。）

excel中行高是以磅为单位 1mm=2.835磅

列宽与EXCEL的标准字体有关 1mm----0.45

“磅”是“点”的旧称。“点”是印刷上计算活字及字模大小的单位，约等于0.35毫米

start OpenOffice.org and select

Tools > Options > Load/Save > General

then choose the following file associations from the menus

Text Document --- Microsoft Word 97/2000/XP

Spreadsheet --- Microsoft Excel 97/2000/XP

Presentation --- Microsoft Powerpoint 97/2000/XP

}

interface

uses SysUtils, Variants, Dialogs;

type

EOOoError = class(Exception);

var

OpenOffice, StarDesktop: Variant;

OOoIntrospection, OOoReflection: Variant;

procedure ConnectOpenOffice; ////连接OPENOFFICE

procedure DisconnectOpenOffice(closeOpenOffice: Boolean = False); //断开连接OPENOFFICE

function IsOpenOfficeConnected: Boolean;

function CreateUnoService(serviceName: string): Variant;

function CreateUnoStruct(structName: string; indexMax: Integer = -1): Variant;

function CreateProperties(propertyList: array of Variant): Variant; //创立一个属性值的数组

function MakePropertyValue(PropName: string; PropValue: Variant): Variant;

function HasUnoInterfaces(thisObject: Variant; interfaceList: array of string): Boolean;

function isNullEmpty(thisVariant: Variant): Boolean;

function dummyArray: Variant; //创立一个空数组

procedure execDispatch(Command: string; params: Variant);

function runScript(scriptName: string; argsList: array of Variant;

language: string = 'Basic'; location: string = 'user'): Variant;

procedure runBasicMacro(macroName: string; argsList: string = ''; docName: string = '');

procedure BasicXray(var myObject: Variant);

procedure copyToClipboard; //复制

procedure pasteFromClipboard; //粘贴

function convertToURL(winAddr: string): string; //将WINDOWS格式转成OOo需要的URL格式

function convertFromURL(URLaddr: string): string; //将OOo的URL格式转成 WINDOWS格式

function RGB(redV, greenV, blueV: byte): Longword; //颜色值

function Red(colorOOo: Longword): Byte;

function Green(colorOOo: Longword): Byte;

function Blue(colorOOo: Longword): Byte;

function GetColChr(IntNumber: Integer): string; //将得到列字母

function GetCellsRang(iscol, isrow: integer; iecol: integer = 0; ierow: integer = 0): string; //得到单元格地址范围

procedure setsheetvalue(ic, ir: integer; objsheet: OleVariant; psvalue: string); //对单元格赋值

procedure setsheetint(ic, ir: integer; objsheet: OleVariant; psvalue: string); //针对公式或数值赋值

procedure gotocell(cellRang: string); overload; //选择单元格

procedure gotocell(ic, ir: integer); overload; //选择单元格

procedure MergeCells(cellRang: string = ''); //合并单元格

procedure HorizontalCell(postag: integer; CellRang: string = ''); //单元格水平

procedure VerticalCell(postag: integer; CellRang: string = ''); //D单元格垂直

procedure SetBlod(IfBlod: boolean); //字体黑体

procedure setfontsize(size: integer); //字体大小

procedure SetColWidthold(cellRang: string; colWidth: double = 0); //数值列宽

procedure setCelllines(show: boolean = true); //单元格画线

procedure setremark(remark: string; objsheet: variant; col: integer; row: integer; showrem: boolean = false); //插入备注

procedure saveasxls(filename: string); //保持XLS格式文件

function geturl(filename: string): string; //将WINDOWS文件名转换成OPEN OFFICE 支持文件名

procedure selectoosheet(tableindex: integer); //选择SHHET

procedure insertoosheet(tableindex: integer; tablename: string = ''); //插入SHEET

procedure renameoosheet(tablename: string); //将SHEET改名

procedure SetRowHeight(cellRang: string; colWidth: double = 0); //数值行高

procedure setCellsproperty(objsheet: OleVariant; cellRang, myProperty: string; ifvalue: boolean = false);

procedure SetsingleRowHeight(objsheet: OleVariant; row: integer; Rowheight: integer = 0); //数值行高

function getsingleRowHeight(objsheet: OleVariant; row: integer):integer;

procedure setcellwrap(objsheet: OleVariant; cellRang: string; ifwrap: boolean = true); //自动换行

procedure setcellfix(objsheet: OleVariant; cellRang: string; iffix: boolean = true); //缩小字体填充

procedure setCellBackColor(objsheet: OleVariant; cellRang: string; redV, greenV, blueV: byte); //背景色

procedure setCellBackgroundTransparent(objsheet: OleVariant; cellRang: string; ifTransparent: boolean = true); //背景透明

procedure setfontname(fontname: string); //字体名称

procedure setouterborder(cellrang: string = ''; bordercolorvalue: integer = 0); //对一个区域画边框 bordercolorvalue是颜色值

procedure copycells(CellRang: string = ''); //Copy

procedure pastecells(CellRang: string = ''); //paste

procedure mychangerows(objsheet: OleVariant; iscol, isrow: integer; iecol: integer = 0; ierow: integer = 0; insertrow: integer = 1);

//删除行增加行

procedure printtitle(printcellrang: string = ''; RowCellrang: string = ''; colCellrang: string = '');

procedure setpagehead(oDocument: OleVariant; Mtop, Mbottom, mleft, mright: integer; Mheadleft, Mheadmid, Mheadright: string; headheight: integer = 0; colorOOo: Longword = 0); //设置页边距和页头

procedure setpagefoot(oDocument: OleVariant; Mfootleft: string = ''; Mfootmid: string = ''; Mfootright: string = ''; footheight: integer = 0; colorOOo: Longword = 0; ifpage: boolean = false; currpage: integer = 0); //设置页边距和页头

procedure Setpageother(oDocument: OleVariant; Owidth: integer = -1; Oheight: integer = -1; ifLandscape: boolean = false; ifprintGrid: boolean = false; ifPrintHeaders: boolean = false; ifPrintCharts: boolean = false;

ifPrintObjects: boolean = false; ifPrintDrawing: boolean = false; ifPrintDownFirst: boolean = false;

ifPrintFormulas: boolean = false; ifPrintZeroValues: boolean = false; ifPrintAnnotations: boolean = false; currpage: integer = 0);

procedure savexls(filename: string);

procedure Setcolwidth(objsheet: OleVariant; col: integer; colwidth: integer = 0); //数值列高

function fnGetNumberFormatId(oDoc: oleVariant; sNumberFormat: string = ''): integer;

procedure setnumberproperty(oDoc: oleVariant; cellrang: string; sNumberFormat: string = '');

procedure insertbreak(CellRang: string = ''); //插入换页

procedure setproperty(objsheet: oleVariant; MYproperty: integer); //设置属性值

{procedure setpropertystring(objsheet: oleVariant; MYstr: string); //设置属性值格式 (暂没有测试PASS)

}

function returnfield(fieldstr: string): OleVariant; //(暂没有测试PASS)

implementation

uses Classes, Controls, Forms, StrUtils, ComObj, OOoMessages;

const URLprefix: array[1..7] of string =

('file:///', 'ftp://', 'news:', 'http://', 'mailto:', 'macro:', 'private:');

var

disp: Variant;

function IsOpenOfficeConnected: Boolean;

var

DeskTopbis: Variant;

begin

IsOpenOfficeConnected := False;

if isNullEmpty(OpenOffice) then exit;

try

DeskTopbis := OpenOffice.createInstance('com.sun.star.frame.Desktop');

IsOpenOfficeConnected := True;

except

OpenOffice := Null;

end;

procedure ConnectOpenOffice; //连接OPENOFFICE

begin

if IsOpenOfficeConnected then exit;

Screen.Cursor := crHourglass; Application.ProcessMessages;

try

OpenOffice := CreateOleObject('com.sun.star.ServiceManager');

if isNullEmpty(OpenOffice) then raise EOOoError.Create(OOo_connectKO);

StarDesktop := CreateUnoService('com.sun.star.frame.Desktop');

disp := CreateUnoService('com.sun.star.frame.DispatchHelper');

OOoIntrospection := CreateUnoService('com.sun.star.beans.Introspection');

OOoReflection := CreateUnoService('com.sun.star.reflection.CoreReflection');

finally

Screen.Cursor := crDefault;

end;

function isNullEmpty(thisVariant: Variant): Boolean;

begin

Result := VarIsEmpty(thisVariant) or VarIsNull(thisVariant) or VarIsClear(thisVariant);

end;

function CreateUnoService(serviceName: string): Variant;

begin

Result := OpenOffice.createInstance(serviceName);

if isNullEmpty(Result) then raise EOOoError.Create(Format(OOo_serviceKO, [serviceName]));

end;

procedure DisconnectOpenOffice(closeOpenOffice: Boolean = False); //断开连接OPENOFFICE close COM interface

begin

if closeOpenOffice then StarDesktop.terminate;

OpenOffice := unassigned;

StarDesktop := unassigned;

disp := unassigned;

OOoIntrospection := unassigned;

OOoReflection := unassigned;

end;

function CreateUnoStruct(structName: string; indexMax: Integer = -1): Variant;

var

d: Integer;

begin

try

if indexMax < 0 then

Result := OpenOffice.Bridge_GetStruct(structName)

else begin

Result := VarArrayCreate([0, indexMax], varVariant);

for d := 0 to indexMax do

Result[d] := OpenOffice.Bridge_GetStruct(structName);

end;

except

Result := Null;

end;

if isNullEmpty(Result) then raise EOOoError.Create(Format(OOo_structureKO, [structName]));

end;

function MakePropertyValue(PropName: string; PropValue: Variant): Variant;

begin

Result := OpenOffice.Bridge_GetStruct('com.sun.star.beans.PropertyValue');

Result.Name := PropName; Result.Value := PropValue;

end;

function CreateProperties(propertyList: array of Variant): Variant; //创立一个属性值的数组

var

x, y, xMax: Integer;

begin

xMax := High(propertyList);

if (not odd(xMax)) or (xMax < 1) then

raise EOOoError.Create(OOo_nbrArgsKO);

Result := VarArrayCreate([0, xMax shr 1], varVariant); x := 0; y := 0;

repeat

Result[y] := OpenOffice.Bridge_GetStruct('com.sun.star.beans.PropertyValue');

case VarType(propertyList[x]) of { check that the argument is a String }

varOleStr, varStrArg, varString: Result[y].Name := propertyList[x];

else

raise EOOoError.Create(Format(OOo_notString, [x]));

end;

Result[y].Value := propertyList[x + 1];

inc(y); inc(x, 2);

until x > xMax;

end;

function dummyArray: Variant; //创立一个空数组

begin

Result := VarArrayCreate([0, -1], varVariant);

end;

function HasUnoInterfaces(thisObject: Variant; interfaceList: array of string): Boolean;

var

objInterf: TStringList;

insp, info1, info2, info3: Variant; x, x2: Integer; oneInterf: string;

begin

Result := False;

objInterf := TStringList.Create;

try

insp := OOoIntrospection.inspect(thisObject);

info1 := insp.getMethods(-1);

for x := 0 to VarArrayHighBound(info1, 1) do begin

info2 := info1[x]; info3 := info2.DeclaringClass; oneInterf := info3.Name;

if (oneInterf <> '') and (objInterf.IndexOf(oneInterf) < 0) then

objInterf.Add(oneInterf);

end;

for x := 0 to High(interfaceList) do begin

x2 := objInterf.IndexOf(interfaceList[x]);

if x2 < 0 then exit;

if objInterf.Strings[x2] <> interfaceList[x] then exit; // v閞ifier la casse // check case

end;

Result := True;

except

raise EOOoError.Create(OOo_inspectionKO);

end;

procedure execDispatch(Command: string; params: Variant);

begin

disp.executeDispatch(StarDesktop.CurrentFrame, Command, '', 0, params);

end;

function runScript(scriptName: string; argsList: array of Variant;

language: string = 'Basic'; location: string = 'user'): Variant;

var

mspf, scriptPro, xScript, args: Variant; x, xMax: Integer;

begin

if (language = 'Basic') and (location = 'user') then location := 'application';

mspf := CreateUnoService('com.sun.star.script.provider.MasterScriptProviderFactory');

scriptPro := mspf.createScriptProvider('');

xScript := scriptPro.getScript('vnd.sun.star.script:' + scriptName

+ '?language=' + language

+ '&location=' + location);

xMax := High(argsList);

args := VarArrayCreate([0, xMax], varVariant);

for x := 0 to xMax do args[x] := argsList[x];

Result := xScript.invoke(args, dummyArray, dummyArray);

end;

procedure runBasicMacro(macroName: string;

argsList: string = ''; docName: string = '');

begin

execDispatch('macro://' + docName + '/' + macroName + '(' + argsList + ')', dummyArray);

end;

procedure BasicXray(var myObject: Variant);

begin

runScript('XrayTool._Main.Xray', [myObject]);

end;

procedure copyToClipboard;

begin

execDispatch('.uno:Copy', dummyArray); //复制

end;

procedure pasteFromClipboard; //粘贴

begin

execDispatch('.uno:Paste', dummyArray);

end;

function convertToURL(winAddr: string): string; //将WINDOWS格式转成OOo需要的URL格式

var

sv: Variant; x: Integer; sLow, UTF8Addr, prefix: string;

begin

sLow := AnsiLowerCase(winAddr);

prefix := '';

for x := 1 to High(URLprefix) do

if Pos(URLprefix[x], sLow) = 1 then begin

winAddr := Copy(winAddr, Length(URLprefix[x]) + 1, 2000);

if x > 1 then prefix := URLprefix[x]; // prefix file:/// is useless

Break;

end;

if (Length(prefix) = 0) and (Pos('@', sLow) > 0) then

Result := 'mailto:' + winAddr

else begin

sv := CreateUnoService('com.sun.star.ucb.FileContentProvider');

UTF8Addr := sv.getFileURLFromSystemPath('', winAddr);

if Length(UTF8Addr) = 0 then raise EOOoError.Create(OOo_convertToURLKO);

Result := prefix + UTF8Addr;

end;

function convertFromURL(URLaddr: string): string; //将OOo的URL格式转成 WINDOWS格式

var

sv: Variant; x: Integer; sLow, winAddr, prefix: string;

begin

sLow := AnsiLowerCase(URLaddr);

prefix := '';

for x := 1 to High(URLprefix) do

if Pos(URLprefix[x], sLow) = 1 then begin

if x > 1 then begin

URLaddr := Copy(URLaddr, Length(URLprefix[x]) + 1, 2000);

prefix := URLprefix[x];

end;

Break;

end;

sv := CreateUnoService('com.sun.star.ucb.FileContentProvider');

winAddr := sv.getSystemPathFromFileURL(URLaddr);

if Length(prefix) <> 0 then // backslash only with file:///

winAddr := StringReplace(winAddr, '\', '/', [rfReplaceAll]);

if Length(winAddr) = 0 then raise EOOoError.Create(OOo_convertFromURLKO);

Result := prefix + winAddr;

end;

function RGB(redV, greenV, blueV: byte): Longword; //颜色值

begin

Result := (redV shl 16) + (greenV shl 8) + blueV

end;

function Blue(colorOOo: Longword): Byte;

begin

Result := colorOOo and 255

end;

function Green(colorOOo: Longword): Byte;

begin

Result := (colorOOo shr 8) and 255

end;

function Red(colorOOo: Longword): Byte;

begin

Result := (colorOOo shr 16) and 255

end;

function GetColChr(IntNumber: Integer): string;

begin

if IntNumber < 1 then

Result := 'A'

else

begin

if IntNumber > 702 then

Result := 'ZZ'

else

begin

if IntNumber > 26 then begin

if (IntNumber mod 26) = 0 then

Result := Chr(64 + (IntNumber div 26) - 1)

else

Result := Chr(64 + (IntNumber div 26));

if (IntNumber mod 26) = 0 then

result := result + chr(64 + 26)

else

result := Result + Chr(64 + (IntNumber mod 26));

end

else

Result := Chr(64 + IntNumber);

end;

function GetCellsRang(iscol, isrow: integer; iecol: integer = 0; ierow: integer = 0): string;

begin

if isrow < 0 then isrow := 1;

if ierow < 0 then ierow := 1;

if (iErow = 0) and (iecol = 0) then

result := '$' + GetColChr(iscol + 1) + '$' + inttostr(isrow + 1)

else

result := '$' + GetColChr(iscol + 1) + '$' + inttostr(isrow + 1) + ':' + '$' + GetColChr(iecol + 1) + '$' + inttostr(ierow + 1);

end;

procedure setsheetvalue(ic, ir: integer; objsheet: OleVariant; psvalue: string);

begin

objsheet.getCellByPosition(ic, ir).formula := psvalue;

end;

procedure setsheetint(ic, ir: integer; objsheet: OleVariant; psvalue: string);

begin

// objsheet.getCellByPosition(ic, ir).Formula := '=' + psvalue;

objsheet.getCellByPosition(ic, ir).Formula := psvalue;

end;

procedure gotocell(cellRang: string); overload;

var args: Variant;

begin

args := CreateProperties(['ToPoint', CellRang]);

execDispatch('.uno:GoToCell', args);

end;

procedure gotocell(ic, ir: integer); overload;

var args: Variant;

CellRang: string;

begin

cellrang := getcellsrang(ic, ir);

args := CreateProperties(['ToPoint', CellRang]);

execDispatch('.uno:GoToCell', args);

end;

procedure MergeCells(cellRang: string = '');

var args: Variant;

begin

if cellrang = '' then

args := CreateProperties(['', ''])

else

begin

args := CreateProperties(['ToPoint', cellRang]);

execDispatch('.uno:GoToCell', args);

end;

execDispatch('.uno:ToggleMergeCells', args);

end;

procedure Horizontalcell(postag: integer; CellRang: string = '');

var args: Variant;

begin

if CellRang <> '' then

begin

args := CreateProperties(['ToPoint', cellRang]);

execDispatch('.uno:GoToCell', args);

Varclear(args);

end;

if (postag >= 0) and (postag <= 5) then

args := CreateProperties(['HorizontalJustification', postag])

else

args := CreateProperties(['HorizontalJustification', postag]);

execDispatch('.uno:HorizontalJustification', args);

end;

procedure VerticalCell(postag: integer; CellRang: string = '');

var args: Variant;

begin

if CellRang <> '' then

begin

args := CreateProperties(['ToPoint', cellRang]);

execDispatch('.uno:GoToCell', args);

Varclear(args);

end;

if (postag >= 0) and (postag <= 5) then

args := CreateProperties(['VerticalJustification', postag])

else

args := CreateProperties(['VerticalJustification', postag]);

execDispatch('.uno:VerticalJustification', args);

end;

procedure saveasxls(filename: string);

var args: Variant;

begin

args := CreateProperties(['URL', filename, 'FilterName', 'MS Excel 97', 'SelectionOnly', true]);

execDispatch('.uno:SaveAs', args);

end;

procedure SetColWidthold(cellRang: string; colWidth: double = 0);

var args: Variant;

begin

GotoCell(CellRang);

if ColWidth = 0 then

begin

args := CreateProperties(['aExtraWidth', 0]);

ExecDispatch('.uno:SetOptimalColumnWidth', args);

end

else

begin

args := CreateProperties(['ColumnWidth', ColWidth]);

ExecDispatch('.uno:ColumnWidt', args);

end;

procedure SetBlod(IfBlod: boolean);

var args: Variant;

begin

args := CreateProperties(['Bold', IfBlod]);

ExecDispatch('.uno:Bold', args);

end;

procedure setfontsize(size: integer);

var args: Variant;

begin

args := CreateProperties(['FontHeight.Height', size, 'FontHeight.Prop', 100, 'FontHeight.Diff', 0]);

ExecDispatch('.uno:FontHeight', args);

end;

function geturl(filename: string): string;

begin

result := 'file:///' + ansireplacestr(filename, '\', '/');

end;

procedure setCelllines(show: boolean = true);

var args: Variant;

values: Variant;

begin

if show then

values := VarArrayOf([0, 0, 2, 0])

else

values := VarArrayOf([0, 0, 0, 0]);

args := CreateProperties(['OuterBorder.LeftBorder', values, 'OuterBorder.LeftDistance', 0

, 'OuterBorder.RightBorder', values, 'OuterBorder.RightDistance', 0

, 'OuterBorder.TopBorder', values, 'OuterBorder.TopDistance', 0

, 'OuterBorder.BottomBorder', values, 'OuterBorder.BottomDistance', 0,

'InnerBorder.Horizontal', values, 'InnerBorder.Vertical', values

, 'InnerBorder.Flags', 0, 'InnerBorder.ValidFlags', 127

, 'InnerBorder.DefaultDistance', 0]);

ExecDispatch('.uno:SetBorderStyle', args);

end;

procedure setremark(remark: string; objsheet: variant; col: integer; row: integer; showrem: boolean = false);

var ocell, onote: Variant;

begin

ocell := objsheet.getCellByPosition(col, row);

oNote := oCell.Annotation;

oNote.string := remark;

oNote.IsVisible := showrem;

end;

procedure selectoosheet(tableindex: integer);

var args: Variant;

begin

args := CreateProperties(['Nr', tableindex]);

ExecDispatch('.uno:JumpToTable', args);

end;

procedure insertoosheet(tableindex: integer; tablename: string = '');

var args: Variant;

begin

args := CreateProperties(['Name', tablename, 'Index', tableindex]);

ExecDispatch('.uno:Insert', args);

end;

procedure renameoosheet(tablename: string);

var args: Variant;

begin

args := CreateProperties(['Name', tablename]);

ExecDispatch('.uno:RenameTable', args);

end;

procedure SetRowHeight(cellRang: string; colWidth: double = 0);

var args: Variant;

begin

GotoCell(CellRang);

if ColWidth = 0 then

begin

args := CreateProperties(['aExtraHeight', 0]);

ExecDispatch('.uno:SetOptimalRowHeight', args);

end

else

begin

args := CreateProperties(['RowHeight', ColWidth]);

ExecDispatch('.uno:RowHeight', args);

end;

procedure printtitle(printcellrang: string = ''; RowCellrang: string = ''; colCellrang: string = '');

var args: Variant;

begin

args := CreateProperties(['PrintArea', printcellrang, 'PrintRepeatRow', Rowcellrang

, 'PrintRepeatCol', colcellrang]);

ExecDispatch('.uno:ChangePrintArea', args);

end;

procedure SetsingleRowHeight(objsheet: OleVariant; row: integer; Rowheight: integer = 0);

var Orow: OleVariant;

begin

if Rowheight > 0 then

begin

orow := objSheet.getRows.getByIndex(row);

oRow.setPropertyValue('Height', rowheight);

end;

function getsingleRowHeight(objsheet: OleVariant; row: integer):integer;

var Orow: OleVariant;

begin

orow := objSheet.getRows.getByIndex(row);

result:=orow.getPropertyValue('Height');

end;

procedure setCellsproperty(objsheet: OleVariant; cellRang, myproperty: string; ifvalue: boolean = false);

var Selectedrange: OleVariant;

begin

Selectedrange := objsheet.getCellRangeByname(cellrang);

Selectedrange.setPropertyValue(MYproperty, ifvalue);

end;

procedure setcellwrap(objsheet: OleVariant; cellRang: string; ifwrap: boolean = true);

begin

setCellsproperty(objsheet, cellRang, 'IsTextWrapped', ifwrap); //is true, if text in the cells will be wrapped automatically at the right border.

end;

procedure setcellfix(objsheet: OleVariant; cellRang: string; iffix: boolean = true); //是否缩小字体填充

begin

setCellsproperty(objsheet, cellRang, 'ShrinkToFit', iffix); //is true, if the cell content will be shrinked to fit in the cell.

end;

procedure setCellBackColor(objsheet: OleVariant; cellRang: string; redV, greenV, blueV: byte); //contains the cell background color. 背景色

var Selectedrange: OleVariant;

begin

Selectedrange := objsheet.getCellRangeByname(cellrang);

Selectedrange.setPropertyValue('CellBackColor', RGB(redV, greenV, blueV));

end;

procedure setCellBackgroundTransparent(objsheet: OleVariant; cellRang: string; ifTransparent: boolean = true); //背景透明

begin

setCellsproperty(objsheet, cellRang, 'IsCellBackgroundTransparent', ifTransparent); //is true, if the cell background is transparent.

end;

procedure setfontname(fontname: string); //字体名称

var args: Variant;

begin

args := CreateProperties(['CharFontName.StyleName', '', 'CharFontName.Pitch', 2, 'CharFontName.CharSet', -1, 'CharFontName.Family', 5, 'CharFontName.FamilyName', fontname]);

ExecDispatch('.uno:CharFontName', args);

end;

procedure setpagehead(oDocument: OleVariant; Mtop, Mbottom, Mleft, Mright: integer; Mheadleft, Mheadmid, Mheadright: string; headheight: integer = 0; colorOOo: Longword = 0); //设置页边距

var HContent, htext, StyleFamilies, PageStyles, DefPage: OleVariant;

begin

StyleFamilies := oDocument.StyleFamilies;

PageStyles := StyleFamilies.getByName('PageStyles');

DefPage := PageStyles.getByName('Default');

DefPage.LeftMargin := Mleft; //LeftMargin (long) width of the left hand page margin in hundredths of a millimeter

DefPage.RightMargin := Mright; //RightMargin (long) width of the right hand page margin in hundredths of a millimeter

DefPage.TopMargin := Mtop; //TopMargin (long) width of the top page margin in hundredths of a millimeter

DefPage.BottomMargin := Mbottom; //BottomMargin (long) width of the bottom page margin in hundredths of a millimeter

{

LeftBorder (struct) specifications for left-hand line of page border (com.sun.star.table.BorderLine structure)

RightBorder (struct) specifications for right-hand line of page border (com.sun.star.table.BorderLine structure)

TopBorder (struct) specifications for top line of page border (com.sun.star.table.BorderLine structure)

BottomBorder (struct) specifications for bottom line of page border (com.sun.star.table.BorderLine structure)

LeftBorderDistance (long) distance between left-hand page border and page content in hundredths of a millimeter

RightBorderDistance (long) distance between right-hand page border and page content in hundredths of a millimeter

TopBorderDistance (long) distance between top page border and page content in hundredths of a millimeter

BottomBorderDistance (long) distance between bottom page border and page content in hundredths of a millimeter

ShadowFormat (struct) specifications for shadow of content area of page (com.sun.star.table.ShadowFormat structure)

}

{LeftPageHeaderContent (Object) content of headers for even 双数 pages (com.sun.star.sheet.HeaderFooterContent service)

RightPageHeaderContent (Object) content of headers for odd 单数 pages (com.sun.star.sheet.HeaderFooterContent service)

LeftPageFooterContent (Object) content of footers for even pages (com.sun.star.sheet.HeaderFooterContent service)

RightPageFooterContent (Object) content of footers for odd pages (com.sun.star.sheet.HeaderFooterContent service)

}

if length(trim(Mheadleft)) + length(trim(Mheadmid)) + length(trim(Mheadright)) > 0 then

begin

DefPage.HeaderIsOn := True;

if headheight > 0 then

defpage.HeaderHeight := headheight

else

defpage.HeaderIsDynamicHeight := true;

if colorOOo > 0 then

begin

defpage.HeaderBackColor := colorOOo;

end;

HContent := DefPage.RightPageHeaderContent;

HText := HContent.CenterText;

HText.string := Mheadmid;

DefPage.RightPageHeaderContent := HContent; //写中间页头

HContent := DefPage.RightPageHeaderContent;

HText := HContent.leftText;

HText.string := Mheadleft;

DefPage.RightPageHeaderContent := HContent; //写左页头

HContent := DefPage.RightPageHeaderContent;

HText := HContent.rightText;

HText.string := Mheadright;

DefPage.RightPageHeaderContent := HContent; //写右页头

DefPage.HeaderIsShared := true;

end;

{HeaderIsOn (Boolean) header is activated

HeaderLeftMargin (long) distance between header and left-hand page margin in hundredths of a millimeter

HeaderRightMargin (long) distance between header and right-hand page margin in hundredths of a millimeter

HeaderBodyDistance (long) distance between header and main body of document in hundredths of a millimeter

HeaderHeight (long) height of header in hundredths of a millimeter

HeaderIsDynamicHeight (Boolean) height of header is automatically adapted to content

HeaderLeftBorder (struct) details of the left-hand border of frame around header (com.sun.star.table.BorderLine structure)

HeaderRightBorder (struct) details of the right-hand border of frame around header (com.sun.star.table.BorderLine structure)

HeaderTopBorder (struct) details of the top line of the border around header (com.sun.star.table.BorderLine structure)

HeaderBottomBorder (struct) details of the bottom line of the border around header (com.sun.star.table.BorderLine structure)

HeaderLeftBorderDistance (long) distance between left-hand border and content of header in hundredths of a millimeter

HeaderRightBorderDistance (long) distance between right-hand border and content of header in hundredths of a millimeter

HeaderTopBorderDistance (long) distance between top border and content of header in hundredths of a millimeter

HeaderBottomBorderDistance (long)distance between bottom border and content of header in hundredths of a millimeter

HeaderIsShared (Boolean) headers on even and odd pages have the same content (refer to HeaderText , HeaderTextLeft, and HeaderTextRight )

HeaderBackColor (long) background color of header

HeaderBackGraphicURL (String) URL of the background graphics that you want to use

HeaderBackGraphicFilter (String) name of the filter for interpreting the background graphics for the header

HeaderBackGraphicLocation (Enum) position of the background graphics for the header (value according to com.sun.star.style.GraphicLocation enumeration)

HeaderBackTransparent (Boolean) shows the background of the header as transparent

HeaderShadowFormat (struct) details of shadow of header (com.sun.star.table.ShadowFormat structure)

}

end;

var HContent, htext, StyleFamilies, PageStyles, DefPage, oField: OleVariant;

oCursor: Variant;

mystr: string;

begin

StyleFamilies := oDocument.StyleFamilies;

PageStyles := StyleFamilies.getByName('PageStyles');

if currpage = 0 then

DefPage := PageStyles.getByName('Default')

else

DefPage := PageStyles.getByindex(currpage);

// showmessage(defpage.name);

if length(trim(Mfootleft)) + length(trim(Mfootmid)) + length(trim(Mfootright)) > 0 then

begin

DefPage.footerIsOn := True;

if footheight > 0 then

defpage.footerHeight := footheight

else

defpage.footerIsDynamicHeight := true;

if colorOOo > 0 then

begin

defpage.footerBackColor := colorOOo;

end;

if mfootmid <> '' then

begin

HContent := DefPage.RightPagefooterContent;

HText := HContent.CenterText;

HText.setString('');

oCursor := hText.createTextCursor;

HText.insertString(oCursor, mfootmid, False); //' This will have the sheet name of the current sheet!

if ifpage then

begin

oField := oDocument.createInstance('com.sun.star.text.TextField.PageNumber');

HText.insertTextContent(oCursor, oField, False);

HText.insertString(oCursor, ' / ', False);

oField := oDocument.createInstance('com.sun.star.text.TextField.PageCount'); //注意大小写

HText.insertTextContent(oCursor, oField, False);

// htext.text.CharFontName:='Arial Black';

end;

DefPage.RightPagefooterContent := HContent; //写中间页头

end;

if mfootleft <> '' then

begin

HContent := DefPage.RightPagefooterContent;

HText := HContent.leftText;

HText.string := Mfootleft;

DefPage.RightPagefooterContent := HContent; //写左页头

end;

if mfootright <> '' then

begin

HContent := DefPage.RightPagefooterContent;

HText := HContent.rightText;

HText.string := Mfootright;

DefPage.RightPagefooterContent := HContent; //写右页头

end;

DefPage.footerIsShared := true;

{

The properties for formatting footers are:

FooterIsOn (Boolean) footer is activated

FooterLeftMargin (long) distance between footer and left-hand page margin in hundredths of a millimeter

FooterRightMargin (long) distance between footer and right-hand page margin in hundredths of a millimeter

FooterBodyDistance (long) distance between footer and main body of document in hundredths of a millimeter

FooterHeight (long) height of footer in hundredths of a millimeter

FooterIsDynamicHeight (Boolean) height of footer is adapted automatically to the content

FooterLeftBorder (struct) details of left-hand line of border around footer (com.sun.star.table.BorderLine structure)

FooterRightBorder (struct) details of right-hand line of border around footer (com.sun.star.table.BorderLine structure)

FooterTopBorder (struct) details of top line of border around footer (com.sun.star.table.BorderLine structure)

FooterBottomBorder (struct) details of bottom line of border around footer (com.sun.star.table.BorderLine structure)

FooterLeftBorderDistance (long) distance between left-hand border and content of footer in hundredths of a millimeter

FooterRightBorderDistance (long) distance between right-hand border and content of footer in hundredths of a millimeter

FooterTopBorderDistance (long) distance between top border and content of footer in hundredths of a millimeter

FooterBottomBorderDistance (long) distance between bottom border and content of footer in hundredths of a millimeter

FooterIsShared (Boolean) the footers on the even and odd pages have the same content (refer to FooterText, FooterTextLeft, and FooterTextRight )

FooterBackColor (long) background color of footer

FooterBackGraphicURL (String) URL of the background graphics that you want to use

FooterBackGraphicFilter (String) name of the filter for interpreting the background graphics for the footer

FooterBackGraphicLocation (Enum) position of background graphics for the footer (value according to com.sun.star.style.GraphicLocation enumeration)

FooterBackTransparent (Boolean) shows the background of the footer as transparent

FooterShadowFormat (struct) details of shadow of footer (com.sun.star.table.ShadowFormat structure)

}

end;

ifPrintObjects: boolean = false; ifPrintDrawing: boolean = false; ifPrintDownFirst: boolean = false;

ifPrintFormulas: boolean = false; ifPrintZeroValues: boolean = false; ifPrintAnnotations: boolean = false; currpage: integer = 0);

//width,height, // ifLandscape 纵向或横向 //ifprintGrid打印网格线 ifPrintHeaders打印页头; ifPrintCharts 打印图表

//ifPrintObjects 打印对象/图形; ifPrintDrawing 打印绘图对象 ifPrintDownFirst: 从下向下打印

//ifPrintFormulas: 打印公式 ifPrintZeroValues:打印零值 ifPrintAnnotations 打印批注

var HContent, htext, StyleFamilies, PageStyles, DefPage: OleVariant;

begin

StyleFamilies := oDocument.StyleFamilies;

PageStyles := StyleFamilies.getByName('PageStyles');

// DefPage := PageStyles.getByName('Default');

if currpage = 0 then

DefPage := PageStyles.getByName('Default')

else

DefPage := PageStyles.getByindex(currpage);

if Owidth >= 0 then defpage.width := owidth;

if Oheight >= 0 then defpage.height := oheight;

defpage.isLandscape := ifLandscape; //determins if the page format is landscape.

defpage.printGrid := ifprintGrid; //PrintGrid (Boolean) prints the cell gridlines

defpage.PrintHeaders := ifPrintHeaders; //PrintHeaders (Boolean) prints the row and column headings

defpage.PrintCharts := ifPrintCharts; //PrintCharts (Boolean) prints charts contained in a sheet

defpage.PrintObjects := ifPrintObjects; //PrintObjects (Boolean) prints embedded objects

defpage.PrintDrawing := ifPrintDrawing; //PrintDrawing (Boolean) prints draw objects

defpage.PrintDownFirst := ifPrintDownFirst; //PrintDownFirst (Boolean) if the contents of a sheet extend across several pages, they are first printed in vertically descending order, and then down the right-hand side.

defpage.PrintFormulas := ifPrintFormulas; //PrintFormulas (Boolean) prints the formulas instead of the calculated values

defpage.PrintZeroValues := ifPrintZeroValues; //PrintZeroValues (Boolean) prints the zero values

defpage.PrintAnnotations := ifPrintAnnotations; //PrintAnnotations (Boolean) prints cell comments

end;

procedure Setcolwidth(objsheet: OleVariant; col: integer; colwidth: integer = 0);

var Ocol: OleVariant;

begin

if colwidth > 0 then

begin

Ocol := objSheet.getColumns.getByIndex(col);

Ocol.setPropertyValue('Width', colwidth);

end;

procedure mychangerows(objsheet: OleVariant; iscol, isrow: integer; iecol: integer = 0; ierow: integer = 0; insertrow: integer = 1); //删除行增加行

var Orow, ocell: OleVariant;

begin

{ From Andrew's macro information 6.23

Dim oCell As Object

Dim oCursor As Object

Dim aAddress As Variant

oCell = oSheet.GetCellbyPosition( 0, 0 )

oCursor = oSheet.createCursorByRange(oCell)

oCursor.GotoEndOfUsedArea(True)

aAddress = oCursor.RangeAddress

Create a CellRange covering the whole sheet :

Code:

oCellRange = oSheet.getCellRangeByPosition(0,0, aAddress.Column,aAddress.Row)

Insert 1 blank line using "insertByIndex" to ".Rows" of this range :

Code:

oRows = oCellRange.Rows

oRows.insertByIndex(0,1)

}

oCell := oBJSheet.getCellRangeByPosition(iscol, isrow, iecol, ierow);

orow := OCELL.Rows;

oRow.insertByIndex(0, insertrow);

end;

procedure copyCells(CellRang: string = ''); //Copy

var args: Variant;

begin

GotoCell(CellRang);

args := CreateProperties(['null', '']);

ExecDispatch('.uno:Copy', args);

end;

procedure pastecells(CellRang: string = ''); //paste

var args: Variant;

begin

GotoCell(CellRang);

args := CreateProperties(['null', '']);

ExecDispatch('.uno:paste', args);

end;

function fnGetNumberFormatId(oDoc: oleVariant; sNumberFormat: string = ''): integer;

var sCharLocale: variant;

nFormatId: integer;

begin

sCharLocale := oDoc.getPropertyValue('CharLocale');

nFormatId := oDoc.getNumberFormats.queryKey(sNumberFormat, sCharLocale, false);

if nFormatId = -1 then //Not yet defined

begin

nFormatId := oDoc.getNumberFormats.addNew(sNumberFormat, sCharLocale);

end;

result := nFormatId;

end;

procedure setnumberproperty(oDoc: oleVariant; cellrang: string; sNumberFormat: string = '');

var ocells: olevariant;

nFourDP: integer;

begin

oCells := odoc.getSheets.getByIndex(0).getCellRangeByName(cellrang);

nFourDP := fnGetNumberFormatId(odoc, sNumberFormat);

oCells.setPropertyValue('NumberFormat', nFourDp);

end;

procedure setproperty(objsheet: oleVariant; MYproperty: integer); //设置属性值

var args: Variant;

begin

args := CreateProperties(['NumberFormatValue', myproperty]);

execDispatch('.uno:NumberFormatValue', args);

// args := CreateProperties(['DateFormatValue', myproperty]);

// execDispatch('.uno:DateFormatValue', args);

end;

{procedure setpropertystring(objsheet: oleVariant; MYstr: string); //设置属性值格式

var args: Variant;

begin

args := CreateProperties(['StringName', mystr]);

execDispatch('.uno:EnterString', args);

end;

}

procedure setouterborder(cellrang: string = ''; bordercolorvalue: integer = 0);

var args, args2: Variant;

values: Variant;

begin

values := VarArrayOf([bordercolorvalue, 0, 2, 0]);

GotoCell(CellRang);

args := CreateProperties(['OuterBorder.LeftBorder', values, 'OuterBorder.LeftDistance', 0

, 'OuterBorder.RightBorder', values, 'OuterBorder.RightDistance', 0

, 'OuterBorder.TopBorder', values, 'OuterBorder.TopDistance', 0

, 'OuterBorder.BottomBorder', values, 'OuterBorder.BottomDistance', 0, 'InnerBorder.Horizontal', values

, 'InnerBorder.Vertical', values, 'InnerBorder.Flags', 0

, 'InnerBorder.ValidFlags', 127, 'InnerBorder.DefaultDistance', 0]);

ExecDispatch('.uno:SetBorderStyle', args);

{ mArgs2(8).Name = "InnerBorder.Horizontal"

mArgs2(8).Value = Array(8421504, 0, 2, 0)

mArgs2(9).Name = "InnerBorder.Vertical"

mArgs2(9).Value = Array(8421504, 0, 2, 0)

mArgs2(10).Name = "InnerBorder.Flags"

mArgs2(10).Value = 0

mArgs2(11).Name = "InnerBorder.ValidFlags"

mArgs2(11).Value = 127

mArgs2(12).Name = "InnerBorder.DefaultDistance"

mArgs2(12).Value = 0

oDispatcher.executeDispatch(oDocumentFrame, ".uno:SetBorderStyle" ,"" ,0 ,mArgs2())

}

end;

function returnfield(fieldstr: string): OleVariant; //此功能暂未开发完成(08-10-26)

var HContent, htext, StyleFamilies, PageStyles, DefPage, oField: OleVariant;

oCursor: Variant;

mystr, Lstr: string;

nnn: integer;

ifsnap: boolean;

begin

mystr := '';

ifsnap := false;

nnn := 1;

while (length(fieldstr) > 0) and (nnn > 0) do

begin

nnn := pos('~~', FIELDSTR);

mystr := copy(fieldstr, 1, nnn - 1);

fieldstr := trim(copy(fieldstr, nnn + 2, length(fieldstr)));

if ifsnap then

begin

Lstr := copy(fieldstr, 1, nnn - 1);

end;

ifsnap := not ifsnap;

end;

{

StyleFamilies := oDocument.StyleFamilies;

PageStyles := StyleFamilies.getByName('PageStyles');

DefPage := PageStyles.getByName('Default');

HContent := DefPage.RightPagefooterContent;

HText := HContent.CenterText;

// HText.string := Mfootmid;

HText.setString('');

// ocursor := VarArrayCreate([0, 1], varVariant);

oCursor := hText.createTextCursor;

HText.insertString(oCursor, 'SHEET: ', False); //' This will have the sheet name of the current sheet!

oField := oDocument.createInstance('com.sun.star.text.TextField.SheetName');

HText.insertTextContent(oCursor, oField, False);

}

end;

procedure savexls(filename: string);

var args: Variant;

begin

args := CreateProperties(['URL', filename, 'FilterName', 'MS Excel 97']);

execDispatch('.uno:storeToUrl', args);

end;

procedure insertbreak(CellRang: string = ''); //插入换页

var args: Variant;

begin

GotoCell(CellRang);

args := CreateProperties(['null', '']);

ExecDispatch('.uno:InsertRowBreak', args);

end;

end.

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

unit OOoMessages;

interface

const { these messages may be translated to another idiom }

{ OOoTools unit }

OOo_serviceKO= 'Impossible to create service : %s';

OOo_connectKO= 'OpenOffice connection is impossible';

OOo_structureKO= 'Unknown structure name : %s';

OOo_inspectionKO= 'Object cannot be inspected';

OOo_nbrArgsKO= 'Incorrect number of arguments';

OOo_notString= 'The argument in position %d (starting from 0) should be a String';

OOo_convertToURLKO= 'ConvertToURL impossible';

OOo_convertFromURLKO= 'ConvertFromURL impossible';

{ OOoXray units }

XrayMess10= '- Properties -';

XrayMess10T= '- Sorted properties -';

XrayMess13= '- Notes -';

XrayMess20= '- Methods -';

XrayMess20T= '- Sorted methods -';

XrayMess21= '- Arguments -';

XrayMess22= '- Return type -';

XrayMess23= '- Interface -';

XrayMess30= '- Sorted supported services -';

XrayMess31= '- Sorted available services -';

XrayMess32= '- Sorted supported interfaces -';

XrayMess40= '*** un-named object ***';

XrayMess61= '???';

XrayMess62= 'Structure : ';

XrayMess70= 'Xray impossible because method needs arguments';

XrayMess71= 'This method returns nothing';

XrayMess72= 'COM bridge limitation : %s is inaccessible through Xray';

XrayMess74= 'This property can''t be read, you can only write to it !';

XrayMess80= 'Sorry, there is no page in the SDK for this';

XrayMess81= 'Sorry, this pseudo-property is not documented';

XrayMess82= 'Pseudo-property, displaying : %s';

XrayMess83= 'There are several pages on : %s';

XrayMess84= 'SDK address is incorrect.'#13'Please modify constant SDKaddr in OOoXray.pas';

XrayMess85= 'Browser address is incorrect.'#13'Please modify constant myBrowser in OOoXray.pas';

XrayMess86= 'This property is not documented in the supported services';

XrayMess87= 'Displayed documentation is found in other services';

XrayMess88= 'The content of this Xray window is saved';

XrayMvalue = 'Value = ';

XrayMzeroString= 'Zero length string';

XrayMcolType = '- Type -';

XrayMcolValue = '- Value -';

{ Unit1 unit }

OOoMess001= 'Connected to OpenOffice';

OOoMess002= 'Disconnected from OpenOffice';

{ OOoExamples unit }

OOoMess105= 'Document will close';

OOoMess107= 'Table not yet sorted';

OOoMess108= 'Table is sorted now !';

OOoMess111= 'Hello World';

OOoMess112= 'written with ';

OOoMess113= 'OpenOffice.org ';

implementation

end.

推荐分享