Freelog 52/Freelog052.iso/Dossier/OpenOffice/f_0218/HtmlAutoPilotBasic.xba

Extensible Markup Language | 2003-03-27 | 14KB | 436 lines

<?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="HtmlAutoPilotBasic" script:language="StarBasic">' Variables must be declared
Option Explicit

Public CurDocIndex as Integer
Public CurWebPageIndex as Integer


Public bWithBackGraphic as Boolean
Public oStyle as Object
' Maximum number of content templates, style templates and bullets
Const MaxLayouts = 50
Const MaxStyles = 100
Const MaxBullets = 10

'Public NumberOfLayouts%, NumberOfStyles%

' Filled with title, previous, next, home, top, bullet, background, file name
Public Style(MaxStyles, 8) as String

Public Layout$(MaxLayouts, 2)

Public TextureDir$, BulletDir$, GraphicsDir$, GalleryDir$, PhotosDir$
Public SOBitmapPath as String
Public CurrentBullet$, CurrentPrev$, CurrentNext$, CurrentHome$, CurrentTop$
Public FileStr as String

Public WebWiz_gWizardName$, WebWiz_gErrContentNotFound$, WebWiz_gErrStyleNotFound$
Public WebWiz_gErrMainTemplateError$, WebWiz_gErrWhileReloading$
Public WebWiz_gErrWhileLoadStyles$, WebWiz_gErrMsg$, WebWiz_gErrMainDocumentError$

Public ProgressBar as Object
Public ProgressValue As Long
Public oBaseDocument as Object
Public oViewCursor as Object
Public oViewSettings as Object
Public NoArgs as New com.sun.star.beans.PropertyValue

Public oCursor as Object
Public oBookmarks as Object
Public oBookMark as Object

Public oUcb as Object
Public MainDialog as Object
Public DialogModel as Object


Sub Main
Dim RetValue
On Local Error Goto GlobalErrorHandler
    BasicLibraries.LoadLibrary("Tools")
    oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
    oBaseDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter/web", "_default", 0, NoArgs())
    oViewSettings = oBaseDocument.CurrentController.ViewSettings
    oViewCursor = oBaseDocument.GetCurrentController.ViewCursor
    CurWebPageIndex = -1
    ProgressBar = oBaseDocument.GetCurrentController.GetFrame.CreateStatusIndicator
    ProgressBar.Start("", 100)
    SetProgressValue(2)
    oBaseDocument.LockControllers
    oViewSettings.ShowTableBoundaries = False
    If Not GetWebWizardPaths() Then
        Exit Sub
    End If
    LoadLanguage
    SetProgressValue(10)
    Layout() = getListBoxArrays(oUcb, "/cnt")
    GetCurIndex(DialogModel, Layout(),2)
    SetProgressValue(30)
    oCursor = oBasedocument.Text.CreateTextCursor
    oCursor.InsertDocumentfromURL(FileStr, NoArgs())
    SetProgressValue(50)
    Style() = getListBoxArrays(oUcb, "/stl")
    SetProgressValue(70)
    LoadWebPageStyles(oBaseDocument)
    SetProgressValue(90)
    oBaseDocument.UnlockControllers
    OpenWebDialog()
    SetProgressValue(98)
    SetProgressValue(0)
    MainDialog.Model.ImagePreview.BackGroundColor = RGB(0, 60,126)
    RetValue = MainDialog.Execute
    Select Case RetValue
        Case 0
            MainDialog.Dispose()
            DisposeDocument(oBaseDocument)
        Case 1
            EndDialog()
            MainDialog.Dispose()
    End Select
GLOBALERRORHANDLER:
    If Err <> 0 Then
        MsgBox (WebWiz_gErrMsg$, 16, WebWiz_gWizardName$)
        DisposeDocument(oBaseDocument)
        RESUME EXITWIZARD
EXITWIZARD:
    End If
End Sub


Function SetProgressValue(iValue as Integer)
    If iValue = 0 Then
        ProgressBar.End
    End If
    ProgressValue = iValue
    ProgressBar.Value = iValue
End Function


Sub ReloadCurrentDocument()
Dim OldDocIndex as Integer
On Local Error Goto ErrorOcurred
    OldDocIndex = CurDocIndex
    CurDocIndex = GetCurIndex(DialogModel.lbTemplate, Layout(), 2)
    If OldDocIndex <> CurDocIndex Then
        oBaseDocument.LockControllers
        ToggleDialogControls(False)
        oCursor = oBaseDocument.Text.CreateTextCursor()
        oCursor.GotoStart(False)
        oCursor.GotoEnd(True)
        oCursor.SetAllPropertiesToDefault()
        oCursor.InsertDocumentfromURL(FileStr, NoArgs())
        SetBulletAndGraphics
        CheckControls(oBaseDocument.DrawPage)
    ErrorOcurred:
        If Err <> 0 Then
            MsgBox(WebWiz_gErrWhileReloading$, 16, WebWiz_gWizardName$)
        End If
        oBaseDocument.UnlockControllers
        oViewCursor.GotoStart(False)
        ToggleDialogControls(True, "lbTemplate")
    End If
End Sub




Sub LoadWebPageStyles(aEvent as Object, Optional bStartUp as Boolean)
Dim OldWebPageIndex as Integer
    OldWebPageIndex = CurWebPageIndex
    If IsNull(DialogModel) Then
        CurWebPageIndex = GetCurIndex(DialogModel, Style(), 8)
    Else
        CurWebPageIndex = GetCurIndex(DialogModel.lbStyles, Style(), 8)
    End If
    If OldWebPageIndex <> CurWebPageIndex Then
        ToggleDialogControls(False)
        oBaseDocument.LockControllers
        bWithBackGraphic = LoadNewStyles(oBaseDocument, DialogModel, CurWebPageIndex, FileStr, Style(), TextureDir)
        CurrentBullet$ = BulletDir + Style(CurWebPageIndex, 6)
        CurrentPrev$ = GraphicsDir + Style(CurWebPageIndex, 2)
        CurrentNext$ = GraphicsDir + Style(CurWebPageIndex, 3)
        CurrentHome$ = GraphicsDir + Style(CurWebPageIndex, 4)
        CurrentTop$ = GraphicsDir + Style(CurWebPageIndex, 5)
        With oBaseDocument.DocumentInfo
            .GetUserFieldValue(0) = ExtractGraphicNames(CurWebPageIndex,2)
            .GetUserFieldValue(1) = ExtractGraphicNames(CurWebPageIndex, 4)
            .GetUserFieldValue(2) = Style(CurWebPageIndex, 6)       ' Bullet
            .GetUserFieldValue(3) = Style(CurWebPageIndex, 7)       ' Background
        End With
        SetBulletAndGraphics()
        CheckControls(oBaseDocument.DrawPage)
        oViewCursor.GotoStart(False)
        oBaseDocument.UnlockControllers
        ToggleDialogControls(True, "lbStyles")
    End If
End Sub


Function ExtractGraphicNames(CurIndex as Integer, i as Integer) as String
Dim FieldValue as String
    FieldValue = GetFileNameWithoutExtension(Style(CurIndex, i))
    FieldValue = FieldValue & " " &    GetFileNameWithoutExtension(Style(CurIndex, i+1))
    ExtractGraphicNames = FieldValue
End Function


Sub SetBulletAndGraphics
    SetGraphic("Prev", CurrentPrev)
    SetGraphic("Next", CurrentNext)
    SetGraphic("Home", CurrentHome)
    SetGraphic("Top", CurrentTop)
    SetBulletGraphics(CurrentBullet)
    SetGraphicsToOriginalSize()
End Sub


Sub SetGraphicsToOriginalSize()
Dim oGraphics as Object
Dim oGraphic as Object
Dim i as Integer
Dim aActSize as New com.sun.star.awt.Size
    oGraphics = oBaseDocument.GraphicObjects
    For i = 0 To oGraphics.Count-1
        oGraphic = oGraphics.GetByIndex(i)
        aActSize = oGraphic.ActualSize
        If aActSize.Height > 0 And aActSize.Width > 0 Then
            oGraphic.SetSize(aActSize)
        End If
    Next i
End Sub


Sub EndDialog()
    If DialogModel.chkSaveasTemplate.State = 1 Then
        ' Generating template? Set events later!
        AttachBasicMacroToEvent(oBaseDocument,"OnNew", "WebWizard.HtmlAutoPilotBasic.SetEvent()")
        ' Call the Store template dialog
        DispatchSlot(5538)
        AttachBasicMacroToEvent(oBaseDocument,"OnNew", "")
    End If
    SetEvent()
End Sub


Sub SetEvent()
Dim oDocument as Object
' This sub links the events OnSaveDone and OnSaveAsDone to the procedure
' CopyGraphics. It is invoked when a document is created, either directly
' from the AutoPilot or from a template. It is not possible to set these
' links for the template created by the AutoPilot because then it is not
' possible to modify the template.
    BasicLibraries.LoadLibrary("Tools")
    oDocument = ThisComponent
    AttachBasicMacroToEvent(oDocument,"OnSaveDone", "WebWizard.HtmlAutoPilotBasic.CopyGraphics()")
    AttachBasicMacroToEvent(oDocument,"OnSaveAsDone", "WebWizard.HtmlAutoPilotBasic.CopyGraphics()")
End Sub



Sub CopyGraphics
' This sub copies all the graphics used in the document to the same directory the
' document has been copied into and changes the graphics links in the document.
Dim oGraphicObjects as Object
Dim oGraphic as Object
Dim i as Integer
Dim SavePath as String
    BasicLibraries.LoadLibrary("Tools")
    oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
    GetWebWizardPaths()
    oBaseDocument = ThisComponent
'    oBaseDocument.LockControllers()

    ' Note: The sub DirectoryNameoutofPath should be change, so that the last character is a slash
    SavePath = DirectoryNameoutofPath(oBaseDocument.Url, "/") & "/"

    oGraphicObjects = oBaseDocument.GraphicObjects
    For i = 0 to oGraphicObjects.Count-1
        oGraphic = oGraphicObjects.GetbyIndex(i)
        oGraphic.GraphicUrl = CopyFile(oGraphic.GraphicURL, SavePath)
    Next i

    ChangeBackGraphicUrl(SavePath)

    BulletUrlsToSavePath(SavePath)

    With oBaseDocument.DocumentInfo
        .GetUserFieldValue(0) = ""
        .GetUserFieldValue(1) = ""
        .GetUserFieldValue(2) = ""
        .GetUserFieldValue(3) = ""
    End With
    AttachBasicMacroToEvent(oBaseDocument,"OnSaveDone", "")
    AttachBasicMacroToEvent(oBaseDocument,"OnSaveAsDone", "")
    AttachBasicMacroToEvent(oBaseDocument,"OnNew", "")
    oBaseDocument.Store
'    oBaseDocument.UnlockControllers()
End Sub


Function CopyFile(ByVal SourceUrl as String, TargetDir as String)
Dim sFileName as String
Dim sNewFileUrl as String
    If oUcb.Exists(TargetDir) Then
        If Len(TargetDir) > 2 Then
            sFileName = FileNameoutofPath(SourceUrl)
            sNewFileUrl = TargetDir & sFileName
            oUcb.Copy(SourceUrl, sNewFileUrl)
            CopyFile() = sNewFileUrl
        End If
    End If
End Function


Function getListBoxArrays(oUcb as Object, sFileFilter as String)
Dim oDocInfo as Object
Dim oListboxControl as Object
Dim Description as String
Dim sField as String
Dim sFieldList() as String
Dim bItemFound as Boolean
Dim MaxIndex as Integer
Dim DirContent() as String
Dim FileName as String
Dim TemplatePath as String
Dim FilterLen as Integer
Dim i as Integer
Dim m as Integer
Dim n as Integer
Dim s as Integer
Dim a as Integer
Dim LocMaxIndex as Integer
Dim InfoNames()
Dim DimCount as Integer
Dim sExtension as String
    oDocInfo = CreateUnoService("com.sun.star.document.DocumentProperties")
    FilterLen = Len(sFileFilter)
    bItemFound = False
    ' It has to be made sure that the TemplatePath <> ""
    TemplatePath = GetOfficeSubPath("Template", "wizard/web/")
    If TemplatePath = "" Then
        Dim NullList()
        getListBoxArrays() = NullList()
        Exit Function
    End If
    DirContent() = oUcb.GetFolderContents(TemplatePath,True)
    If sFileFilter = "/cnt" Then
        DimCount = 2
    Else
        DimCount = 8
    End If
    LocMaxIndex = Ubound(DirContent())
    Dim List(LocMaxIndex, DimCount) as String
    Dim SortList(LocMaxIndex,1)
    For i = 0 to LocMaxIndex
        SortList(i,0) = DirContent(i)
        SortList(i,1) = RetrieveDocTitle(oDocInfo, DirContent(i))
    Next i
    SortList() = BubbleSortList(SortList(),True)
    For i = 0 to LocMaxIndex
        DirContent(i) = SortList(i,0)
    Next i
    a = 0
    For i = 0 To LocMaxIndex
        FileName = DirContent(i)
        sExtension = Ucase(GetFileNameExtension(FileName))
        If Instr(1,Filename, sFileFilter) And sExtension = "STW" Then
            bItemFound = True
            Description = RetrieveDocTitle(oDocInfo, FileName)
            oDocInfo.Read(FileName)
            InfoNames = oDocInfo.ElementNames()
            List(a,1) = Description
            If sFileFilter = "/cnt" Then
                List(a,2) = Filename
            Else
                m = 2
                For n = 0 To 3
                    sField = oDocInfo.GetByName(InfoNames(n))
                    sFieldList() = ArrayoutofString(sField, " ", MaxIndex)
                    For s = 0 To MaxIndex
                        If m < 6 Then
                            List(a,m) = sFieldList(s) & ".gif"
                        Else
                            List(a,m) = sFieldList(s)
                        End If
                        m = m + 1
                    Next s
                Next n
                List(a,8) = FileName
            End If
            a = a + 1
        End If
    Next i
    If sFileFilter = "/cnt" Then
        ReDim Preserve List(a-1,2) as String
    Else
        ReDim Preserve List(a-1,8) as String
    End If
    If Not bItemfound Then
        MsgBox(WebWiz_gErrContentNotFound$, 16, WebWiz_gWizardName$)
        DisposeDocument(oBaseDocument)
        Stop
    End If
    getListBoxArrays = List()
End Function


Sub SetGraphic(sWhich, sGraphicText as String)
Dim oLocCursor as Object
Dim oGraphic as Object
Dim bGetGraphic as Boolean
    oBookmarks = oBaseDocument.BookMarks
    If oBookmarks.HasbyName(sWhich)Then
        oBookMark = oBookmarks.GetbyName(sWhich)
        oLocCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor)
        oGraphic = oBaseDocument.CreateInstance("com.sun.star.text.GraphicObject")
        oLocCursor.GoRight(3,True)
        oGraphic.AnchorType = 1
        oGraphic.GraphicURL = ConverttoURL(sGraphicText)
        oLocCursor.Text.InsertTextContent(oLocCursor, oGraphic, True)
        oGraphic.Name = sWhich
    ElseIf oBaseDocument.GraphicObjects.HasbyName(sWhich) Then
        oGraphic = oBaseDocument.GraphicObjects.GetByName(sWhich)
        oGraphic.GraphicUrl = sGraphicText
    End If
End Sub


Sub CheckControls(oDrawPage as Object)
Dim aForm as Object
Dim m,n as integer
Dim lColor as Long
Dim oControl as Object
    lColor = oBaseDocument.StyleFamilies.GetbyName("ParagraphStyles").GetByName("Standard").CharColor
    'SearchFor all possible Controls
    For n = 0 to oDrawPage.Forms.Count - 1
        aForm = oDrawPage.Forms(n)
        For m = 0 to aForm.Count-1
            oControl = aForm.GetbyIndex(m)
            oControl.TextColor = lColor
        Next
    Next
End Sub


Sub RepaintHeaderPreview()
Dim Bitmap As Object
Dim sBitmapPath as String
    sBitmapPath = SOBitmapPath & "webwizard.bmp"
    WebWzrd.ImagePreview.ImageURL = sBitmapPath
End Sub


Sub ToggleDialogControls(ByVal bDoEnable as Boolean, Optional FocusControlName as String)
    If Not IsNull(DialogModel) Then
        DialogModel.Enabled = bDoEnable
        If bDoEnable Then
            ' Enable Controls referring to Background graphic only when this Property is set
            bDoEnable = bWithBackGraphic
            ToggleOptionButtons(DialogModel, bDoEnable)
            MainDialog.GetControl(FocusControlName).SetFocus()
        End If
    End If
End Sub</script:module>