LibreOffice Impress progress bar with square/circle

Well, may be not so sophisticated. I had looked to start by forking that repository but end up, writing from scratch.

Current state, it is working (LibreOffice v6.0.2.1). However, Setting are not presented in GUI.

Setup

  1. Tools > Macros > Organize Macros > LibreOffice Basic...
  2. My Macros > Standard: New module name it "ProgressLine" or whatever.
  3. Select it then Edit, Copy below code into it

    REM  *****  BASIC  *****
    
    Dim iFileNumber As Integer
    Dim iSectionCount As Integer
    Dim iSectionPage As Integer
    Dim iSectionIndex As Integer
    Dim iSectionIndexCurrent As Integer
    
    Dim oDocument As Object
    Dim oPage As Object
    Dim iPageCount As Integer
    Dim oPositionPageMark As New com.sun.star.awt.Point
    Dim oSizePageMark As New com.sun.star.awt.Size
    Dim oSizeSectionTitle As New com.sun.star.awt.Size
    
    
    Sub ProgressLine
    
        'Default values
        'sBulletShape = "com.sun.star.drawing.RectangleShape"
        sBulletShape = "com.sun.star.drawing.EllipseShape"
        'Values are fracture of page width
        oSizePageMark_Width = 0.02
        oSizePageMark_Height = 0.02
        oSizeSectionTitle_Width = 0.20
        oSizeSectionTitle_Height = 0.03
        dSeparationRatioSection = 3.0
        dMargin_Start = 0.05
        dMargin_End = 0.10
        dMargin_Side = 0.03
    
        oFillColorPageMarkActive = RGB(255,0,0)
        oFillColorPageMarkInactive = RGB(240, 200, 200)
        oCharColorSectionTitleActive = RGB(255, 0, 0)
        oCharColorSectionTitleInactive = RGB(150, 150, 150)
    
    
        ProgressLineRemove()
    
        oDocument = ThisComponent
        If oDocument.supportsService("com.sun.star.drawing.GenericDrawingDocument") Then
            'Load index
            sIndexPath = oDocument.URL
            sIndexPath = Mid( Left(sIndexPath, InStr(sIndexPath, ".odp")-1) & ".index",1,Len(sIndexPath)+2)
            iFileNumber = Freefile
            Open sIndexPath For Input As #iFileNumber
            'First line is section total count
            If Not eof(#iFileNumber) Then
                Line Input #iFileNumber, sLine
                If sLine<>"" Then
                    iSectionCount = Int(sLine)
                End If
            End If
            'Remaining lines for sections: page, title
            iPageCount = oDocument.DrawPages.Count
            Dim sSectionTitle(iPageCount) As String
            While Not eof(#iFileNumber)
                Line Input #iFileNumber, sLine
                If sLine<>"" Then
                    iSectionPage = Int(Left(sLine, InStr(sLine, ",")-1))
                    sSectionTitle(iSectionPage-1) = Right(sLine, Len(sLine)-InStr(sLine, ","))
                End If
            Wend
    
            'loop over pages
            iSectionIndex=-1
            For iPageIndex=0 To iPageCount-1
                If sSectionTitle(iPageIndex)<>"" Then
                    iSectionIndex = iSectionIndex+1
                End If
                oPage = oDocument.DrawPages(iPageIndex)
                oSizePageMark.Width = oPage.Width*oSizePageMark_Width
                oSizePageMark.Height = oPage.Width*oSizePageMark_Height
                dSeparation = (oPage.Width*(1-dMargin_Start-dMargin_End)-oSizePageMark.Width*iPageCount)/((iPageCount-iSectionCount)+(iSectionCount-1)*dSeparationRatioSection)
    
    
                'Place new shapes, loop over page for progress
                iSectionIndexCurrent=-1
                For iPageIndexCurrent=0 To iPageCount-1
                    If sSectionTitle(iPageIndexCurrent)<>"" Then
                        iSectionIndexCurrent = iSectionIndexCurrent+1
                    End If
                    oShape = oDocument.createInstance(sBulletShape)
                    oPositionPageMark.x = (iPageIndexCurrent+iSectionIndexCurrent*(dSeparationRatioSection-1))*dSeparation+iPageIndexCurrent*oSizePageMark.Width+oPage.Width*dMargin_Start
                    oPositionPageMark.y = oPage.Height-oPage.Width*dMargin_Side-oSizePageMark.Height
                    oShape.Size = oSizePageMark
                    oShape.Position = oPositionPageMark
                    oShape.LineStyle = none
                    If (iPageIndexCurrent=iPageIndex) Then
                        oShape.FillColor = oFillColorPageMarkActive
                    Else
                        oShape.FillColor = oFillColorPageMarkInactive
                    End If
                    oShape.Name = "Progress Line RS_" + (iPageIndex+1)+"_"+(iPageIndexCurrent+1)
                    oPage.add(oShape)
    
                    'Section titles, skip dummy title: "_"
                    If sSectionTitle(iPageIndexCurrent)<>"" And sSectionTitle(iPageIndexCurrent)<>"_" Then        
                        oShape = oDocument.createInstance("com.sun.star.drawing.RectangleShape")    
                        oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.TOP
                        oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.LEFT
                        oShape.TextLeftDistance = 0
                        oSizeSectionTitle.Width = oPage.Width*oSizeSectionTitle_Width
                        oSizeSectionTitle.Height = oPage.Width*oSizeSectionTitle_Height
                        oShape.Size = oSizeSectionTitle
                        oPositionPageMark.y = oPositionPageMark.y-oSizeSectionTitle.Height
                        oShape.Position = oPositionPageMark
                        oShape.LineStyle = none
                        oShape.FillStyle = none
                        oShape.Name = "Progress Line TS_" + (iPageIndex+1)+"_"+(iPageIndexCurrent+1)
                        oPage.add(oShape)
                        oShape.String = sSectionTitle(iPageIndexCurrent)
                        oShape.CharWeight = com.sun.star.awt.FontWeight.BOLD  
                        oShape.CharFontName = "Arial" 'todo: doesn't work
    
                        If iSectionIndexCurrent=iSectionIndex Then
                            oShape.CharColor = oCharColorSectionTitleActive
                        Else
                            oShape.CharColor = oCharColorSectionTitleInactive
                        End If 
    
                    End If
                Next iPageIndexCurrent
            Next iPageIndex
            Close #iFileNumber
        End If
    End Sub
    
    Sub ProgressLineRemove
        oDocument = ThisComponent
        If oDocument.supportsService("com.sun.star.drawing.GenericDrawingDocument") Then
            'loop over pages
            iSectionIndexCurrent=0
            For iPageIndex=0 To oDocument.DrawPages.Count-1
                oPage = oDocument.DrawPages(iPageIndex)
                'Cleanup old shapes
                iShapeIndex = oPage.getCount-1
                Do While (iShapeIndex>=0)
                    oShape = oPage.getByIndex(iShapeIndex)
                    If (InStr(oShape.Name, "Progress Line") <> 0) Then
                        oPage.remove(oShape)
                    End If
                    iShapeIndex = iShapeIndex-1
                Loop
            Next iPageIndex
        End If
    End Sub
    
  4. Save it

Workflow

Add ProgressLine

  1. Create index, a text file, in same folder with same name but with .index extension

    5
    1,_
    2,H2_a
    4,H2_b
    7,H2_c
    10,_
    
    • First line is total number of section
    • Remaining lines in this format: page, section title
    • _ special for section without title
  2. Open your presentation

  3. Tools > Macros > Organize Macros > LibreOffice Basic...: Run ProgressLine

Remove ProgressLine

  • Tools > Macros > Organize Macros > LibreOffice Basic...: Run ProgressLineRemove

Notes

  • Most settings are grouped at the top of the script, so it should be somehow easy to tweak it.

LibreOffice-OpenOffice Impress-Presentation Progress Bar with Sections Top Outline

Tags:

Libreoffice