' *** MODULE HELPERS *** '======================================================= ' Main '------------------------------------------------------- ' Ensure that necessary library functions are available '======================================================= Sub Main GlobalScope.BasicLibraries.loadLibrary("Tools") End Sub '======================================================= ' ShowProp '------------------------------------------------------- ' Displays a dialog that shows the properties and ' the methods of an object. Used for debugging. '======================================================= Sub ShowProp(Elem As Object) dim oDialog As Object BasicLibraries.LoadLibrary("HelpAuthoring") oDialog = LoadDialog("HelpAuthoring", "dlgObjProp") oDialogModel = oDialog.Model oTxtProp = oDialog.GetControl("txtProp") oTxtProp.Text = Join(Split(Elem.dbg_properties,";"),chr(13)) oTxtMeth = oDialog.GetControl("txtMeth") oTxtMeth.Text = Join(Split(Elem.dbg_methods,";"),chr(13)) oTxtInt = oDialog.GetControl("txtInt") oTxtInt.Text = Join(Split(Elem.dbg_supportedInterfaces,";"),chr(13)) oDialog.Execute() oDialog.dispose End Sub '======================================================= ' AlphaNum '------------------------------------------------------- ' Removes all invalid characters from a string '======================================================= Function AlphaNum(Strg As String) dim OutStrg As String dim sValid As String sValid = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_0123456789" For i=1 to Len(Strg) If (Instr(sValid,LCase(Mid(Strg,i,1)))) Then OutStrg = OutStrg + Mid(Strg,i,1) End If Next i AlphaNum = OutStrg End Function '======================================================= ' Replace '------------------------------------------------------- ' Replaces a character with another character in a string '======================================================= Function Replace(txt As String, ReplaceFrom As String, ReplaceTo As String) dim OutStr As String For i=1 to len(txt) If LCase(mid(txt,i,1))=ReplaceFrom Then OutStr = OutStr + ReplaceTo Else OutStr = OutStr + mid(txt,i,1) End If Next i Replace = OutStr End Function '======================================================= ' ReplaceAll '------------------------------------------------------- ' Replaces a character with another character in a string '======================================================= Function ReplaceAll(txt As String, ReplaceFrom As String, ReplaceTo As String) dim OutStr As String For i=1 to len(txt) bFound = 0 For j=1 to len(ReplaceFrom) If LCase(mid(txt,i,1))=LCase(mid(ReplaceFrom,j,1)) Then bFound = 1 OutStr = OutStr + ReplaceTo j = len(ReplaceFrom) End If Next j If bFound=0 Then OutStr = OutStr + mid(txt,i,1) End If Next i ReplaceAll = OutStr End Function '======================================================= ' CreateID '------------------------------------------------------- ' Creates a numerical randomized ID '======================================================= Function CreateID sDate = ReplaceAll(Date,"/:. \","") sTime = ReplaceAll(Time,"/:. \AMP","") Randomize CreateID = sDate + sTime + Int(Rnd * 100) End Function '======================================================= ' InsertTag '------------------------------------------------------- ' Inserts an inline tag (element) in the document at the ' current cursor position. It also sets the character ' format to hlp_aux_tag '======================================================= Sub InsertTag (Element As String, Content As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(5) as new com.sun.star.beans.PropertyValue args(0).Name = "Type" args(0).Value = 8 args(1).Name = "SubType" args(1).Value = 1 args(2).Name = "Name" args(2).Value = Element args(3).Name = "Content" args(3).Value = Content args(4).Name = "Format" args(4).Value = -1 args(5).Name = "Separator" args(5).Value = " " SetCharStyle("hlp_aux_tag") dispatcher.executeDispatch(document, ".uno:InsertField", "", 0, args()) SetCharStyle("Default") End Sub '======================================================= ' INSERTTAGCR '------------------------------------------------------- ' Inserts a tag (element) in the document at the ' current cursor position in its own newly created paragraph. ' It also sets the character format to hlp_aux_tag and ' the paragraph to the specified value (should start with hlp_) '======================================================= Sub InsertTagCR (Element As String, Content As String, Style As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(5) as new com.sun.star.beans.PropertyValue args(0).Name = "Type" args(0).Value = 8 args(1).Name = "SubType" args(1).Value = 1 args(2).Name = "Name" args(2).Value = Element args(3).Name = "Content" args(3).Value = Content args(4).Name = "Format" args(4).Value = -1 args(5).Name = "Separator" args(5).Value = " " CR goUp(1) SetParaStyle(Style) SetCharStyle("hlp_aux_tag") dispatcher.executeDispatch(document, ".uno:InsertField", "", 0, args()) SetCharStyle("Default") goDown(1) End Sub '======================================================= ' InsertField '------------------------------------------------------- ' Inserts a field in the document at the ' current cursor position. '======================================================= Sub InsertField(Field as String, Content as String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(5) as new com.sun.star.beans.PropertyValue args(0).Name = "Type" args(0).Value = 8 args(1).Name = "SubType" args(1).Value = 1 args(2).Name = "Name" args(2).Value = Field args(3).Name = "Content" args(3).Value = Content args(4).Name = "Format" args(4).Value = -1 args(5).Name = "Separator" args(5).Value = " " dispatcher.executeDispatch(document, ".uno:InsertField", "", 0, args()) End Sub '======================================================= ' GoUp '------------------------------------------------------- ' Simulates the CursorUp key '======================================================= Sub goUp(Count As Integer, Optional bSelect As Boolean) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Count" args(0).Value = Count args(1).Name = "Select" If IsMissing(bSelect) Then args(1).Value = false Else args(1).Value = bSelect End If dispatcher.executeDispatch(document, ".uno:GoUp", "", 0, args()) End Sub '======================================================= ' GoDown '------------------------------------------------------- ' Simulates the CursorDown key '======================================================= Sub goDown(Count As Integer, Optional bSelect As Boolean) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Count" args(0).Value = Count args(1).Name = "Select" If IsMissing(bSelect) Then args(1).Value = false Else args(1).Value = bSelect End If dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args()) End Sub '======================================================= ' GoRight '------------------------------------------------------- ' Simulates the CursorRight key '======================================================= Sub goRight(Count As Integer, Optional bSelect As Boolean) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Count" args(0).Value = Count args(1).Name = "Select" If IsMissing(bSelect) Then args(1).Value = false Else args(1).Value = bSelect End If dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args()) End Sub '======================================================= ' GoLeft '------------------------------------------------------- ' Simulates the CursorLeft key '======================================================= Sub goLeft(Count As Integer, optional bSelect As boolean) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Count" args(0).Value = Count args(1).Name = "Select" If IsMissing(bSelect) Then args(1).Value = false Else args(1).Value = bSelect End If dispatcher.executeDispatch(document, ".uno:GoLeft", "", 0, args()) End Sub '======================================================= ' CR '------------------------------------------------------- ' Inserts a Carriage Return (a new paragraph) '======================================================= Sub CR dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoEndOfParagraph(0) thiscomponent.getcurrentcontroller.select(oCur) dispatcher.executeDispatch(document, ".uno:InsertPara", "", 0, Array()) End Sub '======================================================= ' CR_before '------------------------------------------------------- ' Inserts a Carriage Return (a new paragraph) before the current para '======================================================= Sub CR_before dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoStartOfParagraph(0) thiscomponent.getcurrentcontroller.select(oCur) dispatcher.executeDispatch(document, ".uno:InsertPara", "", 0, Array()) End Sub '======================================================= ' LF '------------------------------------------------------- ' Inserts a line feed (manual line break) '======================================================= sub LF dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:InsertLinebreak", "", 0, Array()) end sub '======================================================= ' SetParaStyle '------------------------------------------------------- ' Sets the para style to the given value '======================================================= Sub SetParaStyle(StyleName As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Template" args(0).Value = StyleName args(1).Name = "Family" args(1).Value = 2 dispatcher.executeDispatch(document, ".uno:StyleApply", "", 0, args()) end Sub '======================================================= ' SetCharStyle '------------------------------------------------------- ' Sets the character style to the given value '======================================================= Sub SetCharStyle(StyleName As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Template" args(0).Value = StyleName args(1).Name = "Family" args(1).Value = 1 dispatcher.executeDispatch(document, ".uno:StyleApply", "", 0, args()) end Sub '======================================================= ' InsertNewParaData '------------------------------------------------------- ' Inserts a new ID for the paragraph '======================================================= Sub InsertNewParaData If not IsHelpFile Then msgbox(strErr_NoHelpFile) Exit Sub End If oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) arParaData = GetParaData sID = arParaData(0) slocalize = arParaData(1) sMsg = arParaData(2) If sMsg <> "" Then msgbox "Cannot assign paragraph id:"+chr(13)+sMsg,48,"Error" Exit Sub End If If sID <> "" Then msgbox "Paragraph already has an ID."+chr(13)+"If you want to assign a new ID delete the existing one first.",48,"Error" Exit Sub End If oCur.gotoStartOfParagraph(0) If (Left(oCur.ParaStyleName,8) = "hlp_head") Then id = "hd_id" + CreateID thiscomponent.getcurrentcontroller.select(oCur) MetaData = id SetCharStyle("hlp_aux_parachanged") InsertField("ID",MetaData) SetCharStyle("Default") Else id = "par_id" + CreateID thiscomponent.getcurrentcontroller.select(oCur) MetaData = id SetCharStyle("hlp_aux_parachanged") InsertField("ID",MetaData) SetCharStyle("Default") End If End Sub '======================================================= ' LoadDialog '------------------------------------------------------- ' Loads a BASIC dialog '======================================================= Function LoadDialog(Libname as String, DialogName as String, Optional oLibContainer) Dim oLib as Object Dim oLibDialog as Object Dim oRuntimeDialog as Object If IsMissing(oLibContainer ) then oLibContainer = DialogLibraries End If oLibContainer.LoadLibrary(LibName) oLib = oLibContainer.GetByName(Libname) oLibDialog = oLib.GetByName(DialogName) oRuntimeDialog = CreateUnoDialog(oLibDialog) LoadDialog() = oRuntimeDialog End Function '======================================================= ' Surprise '------------------------------------------------------- ' D'oh '======================================================= Sub Surprise msgbox "This function is unsupported."+chr(13)+"If you know how to implement this -- go ahead!",0,"D'oh!" End Sub '======================================================= ' InsertNote '------------------------------------------------------- ' Inserts a note (annotation) at the current position '======================================================= sub InsertNote(Content As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(2) as new com.sun.star.beans.PropertyValue args(0).Name = "Text" args(0).Value = Content args(1).Name = "Author" args(1).Value = "Help Tooling - DO NOT EDIT" args(2).Name = "Date" args(2).Value = "02/27/2004" dispatcher.executeDispatch(document, ".uno:InsertAnnotation", "", 0, args()) end sub '======================================================= ' InsertText '------------------------------------------------------- ' Inserts a string at the current position '======================================================= Sub InsertText(strg As String) oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.String = strg End Sub '======================================================= ' ParaIsEmpty '------------------------------------------------------- ' Evaluates if a paragraph is empty. '======================================================= Function ParaIsEmpty oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoStartOfParagraph(0) ParaIsEmpty = oCur.IsEndOfParagraph End Function '======================================================= ' IsInBookmark '------------------------------------------------------- ' Evaluates if the cursor is inside a <bookmark> </bookmark> element '======================================================= Function IsInBookmark oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) If ((oCur.ParaStyleName = "hlp_aux_bookmark") AND (not(oCur.IsEndOfParagraph))) Then oCur.GotoStartOfParagraph(0) oCur.GotoEndOfParagraph(1) sText = Left(oCur.GetString,Instr(oCur.GetString,""" id=""")-1) sText = Right(sText,Len(sText)-InStr(sText,"""")) Select Case Left(sText,3) Case "ind" IsInBookmark = 1 Case "hid" IsInBookmark = 2 Case "con" IsInBookmark = 3 Case Else IsInBookmark = 0 End Select Else IsInBookmark = 0 End If End Function '======================================================= ' IsInTable '------------------------------------------------------- ' Evaluates if the cursor is in a table '======================================================= Function IsInTable oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) IsInTable = (VarType(oCur.TextTable) <> 0) End Function '======================================================= ' InsertLink '------------------------------------------------------- ' Inserts a hyperlink at the current position '======================================================= Sub InsertLink(sPath As String, sText As String, sName As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(4) as new com.sun.star.beans.PropertyValue args(0).Name = "Hyperlink.Text" args(0).Value = sText args(1).Name = "Hyperlink.URL" args(1).Value = sPath args(2).Name = "Hyperlink.Target" args(2).Value = "" args(3).Name = "Hyperlink.Name" args(3).Value = sName args(4).Name = "Hyperlink.Type" args(4).Value = 1 dispatcher.executeDispatch(document, ".uno:SetHyperlink", "", 0, args()) args(0).Name = "Count" args(0).Value = 1 args(1).Name = "Select" args(1).Value = false dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args()) End Sub '======================================================= ' AssignMissingIDs '------------------------------------------------------- ' Assigns IDs to elements that miss them '======================================================= Sub AssignMissingIDs ' NOT IMPLEMENTED YET end sub '======================================================= ' CreateTable '------------------------------------------------------- ' Creates a new table '======================================================= Sub CreateTable(nRows as Integer, nCols as Integer, sID as String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args1(3) as new com.sun.star.beans.PropertyValue args1(0).Name = "TableName" args1(0).Value = sID args1(1).Name = "Columns" args1(1).Value = nCols args1(2).Name = "Rows" args1(2).Value = nRows args1(3).Name = "Flags" args1(3).Value = 9 dispatcher.executeDispatch(document, ".uno:InsertTable", "", 0, args1()) args1(0).Name = "TopBottomMargin.TopMargin" args1(0).Value = 500 args1(1).Name = "TopBottomMargin.BottomMargin" args1(1).Value = 0 args1(2).Name = "TopBottomMargin.TopRelMargin" args1(2).Value = 100 args1(3).Name = "TopBottomMargin.BottomRelMargin" args1(3).Value = 100 dispatcher.executeDispatch(document, ".uno:TopBottomMargin", "", 0, args1()) dispatcher.executeDispatch(document, ".uno:SelectAll", "", 0, Array()) SetParaStyle("hlp_tablecontent") GoDown(1) end Sub '======================================================= ' IsBlockImage '------------------------------------------------------- ' Evaluates if the cursor is in a paragraph with ' a block image (image in its own paragraph) '======================================================= Function IsBlockImage oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoStartOfParagraph(0) oCur.gotoEndOfParagraph(1) sStr = Right(oCur.String,Len(oCur.String)-InStr(oCur.String," ")) 'string must start with <IMG and end with IMG with no <IMG in between IsBlockImage = (not(Left(sStr,4)="IMG>") AND (Right(sStr,6)="</IMG>")) End Function '======================================================= ' HasCaption '------------------------------------------------------- ' Evaluates if the current image has a caption element '======================================================= Function HasCaption oSel = thiscomponent.getcurrentcontroller.getselection If oSel.ImplementationName = "SwXTextGraphicObject" Then oCur = oSel(0).getAnchor.getText.createTextCursorByRange(oSel(0).getAnchor) Else oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) End If oCur.gotoStartOfParagraph(0) oCur.gotoEndOfParagraph(1) HasCaption = (InStr(oCur.String,"<IMGCAPTION")>0) End Function '======================================================= ' GetImageID '------------------------------------------------------- ' Returns the ID of an image at the cursor position '======================================================= Function GetImageID oSel = thiscomponent.getcurrentcontroller.getselection If oSel.ImplementationName = "SwXTextGraphicObject" Then oCur = oSel(0).getAnchor.getText.createTextCursorByRange(oSel(0).getAnchor) Else oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) End If oCur.gotoStartOfParagraph(0) oCur.gotoEndOfParagraph(1) sStr = Right(oCur.String,Len(oCur.String)-(InStr(oCur.String,"IMG ID=""")+7)) GetImageID = Left(sStr,InStr(sStr,""">")+1) 'string must start with <IMG and end with IMG with no <IMG in between End Function '======================================================= ' SelAll '------------------------------------------------------- ' Selects everything '======================================================= Sub SelAll dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:SelectAll", "", 0, Array()) End Sub '======================================================= ' GetParaData '------------------------------------------------------- ' Returns the Paragraph ID and localization status '======================================================= Function GetParaData arParaData = Array("","","") ' ID, localize, #message oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoStartOfParagraph(0) oCur.gotoEndOfParagraph(1) sID = "" Enum = oCur.createEnumeration Fd = FALSE TE = Enum.nextElement TP = TE.createEnumeration Ct = 0 posID = 0 Do While TP.hasmoreElements Ct = Ct+1 TPE = TP.nextElement If TPE.TextPortionType="TextField" Then If TPE.TextField.TextFieldMaster.Name="ID" Then sID = TPE.TextField.Content Fd = TRUE Exit Do End If End If If TPE.String = "" Then Ct = Ct-1 End If Loop If ((Left(oCur.ParaStyleName,8) = "hlp_aux_") or (Left(oCur.ParaStyleName,4) <> "hlp_")) Then arParaData(2)="Invalid Paragraph Style" GetParaData = arParaData Exit Function End If If sID = "" Then GetParaData = arParaData Exit Function End If If Right(sID,7) = "_NOL10N" Then arParaData(0) = Left(sID,Len(sID)-7) arParaData(1) = "no" Else arParaData(0) = sID arParaData(1) = "yes" End If GetParaData = arParaData End Function '======================================================= ' SetsParaData '------------------------------------------------------- ' Sets the Paragraph ID and localization status '======================================================= Sub SetParaData(sID as String, sLocalize as String) oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoStartOfParagraph(0) oCur.gotoEndOfParagraph(1) Enum = oCur.createEnumeration Fd = FALSE Do While Enum.hasMoreElements TE = Enum.nextElement TP = TE.createEnumeration Ct = 0 posID = 0 Do While TP.hasmoreElements Ct = Ct+1 TPE = TP.nextElement If TPE.TextPortionType="TextField" Then If TPE.TextField.TextFieldMaster.Name="ID" Then posID = Ct If sLocalize = "no" Then TPE.TextField.Content = sID+"_NOL10N" TPE.TextField.IsVisible = TRUE ElseIf sLocalize = "yes" Then TPE.TextField.Content = sID TPE.TextField.IsVisible = TRUE Else msgbox "Unknown localization parameter: "+sLocalize,0,"Error" End If Fd = TRUE Exit Do End If End If If TPE.String = "" Then Ct = Ct-1 End If Loop If Fd Then Exit Do End If Loop oCur.TextField.update UpdateFields End Sub '======================================================= ' IsInList '------------------------------------------------------- ' Evaluates if the cursor is inside a list (ordered or unordered) '======================================================= Function IsInList oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) If oCur.NumberingStyleName = "" Then IsInList = false ElseIf oCur.NumberingRules.NumberingIsOutline = true Then IsInList = false Else IsInList = true End If End Function '======================================================= ' TagFormatIsCorrect '------------------------------------------------------- ' Checks for correct paragraph format for tags '======================================================= Function TagFormatIsCorrect(sTN As String, sPS As String) arTag = Array("BOOKMARK","SORT","SECTION","SWITCH","CASE","DEFAULT") arTagFormat = Array("hlp_aux_bookmark","hlp_aux_sort","hlp_aux_section","hlp_aux_switch","hlp_aux_switch","hlp_aux_switch") For n=0 to ubound(arTag) If (sTN = arTag(n) AND sPS <> arTagFormat(n)) Then TagFormatIsCorrect = arTagFormat(n) Exit Function End If TagFormatIsCorrect = "" Next n End Function '======================================================= ' GetFilePath '------------------------------------------------------- ' look for the "text/..." part of the file name and separate it '======================================================= Function GetFilePath(fname As String) i = 1 Do If (Mid(fname,i,5) = "text/") Then Strg = Mid(fname,i,Len(fname)-i+1) Exit Do Else i = i+1 Strg = fname End If Loop While (i+5 < Len(fname)) GetFilePath = Strg End Function '======================================================= ' OpenGraphics '------------------------------------------------------- ' Calls the graphic open dialog for inserting an image '======================================================= Function OpenGraphics(oDoc As Object) Dim ListAny(0) as Long Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue GlobalScope.BasicLibraries.loadLibrary("Tools") ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE ' ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_LINK_PREVIEW_IMAGE_TEMPLATE oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") oFileDialog.Initialize(ListAny()) sLastImgDir = ReadConfig("LastImgDir") If sLastImgDir <> "" Then oFileDialog.setDisplayDirectory(sLastImgDir) End If oMasterKey = GetRegistryKeyContent("org.openoffice.TypeDetection.Types/") oTypes() = oMasterKey.Types oFileDialog.AppendFilter(oTypes.GetByName("gif_Graphics_Interchange").UIName, "*.gif") oFileDialog.AppendFilter(oTypes.GetByName("png_Portable_Network_Graphic").UIName, "*.png") oFileDialog.SetTitle("Insert Image") iAccept = oFileDialog.Execute() If iAccept = 1 Then sPath = oFileDialog.Files(0) WriteConfig("LastImgDir",oFileDialog.getDisplayDirectory) UIFilterName = oFileDialog.GetCurrentFilter() OpenGraphics = oFileDialog.Files(0) Else OpenGraphics = "" End If oFileDialog.Dispose() End Function '======================================================= ' WriteConfig '------------------------------------------------------- ' Reads a parameter value from the config file '======================================================= Function ReadConfig(Parm As String) oPath = createUNOService("com.sun.star.util.PathSettings") filename = oPath.UserConfig+"/helpauthoring.cfg" iNumber = Freefile bFound = false If FileExists(filename) Then Open filename For Input As iNumber Do While (not eof(iNumber) AND not(bFound)) Line Input #iNumber, sLine If InStr(sLine, "=") > 0 Then arLine = split(sLine,"=") If arLine(0) = Parm Then sResult = arLine(1) bFound = true End If End If Loop Close #iNumber If bFound Then ReadConfig = sResult Else ReadConfig = "" End If Else ReadConfig = "" End If End Function '======================================================= ' WriteConfig '------------------------------------------------------- ' Writes a parameter/value pair to the config file '======================================================= Function WriteConfig(Parm As String, Value As String) Dim arLines(0) As String bFound = false oPath = createUNOService("com.sun.star.util.PathSettings") filename = oPath.UserConfig+"/helpauthoring.cfg" iNumber = Freefile If FileExists(filename) Then Open filename For Input As iNumber Do While (not eof(iNumber)) Line Input #iNumber, sLine If InStr(sLine, "=") > 0 Then sDim = ubound(arLines())+1 ReDim Preserve arLines(sDim) arLines(sDim) = sLine End If Loop Close #iNumber nLine = 1 Do While (nLine <= ubound(arLines())) and (not bFound) arLine = split(arLines(nLine),"=") If arLine(0) = Parm Then arLines(nLine) = Parm+"="+Value bFound = true End If nLine = nLine +1 Loop nLine = 1 Open filename For Output As iNumber Do While (nLine <= ubound(arLines())) Print #iNumber, arLines(nLine) nLine = nLine + 1 Loop If (not bFound) Then Print #iNumber, Parm+"="+Value End If Close #iNumber Else Open filename For Output As iNumber Print #iNumber, Parm+"="+Value Close #iNumber End If End Function Function GetRelPath(sPath As String) sHelpPrefix = ReadConfig("HelpPrefix") If sHelpPrefix = "" Then sHelpPrefix = SetDocumentRoot End If GetRelPath = Right(sPath, Len(sPath)-(InStr(sPath,sHelpPrefix) + Len(sHelpPrefix)-1)) End Function Function SetDocumentRoot sHelpPrefix = ReadConfig("HelpPrefix") oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker") oFolderDialog.SetTitle("Select Document Root Folder") If sHelpPrefix > "" Then oFolderDialog.setDisplayDirectory(sHelpPrefix) End If iAccept = oFolderDialog.Execute() If iAccept = 1 Then sHelpPrefix = oFolderDialog.getDirectory + "/" WriteConfig("HelpPrefix",sHelpPrefix) End If SetDocumentRoot = sHelpPrefix End Function Function MakeAbsPath(sPath As String) sHelpPrefix = ReadConfig("HelpPrefix") If sHelpPrefix = "" Then sHelpPrefix = SetDocumentRoot End If If Right(sPath,4) <> ".xhp" Then sPath=sPath+".xhp" End If MakeAbsPath = sHelpPrefix+sPath End Function Sub UpdateFields dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:UpdateFields", "", 0, Array()) End Sub Function IsHelpFile document = StarDesktop.CurrentComponent IsHelpFile = (Right(GetFilePath(document.URL),4)=".xhp") End Function Function GetUserFieldNumber(fn as String) fnum = -1 For a=0 to document.DocumentInfo.getUserFieldCount - 1 If document.DocumentInfo.getUserFieldName(a) = fn Then fnum = a Exit for End If Next a GetUserFieldNumber = fnum End Function ' *** MODULE HELPERS *** '======================================================= ' Main '------------------------------------------------------- ' Ensure that necessary library functions are available '======================================================= Sub Main GlobalScope.BasicLibraries.loadLibrary("Tools") End Sub '======================================================= ' ShowProp '------------------------------------------------------- ' Displays a dialog that shows the properties and ' the methods of an object. Used for debugging. '======================================================= Sub ShowProp(Elem As Object) dim oDialog As Object BasicLibraries.LoadLibrary("HelpAuthoring") oDialog = LoadDialog("HelpAuthoring", "dlgObjProp") oDialogModel = oDialog.Model oTxtProp = oDialog.GetControl("txtProp") oTxtProp.Text = Join(Split(Elem.dbg_properties,";"),chr(13)) oTxtMeth = oDialog.GetControl("txtMeth") oTxtMeth.Text = Join(Split(Elem.dbg_methods,";"),chr(13)) oTxtInt = oDialog.GetControl("txtInt") oTxtInt.Text = Join(Split(Elem.dbg_supportedInterfaces,";"),chr(13)) oDialog.Execute() oDialog.dispose End Sub '======================================================= ' AlphaNum '------------------------------------------------------- ' Removes all invalid characters from a string '======================================================= Function AlphaNum(Strg As String) dim OutStrg As String dim sValid As String sValid = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_0123456789" For i=1 to Len(Strg) If (Instr(sValid,LCase(Mid(Strg,i,1)))) Then OutStrg = OutStrg + Mid(Strg,i,1) End If Next i AlphaNum = OutStrg End Function '======================================================= ' Replace '------------------------------------------------------- ' Replaces a character with another character in a string '======================================================= Function Replace(txt As String, ReplaceFrom As String, ReplaceTo As String) dim OutStr As String For i=1 to len(txt) If LCase(mid(txt,i,1))=ReplaceFrom Then OutStr = OutStr + ReplaceTo Else OutStr = OutStr + mid(txt,i,1) End If Next i Replace = OutStr End Function '======================================================= ' ReplaceAll '------------------------------------------------------- ' Replaces a character with another character in a string '======================================================= Function ReplaceAll(txt As String, ReplaceFrom As String, ReplaceTo As String) dim OutStr As String For i=1 to len(txt) bFound = 0 For j=1 to len(ReplaceFrom) If LCase(mid(txt,i,1))=LCase(mid(ReplaceFrom,j,1)) Then bFound = 1 OutStr = OutStr + ReplaceTo j = len(ReplaceFrom) End If Next j If bFound=0 Then OutStr = OutStr + mid(txt,i,1) End If Next i ReplaceAll = OutStr End Function '======================================================= ' CreateID '------------------------------------------------------- ' Creates a numerical randomized ID '======================================================= Function CreateID sDate = ReplaceAll(Date,"/:. \","") sTime = ReplaceAll(Time,"/:. \AMP","") Randomize CreateID = sDate + sTime + Int(Rnd * 100) End Function '======================================================= ' InsertTag '------------------------------------------------------- ' Inserts an inline tag (element) in the document at the ' current cursor position. It also sets the character ' format to hlp_aux_tag '======================================================= Sub InsertTag (Element As String, Content As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(5) as new com.sun.star.beans.PropertyValue args(0).Name = "Type" args(0).Value = 8 args(1).Name = "SubType" args(1).Value = 1 args(2).Name = "Name" args(2).Value = Element args(3).Name = "Content" args(3).Value = Content args(4).Name = "Format" args(4).Value = -1 args(5).Name = "Separator" args(5).Value = " " SetCharStyle("hlp_aux_tag") dispatcher.executeDispatch(document, ".uno:InsertField", "", 0, args()) SetCharStyle("Default") End Sub '======================================================= ' INSERTTAGCR '------------------------------------------------------- ' Inserts a tag (element) in the document at the ' current cursor position in its own newly created paragraph. ' It also sets the character format to hlp_aux_tag and ' the paragraph to the specified value (should start with hlp_) '======================================================= Sub InsertTagCR (Element As String, Content As String, Style As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(5) as new com.sun.star.beans.PropertyValue args(0).Name = "Type" args(0).Value = 8 args(1).Name = "SubType" args(1).Value = 1 args(2).Name = "Name" args(2).Value = Element args(3).Name = "Content" args(3).Value = Content args(4).Name = "Format" args(4).Value = -1 args(5).Name = "Separator" args(5).Value = " " CR goUp(1) SetParaStyle(Style) SetCharStyle("hlp_aux_tag") dispatcher.executeDispatch(document, ".uno:InsertField", "", 0, args()) SetCharStyle("Default") goDown(1) End Sub '======================================================= ' InsertField '------------------------------------------------------- ' Inserts a field in the document at the ' current cursor position. '======================================================= Sub InsertField(Field as String, Content as String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(5) as new com.sun.star.beans.PropertyValue args(0).Name = "Type" args(0).Value = 8 args(1).Name = "SubType" args(1).Value = 1 args(2).Name = "Name" args(2).Value = Field args(3).Name = "Content" args(3).Value = Content args(4).Name = "Format" args(4).Value = -1 args(5).Name = "Separator" args(5).Value = " " dispatcher.executeDispatch(document, ".uno:InsertField", "", 0, args()) End Sub '======================================================= ' GoUp '------------------------------------------------------- ' Simulates the CursorUp key '======================================================= Sub goUp(Count As Integer, Optional bSelect As Boolean) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Count" args(0).Value = Count args(1).Name = "Select" If IsMissing(bSelect) Then args(1).Value = false Else args(1).Value = bSelect End If dispatcher.executeDispatch(document, ".uno:GoUp", "", 0, args()) End Sub '======================================================= ' GoDown '------------------------------------------------------- ' Simulates the CursorDown key '======================================================= Sub goDown(Count As Integer, Optional bSelect As Boolean) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Count" args(0).Value = Count args(1).Name = "Select" If IsMissing(bSelect) Then args(1).Value = false Else args(1).Value = bSelect End If dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args()) End Sub '======================================================= ' GoRight '------------------------------------------------------- ' Simulates the CursorRight key '======================================================= Sub goRight(Count As Integer, Optional bSelect As Boolean) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Count" args(0).Value = Count args(1).Name = "Select" If IsMissing(bSelect) Then args(1).Value = false Else args(1).Value = bSelect End If dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args()) End Sub '======================================================= ' GoLeft '------------------------------------------------------- ' Simulates the CursorLeft key '======================================================= Sub goLeft(Count As Integer, optional bSelect As boolean) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Count" args(0).Value = Count args(1).Name = "Select" If IsMissing(bSelect) Then args(1).Value = false Else args(1).Value = bSelect End If dispatcher.executeDispatch(document, ".uno:GoLeft", "", 0, args()) End Sub '======================================================= ' CR '------------------------------------------------------- ' Inserts a Carriage Return (a new paragraph) '======================================================= Sub CR dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoEndOfParagraph(0) thiscomponent.getcurrentcontroller.select(oCur) dispatcher.executeDispatch(document, ".uno:InsertPara", "", 0, Array()) End Sub '======================================================= ' CR_before '------------------------------------------------------- ' Inserts a Carriage Return (a new paragraph) before the current para '======================================================= Sub CR_before dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoStartOfParagraph(0) thiscomponent.getcurrentcontroller.select(oCur) dispatcher.executeDispatch(document, ".uno:InsertPara", "", 0, Array()) End Sub '======================================================= ' LF '------------------------------------------------------- ' Inserts a line feed (manual line break) '======================================================= sub LF dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:InsertLinebreak", "", 0, Array()) end sub '======================================================= ' SetParaStyle '------------------------------------------------------- ' Sets the para style to the given value '======================================================= Sub SetParaStyle(StyleName As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Template" args(0).Value = StyleName args(1).Name = "Family" args(1).Value = 2 dispatcher.executeDispatch(document, ".uno:StyleApply", "", 0, args()) end Sub '======================================================= ' SetCharStyle '------------------------------------------------------- ' Sets the character style to the given value '======================================================= Sub SetCharStyle(StyleName As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(1) as new com.sun.star.beans.PropertyValue args(0).Name = "Template" args(0).Value = StyleName args(1).Name = "Family" args(1).Value = 1 dispatcher.executeDispatch(document, ".uno:StyleApply", "", 0, args()) end Sub '======================================================= ' InsertNewParaData '------------------------------------------------------- ' Inserts a new ID for the paragraph '======================================================= Sub InsertNewParaData If not IsHelpFile Then msgbox(strErr_NoHelpFile) Exit Sub End If oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) arParaData = GetParaData sID = arParaData(0) slocalize = arParaData(1) sMsg = arParaData(2) If sMsg <> "" Then msgbox "Cannot assign paragraph id:"+chr(13)+sMsg,48,"Error" Exit Sub End If If sID <> "" Then msgbox "Paragraph already has an ID."+chr(13)+"If you want to assign a new ID delete the existing one first.",48,"Error" Exit Sub End If oCur.gotoStartOfParagraph(0) If (Left(oCur.ParaStyleName,8) = "hlp_head") Then id = "hd_id" + CreateID thiscomponent.getcurrentcontroller.select(oCur) MetaData = id SetCharStyle("hlp_aux_parachanged") InsertField("ID",MetaData) SetCharStyle("Default") Else id = "par_id" + CreateID thiscomponent.getcurrentcontroller.select(oCur) MetaData = id SetCharStyle("hlp_aux_parachanged") InsertField("ID",MetaData) SetCharStyle("Default") End If End Sub '======================================================= ' LoadDialog '------------------------------------------------------- ' Loads a BASIC dialog '======================================================= Function LoadDialog(Libname as String, DialogName as String, Optional oLibContainer) Dim oLib as Object Dim oLibDialog as Object Dim oRuntimeDialog as Object If IsMissing(oLibContainer ) then oLibContainer = DialogLibraries End If oLibContainer.LoadLibrary(LibName) oLib = oLibContainer.GetByName(Libname) oLibDialog = oLib.GetByName(DialogName) oRuntimeDialog = CreateUnoDialog(oLibDialog) LoadDialog() = oRuntimeDialog End Function '======================================================= ' Surprise '------------------------------------------------------- ' D'oh '======================================================= Sub Surprise msgbox "This function is unsupported."+chr(13)+"If you know how to implement this -- go ahead!",0,"D'oh!" End Sub '======================================================= ' InsertNote '------------------------------------------------------- ' Inserts a note (annotation) at the current position '======================================================= sub InsertNote(Content As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(2) as new com.sun.star.beans.PropertyValue args(0).Name = "Text" args(0).Value = Content args(1).Name = "Author" args(1).Value = "Help Tooling - DO NOT EDIT" args(2).Name = "Date" args(2).Value = "02/27/2004" dispatcher.executeDispatch(document, ".uno:InsertAnnotation", "", 0, args()) end sub '======================================================= ' InsertText '------------------------------------------------------- ' Inserts a string at the current position '======================================================= Sub InsertText(strg As String) oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.String = strg End Sub '======================================================= ' ParaIsEmpty '------------------------------------------------------- ' Evaluates if a paragraph is empty. '======================================================= Function ParaIsEmpty oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoStartOfParagraph(0) ParaIsEmpty = oCur.IsEndOfParagraph End Function '======================================================= ' IsInBookmark '------------------------------------------------------- ' Evaluates if the cursor is inside a <bookmark> </bookmark> element '======================================================= Function IsInBookmark oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) If ((oCur.ParaStyleName = "hlp_aux_bookmark") AND (not(oCur.IsEndOfParagraph))) Then oCur.GotoStartOfParagraph(0) oCur.GotoEndOfParagraph(1) sText = Left(oCur.GetString,Instr(oCur.GetString,""" id=""")-1) sText = Right(sText,Len(sText)-InStr(sText,"""")) Select Case Left(sText,3) Case "ind" IsInBookmark = 1 Case "hid" IsInBookmark = 2 Case "con" IsInBookmark = 3 Case Else IsInBookmark = 0 End Select Else IsInBookmark = 0 End If End Function '======================================================= ' IsInTable '------------------------------------------------------- ' Evaluates if the cursor is in a table '======================================================= Function IsInTable oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) IsInTable = (VarType(oCur.TextTable) <> 0) End Function '======================================================= ' InsertLink '------------------------------------------------------- ' Inserts a hyperlink at the current position '======================================================= Sub InsertLink(sPath As String, sText As String, sName As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(4) as new com.sun.star.beans.PropertyValue args(0).Name = "Hyperlink.Text" args(0).Value = sText args(1).Name = "Hyperlink.URL" args(1).Value = sPath args(2).Name = "Hyperlink.Target" args(2).Value = "" args(3).Name = "Hyperlink.Name" args(3).Value = sName args(4).Name = "Hyperlink.Type" args(4).Value = 1 dispatcher.executeDispatch(document, ".uno:SetHyperlink", "", 0, args()) args(0).Name = "Count" args(0).Value = 1 args(1).Name = "Select" args(1).Value = false dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args()) End Sub '======================================================= ' AssignMissingIDs '------------------------------------------------------- ' Assigns IDs to elements that miss them '======================================================= Sub AssignMissingIDs ' NOT IMPLEMENTED YET end sub '======================================================= ' CreateTable '------------------------------------------------------- ' Creates a new table '======================================================= Sub CreateTable(nRows as Integer, nCols as Integer, sID as String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args1(3) as new com.sun.star.beans.PropertyValue args1(0).Name = "TableName" args1(0).Value = sID args1(1).Name = "Columns" args1(1).Value = nCols args1(2).Name = "Rows" args1(2).Value = nRows args1(3).Name = "Flags" args1(3).Value = 9 dispatcher.executeDispatch(document, ".uno:InsertTable", "", 0, args1()) args1(0).Name = "TopBottomMargin.TopMargin" args1(0).Value = 500 args1(1).Name = "TopBottomMargin.BottomMargin" args1(1).Value = 0 args1(2).Name = "TopBottomMargin.TopRelMargin" args1(2).Value = 100 args1(3).Name = "TopBottomMargin.BottomRelMargin" args1(3).Value = 100 dispatcher.executeDispatch(document, ".uno:TopBottomMargin", "", 0, args1()) dispatcher.executeDispatch(document, ".uno:SelectAll", "", 0, Array()) SetParaStyle("hlp_tablecontent") GoDown(1) end Sub '======================================================= ' IsBlockImage '------------------------------------------------------- ' Evaluates if the cursor is in a paragraph with ' a block image (image in its own paragraph) '======================================================= Function IsBlockImage oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoStartOfParagraph(0) oCur.gotoEndOfParagraph(1) sStr = Right(oCur.String,Len(oCur.String)-InStr(oCur.String," ")) 'string must start with <IMG and end with IMG with no <IMG in between IsBlockImage = (not(Left(sStr,4)="IMG>") AND (Right(sStr,6)="</IMG>")) End Function '======================================================= ' HasCaption '------------------------------------------------------- ' Evaluates if the current image has a caption element '======================================================= Function HasCaption oSel = thiscomponent.getcurrentcontroller.getselection If oSel.ImplementationName = "SwXTextGraphicObject" Then oCur = oSel(0).getAnchor.getText.createTextCursorByRange(oSel(0).getAnchor) Else oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) End If oCur.gotoStartOfParagraph(0) oCur.gotoEndOfParagraph(1) HasCaption = (InStr(oCur.String,"<IMGCAPTION")>0) End Function '======================================================= ' GetImageID '------------------------------------------------------- ' Returns the ID of an image at the cursor position '======================================================= Function GetImageID oSel = thiscomponent.getcurrentcontroller.getselection If oSel.ImplementationName = "SwXTextGraphicObject" Then oCur = oSel(0).getAnchor.getText.createTextCursorByRange(oSel(0).getAnchor) Else oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) End If oCur.gotoStartOfParagraph(0) oCur.gotoEndOfParagraph(1) sStr = Right(oCur.String,Len(oCur.String)-(InStr(oCur.String,"IMG ID=""")+7)) GetImageID = Left(sStr,InStr(sStr,""">")+1) 'string must start with <IMG and end with IMG with no <IMG in between End Function '======================================================= ' SelAll '------------------------------------------------------- ' Selects everything '======================================================= Sub SelAll dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:SelectAll", "", 0, Array()) End Sub '======================================================= ' GetParaData '------------------------------------------------------- ' Returns the Paragraph ID and localization status '======================================================= Function GetParaData arParaData = Array("","","") ' ID, localize, #message oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoStartOfParagraph(0) oCur.gotoEndOfParagraph(1) sID = "" Enum = oCur.createEnumeration Fd = FALSE TE = Enum.nextElement TP = TE.createEnumeration Ct = 0 posID = 0 Do While TP.hasmoreElements Ct = Ct+1 TPE = TP.nextElement If TPE.TextPortionType="TextField" Then If TPE.TextField.TextFieldMaster.Name="ID" Then sID = TPE.TextField.Content Fd = TRUE Exit Do End If End If If TPE.String = "" Then Ct = Ct-1 End If Loop If ((Left(oCur.ParaStyleName,8) = "hlp_aux_") or (Left(oCur.ParaStyleName,4) <> "hlp_")) Then arParaData(2)="Invalid Paragraph Style" GetParaData = arParaData Exit Function End If If sID = "" Then GetParaData = arParaData Exit Function End If If Right(sID,7) = "_NOL10N" Then arParaData(0) = Left(sID,Len(sID)-7) arParaData(1) = "no" Else arParaData(0) = sID arParaData(1) = "yes" End If GetParaData = arParaData End Function '======================================================= ' SetsParaData '------------------------------------------------------- ' Sets the Paragraph ID and localization status '======================================================= Sub SetParaData(sID as String, sLocalize as String) oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) oCur.gotoStartOfParagraph(0) oCur.gotoEndOfParagraph(1) Enum = oCur.createEnumeration Fd = FALSE Do While Enum.hasMoreElements TE = Enum.nextElement TP = TE.createEnumeration Ct = 0 posID = 0 Do While TP.hasmoreElements Ct = Ct+1 TPE = TP.nextElement If TPE.TextPortionType="TextField" Then If TPE.TextField.TextFieldMaster.Name="ID" Then posID = Ct If sLocalize = "no" Then TPE.TextField.Content = sID+"_NOL10N" TPE.TextField.IsVisible = TRUE ElseIf sLocalize = "yes" Then TPE.TextField.Content = sID TPE.TextField.IsVisible = TRUE Else msgbox "Unknown localization parameter: "+sLocalize,0,"Error" End If Fd = TRUE Exit Do End If End If If TPE.String = "" Then Ct = Ct-1 End If Loop If Fd Then Exit Do End If Loop oCur.TextField.update UpdateFields End Sub '======================================================= ' IsInList '------------------------------------------------------- ' Evaluates if the cursor is inside a list (ordered or unordered) '======================================================= Function IsInList oSel = thiscomponent.getcurrentcontroller.getselection oCur = oSel(0).getText.createTextCursorByRange(oSel(0)) If oCur.NumberingStyleName = "" Then IsInList = false ElseIf oCur.NumberingRules.NumberingIsOutline = true Then IsInList = false Else IsInList = true End If End Function '======================================================= ' TagFormatIsCorrect '------------------------------------------------------- ' Checks for correct paragraph format for tags '======================================================= Function TagFormatIsCorrect(sTN As String, sPS As String) arTag = Array("BOOKMARK","SORT","SECTION","SWITCH","CASE","DEFAULT") arTagFormat = Array("hlp_aux_bookmark","hlp_aux_sort","hlp_aux_section","hlp_aux_switch","hlp_aux_switch","hlp_aux_switch") For n=0 to ubound(arTag) If (sTN = arTag(n) AND sPS <> arTagFormat(n)) Then TagFormatIsCorrect = arTagFormat(n) Exit Function End If TagFormatIsCorrect = "" Next n End Function '======================================================= ' GetFilePath '------------------------------------------------------- ' look for the "text/..." part of the file name and separate it '======================================================= Function GetFilePath(fname As String) i = 1 Do If (Mid(fname,i,5) = "text/") Then Strg = Mid(fname,i,Len(fname)-i+1) Exit Do Else i = i+1 Strg = fname End If Loop While (i+5 < Len(fname)) GetFilePath = Strg End Function '======================================================= ' OpenGraphics '------------------------------------------------------- ' Calls the graphic open dialog for inserting an image '======================================================= Function OpenGraphics(oDoc As Object) Dim ListAny(0) as Long Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue GlobalScope.BasicLibraries.loadLibrary("Tools") ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE ' ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_LINK_PREVIEW_IMAGE_TEMPLATE oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") oFileDialog.Initialize(ListAny()) sLastImgDir = ReadConfig("LastImgDir") If sLastImgDir <> "" Then oFileDialog.setDisplayDirectory(sLastImgDir) End If oMasterKey = GetRegistryKeyContent("org.openoffice.TypeDetection.Types/") oTypes() = oMasterKey.Types oFileDialog.AppendFilter(oTypes.GetByName("gif_Graphics_Interchange").UIName, "*.gif") oFileDialog.AppendFilter(oTypes.GetByName("png_Portable_Network_Graphic").UIName, "*.png") oFileDialog.SetTitle("Insert Image") iAccept = oFileDialog.Execute() If iAccept = 1 Then sPath = oFileDialog.Files(0) WriteConfig("LastImgDir",oFileDialog.getDisplayDirectory) UIFilterName = oFileDialog.GetCurrentFilter() OpenGraphics = oFileDialog.Files(0) Else OpenGraphics = "" End If oFileDialog.Dispose() End Function '======================================================= ' WriteConfig '------------------------------------------------------- ' Reads a parameter value from the config file '======================================================= Function ReadConfig(Parm As String) oPath = createUNOService("com.sun.star.util.PathSettings") filename = oPath.UserConfig+"/helpauthoring.cfg" iNumber = Freefile bFound = false If FileExists(filename) Then Open filename For Input As iNumber Do While (not eof(iNumber) AND not(bFound)) Line Input #iNumber, sLine If InStr(sLine, "=") > 0 Then arLine = split(sLine,"=") If arLine(0) = Parm Then sResult = arLine(1) bFound = true End If End If Loop Close #iNumber If bFound Then ReadConfig = sResult Else ReadConfig = "" End If Else ReadConfig = "" End If End Function '======================================================= ' WriteConfig '------------------------------------------------------- ' Writes a parameter/value pair to the config file '======================================================= Function WriteConfig(Parm As String, Value As String) Dim arLines(0) As String bFound = false oPath = createUNOService("com.sun.star.util.PathSettings") filename = oPath.UserConfig+"/helpauthoring.cfg" iNumber = Freefile If FileExists(filename) Then Open filename For Input As iNumber Do While (not eof(iNumber)) Line Input #iNumber, sLine If InStr(sLine, "=") > 0 Then sDim = ubound(arLines())+1 ReDim Preserve arLines(sDim) arLines(sDim) = sLine End If Loop Close #iNumber nLine = 1 Do While (nLine <= ubound(arLines())) and (not bFound) arLine = split(arLines(nLine),"=") If arLine(0) = Parm Then arLines(nLine) = Parm+"="+Value bFound = true End If nLine = nLine +1 Loop nLine = 1 Open filename For Output As iNumber Do While (nLine <= ubound(arLines())) Print #iNumber, arLines(nLine) nLine = nLine + 1 Loop If (not bFound) Then Print #iNumber, Parm+"="+Value End If Close #iNumber Else Open filename For Output As iNumber Print #iNumber, Parm+"="+Value Close #iNumber End If End Function Function GetRelPath(sPath As String) sHelpPrefix = ReadConfig("HelpPrefix") If sHelpPrefix = "" Then sHelpPrefix = SetDocumentRoot End If GetRelPath = Right(sPath, Len(sPath)-(InStr(sPath,sHelpPrefix) + Len(sHelpPrefix)-1)) End Function Function SetDocumentRoot sHelpPrefix = ReadConfig("HelpPrefix") oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker") oFolderDialog.SetTitle("Select Document Root Folder") If sHelpPrefix > "" Then oFolderDialog.setDisplayDirectory(sHelpPrefix) End If iAccept = oFolderDialog.Execute() If iAccept = 1 Then sHelpPrefix = oFolderDialog.getDirectory + "/" WriteConfig("HelpPrefix",sHelpPrefix) End If SetDocumentRoot = sHelpPrefix End Function Function MakeAbsPath(sPath As String) sHelpPrefix = ReadConfig("HelpPrefix") If sHelpPrefix = "" Then sHelpPrefix = SetDocumentRoot End If If Right(sPath,4) <> ".xhp" Then sPath=sPath+".xhp" End If MakeAbsPath = sHelpPrefix+sPath End Function Sub UpdateFields dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:UpdateFields", "", 0, Array()) End Sub Function IsHelpFile document = StarDesktop.CurrentComponent IsHelpFile = (Right(GetFilePath(document.URL),4)=".xhp") End Function Function GetUserFieldNumber(fn as String) fnum = -1 For a=0 to document.DocumentInfo.getUserFieldCount - 1 If document.DocumentInfo.getUserFieldName(a) = fn Then fnum = a Exit for End If Next a GetUserFieldNumber = fnum End Function