Kaydet (Commit) 815de4b2 authored tarafından Behrend Cornelius's avatar Behrend Cornelius

#104114# New Function 'CreateNewDocument' added

üst f13b1b61
...@@ -41,7 +41,7 @@ Dim MaxIndex as Integer ...@@ -41,7 +41,7 @@ Dim MaxIndex as Integer
sObjectStrings(1) = LocObject.dbg_Methods sObjectStrings(1) = LocObject.dbg_Methods
sObjectStrings(2) = LocObject.dbg_SupportedInterfaces sObjectStrings(2) = LocObject.dbg_SupportedInterfaces
LocUrl = "private:factory/swriter" LocUrl = "private:factory/swriter"
oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs) oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_default",0,NoArgs)
oLocText = oLocDocument.text oLocText = oLocDocument.text
oLocCursor = oLocText.createTextCursor() oLocCursor = oLocText.createTextCursor()
oLocCursor.gotoStart(False) oLocCursor.gotoStart(False)
...@@ -69,7 +69,7 @@ Dim oLocCursor as Object ...@@ -69,7 +69,7 @@ Dim oLocCursor as Object
Dim oLocText as Object Dim oLocText as Object
LocUrl = "private:factory/swriter" LocUrl = "private:factory/swriter"
oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs) oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_default",0,NoArgs)
oLocText = oLocDocument.text oLocText = oLocDocument.text
oLocCursor = oLocText.createTextCursor() oLocCursor = oLocText.createTextCursor()
oLocCursor.gotoStart(False) oLocCursor.gotoStart(False)
......
...@@ -141,7 +141,7 @@ Dim oComponent as Object ...@@ -141,7 +141,7 @@ Dim oComponent as Object
If Not IsMissing(bDisposable) Then If Not IsMissing(bDisposable) Then
bDisposable = True bDisposable = True
End If End If
OpenDocument() = StarDesktop.LoadComponentFromURL(DocPath,"_blank",0,Args()) OpenDocument() = StarDesktop.LoadComponentFromURL(DocPath,"_default",0,Args())
End Function End Function
...@@ -719,4 +719,44 @@ Function isHighContrast(oPeer as Object) ...@@ -719,4 +719,44 @@ Function isHighContrast(oPeer as Object)
isHighContrast = false isHighContrast = false
If myLuminance <= 25 Then isHighContrast = true If myLuminance <= 25 Then isHighContrast = true
End Function End Function
Function CreateNewDocument(sType as String, Optional sAddMsg as String) as Object
Dim NoArgs() as new com.sun.star.beans.PropertyValue
Dim oDocument as Object
Dim sUrl as String
Dim ErrMsg as String
On Local Error Goto NOMODULEINSTALLED
sUrl = "private:factory/" & sType
oDocument = StarDesktop.LoadComponentFromURL(sUrl,"_default",0, NoArgs())
NOMODULEINSTALLED:
If (Err <> 0) OR IsNull(oDocument) Then
If InitResources("", "com") Then
Select Case sType
Case "swriter"
ErrMsg = GetResText(1001)
Case "scalc"
ErrMsg = GetResText(1002)
Case "simpress"
ErrMsg = GetResText(1003)
Case "sdraw"
ErrMsg = GetResText(1004)
Case "smath"
ErrMsg = GetResText(1005)
Case Else
ErrMsg = "Invalid Document Type!"
End Select
ErrMsg = ReplaceString(ErrMsg, chr(13), "<BR>")
If Not IsMissing(sAddMsg) Then
ErrMsg = ErrMsg & chr(13) & sAddMsg
End If
Msgbox(ErrMsg, 48, GetProductName())
End If
If Err <> 0 Then
Resume GOON
End If
End If
GOON:
CreateNewDocument = oDocument
End Function
</script:module> </script:module>
\ No newline at end of file
...@@ -249,7 +249,7 @@ Dim FilterIndex as Integer ...@@ -249,7 +249,7 @@ Dim FilterIndex as Integer
End If End If
On Local Error Goto NOSAVING On Local Error Goto NOSAVING
If FilterName = &quot;&quot; Then If FilterName = &quot;&quot; Then
&apos; Todo: Den Fall abfangen, wenn ein zu überschreibendes Dokument schreibgeschützt ist (weil es z.B. gerade geöffnet ist) &apos; Todo: Catch the case that a document that has to be overwritten is writeportected (e.g. it is open)
oDocument.StoreAsUrl(sPath, NoArgs()) oDocument.StoreAsUrl(sPath, NoArgs())
Else Else
oStoreProperties(0).Name = &quot;FilterName&quot; oStoreProperties(0).Name = &quot;FilterName&quot;
......
...@@ -43,8 +43,6 @@ Dim BigLen%, PreLen%, PostLen% ...@@ -43,8 +43,6 @@ Dim BigLen%, PreLen%, PostLen%
BigLen = Len(BigString) BigLen = Len(BigString)
PostLen = Len(PostString) PostLen = Len(PostString)
FindPartString = Mid(BigString,StartPos + PreLen, EndPos - (StartPos + PreLen)) FindPartString = Mid(BigString,StartPos + PreLen, EndPos - (StartPos + PreLen))
&apos; Da diese Funktion dafür programmiert wurde, in einer Schleife abgearbeitet zu werden
&apos; muss die initiale Suchposition hinter die Position des gefundenen Teilstrings gesetzt werden.
SearchPos = EndPos + PostLen SearchPos = EndPos + PostLen
Else Else
Msgbox(&quot;No final tag for &apos;&quot; &amp; PreString &amp; &quot;&apos; existing&quot;, 16, GetProductName()) Msgbox(&quot;No final tag for &apos;&quot; &amp; PreString &amp; &quot;&apos; existing&quot;, 16, GetProductName())
......
...@@ -16,7 +16,6 @@ Dim LocsfileContent(0) as String ...@@ -16,7 +16,6 @@ Dim LocsfileContent(0) as String
End Sub End Sub
&apos; Prozedur, die die rekursive Auslesefunktion anwirft
Function ReadDirectories(ByVal AnchorDir As String, bRecursive as Boolean, bcheckFileType as Boolean, bGetByTitle as Boolean, Optional sFileContent(), Optional sExtension as String) Function ReadDirectories(ByVal AnchorDir As String, bRecursive as Boolean, bcheckFileType as Boolean, bGetByTitle as Boolean, Optional sFileContent(), Optional sExtension as String)
Dim i as integer Dim i as integer
Dim Status as Object Dim Status as Object
...@@ -71,10 +70,10 @@ Dim sFileArray(StartUbound,1) as String ...@@ -71,10 +70,10 @@ Dim sFileArray(StartUbound,1) as String
&apos; precisely identified by their mimetype and their extension &apos; precisely identified by their mimetype and their extension
FileExtension = GetFileNameExtension(FileName) FileExtension = GetFileNameExtension(FileName)
If FileExtension = sExtension Then If FileExtension = sExtension Then
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex) AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
End If End If
Else Else
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex) AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
End If End If
Else Else
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex) AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
...@@ -94,7 +93,7 @@ Dim sFileArray(StartUbound,1) as String ...@@ -94,7 +93,7 @@ Dim sFileArray(StartUbound,1) as String
Loop Until DirIndex &gt;= iDirCount Loop Until DirIndex &gt;= iDirCount
If CurIndex &gt; -1 Then If CurIndex &gt; -1 Then
ReDim Preserve sFileArray(CurIndex,1) as String ReDim Preserve sFileArray(CurIndex,1) as String
Else Else
ReDim sFileArray() as String ReDim sFileArray() as String
End If End If
Else Else
...@@ -123,7 +122,7 @@ Dim FileCount As Integer ...@@ -123,7 +122,7 @@ Dim FileCount As Integer
&apos; Add the documenttitles to the Filearray &apos; Add the documenttitles to the Filearray
Else Else
sFileArray(CurIndex,1) = FileContent sFileArray(CurIndex,1) = FileContent
End If End If
End Sub End Sub
...@@ -250,7 +249,7 @@ Dim MaxIndex as Integer ...@@ -250,7 +249,7 @@ Dim MaxIndex as Integer
Redim Preserve DataList(i) Redim Preserve DataList(i)
End If End If
LoadDataFromFile() = True LoadDataFromFile() = True
oOutputStream.CloseInput() oInputStream.CloseInput()
Else Else
LoadDataFromFile() = False LoadDataFromFile() = False
End If End If
...@@ -267,9 +266,12 @@ Dim oUcb as Object ...@@ -267,9 +266,12 @@ Dim oUcb as Object
CreateFolder = True CreateFolder = True
NOSPACEONDRIVE: NOSPACEONDRIVE:
If Err &lt;&gt; 0 Then If Err &lt;&gt; 0 Then
Msgbox &quot;Folder &apos;&quot; &amp; ConvertFromUrl(sNewFolder) &amp; &quot;&apos; could not be created! Probably your harddisk is out of space!&quot; If InitResources(&quot;&quot;, &quot;com&quot;) Then
CreateFolder() = False ErrMsg = GetResText(1000)
Resume LETSGO Msgbox(ErrMsg, 48, GetProductName())
LETSGO: End If
End If CreateFolder = False
Resume GOON
End If
GOON:
End Function</script:module> End Function</script:module>
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment