Daniel Garcia wrote:
Hi Fernand,
Thank you very much for your reply. That is really a good solution when
client and servers are at the same place. In my case, I have got
server-client application so that users send through the document and then
the system will place the css and html files somewhere behind Apache...
I would need something that can be done via coding.
its all done with code, the macro's are in the OO-writerdoc
please find the 3 SUB's and FUNCTIONS below here
SUB SaveGraphicsToPmgServer()
Dim oAllGraphics As Object
Dim oGraphic, oPictures As Object
oAllGraphics = oDoc.getGraphicObjects
if oDoc.getDocumentStorage.hasbyname("Pictures") then
oPictures = oDoc.getDocumentStorage.getbyname("Pictures")
dim mfiles() as string
mFiles() = oPictures.getElementNames
end if
Dim n , j As Integer
sName = FileNameOutOfPath(sfile)
sName = removeExtension(sName)
opendraw = true
FOR n = 0 to oAllGraphics.Count - 1
oGraphic = oAllGraphics(n)
if Lcase(left(oGraphic.GraphicURL,7)) = "http://"; then
'niets doen foto ij OK
else
' we zoeken naar het fileformat van de foto
If InStr(1, oGraphic.GraphicURL,
"vnd.sun.star.GraphicObject:", 0) = 0 Then ' geeft de positie (soort
textpos)van een string
("vnd.sun.star.GraphicObject:") in een andere string(sGraphicURL)
'file is gelinkt en format vonden we in de URL
sOriginalFormat = Right(oGraphic.GraphicURL,3)
sOriginalName =
left(oGraphic.GraphicURL,int(len(oGraphic.GraphicURL))-4 )
else 'foto zit in document
sGraphicURL = Mid(sGraphicURL, 28, Len(sGraphicURL))
' so search all files in pictures folder for the current
picture ...
For j = 0 to ubound(mfiles())
If InStr(1 , mFiles(j), sGraphicURL, 0) = 1 Then
sOriginalformat = right(mFiles(j),3)
sOriginalName =
mid(oGraphic.GraphicURL,int(len(oGraphic.GraphicURL))-10 , 6 )
exit for
end if
next j
endif
if lcase(sOriginalFormat) <> "eps" and lcase(sOriginalFormat)
<> "gif" then
sFilterFormat = "jpg"
else
sFilterFormat = "gif"
endif
sFName = sName + "F" + sOriginalName + "." + sFilterFormat
ExportGraphicNaar(oGraphic,convertToURL("\\pmg-web\foto.pmg.be\"
+ LEFT(sFName,3) + "\" + sFName), 96 )
oGraphic.setPropertyValue("HyperLinkURL",sHyperLink)
oGraphic.setPropertyValue("GraphicURL", "http://foto.pmg.be/"; +
LEFT(sFName,3) + "/" + sFName)
dim aCrop As New com.sun.star.text.GraphicCrop
oGraphic.SetPropertyValue("GraphicCrop" , aCrop) ' alles op
nul
ographic = nothing
endif
NEXT n
if not isempty(odrawdoc) then
oDrawDoc.Close(True)
end if
END SUB
'-------------------------------------------------------------------
SUB ExportGraphicNaar(oGraphic As SwXTextGraphicObject, sURLImageResized
As String, iPixels As Integer)
if opendraw = true then
'***********************************
'* open a sdraw hidden document *
'***********************************
Dim mFileProperties(0) As New com.sun.star.beans.PropertyValue
mFileProperties(0).Name= "Hidden"
mFileProperties(0).Value= True
oDrawDoc =
oDesktop.LoadComponentFromURL("private:factory/sdraw","_blank",0,mFileProperties())
oDrawPage = oDrawDoc.DrawPages(0)
opendraw = false
end if
oDrawGraphic =
oDrawDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
oDrawPage.add(oDrawGraphic)
' **************
' export GROOT
' **************
Dim SelSize As New com.sun.star.awt.Size
SelSize = oGraphic.graphic.Size100thMM
if selsize.width = 0 then
selsize.width = ographic.graphic.SizePixel.width/96*2540
selsize.Height = ographic.graphic.SizePixel.Height/96*2540
endif
oDrawGraphic.GraphicURL = oGraphic.GraphicURL
oDrawGraphic.Size = SelSize
oDrawGraphic.GraphicCrop.left = 0
oDrawGraphic.GraphicCrop.right = 0
oDrawGraphic.GraphicCrop.Top = 0
oDrawGraphic.GraphicCrop.Bottom = 0
oDrawPage.Width = odrawGraphic.Size.Width
oDrawPage.Height = odrawGraphic.Size.Height
Dim aFilterData (1) As new com.sun.star.beans.PropertyValue
aFilterData(0).Name = "PixelWidth" '
aFilterData(0).Value = oGraphic.graphic.sizepixel.width
aFilterData(1).Name = "PixelHeight"
aFilterData(1).Value = oGraphic.graphic.sizepixel.height
sURLgroot = left(sURLImageResized,int(len(sURLImageResized)-4)) &
"_groot" & right(sURLImageResized,4)
sHyperLink = "http://"; & mid(sURLgroot, 16, int(len(sURLgroot))-15 )
Export( oDrawPage, sURLgroot , aFilterData() )
odrawGraphic = nothing
On error resume Next
On error goto 0
END SUB
'-------------------------------------------------------------------
SUB Export( xObject, sFileUrl As String, aFilterData )
Dim xExporter As Object
xExporter = createUnoService(
"com.sun.star.drawing.GraphicExportFilter" )
xExporter.SetSourceDocument( xObject )
Dim aArgs (2) As new com.sun.star.beans.PropertyValue
'sFileURL = ConvertToURL(sFileURL)
aArgs(0).Name = "FilterName"
aArgs(0).Value = sFilterFormat
aArgs(1).Name = "URL"
aArgs(1).Value = sFileURL
'print sFileURL
aArgs(2).Name = "FilterData"
aArgs(2).Value = aFilterData
xExporter.filter( aArgs() )
END SUB
'-------------------------------------------------------------------
FUNCTION removeExtension(filename As String) As String
Dim length As Integer
length = Len(filename)
If LCase(Right(filename, 5)) = ".html" Then
removeExtension = Left(filename, length - 5)
ElseIf LCase(Right(filename, 4)) = ".htm" Then
removeExtension = Left(filename, length - 4)
Else
'Testing purposes only
removeExtension = Left(filename, length - 4)
END If
END FUNCTION
'-------------------------------------------------------------------
FUNCTION fileNameOutOfPath(path As String) As String
'print path
Dim stringArray() As String
' print path
stringArray = Split(convertToURL(path), "/")
fileNameOutOfPath = stringArray(UBound(stringArray))
END FUNCTION
'-------------------------------------------------------------------
FUNCTION MakePropertyValue( Optional cName As String, Optional uValue )
As com.sun.star.beans.PropertyValue
Dim oPropertyValue As Object
oPropertyValue = createUnoStruct(
"com.sun.star.beans.PropertyValue" )
If Not IsMissing( cName ) Then
oPropertyValue.Name = cName
ENDIf
If Not IsMissing( uValue ) Then
oPropertyValue.Value = uValue
ENDIf
MakePropertyValue() = oPropertyValue
END FUNCTION
---------------------------------------------------------------------
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
