﻿REM  *****  BASIC  *****
REM  ***** Convert Open Office Draw Files into Star View Meta Files
REM  ***** For Genealogy Tree Generation
REM  ***** by Rüdiger Arnold, 11.09.2012


option explicit

sub generiereRahmen
	rem convert all *.odg file in the import directory into *.emf files in the export directory		
	rem but only the frames and drawn objects, not the page size and page background.

dim sPathImport as string
dim sUrlPathImport as string
dim sUrlPathImportFile as string
dim sConvertedFileList as string
dim sFileName as string

sPathImport="C:\Programme_Util\cygwin\home\arnold\doc\doc\doc\Familie\Stammbaum\Familienbande2Odg\Familienbande2Odg\oo_draw"
rem sPathImport="C:\Users\Public\Documents\doc\doc\doc\Familie\Stammbaum\Familienbande2Odg\oo_draw"
	rem import directory with open office drawings
	rem sPathImport=Environ("$odgdir") <- funktioniert leider nicht um diese Umgebungsvariable zu lesen

sUrlPathImport=ConvertToURL(sPathImport)
	rem convert the import path into a URL path

sConvertedFileList = sPathImport + chr(13)


rem sPath="C:\Users\Public\Documents\doc\Familie\Stammbaum\Stammbaum_Versuch\oo_draw"
sFileName = Dir$(sPathImport + getPathSeparator + "*.odg",0)
	rem Dir$ delivers, which each call a new filename in the import directory
	rem only filenames with the ending *.odg are delivered, so open office drawing files
	rem with a 0, filenames are delivered
	rem with a 16 as argument, directory names are delivered
	
rem MsgBox sUrlPathImport,0,"UrlPathImport"
	
Do
rem If sFileName <> "." and sFileName <> ".." Then
rem test_file= sPath + getPathSeparator + sFileName
rem test_attr=GetAttr( sPath + getPathSeparator + sValue)
if GetAttr( sPathImport + getPathSeparator + sFileName)=0 then
	rem attribut = 0 means a normal readable file
	rem attribut = 16 means a directory
sConvertedFileList = sConvertedFileList & chr(13) & sFileName
	rem put the file name into sDir

sUrlPathImportFile = sUrlPathImport + "/" + sFilename
saveOdgToGetHeight(sUrlPathImportFile)
	rem call the conversion routine
	
End If

sFilename = Dir$
	rem get the next filename with the Dir$ command
	
Loop Until sFilename = ""
	rem stop if end of file list

rem MsgBox sConvertedFileList,0,"Converted Files in directory"
	rem show a message box, which files has been converted
MsgBox "Das Makro wurde erfolgreich ausgeführt," & Chr(12) & Chr(10) _
 & "auch wenn sich (beim zweiten Mal) keine Fenster geöffnet haben."  & Chr(12) & Chr(10) _
 & " Dann gab es eben keine neuen Personen-Daten von FB.", 0, "Alles OK!"


end sub





sub saveOdgToGetHeight(sImportFile as string)
	rem a function, which just open and save the frame, to get updated Frame Size

dim oDocument as object
dim document as object
dim dispatcher as object


oDocument=StarDesktop.loadComponentFromURL(sImportFile,"_blank",0,DimArray())
	rem open the document with a window

document   = ThisComponent.CurrentController.Frame
	rem get access to the open document in the window
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	rem start a modifing service as dispatcher


dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
args1(0).Value = sImportFile
args1(1).Name = "FilterName"
args1(1).Value = "draw8"
dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())
	rem  save the document to get the actual frame size into the document
	
oDocument.close(true)
	rem close the document window and the document

end sub



'----------
'	Create and return a new com.sun.star.beans.PropertyValue.
'
Function MakePropertyValue( Optional cName As String, Optional uValue ) As com.sun.star.beans.PropertyValue
	Dim oPropertyValue As New 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


