Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Sub DeleteCustomStyles 'JohnV with Villeroy's dialog code. v1 February 6, 2008
- Dim ShowFirstMessage, ShowProgress, ShowDone, NumberStyle
- '>>>>>>>>>>>>>USER VARIABLES<<<<<<<<<<<<<<
- ShowFirstMessage = True 'Change to False to avoid 1st message.
- ShowProgress = True 'Change to False to avoid progress updates.
- ShowDone = True 'Change to False to avoid Done message.
- NumberStyle = "Numbering 1" 'Your preferred List Style (Case Sensitive).
- '>>>>>>>>>>>END USER VARIABLES<<<<<<<<<<<<
- Dim a,c,cc,oStyleType,NamesArray,StyleName,ThisStyle,cnt,checked as Boolean
- If ShowFirstMessage then
- a = "Remove custom styles?" & chr(13) & "You will get to choose the type of style."
- a = a & Chr(13) & "This will not affect OOo's predefined styles."
- If MsgBox(a,4,"Delete Custom Styles") = 7 then End
- EndIf
- 'Start Villeroy's code.
- Dim sElements() as string, oFamilies, oFamily, sFamily$, sLabel, oDlg, i%
- oFamilies = thiscomponent.StyleFamilies
- sElements() = oFamilies.getElementNames()
- sLabel = "Pick one style family or <All>"& chr(10) _
- &"in order to remove all user defined (custom) styles"
- oDlg = getListboxDialog("Remove Custom Styles", sLabel, sElements())
- With oDlg.getControl("ListBox")
- .addItem("<All>",0)
- .selectItemPos(0,True)
- End With
- i = oDlg.execute()
- sFamily = oDlg.getControl("ListBox").getSelectedItem
- if i = 0 then
- exit sub
- endIf
- 'End Villeroy's code.
- For c = 0 to uBound(oFamilies.ElementNames)
- oStyleType = oFamilies.getByName(oFamilies.ElementNames(c))
- If sFamily <> "<All>" and sFamily <> sElements(c) then goto SKIP
- NamesArray = oStyleType.getElementNames
- cnt = 0
- For cc = 0 to uBound(NamesArray)
- StyleName = NamesArray(cc)
- ThisStyle = oStyleType.getByName(StyleName)
- If ThisStyle.isUserDefined then
- If sElements(c) = "NumberingStyles" and ThisStyle.isInUse _
- and Not checked then
- checked = True
- Dim oDoc,NamesArray1,Used(),x,ts,n
- oDoc = ThisComponent
- NamesArray1 = oStyleType.getElementNames
- For x = 0 to uBound(NamesArray1)
- ts = oStyleType.getByName(NamesArray1(x))
- If ts.isUserDefined and ts.isInUse then
- n = uBound(Used)+1
- ReDim Preserve Used(n)
- Used(n) = NamesArray1(x)
- EndIf
- Next x
- IterateParagraphs(oDoc,Used(),NumberStyle)
- EndIf
- oStyleType.removeByName(StyleName)
- cnt = cnt + 1
- EndIf
- Next cc
- If ShowProgress then
- a = "Deleted "& cnt &" custom style(s) of type " & sElements(c) & "."
- MsgBox a
- EndIf
- SKIP:
- Next c
- If ShowDone then MsgBox "Done."
- End Sub
- 'Villeroy's code
- REM get a auto-sized dialog with title, label, listbox, OK and Cancel
- REM pass sFixedText with linebreaks Chr(10)
- Function getListboxDialog(sTitle$,sFixedText$,aListItems())
- Dim oDM,oDlg,oTools,oRegion,oRect,oPoint,oSz
- oDM = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
- oDM.Title = sTitle
- REM addAwtModel dialogModel, c.s.s.awt.UnoControl<type>, name of control,
- REM (propertyNames), (propertyValues) !propertyNames in alpabetical order!
- addAwtModel oDM,"FixedText","FixedText", _
- Array("Label","MultiLine"), _
- Array(sFixedText,True)
- addAwtModel oDM,"ListBox","ListBox", _
- Array("Dropdown","StringItemList"), _
- Array(True,aListItems())
- addAwtModel oDM,"Button","btnOK", _
- Array("DefaultButton","Label","PushButtonType"), _
- Array(True,"OK",com.sun.star.awt.PushButtonType.OK)
- addAwtModel oDM,"Button","btnCancel", _
- Array("Label","PushButtonType"), _
- Array("Cancel",com.sun.star.awt.PushButtonType.CANCEL)
- oDlg = CreateUnoService("com.sun.star.awt.UnoControlDialog")
- oDlg.setModel(oDM)
- oDlg.setVisible(True)
- oTools = oDlg.getPeer.getToolkit
- oRegion = oTools.createRegion
- oPoint = createUnoStruct("com.sun.star.awt.Point")
- oPoint.X = 5
- oPoint.Y = 5
- oRect = stackVertically(oDlg,Array("FixedText","ListBox","btnOK","btnCancel"),oRegion,oPoint,5)
- oDlg.setPosSize(0,0, oRect.Width +oRect.X, oRect.Height +oRect.Y,com.sun.star.awt.PosSize.SIZE)
- getListboxDialog = oDlg
- End Function
- 'Villery's code
- Sub addAwtModel(oDM,srv,sName,aNames(),aValues())
- Dim oCM
- oCM = oDM.createInstance("com.sun.star.awt.UnoControl"+ srv +"Model")
- oCM.setPropertyValues(aNames(),aValues())
- oDM.insertByName(sName,oCM)
- End Sub
- 'Villeroy's code
- Function getControlSize(oCtrl)
- '''Return preferred width and/or height, if not already set larger.'''
- Dim curPS, prefSz
- curPS = oCtrl.getPosSize()
- prefSz = oCtrl.getPreferredSize()
- if curPS.Width >= prefSz.Width then prefSz.Width = curPS.Width
- if curPS.Height >= prefSz.Height then prefSz.Height = curPS.Height
- getControlSize = prefSz
- End Function
- 'Villeroy's code
- Function stackVertically(oDlg,sNames(),oRegion,oPoint,optional spc)
- 'calls: getControlSize
- '''Stack list of controls vertically, starting at point with optional spaces below.
- 'Calculate and set preferred width and/or height if not already set >= preferredSize.
- 'Out: resized oRegion with added rectangles.
- 'Returns new bounds of region'''
- Dim y&, i%, s$, c, sz
- if isMissing(spc) then spc = 0
- y = oPoint.Y
- for i = 0 to uBound(sNames())
- s = sNames(i)
- c = oDlg.getControl(s)
- sz = getControlSize(c)
- c.setPosSize(oPoint.X, y, sz.Width, sz.Height, com.sun.star.awt.PosSize.POSSIZE)
- oRegion.unionRectangle(c.getPosSize())
- y = y +sz.Height +spc
- next
- stackVertically = oRegion.getBounds()
- End Function
- 'End Villery's code.
- Sub IterateParagraphs(oDoc,Used(),NumberStyle)
- Dim enum,thisParagraph,c
- enum = oDoc.Text.createEnumeration
- While enum.hasMoreElements
- thisParagraph = enum.nextElement
- For c = 0 to uBound(Used)
- If Not thisParagraph.SupportsService("com.sun.star.text.TextTable") then
- If thisParagraph.NumberingStyleName = Used(c) then
- thisParagraph.NumberingStyleName = NumberStyle
- EndIf
- EndIf
- Next
- Wend
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement