home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmProgress
- Appearance = 0 'Flat
- BackColor = &H00C0C0C0&
- BorderStyle = 3 'Fixed Dialog
- ClientHeight = 4455
- ClientLeft = -30
- ClientTop = 1530
- ClientWidth = 6480
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H00000000&
- Height = 4860
- Left = -90
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4455
- ScaleWidth = 6480
- Top = 1185
- Width = 6600
- Begin Threed.SSPanel pnlStndoc
- Height = 3390
- Left = 180
- TabIndex = 7
- Top = 180
- Width = 1950
- _Version = 65536
- _ExtentX = 3440
- _ExtentY = 5980
- _StockProps = 15
- ForeColor = -2147483640
- BackColor = 8421376
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- BevelOuter = 1
- Begin VB.Image imgStndoc
- Appearance = 0 'Flat
- Height = 3360
- Left = 0
- Picture = "PROGRESS.frx":0000
- Top = 0
- Width = 1920
- End
- End
- Begin VB.CommandButton cmdCancel
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "Cancel"
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 5160
- TabIndex = 6
- Top = 3960
- Width = 1155
- End
- Begin VB.CommandButton cmdNext
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "Next >"
- Default = -1 'True
- Enabled = 0 'False
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 3840
- TabIndex = 0
- Top = 3960
- Width = 1155
- End
- Begin VB.CommandButton cmdBack
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "< &Back"
- Enabled = 0 'False
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 2700
- TabIndex = 5
- Top = 3960
- Width = 1155
- End
- Begin Threed.SSPanel Panel3D1
- Height = 375
- Left = 2220
- TabIndex = 4
- Top = 3000
- Width = 4215
- _Version = 65536
- _ExtentX = 7435
- _ExtentY = 661
- _StockProps = 15
- Caption = "Panel3D1"
- ForeColor = 4210752
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- BevelOuter = 1
- FloodType = 1
- End
- Begin VB.Line Line2
- BorderColor = &H00FFFFFF&
- X1 = 180
- X2 = 6300
- Y1 = 3795
- Y2 = 3795
- End
- Begin VB.Label Label3
- Appearance = 0 'Flat
- BackColor = &H80000005&
- BackStyle = 0 'Transparent
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H00000000&
- Height = 255
- Left = 2220
- TabIndex = 3
- Top = 2520
- Width = 4215
- End
- Begin VB.Label Label2
- Appearance = 0 'Flat
- BackColor = &H80000005&
- BackStyle = 0 'Transparent
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H00000000&
- Height = 255
- Left = 2220
- TabIndex = 2
- Top = 2160
- Width = 4215
- End
- Begin VB.Label Label1
- Appearance = 0 'Flat
- BackColor = &H80000005&
- BackStyle = 0 'Transparent
- Caption = "Creating report..."
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H80000008&
- Height = 255
- Left = 2220
- TabIndex = 1
- Top = 240
- Width = 4215
- End
- Attribute VB_Name = "frmProgress"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- Private Sub Cancel_Click()
- End
- End Sub
- Private Sub cmdCancel_Click()
- g_appVisio.ScreenUpdating = True
- End
- End Sub
- Private Sub DrawCreate()
- Dim stencil As Visio.Document ' stencil document
- Dim Page As Visio.Page
- Dim shape As Visio.shape
- Dim master As Visio.master
- Dim masters As Visio.masters
- Dim label As Visio.master
- Dim text As Visio.master
- Dim inst As Visio.shape ' 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.BackPageFromName = 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)
- 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
- 'If master is empty, skip it
- If master.Shapes.Count > 0 Then
-
- xLeft = gGridArray(row, col).left + gGrid.ColWidth / 2
- yTop = gGridArray(row, col).Top - gGrid.RowHeight / 2
- ' Set the alertresponse so that the custom properties
- ' dialog doesn't stop us
- g_appVisio.AlertResponse = 1
- Set inst = Page.Drop(master, xLeft, yTop)
- g_appVisio.AlertResponse = 0
-
- ' 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
- End If
- ProgressGauge (25 + masterIndex / masters.Count * 75)
- masterIndex = masterIndex + 1
- Next
- Next
- Next
- fexit:
- SetScreenUpdating (True)
- g_appVisio.ActiveWindow.DeselectAll
- g_appVisio.ActiveWindow.PageFromName = gDocDraw.Pages.Item(1) 'go to first page
- End
- End Sub
- Private 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
- Private Sub Form_Load()
- ' Initialize the form.
- '
- formInit frmProgress
- ' Center the picture
- imgStndoc.Top = pnlStndoc.Height / 2 - imgStndoc.Height / 2
- imgStndoc.left = pnlStndoc.Width / 2 - imgStndoc.Width / 2
- End Sub
- Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
- End
- End Sub
- Private Sub Form_Resize()
- DoEvents
- 'Turn off screen updating
- SetScreenUpdating (False) 'Turn off screen updating
- DrawCreate
- End Sub
- ' Resize shape to fit in grid
- Private Sub GridFit(row, col, shape As Visio.shape)
- Dim shapeWidth As Visio.Cell ' cell object
- Dim shapeHeight As Visio.Cell ' 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
- Private Sub GridPos(row, col, shape As Visio.shape)
- 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
- Private 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
- Private Sub SetScreenUpdating(bUpdate As Integer)
- If g_appVisio.Version < 2.1 Then
- Exit Sub
- Else
- g_appVisio.ScreenUpdating = bUpdate
- End If
- End Sub
-