Program Metropolis - Software Boutique 95/SOFTWARECD.iso/visio3/disk4/progress.fr_/progress.bin

Visual Basic Form | 1994-08-09 | 12.4 KB | 381 lines

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
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)
                        Set inst = inst.Parent
                    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:
    g_AppVisio.ActiveWindow.DeselectAll
    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
    g_AppVisio.ScreenUpdating = False
    DrawCreate
    'Turn off screen updating
    g_AppVisio.ScreenUpdating = True
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