1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Tools" script:language="StarBasic">REM ***** BASIC *****
' Somes useful tools used in OOoLilyPondMusic
'*********************************************************
' Add a slash if necessary
Function AddSlash( sPath as String) as String
If Right(sPath,1) = "/" then
AddSlash = sPath
else
AddSlash = sPath & "/"
end if
end Function
'Executes the command sCommand in a bash and returnes when finished
'The command must not include any single quote (')
sub BashCommand(sCommand)
Shell("bash -c '" & sCommand & "'", 1, "", True)
end sub
'**********************************************************
' Check the existance of the file...
Function CheckFile( sUrl as String, ErrorMsg as String) As Boolean
' Test the existance of the OOoLilyPond script ...
if FileExists(sUrl) then
CheckFile = False
else
if ErrorMsg = "OOoLilyPond" then _
ErrorMsg = "Cannot find " & sUrl & chr(10) & "Check your installation..."
Msgbox ErrorMsg
CheckFile = True
end if
End Function
Function GetOSType()
If GetPathSeparator() = "\" Then
GetOSType="Windows"
Else
GetOSType="Unix"
End If
End Function
sub InspectObject(vObj)
vObj=ThisComponent()
MsgBox vObj.getImplementationName
'MsgBox vObj.dbg_methods 'Methods for this object.
'MsgBox vObj.dbg_supportedInterfaces 'Interfaces for by this object.
'MsgBox vObj.dbg_properties 'Properties for this object.
end sub
'***********************************************************
' Import graphic from URL into the clipboard.
' Inspired from OOoForums Danny's code
Sub ImportGraphicIntoClipboard(cURL)
' MsgBox(cURL)
oDispatcher = createUnoService( "com.sun.star.frame.DispatchHelper" )
' Import the graphic from URL into a new draw document.
Dim arg1(0) As New com.sun.star.beans.PropertyValue
arg1(0).Name = "Hidden"
arg1(0).Value = true
oDrawDoc = StarDesktop.loadComponentFromURL( cURL, "_blank", 0, arg1() )
oDrawDocCtrl = oDrawDoc.getCurrentController()
' Get the shape...
oDrawPage = oDrawDoc.DrawPages(0)
oImportShape = oDrawPage(0)
' Get the dimension of the image...
oShapeSize = oImportShape.Size()
' Strange bug with the eps and emf format... correction of the size
if sFormat = "eps" then oShapeSize.Width = oShapeSize.Width * 0.99
if sFormat = "eps" then oShapeSize.Height = oShapeSize.Height * 0.91
if sFormat = "emf" then oShapeSize.Width = oShapeSize.Width * 1.13
if sFormat = "emf" then oShapeSize.Height = oShapeSize.Height * 1.1
' Copy the image to clipboard and close the draw document
oDrawDocCtrl.select(oImportShape)
Dim Array()
oDispatcher.executeDispatch( oDrawDocCtrl.Frame, ".uno:Copy", "", 0, Array() )
oDrawDoc.dispose()
End Sub
'************************************************************
Sub PrintFile(sFile as String)
if not FileExists(sTmpPath & sFile) then
Msgbox "Error : the file " & TmpPath & sFile & " doesn't exist..."
exit sub
end if
iNumber = Freefile
Open sTmpPath & sFile For Input As iNumber
While not eof(iNumber)
Line Input #iNumber, sLine
'if sLine <> "" then
sMsg = sMsg & sLine & chr(10)
wend
Close #iNumber
Msgbox sMsg
End sub
Sub SortStringArray(StringArray As Variant)
Dim l, u as Integer
l=LBound(StringArray())
u=UBound(StringArray())
Dim i, j As Integer
Dim sTemp As String
For i = l To (u - 1)
For j = (i + 1) To u
If StringArray(i) > StringArray(j) Then
sTemp = StringArray(i)
StringArray(i) = StringArray(j)
StringArray(j) = sTemp
End If
Next j
Next i
End Sub
' The Function returns the name of a file that does not already exist.
' This prevents unintended overwriting of existing files.
Function TmpFileName(sPrefix , sSuffix As String) As String
Do
TmpFileName=sPrefix & Int(Str(Rnd*1e6)) & sSuffix
Loop While FileExists(TmpFileName)
End Function
' Did not achieve to run lilypond directly with the Shell command and the
' Output redirected to files.
' I tried: Shell("cmd /c lilypond >file1 2>file2")
' But this did not work :-(
' Now I write down the command in a batch file and call it with Shell.
Sub WindowsCommand(sCommand as String)
Dim sBatFile As String
Dim iNumber As Integer
sBatFile=TmpFileName(ConvertFromURL(sTmpPath) & "CommandCallFromOOo_",".bat")
iNumber = Freefile
Open sBatFile For Output As #iNumber
Print #iNumber, sCommand
Close #iNumber
Shell(sBatFile,1,"",True)
Kill(sBatFile)
End Sub
</script:module>
|
