PC World 2002 June/PCWorld_2002-06_cd.bin/Software/Komercni/openoffice/install/f_0206/HtmlAutoPilotBasic.xba

Extensible Markup Language | 2001-11-19 | 14KB | 414 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(8, MaxStyles) as String

Public Layout$(2, MaxLayouts)

Public TextureDir$, BulletDir$, GraphicsDir$, GalleryDir$, PhotosDir$
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
    Dim SOBitmapPath,sBitmapPath as String
    BasicLibraries.LoadLibrary("Tools")
    oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
    oBaseDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter/web", "_blank", 0, NoArgs())
    oViewSettings = oBaseDocument.CurrentController.ViewSettings
    oViewCursor = oBaseDocument.GetCurrentController.ViewCursor
    ProgressBar = oBaseDocument.GetCurrentController.GetFrame.CreateStatusIndicator
    ProgressBar.Start("", 100)
    SetProgressValue(2)
    oBaseDocument.LockControllers
    oViewSettings.ShowTableBoundaries = False
    oViewSettings.ShowTextBoundaries = False
    MainDialog = LoadDialog("WebWizard","WebWzrd")
    DialogModel = MainDialog.Model
    LoadLanguage
    SetProgressValue(10)
    GetPaths()
    NumberofLayouts = FillupWebListbox(oUcb, "/cnt", MainDialog, "lbTemplate", Layout$())
    SetProgressValue(30)
    GetCurIndex(DialogModel.lbTemplate, Layout(),NumberofLayouts,2)
    oCursor = oBasedocument.Text.CreateTextCursor
    oCursor.InsertDocumentfromURL(FileStr, NoArgs())
    SetProgressValue(40)
    NumberofStyles = FillupWebListbox(oUcb, "/stl", MainDialog, "lbStyles", Style())
    SetProgressValue(50)
    LoadWebPageStyles(oBaseDocument)
    SetProgressValue(98)
    SetProgressValue(0)
    oBaseDocument.UnlockControllers
    SOBitmapPath = GetOfficeSubPath("Template", "wizard/bitmap")
    sBitmapPath = SOBitmapPath & "webwizard.bmp"
    DialogModel.ImagePreview.ImageURL = sBitmapPath
    ToggleOptionButtons(DialogModel, bWithBackGraphic)
    MainDialog.GetControl("lbTemplate").SetFocus()
    DialogModel.cbGoOn.DefaultButton = True
    RetValue = MainDialog.Execute
    Select Case RetValue
        Case 0
            MainDialog.Dispose()
            oBaseDocument.Dispose()
        Case 1
            EndDialog()
            MainDialog.Dispose()
    End Select
GLOBALERRORHANDLER:
    If Err <> 0 Then
        MsgBox (WebWiz_gErrMsg$, 16, WebWiz_gWizardName$)
        CancelHTMLWizard()
    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(), NumberofLayouts%, 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()
Dim OldWebPageIndex as Integer
    OldWebPageIndex = CurWebPageIndex
    CurWebPageIndex = GetCurIndex(DialogModel.lbStyles, Style(), NumberofStyles%,8)
    If OldWebPageIndex <> CurWebPageIndex Then
        ToggleDialogControls(False)
        oBaseDocument.LockControllers
        bWithBackGraphic = LoadNewStyles(oBaseDocument, DialogModel, CurWebPageIndex, FileStr, Style(), TextureDir)
        CurrentBullet$ = BulletDir + Style(6, CurWebPageIndex)
        CurrentPrev$ = GraphicsDir + Style(2, CurWebPageIndex)
        CurrentNext$ = GraphicsDir + Style(3, CurWebPageIndex)
        CurrentHome$ = GraphicsDir + Style(4, CurWebPageIndex)
        CurrentTop$ = GraphicsDir + Style(5, CurWebPageIndex)
        With oBaseDocument.DocumentInfo
            .GetUserFieldValue(0) = ExtractGraphicNames(CurWebPageIndex,2)
            .GetUserFieldValue(1) = ExtractGraphicNames(CurWebPageIndex, 4)
            .GetUserFieldValue(2) = Style(6, CurWebPageIndex)       ' Bullet
            .GetUserFieldValue(3) = Style(7, CurWebPageIndex)       ' 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(i,CurIndex))
    FieldValue = FieldValue & " " &    GetFileNameWithoutExtension(Style(i+1,CurIndex))
    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")
    GetPaths()
    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
    sFileName = FileNameoutofPath(SourceUrl)
    sNewFileUrl = TargetDir & sFileName
    oUcb.Copy(SourceUrl, sNewFileUrl)
    CopyFile() = sFileName
End Function



Function FillupWebListbox(oUcb as Object, sFileFilter as String, oDialog as Object, ListboxName as String, List() 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 SelList(0) as Integer
Dim LocMaxIndex as Integer
Dim InfoNames()
    oListboxControl = oDialog.GetControl(ListboxName)
    oDocInfo = CreateUnoService("com.sun.star.document.DocumentProperties")
    FilterLen = Len(sFileFilter)
    bItemFound = False
    TemplatePath = GetOfficeSubPath("Template", "wizard/web/")
    DirContent() = oUcb.GetFolderContents(TemplatePath,True)

    LocMaxIndex = Ubound(DirContent())

    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)
        If Instr(1,Filename, sFileFilter) Then
            bItemFound = True
            Description = RetrieveDocTitle(oDocInfo, FileName)
            oDocInfo.Read(FileName)
            InfoNames = oDocInfo.ElementNames()
            oListboxControl.AddItem(Description,a)
            a = a + 1
            List(1,i) = Description
            If sFileFilter = "/cnt" Then
                List(2,i) = 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(m,i) = sFieldList(s) & ".gif"
                        Else
                            List(m,i) = sFieldList(s)
                        End If
                        m = m + 1
                    Next s
                Next n
                List(8,i) = FileName
            End If
        End If
    Next i
    If Not bItemfound Then
        MsgBox(WebWiz_gErrContentNotFound$ , 16, WebWiz_gWizardName$)
        oBaseDocument.Dispose()
        Stop
    End If
    SelList(0) = 0
    oListboxControl.Model.SelectedItems() = SelList()
    FillupWebListbox = i
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)
    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 Sub</script:module>