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
sObjectStrings(1) = LocObject.dbg_Methods
sObjectStrings(2) = LocObject.dbg_SupportedInterfaces
LocUrl = "private:factory/swriter"
oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs)
oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_default",0,NoArgs)
oLocText = oLocDocument.text
oLocCursor = oLocText.createTextCursor()
oLocCursor.gotoStart(False)
......@@ -69,7 +69,7 @@ Dim oLocCursor as Object
Dim oLocText as Object
LocUrl = "private:factory/swriter"
oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs)
oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_default",0,NoArgs)
oLocText = oLocDocument.text
oLocCursor = oLocText.createTextCursor()
oLocCursor.gotoStart(False)
......
......@@ -141,7 +141,7 @@ Dim oComponent as Object
If Not IsMissing(bDisposable) Then
bDisposable = True
End If
OpenDocument() = StarDesktop.LoadComponentFromURL(DocPath,"_blank",0,Args())
OpenDocument() = StarDesktop.LoadComponentFromURL(DocPath,"_default",0,Args())
End Function
......@@ -719,4 +719,44 @@ Function isHighContrast(oPeer as Object)
isHighContrast = false
If myLuminance <= 25 Then isHighContrast = true
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>
\ No newline at end of file
......@@ -249,7 +249,7 @@ Dim FilterIndex as Integer
End If
On Local Error Goto NOSAVING
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())
Else
oStoreProperties(0).Name = &quot;FilterName&quot;
......
......@@ -43,8 +43,6 @@ Dim BigLen%, PreLen%, PostLen%
BigLen = Len(BigString)
PostLen = Len(PostString)
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
Else
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
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)
Dim i as integer
Dim Status as Object
......@@ -71,10 +70,10 @@ Dim sFileArray(StartUbound,1) as String
&apos; precisely identified by their mimetype and their extension
FileExtension = GetFileNameExtension(FileName)
If FileExtension = sExtension Then
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
End If
Else
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
End If
Else
AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
......@@ -94,7 +93,7 @@ Dim sFileArray(StartUbound,1) as String
Loop Until DirIndex &gt;= iDirCount
If CurIndex &gt; -1 Then
ReDim Preserve sFileArray(CurIndex,1) as String
Else
Else
ReDim sFileArray() as String
End If
Else
......@@ -123,7 +122,7 @@ Dim FileCount As Integer
&apos; Add the documenttitles to the Filearray
Else
sFileArray(CurIndex,1) = FileContent
End If
End If
End Sub
......@@ -250,7 +249,7 @@ Dim MaxIndex as Integer
Redim Preserve DataList(i)
End If
LoadDataFromFile() = True
oOutputStream.CloseInput()
oInputStream.CloseInput()
Else
LoadDataFromFile() = False
End If
......@@ -267,9 +266,12 @@ Dim oUcb as Object
CreateFolder = True
NOSPACEONDRIVE:
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;
CreateFolder() = False
Resume LETSGO
LETSGO:
End If
If InitResources(&quot;&quot;, &quot;com&quot;) Then
ErrMsg = GetResText(1000)
Msgbox(ErrMsg, 48, GetProductName())
End If
CreateFolder = False
Resume GOON
End If
GOON:
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