' 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.DocumentProperties.UserDefinedProperties .AutoPilotName1 = ExtractGraphicNames(CurWebPageIndex,2) .AutoPilotName2 = ExtractGraphicNames(CurWebPageIndex, 4) .AutoPilotBullet = Style(CurWebPageIndex, 6) .AutoPilotBackground = Style(CurWebPageIndex, 7) 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 udProps as Object 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) udProps = oBaseDocument.DocumentProperties.UserDefinedProperties udProps.addProperty("AutoPilotName1", 0, "") udProps.addProperty("AutoPilotName2", 0, "") udProps.addProperty("AutoPilotBullet", 0, "") udProps.addProperty("AutoPilotBackground", 0, "") 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 oDocProps 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 Properties() Dim DimCount as Integer Dim sExtension as String oDocProps = 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(oDocProps, 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(oDocProps, FileName) Properties = oDocProps.UserDefinedProperties.PropertyValues List(a,1) = Description If sFileFilter = "/cnt" Then List(a,2) = Filename Else m = 2 For n = 0 To 3 sField = Properties(n).Value 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