VERSION 2.00
Begin Form frmProgress 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   ClientHeight    =   1605
   ClientLeft      =   5400
   ClientTop       =   5955
   ClientWidth     =   4455
   ForeColor       =   &H00000000&
   Height          =   2010
   Left            =   5340
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1605
   ScaleWidth      =   4455
   Top             =   5610
   Width           =   4575
   Begin SSPanel Panel3D1 
      BackColor       =   &H00C0C0C0&
      BevelOuter      =   1  'Inset
      Caption         =   "Panel3D1"
      FloodType       =   1  'Left To Right
      Font3D          =   0  'None
      ForeColor       =   &H00404040&
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   1080
      Width           =   4215
   End
   Begin CommandButton Cancel 
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   3360
      TabIndex        =   1
      Top             =   120
      Width           =   975
   End
   Begin Label Label3 
      BackStyle       =   0  'Transparent
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   600
      Width           =   4215
   End
   Begin Label Label2 
      BackStyle       =   0  'Transparent
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   360
      Width           =   3135
   End
   Begin Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Creating report..."
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3135
   End
End
Option Explicit

Sub Cancel_Click ()
    End
End Sub

Sub DrawCreate ()
    Dim stencil As Object             ' stencil document
    Dim Page As Object
    Dim shape As Object
    Dim master As Object
    Dim masters As Object
    Dim footerRight As Object
    Dim label As Object
    Dim text As Object
    Dim inst As Object                  ' instance

    Dim xLeft
    Dim yTop
    Dim xRight
    Dim yBottom

    Dim row
    Dim col
    Dim pageNumber
    Dim masterIndex
    Dim stencilName
    Dim pageName
    Dim stat

    ' Get stencil
    '
    Set stencil = g_appVisio.documents(gDoc.filename)
    If stencil.Title = "" Then
        stencilName = stencil.Name
    Else
        stencilName = stencil.Title
    End If
        
    stat = DrawYield(stencilName, STR_BACKGROUND, "")
    ProgressGauge (5)

    ' Compute page count
    '
    Set masters = stencil.masters
    gDoc.masters = masters.count
    gDoc.pageCount = gDoc.masters \ gGrid.masters
    If (gDoc.masters Mod gGrid.masters) > 0 Then
        gDoc.pageCount = gDoc.pageCount + 1
    End If

    ' Draw header on background page
    '
    If gDoc.Header = True Then
        xLeft = gPage.LeftMargin
        xRight = gPage.PageWidth - gPage.RightMargin
        yTop = gPage.PageHeight - gPage.TopMargin
        yBottom = yTop - gPage.Header / 6
        Set shape = gPageBack.DrawRectangle(xLeft, yTop, xRight, yBottom)
        shape.FillStyle = "Black fill"

        yTop = yBottom
        yBottom = gPage.PageHeight - gPage.TopMargin - gPage.Header
        Set shape = gPageBack.DrawRectangle(xLeft, yTop, xRight, yBottom)
        shape.Style = "_Header"
        shape.text = stencilName
    End If

    stat = DrawYield("", "", "")
    ProgressGauge (10)

    ' Draw left footer on background page.
    ' The left footer includes the line at the bottom of the page.
    '
    If gDoc.Footer = True Then
        xLeft = gPage.LeftMargin
        xRight = gPage.PageWidth - gPage.RightMargin
        yBottom = gPage.BottomMargin
        yTop = yBottom + gPage.Footer
        Set shape = gPageBack.DrawLine(xLeft, yTop, xRight, yTop)
        shape.Style = "_FootLeft"
        shape.text = UCase(gDoc.filename)
    End If

    stat = DrawYield("", "", "")
    ProgressGauge (15)

    ' Create property masters
    '
    If gDoc.properties = True Then
        ' Create text master
        '
        xRight = gGrid.ColWidth - gPage.LabelWidth
        Set shape = gPageBack.DrawRectangle(0, 0, xRight, 0)
        shape.Style = "_PropText"
        shape.text = "Name:" & Chr(10) & Chr(10) & "Prompt:"
        
        ' Drop text master into local stencil
        '
        Set text = gDocDraw.Drop(shape, 0, 0)
        
        ' Create label master
        '
        shape.Cells("Width").formula = gPage.LabelWidth
        shape.Style = "_PropLabel"

        ' Drop label master into local stencil
        '
        Set label = gDocDraw.Drop(shape, 0, 0)
        shape.[delete]
    End If

    stat = DrawYield("", "", "")
    ProgressGauge (20)

    ' Draw grid
    '
    If gDoc.gridlines = True Then
        ' Draw vertical gridlines
        '
        For col = 0 To gGrid.cols - 2
            xLeft = gGridArray(0, col).Right
            xRight = xLeft
            yTop = gGridArray(gGrid.rows - 1, col).Top
            yBottom = gGridArray(0, col).Bottom
            Set shape = gPageBack.DrawLine(xLeft, yTop, xRight, yBottom)
            shape.Style = "_Gridline"
        Next

        ' Draw horizontal gridlines
        '
        For row = 0 To gGrid.rows - 2
            xLeft = gGridArray(row, 0).Left
            xRight = gGridArray(row, gGrid.cols - 1).Right
            yBottom = gGridArray(row, 0).Top
            yTop = yBottom
            Set shape = gPageBack.DrawLine(xLeft, yTop, xRight, yBottom)
            shape.Style = "_Gridline"
        Next
    End If

    stat = DrawYield("", "", "")
    ProgressGauge (25)

    ' Instance each master in stencil
    '
    masterIndex = 1
    For pageNumber = 1 To gDoc.pageCount
        pageName = "Page " & pageNumber & " of " & gDoc.pageCount

        stat = DrawYield("", pageName, "")

        ' Create new page and set its background
        '
        Set Page = gDocDraw.Pages.Add
        Page.Name = pageName
        Page.Background = False
        Page.BackPage = gPageBack

        ' Draw right footer on page
        '
        If gDoc.Footer = True Then
            xLeft = gPage.PageWidth / 2
            xRight = gPage.PageWidth - gPage.RightMargin
            yTop = gPage.BottomMargin + gPage.Footer
            Set shape = Page.DrawLine(xLeft, yTop, xRight, yTop)
            shape.Style = "_FootRight"
            shape.text = Page.Name
        End If

        ' Drop each master on page
        '
        For row = gGrid.rows - 1 To 0 Step -1
            For col = 0 To gGrid.cols - 1
                If masterIndex > masters.count Then
                    GoTo fexit
                End If

                ' Drop master in the center of the grid
                '
                Set master = masters(masterIndex)
                stat = DrawYield("", "", master.Name)

                xLeft = gGridArray(row, col).Left + gGrid.ColWidth / 2
                yTop = gGridArray(row, col).Top - gGrid.RowHeight / 2
                Set inst = Page.Drop(master, xLeft, yTop)
    
                If gDoc.properties = True Then
                    ' Drop property label
                    '
                    xLeft = gGridArray(row, col).Left + gPage.LabelWidth / 2
                    yTop = gGridArray(row, col).Top
                    Set shape = Page.Drop(label, xLeft, yTop)
    
                    ' Drop property text
                    '
                    xLeft = gGridArray(row, col).Left + gPage.LabelWidth + (gGrid.ColWidth - gPage.LabelWidth) / 2
                    yTop = gGridArray(row, col).Top
                    Set shape = Page.Drop(text, xLeft, yTop)
                    shape.text = master.Name & Chr(10) & Chr(10) & master.prompt
                End If

                ' Fit in grid
                '
                If gDoc.resize = True Then
                    ' Group the shape if not already a group
                    '
                    If inst.type <> 2 Then
                        inst.Group
                        'Set inst = gWinDraw.Selection.Item(1)
                        If g_appVisio.version < 2.1 Then
                            Set inst = gWinDraw.Selection.Item(1)
                        Else
                           Set inst = inst.Parent
                        End If
                    End If

                    GridFit row, col, inst  ' Resize the shape to fit in grid
                    GridPos row, col, inst  ' Reposition the shape
                End If

                ProgressGauge (25 + masterIndex / masters.count * 75)

                masterIndex = masterIndex + 1
            Next
        Next
    Next
    
fexit:
    SetScreenUpdating (True)
    g_appVisio.ActiveWindow.DeselectAll
    g_appVisio.ActiveWindow.Page = gDocDraw.Pages.Item(1) 'go to first page
    End

End Sub

Function DrawYield (ByVal stencil As String, ByVal Page As String, ByVal master As String)
    If stencil <> "" Then
        label1.Caption = "Stencil:  " & stencil
    End If
    If Page <> "" Then
        label2.Caption = "Page:  " & Page
    End If
    If master <> "" Then
        label3.Caption = "Master:  " & master
    End If

    DoEvents
End Function

Sub Form_Load ()
    ' Initialize the form.
    '
    formInit frmProgress
    
    ' Center the form
    '
    Top = screen.Height - Height - 500
    Left = screen.Width - Width - 500

End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
    End
End Sub

Sub Form_Resize ()
    DoEvents
    'Turn off screen updating
    SetScreenUpdating (False)  'Turn off screen updating
    
    DrawCreate
    
End Sub

'   Resize shape to fit in grid
'
Sub GridFit (row, col, shape As Object)
    Dim shapeWidth As Object    ' cell object
    Dim shapeHeight As Object   ' cell object
    Dim gridWidth
    Dim gridHeight
    Dim LabelHeight
    Dim aspectRatio

    ' General computations
    '
    Set shapeWidth = shape.Cells("Width")
    Set shapeHeight = shape.Cells("Height")

    LabelHeight = 0
    If gDoc.properties = True Then
        LabelHeight = gPage.LabelHeight
    End If

    gridWidth = gGrid.ColWidth - 2 * gPage.GridMargin
    gridHeight = gGrid.RowHeight - LabelHeight - 2 * gPage.GridMargin

    ' Is the shape too big for the grid
    '
    If shapeWidth <= gridWidth And shapeHeight <= gridHeight Then
        Exit Sub      ' nothing to do
    End If

    ' Resize shape to fit in grid
    '
    aspectRatio = 1
    If shapeHeight <> 0 Then
        aspectRatio = shapeWidth / shapeHeight
    End If

    '   Adjust height
    '
    If shapeHeight > gridHeight Then
        shapeHeight.FormulaForce = gridHeight
        If shapeWidth > 0 Then
            shapeWidth.FormulaForce = aspectRatio * gridHeight
        End If
    End If

    '   Adjust width
    '
    If shapeWidth > gridWidth Then
        shapeWidth.FormulaForce = gridWidth
        If shapeHeight > 0 Then
            shapeHeight.FormulaForce = gridWidth / aspectRatio
        End If
    End If

End Sub

' Position shape in grid
'
Sub GridPos (row, col, shape As Object)
    Dim X
    Dim Y

    X = gGridArray(row, col).Left + gGrid.ColWidth / 2
    Y = gGridArray(row, col).Bottom + gGrid.RowHeight / 2
    If gDoc.properties = True Then
        Y = Y - gPage.LabelHeight / 2
    End If
    shape.SetCenter X, Y
End Sub

Sub ProgressGauge (ByVal percent As Integer)
    Dim X As Single
    Dim Y As Single
    Dim t As String

    ' Set coordinates for the right end of the rectangle
    ' that displays the progress bar.
    '
    'y = Picture1.ScaleHeight
    'x = percent * Picture1.ScaleWidth / 100
    
    ' Draw the rectangle
    '
    'Picture1.Line (0, 0)-(x, y), QBColor(1), BF
    'Picture1.Line (x, 0)-(Picture1.ScaleWidth, y), QBColor(7), BF

    ' Center and draw the text
    '
    't = percent & "%"
    'Picture1.CurrentY = (Picture1.ScaleHeight - Picture1.TextHeight(t)) / 2
    'Picture1.CurrentX = (Picture1.ScaleWidth - Picture1.TextWidth(t)) / 2
    
    Panel3D1.FloodPercent = percent
    If percent > 45 Then
        'Picture1.ForeColor = QBColor(1)
        Panel3D1.ForeColor = &HFFFFFF
    'Else
        'Picture1.ForeColor = RGB(255, 255, 255)
    End If
    'Picture1.Print t
End Sub

Sub SetScreenUpdating (bUpdate As Integer)

    If g_appVisio.version < 2.1 Then
        Exit Sub
    Else
       g_appVisio.ScreenUpdating = bUpdate
    End If

End Sub

