RSS订阅 | 匿名投稿
您的位置:网站首页 > 单元 > 正文

Delphi调用openoffice的二个单元文件

作者:admin 来源: 日期:2011/8/18 9:02:41 人气: 标签:

 
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;
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;
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;
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;
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;
  end;
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;
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;

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;
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;

procedure setpagefoot(oDocument: OleVariant; Mfootleft: string = ''; Mfootmid: string = ''; Mfootright: string = ''; footheight: integer = 0; colorOOo: Longword = 0; ifpage: boolean = false; currpage: integer = 0);
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;
end;

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);
   //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;
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.

读完这篇文章后,您心情如何?
0
0
0
0
0
0
0
0
本文网址: