Kompuutteri Kaikille K-CD 2002 #3/K-CD_2002-03.iso/OpenOffice/f_0198/HtmlAutoPilotBasic.xba

Extensible Markup Language | 2001-10-02 | 14KB | 419 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 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

' Filled with title, file name
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
'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)
    DialogModel.optTiled.State = 1
    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 = True
    DialogModel.cbGoOn.DefaultButton = True
    MainDialog.Execute

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 CurInd as Integer
'On Local Error Goto ErrorOcurred
' Todo:Check if the pointer is really disabled, when set to Hourglass
    ToggleDialogControls(False)
    oBaseDocument.LockControllers
    ' Get selected list entry and corresponding file name
    CurInd = GetCurIndex(DialogModel.lbTemplate, Layout(), NumberofLayouts%, 2)
    oCursor = oBaseDocument.Text.CreateTextCursor()
    oCursor.GotoStart(False)
    oCursor.GotoEnd(True)
    oCursor.SetPropertyToDefault("CharHeight")
    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 Sub



Sub LoadWebPageStyles()
Dim CurIndex as Integer
    ToggleDialogControls(False)
    oBaseDocument.LockControllers
    CurIndex = GetCurIndex(DialogModel.lbStyles, Style(), NumberofStyles%,8)
    bWithBackGraphic = LoadNewStyles(oBaseDocument, DialogModel, CurIndex, FileStr, Style(), TextureDir)
    CurrentBullet$ = BulletDir + Style(6, CurIndex)
    CurrentPrev$ = GraphicsDir + Style(2, CurIndex)
    CurrentNext$ = GraphicsDir + Style(3, CurIndex)
    CurrentHome$ = GraphicsDir + Style(4, CurIndex)
    CurrentTop$ = GraphicsDir + Style(5, CurIndex)
    With oBaseDocument.DocumentInfo
        .GetUserFieldValue(0) = ExtractGraphicNames(CurIndex,2)
        .GetUserFieldValue(1) = ExtractGraphicNames(CurIndex, 4)
        .GetUserFieldValue(2) = Style(6, CurIndex)       ' Bullet
        .GetUserFieldValue(3) = Style(7, CurIndex)       ' Background
    End With
    SetBulletAndGraphics()
    CheckControls(oBaseDocument.DrawPage)
    oViewCursor.GotoStart(False)
    oBaseDocument.UnlockControllers
    ToggleDialogControls(True, "lbStyles")
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)
    Else
        SetEvent()
    End If
    MainDialog.EndExecute()
    MainDialog.Dispose()
End Sub


Sub CancelHTMLWizard()
    MainDialog.EndExecute()
    MainDialog.Dispose()
    oBaseDocument.Dispose()
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 = StarDesktop.ActiveFrame.Controller.Model
    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 = StarDesktop.ActiveFrame.Controller.Model
    ' 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

'    ' Reset events
    AttachBasicMacroToEvent(oBaseDocument,"OnSaveDone", "")
    AttachBasicMacroToEvent(oBaseDocument,"OnSaveAsDone", "")
    AttachBasicMacroToEvent(oBaseDocument,"OnNew", "")
    oBaseDocument.Store
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)
    With DialogModel
        .cbCancel.Enabled = bDoEnable
        .cbGoOn.Enabled = bDoEnable
        .cbHelp.Enabled = bDoEnable
        .lblTemplate.Enabled = bDoEnable
        .lblStyle.Enabled = bDoEnable
        .chkSaveasTemplate.Enabled = bDoEnable
        .lbTemplate.Enabled = bDoEnable
        .lbStyles.Enabled = bDoEnable
        If bDoEnable Then
            ' Enable Controls referring to Background graphic only when this Property is set
            bDoEnable = bWithBackGraphic
            MainDialog.GetControl(FocusControlName).SetFocus = True
        End If
        ToggleOptionButtons(DialogModel, bDoEnable)
    End With
End Sub

</script:module>