Hello,
I can't make this plugin (Export as images) work in Impress. I always encounter an error.
I think I did everything properly, you can check:
https://vimeo.com/242435778
And here's a code whick I don't actually know what is:
(It opens in Libreoffice Basic after the error message I get)
Is there a solution to this problem?
I can't make this plugin (Export as images) work in Impress. I always encounter an error.
I think I did everything properly, you can check:
https://vimeo.com/242435778
And here's a code whick I don't actually know what is:
(It opens in Libreoffice Basic after the error message I get)
Code:
REM ***** BASIC *****REM My greatest thanks and regards to Clio (Клио), who helped a lot in developing
REM and testing this extension at http://forumooo.ru/index.php?topic=1543.new;topicseen#new
REM
REM The extension was developed in order to be useful for you.
REM It is published under GPL v. 2 or 3 at your choice.
REM
REM Author Sergii Kuznietsov, svk@svk.pp.ua, www.svk.pp.ua
REM
REM ===================
REM
REM Моя особая благодарность Клио, который сильно помог в разработке
REM и тестировании этого расширения на форуме http://forumooo.ru/index.php?topic=1543.new;topicseen#new
REM
REM Это расширение было разработано с целью быть полезным для вас.
REM Оно публикуется под лицензией GPL 2 или 3 на ваш выбор.
REM
REM Автор Сергей Кузнецов, svk@svk.pp.ua, www.svk.pp.ua
REM
REM
REM
REM This macro was written on a base of examples from OOo forums
REM and Andrew Pitonyak http://www.pitonyak.org/book/
REM ***** BASIC *****
Option Explicit
dim doc
dim exportPath
dim exportName
dim slideNum
dim docDir
dim docName
dim oFolderPickerDlg
dim lastPageNumber as Long
dim formatString
dim decimalRep
dim oPropertyValue
dim imgType
dim dirText
dim nameText
dim Hpx as integer
dim Wpx as integer
dim jpgQ as integer
dim imgColor as boolean
dim pngCompr as integer
dim pngIL
dim gifIL
dim gifTrans
dim bmpColor
dim bmpRLE
dim bmpExMode
dim bmpDPI as integer
dim bmpSzW as double
dim bmpSzH as double
dim StopMark as boolean
dim sep As String
Dim oDialog as Object
Dim oDialog2 as Object
Dim oLibContainer As Object, oLib As Object
Dim oInputStreamProvider As Object
Dim oDialog As Object
Const sLibName = "ExportImages"
Const sDialogName = "Dialog1"
Const sDialogName2 = "Dialog2"
Dim oProgressBar as Object, oProgressBarModel As Object
Dim ProgressValue As Long
Dim ProgressValueMin As Long
Dim ProgressValueMax As Long
Sub ExportAsImages
DocumentFileNames 'returns current path and the current file name
ShowDialog
SplitSlides 'does the job
End Sub
Sub ShowDialog()
REM library container
oLibContainer = DialogLibraries
REM load the library
oLibContainer.loadLibrary( sLibName )
REM get library
oLib = oLibContainer.getByName( sLibName )
REM get input stream provider
oInputStreamProvider = oLib.getByName( sDialogName )
REM create dialog control
oDialog = CreateUnoDialog( oInputStreamProvider )
REM show the dialog
oDialog.Model.Step = 1
imgType = "jpg"
imgColor = true
bmpExMode = 0
StopMark = false
dirText = oDialog.Model.getByName("dirTextField")
nameText = oDialog.Model.getByName("nameTextField")
oDialog.getControl("dirTextField").setText(docDir)
oDialog.getControl("nameTextField").setText(docName)
if oDialog.execute()=1 then
OK
else
StopMark = true
endif
End Sub
Sub OK
dirText = oDialog.getControl("dirTextField")
exportPath = dirText.Text
nameText = oDialog.getControl("nameTextField")
exportName = nameText.Text
Hpx = oDialog.getControl("HeightField").Text
Wpx = oDialog.getControl("WidthField").Text
jpgQ = oDialog.getControl("jpgQualityField").Text
pngCompr = oDialog.getControl("pngCompressionField").Text
pngIL=oDialog.getControl("pngILCB").State
gifTrans=oDialog.getControl("gifTransculent").State
gifIL=oDialog.getControl("gifILCB").State
bmpColor = oDialog.getControl("bmpColorLB").getSelectedItemPos()
bmpRLE=oDialog.getControl("RLECB").State
bmpDPI = oDialog.getControl("bmpDPILB").getSelectedItem()
bmpSzW = oDialog.getControl("bmpSizeW").Text
bmpSzH = oDialog.getControl("bmpSizeH").Text
End Sub
Sub SplitSlides
if exportPath="" or StopMark = true then Exit Sub
dim i
dim slide
dim ocontrol
ocontrol=Doc.getcurrentcontroller()
lastPageNumber = doc.getdrawpages().count - 1
ShowDialog2
Wait 200
formatString = Zeroes(numDigitsIn(lastPageNumber+1)-1)+"#" 'Format string for zero-padding
for i = 0 to lastPageNumber
slideNum = Format(i+1, formatString) 'Zero pad slide number
slide=doc.drawpages(i)
ExportShape(slide)
ProgressValue = i+1
oProgressBarModel.setPropertyValue( "ProgressValue", ProgressValue )
if StopMark = true then Exit Sub
next i
oDialog2.setVisible( False )
Msgbox "Images exported!", 64 ,"Info"
end sub
Sub ExportShape(oShape as Any)
Dim Dl As Double
Dl = oShape.Height/oShape.Width
oShape
'http://www.oooforum.org/forum/viewtopic.phtml?t=51021
'inspired by http://codesnippets.services.openoffice.org/Office/Office.GraphicExport.snip
'creating filter data
Dim aFilterData (7) as new com.sun.star.beans.PropertyValue
If Wpx=0 OR Hpx=0 Then
If Wpx=0 Then
Wpx = Hpx/Dl
EndIf
if Hpx = 0 Then
Hpx = Wpx*Dl
EndIf
aFilterData(0).Name = "PixelWidth" '
aFilterData(0).Value = Wpx '2000
aFilterData(1).Name = "PixelHeight"
aFilterData(1).Value = Hpx '2000*Dl
ElseIf Wpx<>0 AND Hpx<>0 Then
aFilterData(0).Name = "PixelWidth" '
aFilterData(0).Value = Wpx '2000
aFilterData(1).Name = "PixelHeight"
aFilterData(1).Value = Hpx '2000*Dl
EndIf
if imgType = "jpg" then
'filter data for the image/jpeg MediaType
aFilterData(2).Name ="Quality"
aFilterData(2).Value = jpgQ '85 'Quality: 1-100, 100 is best quality / lowest compression
aFilterData(3).Name ="ColorMode"
if imgColor = true then
aFilterData(3).Value = 0' Color;
else
aFilterData(3).Value = 1' Grayscale
endif
endif
'filter data for the image/png MediaType
if imgType = "png" then
aFilterData(2).Name ="Compression"
aFilterData(2).Value = pngCompr
aFilterData(3).Name ="Interlaced"
if pngIL = 1 then
aFilterData(3).Value = 1
endif
if pngIL = 0 then
aFilterData(3).Value = 0
endif
endif
'filter data for the image/gif MediaType
if imgType = "gif" then
aFilterData(2).Name ="Translucent"
if gifTrans = 1 then
aFilterData(2).Value = true
endif
if gifTrans = 0 then
aFilterData(2).Value = false
endif
aFilterData(3).Name ="Interlaced"
if gifIL = 1 then
aFilterData(3).Value = 1
endif
if gifIL = 0 then
aFilterData(3).Value = 0
endif
endif
'filter data for the image/bmp MediaType
if imgType = "bmp" then
aFilterData(2).Name ="Color"
aFilterData(2).Value = bmpColor
aFilterData(3).Name ="ExportMode"
aFilterData(3).Value = bmpExMode
if bmpExMode = 1 then
aFilterData(4).Name ="Resolution"
aFilterData(4).Value = bmpDPI
endif
if bmpColor = 3 or bmpColor = 4 or bmpColor = 5 or bmpColor = 6 then
aFilterData(5).Name ="RLE_Coding"
if bmpRLB = 1 then
aFilterData(5).Value = true
endif
if bmpRLB = 0 then
aFilterData(5).Value = false
endif
endif
if bmpExMode = 2 then
aFilterData(6).Name ="LogicalWidth"
aFilterData(6).Value = bmpSzW*100
aFilterData(7).Name ="LogicalHeight"
aFilterData(7).Value = bmpSzH*100
endif
endif
'Setting UrlName
Dim sFileUrl As String
if imgType = "jpg" then
sFileUrl = ConvertToURL( exportPath + exportName + " - " + slideNum + ".jpg"
endif
if imgType = "png" then
sFileUrl = ConvertToURL( exportPath + exportName + " - " + slideNum + ".png"
endif
if imgType = "gif" then
sFileUrl = ConvertToURL( exportPath + exportName + " - " + slideNum + ".gif"
endif
if imgType = "bmp" then
sFileUrl = ConvertToURL( exportPath + exportName + " - " + slideNum + ".bmp"
endif
if imgType = "tif" then
sFileUrl = ConvertToURL( exportPath + exportName + " - " + slideNum + ".tif"
endif
if imgType = "svg" then
sFileUrl = ConvertToURL( exportPath + exportName + " - " + slideNum + ".svg"
endif
Dim aArgs (2) as new com.sun.star.beans.PropertyValue
if imgType = "jpg" then
aArgs(0).Name = "MediaType"
aArgs(0).Value = "image/jpeg" 'image/gif , image/png ... see http://www.oooforum.org/forum/viewtopic.phtml?t=51021
endif
if imgType = "png" then
aArgs(0).Name = "MediaType"
aArgs(0).Value = "image/png" 'image/gif , image/jpeg ... see http://www.oooforum.org/forum/viewtopic.phtml?t=51021
endif
if imgType = "gif" then
aArgs(0).Name = "MediaType"
aArgs(0).Value = "image/gif" 'image/gif , image/jpeg ... see http://www.oooforum.org/forum/viewtopic.phtml?t=51021
endif
if imgType = "bmp" then
aArgs(0).Name = "MediaType"
aArgs(0).Value = "image/x-MS-bmp" 'image/gif , image/jpeg ... see http://www.oooforum.org/forum/viewtopic.phtml?t=51021
endif
if imgType = "tif" then
aArgs(0).Name = "MediaType"
aArgs(0).Value = "image/tiff" 'image/gif , image/jpeg ... see http://www.oooforum.org/forum/viewtopic.phtml?t=51021
endif
if imgType = "svg" then ' SVG export doesn't work
' aArgs(0).Name = "FilterName"
' aArgs(0).Value = "impress_svg_Export"
' aArgs(0).Value = "svg_Export"
aArgs(0).Name = "MediaType"
aArgs(0).Value = "image/svg+xml" 'image/gif , image/jpeg ... see http://www.oooforum.org/forum/viewtopic.phtml?t=51021
endif
aArgs(1).Name = "URL"
aArgs(1).Value = sFileUrl
aArgs(2).Name = "FilterData"
aArgs(2).Value = aFilterData()
' if imgType="svg" then 'not well working workaround for SVG export
' ThisComponent.storeToUrl( sFileUrl, aArgs )
' else
Dim xExporter
xExporter = createUnoService( "com.sun.star.drawing.GraphicExportFilter" )
xExporter.setSourceDocument( oShape )
xExporter.filter( aArgs() )
' endif
End Sub
Function PickFolderSpecific( docDir ) as string
oFolderPickerDlg = createUnoService( "com.sun.star.ui.dialogs.OfficeFolderPicker" )
' oFolderPickerDlg = createUnoService( "com.sun.star.ui.dialogs.FolderPicker" )
' oFolderPickerDlg = createUnoService( "com.sun.star.ui.dialogs.SystemFolderPicker" )
If docDir<>"" Then
oFolderPickerDlg.setDisplayDirectory( ConvertToURL(docDir) ) Rem... Broken. Does not work with system folder picker.
End If
Dim PickFolderSpecific_tmp As String, send As String
If oFolderPickerDlg.execute()=1 then
PickFolderSpecific_tmp = ConvertFromURL( oFolderPickerDlg.getDirectory() )
send = Right(PickFolderSpecific_tmp,1) 'последний символ, путь должен заканчиваться системным разделителем, а если его там нет, то нужно добавить
if send=sep then
send="" 'если путь заканчивается системным разделителем, то всё ОК, ничего добавлять не надо
else
send=sep ' , а если нет, то его нужно добавить
endif
PickFolderSpecific = PickFolderSpecific_tmp+send
Endif
End Function
'Returns the minimum number of decimal digits required to represent a given integer
function NumDigitsIn(num as Integer) as Integer
decimalRep = cstr(num)
NumDigitsIn = Len(decimalRep)
end function
'Returns the a string consisting of the given number of zeros
function Zeroes(num as Integer) as String
dim result as String
dim i as Integer
result = ""
for i = 1 to num
result = result & "0"
next i
Zeroes = result
end function
REM Author: Andrew Pitonyak
Sub DocumentFileNames
Doc = ThisComponent
sep = getPathSeparator()
If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then
GlobalScope.BasicLibraries.LoadLibrary("Tools")
End If
Dim sDocPath As String
If (Doc.hasLocation()) Then
sDocPath = ConvertFromURL(Doc.URL) 'sDocPath - это Path (не URL)
Dim send As String
send = Right(sDocPath,1) 'последний символ, путь должен заканчиваться системным разделителем, а если его там нет, то нужно добавить
if send=sep then
send=""
else
send=sep
endif
docDir = DirectoryNameoutofPath(sDocPath, sep)+send
docName = GetFileNameWithoutExtension(sDocPath, sep)
Else
docDir = ConvertFromURL(createUnoService("com.sun.star.util.PathSettings").Work)+sep
docName = ThisComponent.Title
End If
End Sub
Sub PickFolder
exportPath = PickFolderSpecific( docDir )
If exportPath="" then Exit Sub 'если была нажата кнопка закрыть или отмена в диалоге выбора папки, то exportPath="", поэтому нам ничего не нужно изменять
docDir = ExportPath
oDialog.getControl("dirTextField").setText(docDir)
'dirText = oDialog.Model.getByName("dirTextField")
' dirText.text = docDir
End Sub
Sub jpgDialog
oDialog.Model.Step = 1
imgType = "jpg"
End Sub
Sub pngDialog
oDialog.Model.Step = 2
imgType = "png"
End Sub
Sub gifDialog
oDialog.Model.Step = 3
imgType = "gif"
End Sub
Sub bmpDialog
oDialog.Model.Step = 4
imgType = "bmp"
End Sub
Sub tifDialog
oDialog.Model.Step = 5
imgType = "tif"
End Sub
Sub svgDialog
oDialog.Model.Step = 6
imgType = "svg"
End Sub
Sub ColorJPG
imgColor = true
End Sub
Sub GrayJPG
imgColor = false
End Sub
Sub SelectBMPColor
bmpColor = oDialog.getControl("bmpColorLB").getSelectedItemPos()
if bmpColor = 3 or bmpColor = 4 or bmpColor = 5 or bmpColor = 6 then
oDialog.getControl("RLECB").setEnable(true)
else
oDialog.getControl("RLECB").setEnable(false)
endif
End Sub
Sub bmpOriginalEM
bmpExMode = 0
oDialog.getControl("bmpDPILB").setEnable(false)
oDialog.getControl("bmpSizeW").setEnable(false)
oDialog.getControl("bmpSizeH").setEnable(false)
End Sub
Sub bmpDPIEM
bmpExMode = 1
oDialog.getControl("bmpDPILB").setEnable(true)
oDialog.getControl("bmpSizeW").setEnable(false)
oDialog.getControl("bmpSizeH").setEnable(false)
End Sub
Sub bmpSizeEM
bmpExMode = 2
oDialog.getControl("bmpDPILB").setEnable(false)
oDialog.getControl("bmpSizeW").setEnable(true)
oDialog.getControl("bmpSizeH").setEnable(true)
End Sub
Sub ShowExportMimeTypes()
dim oDoc, oExportFilter, aMimeTypeNames
oDoc = ThisComponent
oExportFilter = createUnoService( "com.sun.star.drawing.GraphicExportFilter" )
aMimeTypeNames = oExportFilter.getSupportedMimeTypeNames()
' Display result in a MsgBox...
MsgBox Join( aMimeTypeNames, Chr(13) )
' Display result in a Writer doc.
' oOutput = StarDesktop.loadComponentFromURL( "private:factory/swriter", "_blank", 0, Array() )
' Writer_PrintLn( oOutput, Join( aMimeTypeNames, Chr(13) ) )
End Sub
Sub ShowDialog2()
oInputStreamProvider = oLib.getByName( sDialogName2 )
oDialog2 = CreateUnoDialog( oInputStreamProvider )
ProgressValueMin = 1
ProgressValueMax = lastPageNumber
oProgressBarModel = oDialog2.getModel().getByName( "PBar" )
oProgressBarModel.setPropertyValue( "ProgressValueMin", ProgressValueMin)
oProgressBarModel.setPropertyValue( "ProgressValueMax", ProgressValueMax)
REM show the dialog
oDialog2.setVisible( True )
' oDialog2.execute()
End Sub
Sub CancelMacro
StopMark = true
'oDialog2.endExecute()
End Sub
Comment