home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 November / pcwk_11_98a.iso / Wtestowe / Vistdtk / Install / Data.Z / Progress.FRM < prev    next >
Text File  |  1997-05-23  |  19KB  |  618 lines

  1. VERSION 4.00
  2. Begin VB.Form frmProgress 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    BorderStyle     =   3  'Fixed Dialog
  6.    ClientHeight    =   4455
  7.    ClientLeft      =   -30
  8.    ClientTop       =   1530
  9.    ClientWidth     =   6480
  10.    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H00000000&
  20.    Height          =   4860
  21.    Left            =   -90
  22.    LinkTopic       =   "Form1"
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    ScaleHeight     =   4455
  26.    ScaleWidth      =   6480
  27.    Top             =   1185
  28.    Width           =   6600
  29.    Begin Threed.SSPanel pnlStndoc 
  30.       Height          =   3390
  31.       Left            =   180
  32.       TabIndex        =   7
  33.       Top             =   180
  34.       Width           =   1950
  35.       _Version        =   65536
  36.       _ExtentX        =   3440
  37.       _ExtentY        =   5980
  38.       _StockProps     =   15
  39.       ForeColor       =   -2147483640
  40.       BackColor       =   8421376
  41.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  42.          Name            =   "MS Sans Serif"
  43.          Size            =   8.25
  44.          Charset         =   0
  45.          Weight          =   700
  46.          Underline       =   0   'False
  47.          Italic          =   0   'False
  48.          Strikethrough   =   0   'False
  49.       EndProperty
  50.       BevelOuter      =   1
  51.       Begin VB.Image imgStndoc 
  52.          Appearance      =   0  'Flat
  53.          Height          =   3360
  54.          Left            =   0
  55.          Picture         =   "PROGRESS.frx":0000
  56.          Top             =   0
  57.          Width           =   1920
  58.       End
  59.    End
  60.    Begin VB.CommandButton cmdCancel 
  61.       Appearance      =   0  'Flat
  62.       BackColor       =   &H80000005&
  63.       Caption         =   "Cancel"
  64.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  65.          Name            =   "MS Sans Serif"
  66.          Size            =   8.25
  67.          Charset         =   0
  68.          Weight          =   400
  69.          Underline       =   0   'False
  70.          Italic          =   0   'False
  71.          Strikethrough   =   0   'False
  72.       EndProperty
  73.       Height          =   375
  74.       Left            =   5160
  75.       TabIndex        =   6
  76.       Top             =   3960
  77.       Width           =   1155
  78.    End
  79.    Begin VB.CommandButton cmdNext 
  80.       Appearance      =   0  'Flat
  81.       BackColor       =   &H80000005&
  82.       Caption         =   "Next >"
  83.       Default         =   -1  'True
  84.       Enabled         =   0   'False
  85.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  86.          Name            =   "MS Sans Serif"
  87.          Size            =   8.25
  88.          Charset         =   0
  89.          Weight          =   400
  90.          Underline       =   0   'False
  91.          Italic          =   0   'False
  92.          Strikethrough   =   0   'False
  93.       EndProperty
  94.       Height          =   375
  95.       Left            =   3840
  96.       TabIndex        =   0
  97.       Top             =   3960
  98.       Width           =   1155
  99.    End
  100.    Begin VB.CommandButton cmdBack 
  101.       Appearance      =   0  'Flat
  102.       BackColor       =   &H80000005&
  103.       Caption         =   "< &Back"
  104.       Enabled         =   0   'False
  105.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  106.          Name            =   "MS Sans Serif"
  107.          Size            =   8.25
  108.          Charset         =   0
  109.          Weight          =   400
  110.          Underline       =   0   'False
  111.          Italic          =   0   'False
  112.          Strikethrough   =   0   'False
  113.       EndProperty
  114.       Height          =   375
  115.       Left            =   2700
  116.       TabIndex        =   5
  117.       Top             =   3960
  118.       Width           =   1155
  119.    End
  120.    Begin Threed.SSPanel Panel3D1 
  121.       Height          =   375
  122.       Left            =   2220
  123.       TabIndex        =   4
  124.       Top             =   3000
  125.       Width           =   4215
  126.       _Version        =   65536
  127.       _ExtentX        =   7435
  128.       _ExtentY        =   661
  129.       _StockProps     =   15
  130.       Caption         =   "Panel3D1"
  131.       ForeColor       =   4210752
  132.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  133.          Name            =   "MS Sans Serif"
  134.          Size            =   8.25
  135.          Charset         =   0
  136.          Weight          =   700
  137.          Underline       =   0   'False
  138.          Italic          =   0   'False
  139.          Strikethrough   =   0   'False
  140.       EndProperty
  141.       BevelOuter      =   1
  142.       FloodType       =   1
  143.    End
  144.    Begin VB.Line Line2 
  145.       BorderColor     =   &H00FFFFFF&
  146.       X1              =   180
  147.       X2              =   6300
  148.       Y1              =   3795
  149.       Y2              =   3795
  150.    End
  151.    Begin VB.Label Label3 
  152.       Appearance      =   0  'Flat
  153.       BackColor       =   &H80000005&
  154.       BackStyle       =   0  'Transparent
  155.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  156.          Name            =   "MS Sans Serif"
  157.          Size            =   8.25
  158.          Charset         =   0
  159.          Weight          =   400
  160.          Underline       =   0   'False
  161.          Italic          =   0   'False
  162.          Strikethrough   =   0   'False
  163.       EndProperty
  164.       ForeColor       =   &H00000000&
  165.       Height          =   255
  166.       Left            =   2220
  167.       TabIndex        =   3
  168.       Top             =   2520
  169.       Width           =   4215
  170.    End
  171.    Begin VB.Label Label2 
  172.       Appearance      =   0  'Flat
  173.       BackColor       =   &H80000005&
  174.       BackStyle       =   0  'Transparent
  175.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  176.          Name            =   "MS Sans Serif"
  177.          Size            =   8.25
  178.          Charset         =   0
  179.          Weight          =   400
  180.          Underline       =   0   'False
  181.          Italic          =   0   'False
  182.          Strikethrough   =   0   'False
  183.       EndProperty
  184.       ForeColor       =   &H00000000&
  185.       Height          =   255
  186.       Left            =   2220
  187.       TabIndex        =   2
  188.       Top             =   2160
  189.       Width           =   4215
  190.    End
  191.    Begin VB.Label Label1 
  192.       Appearance      =   0  'Flat
  193.       BackColor       =   &H80000005&
  194.       BackStyle       =   0  'Transparent
  195.       Caption         =   "Creating report..."
  196.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  197.          Name            =   "MS Sans Serif"
  198.          Size            =   8.25
  199.          Charset         =   0
  200.          Weight          =   400
  201.          Underline       =   0   'False
  202.          Italic          =   0   'False
  203.          Strikethrough   =   0   'False
  204.       EndProperty
  205.       ForeColor       =   &H80000008&
  206.       Height          =   255
  207.       Left            =   2220
  208.       TabIndex        =   1
  209.       Top             =   240
  210.       Width           =   4215
  211.    End
  212. End
  213. Attribute VB_Name = "frmProgress"
  214. Attribute VB_Creatable = False
  215. Attribute VB_Exposed = False
  216. Option Explicit
  217.  
  218. Private Sub Cancel_Click()
  219.     End
  220. End Sub
  221.  
  222. Private Sub cmdCancel_Click()
  223.  
  224.     g_appVisio.ScreenUpdating = True
  225.     End
  226.  
  227. End Sub
  228.  
  229. Private Sub DrawCreate()
  230.     Dim stencil As Visio.Document             ' stencil document
  231.     Dim Page As Visio.Page
  232.     Dim shape As Visio.shape
  233.     Dim master As Visio.master
  234.     Dim masters As Visio.masters
  235.     Dim label As Visio.master
  236.     Dim text As Visio.master
  237.     Dim inst As Visio.shape                  ' instance
  238.  
  239.     Dim xLeft
  240.     Dim yTop
  241.     Dim xRight
  242.     Dim yBottom
  243.  
  244.     Dim row
  245.     Dim col
  246.     Dim pageNumber
  247.     Dim masterIndex
  248.     Dim stencilName
  249.     Dim pageName
  250.     Dim stat
  251.  
  252.     ' Get stencil
  253.     '
  254.     Set stencil = g_appVisio.Documents(gDoc.Filename)
  255.     If stencil.Title = "" Then
  256.         stencilName = stencil.Name
  257.     Else
  258.         stencilName = stencil.Title
  259.     End If
  260.         
  261.     stat = DrawYield(stencilName, STR_BACKGROUND, "")
  262.     ProgressGauge (5)
  263.  
  264.     ' Compute page count
  265.     '
  266.     Set masters = stencil.masters
  267.     gDoc.masters = masters.Count
  268.     gDoc.PageCount = gDoc.masters \ gGrid.masters
  269.     If (gDoc.masters Mod gGrid.masters) > 0 Then
  270.         gDoc.PageCount = gDoc.PageCount + 1
  271.     End If
  272.  
  273.     ' Draw header on background page
  274.     '
  275.     If gDoc.Header = True Then
  276.         xLeft = gPage.LeftMargin
  277.         xRight = gPage.pageWidth - gPage.RightMargin
  278.         yTop = gPage.pageHeight - gPage.TopMargin
  279.         yBottom = yTop - gPage.Header / 6
  280.         Set shape = gPageBack.DrawRectangle(xLeft, yTop, xRight, yBottom)
  281.         shape.FillStyle = "Black fill"
  282.  
  283.         yTop = yBottom
  284.         yBottom = gPage.pageHeight - gPage.TopMargin - gPage.Header
  285.         Set shape = gPageBack.DrawRectangle(xLeft, yTop, xRight, yBottom)
  286.         shape.style = "_Header"
  287.         shape.text = stencilName
  288.     End If
  289.  
  290.     stat = DrawYield("", "", "")
  291.     ProgressGauge (10)
  292.  
  293.     ' Draw left footer on background page.
  294.     ' The left footer includes the line at the bottom of the page.
  295.     '
  296.     If gDoc.Footer = True Then
  297.         xLeft = gPage.LeftMargin
  298.         xRight = gPage.pageWidth - gPage.RightMargin
  299.         yBottom = gPage.BottomMargin
  300.         yTop = yBottom + gPage.Footer
  301.         Set shape = gPageBack.DrawLine(xLeft, yTop, xRight, yTop)
  302.         shape.style = "_FootLeft"
  303.         shape.text = UCase(gDoc.Filename)
  304.     End If
  305.  
  306.     stat = DrawYield("", "", "")
  307.     ProgressGauge (15)
  308.  
  309.     ' Create property masters
  310.     '
  311.     If gDoc.properties = True Then
  312.         ' Create text master
  313.         '
  314.         xRight = gGrid.ColWidth - gPage.LabelWidth
  315.         Set shape = gPageBack.DrawRectangle(0, 0, xRight, 0)
  316.         shape.style = "_PropText"
  317.         shape.text = "Name:" & Chr(10) & Chr(10) & "Prompt:"
  318.         
  319.         ' Drop text master into local stencil
  320.         '
  321.         Set text = gDocDraw.Drop(shape, 0, 0)
  322.         
  323.         ' Create label master
  324.         '
  325.         shape.Cells("Width").Formula = gPage.LabelWidth
  326.         shape.style = "_PropLabel"
  327.  
  328.         ' Drop label master into local stencil
  329.         '
  330.         Set label = gDocDraw.Drop(shape, 0, 0)
  331.         shape.Delete
  332.     End If
  333.  
  334.     stat = DrawYield("", "", "")
  335.     ProgressGauge (20)
  336.  
  337.     ' Draw grid
  338.     '
  339.     If gDoc.gridlines = True Then
  340.         ' Draw vertical gridlines
  341.         '
  342.         For col = 0 To gGrid.cols - 2
  343.             xLeft = gGridArray(0, col).Right
  344.             xRight = xLeft
  345.             yTop = gGridArray(gGrid.rows - 1, col).Top
  346.             yBottom = gGridArray(0, col).Bottom
  347.             Set shape = gPageBack.DrawLine(xLeft, yTop, xRight, yBottom)
  348.             shape.style = "_Gridline"
  349.         Next
  350.  
  351.         ' Draw horizontal gridlines
  352.         '
  353.         For row = 0 To gGrid.rows - 2
  354.             xLeft = gGridArray(row, 0).left
  355.             xRight = gGridArray(row, gGrid.cols - 1).Right
  356.             yBottom = gGridArray(row, 0).Top
  357.             yTop = yBottom
  358.             Set shape = gPageBack.DrawLine(xLeft, yTop, xRight, yBottom)
  359.             shape.style = "_Gridline"
  360.         Next
  361.     End If
  362.  
  363.     stat = DrawYield("", "", "")
  364.     ProgressGauge (25)
  365.  
  366.     ' Instance each master in stencil
  367.     '
  368.     masterIndex = 1
  369.     For pageNumber = 1 To gDoc.PageCount
  370.         pageName = "Page " & pageNumber & " of " & gDoc.PageCount
  371.  
  372.         stat = DrawYield("", pageName, "")
  373.  
  374.         ' Create new page and set its background
  375.         '
  376.         Set Page = gDocDraw.Pages.Add
  377.         Page.Name = pageName
  378.         Page.Background = False
  379.         Page.BackPageFromName = gPageBack
  380.  
  381.         ' Draw right footer on page
  382.         '
  383.         If gDoc.Footer = True Then
  384.             xLeft = gPage.pageWidth / 2
  385.             xRight = gPage.pageWidth - gPage.RightMargin
  386.             yTop = gPage.BottomMargin + gPage.Footer
  387.             Set shape = Page.DrawLine(xLeft, yTop, xRight, yTop)
  388.             shape.style = "_FootRight"
  389.             shape.text = Page.Name
  390.         End If
  391.  
  392.         ' Drop each master on page
  393.         '
  394.         For row = gGrid.rows - 1 To 0 Step -1
  395.             For col = 0 To gGrid.cols - 1
  396.                 If masterIndex > masters.Count Then
  397.                     GoTo fexit
  398.                 End If
  399.  
  400.                 ' Drop master in the center of the grid
  401.                 '
  402.                 Set master = masters(masterIndex)
  403.                 stat = DrawYield("", "", master.Name)
  404.  
  405.                 If gDoc.properties = True Then
  406.                     ' Drop property label
  407.                     '
  408.                     xLeft = gGridArray(row, col).left + gPage.LabelWidth / 2
  409.                     yTop = gGridArray(row, col).Top
  410.                     Set shape = Page.Drop(label, xLeft, yTop)
  411.     
  412.                     ' Drop property text
  413.                     '
  414.                     xLeft = gGridArray(row, col).left + gPage.LabelWidth + (gGrid.ColWidth - gPage.LabelWidth) / 2
  415.                     yTop = gGridArray(row, col).Top
  416.                     Set shape = Page.Drop(text, xLeft, yTop)
  417.                     shape.text = master.Name & Chr(10) & Chr(10) & master.Prompt
  418.                 End If
  419.  
  420.                 'If master is empty, skip it
  421.                 If master.Shapes.Count > 0 Then
  422.                 
  423.                     xLeft = gGridArray(row, col).left + gGrid.ColWidth / 2
  424.                     yTop = gGridArray(row, col).Top - gGrid.RowHeight / 2
  425.  
  426.                     ' Set the alertresponse so that the custom properties
  427.                     ' dialog doesn't stop us
  428.                     g_appVisio.AlertResponse = 1
  429.                     Set inst = Page.Drop(master, xLeft, yTop)
  430.                     g_appVisio.AlertResponse = 0
  431.         
  432.     
  433.                     ' Fit in grid
  434.                     '
  435.                     If gDoc.resize = True Then
  436.                         ' Group the shape if not already a group
  437.                         '
  438.                         If inst.Type <> 2 Then
  439.                             inst.Group
  440.                             'Set inst = gWinDraw.Selection.Item(1)
  441.                             If g_appVisio.Version < 2.1 Then
  442.                                 Set inst = gWinDraw.Selection.Item(1)
  443.                             Else
  444.                                Set inst = inst.Parent
  445.                             End If
  446.                         End If
  447.     
  448.                         GridFit row, col, inst  ' Resize the shape to fit in grid
  449.                         GridPos row, col, inst  ' Reposition the shape
  450.                     End If
  451.                 End If
  452.  
  453.                 ProgressGauge (25 + masterIndex / masters.Count * 75)
  454.  
  455.                 masterIndex = masterIndex + 1
  456.             Next
  457.         Next
  458.     Next
  459.     
  460. fexit:
  461.     SetScreenUpdating (True)
  462.     g_appVisio.ActiveWindow.DeselectAll
  463.     g_appVisio.ActiveWindow.PageFromName = gDocDraw.Pages.Item(1) 'go to first page
  464.     End
  465.  
  466. End Sub
  467.  
  468. Private Function DrawYield(ByVal stencil As String, ByVal Page As String, ByVal master As String)
  469.     If stencil <> "" Then
  470.         label1.Caption = "Stencil:  " & stencil
  471.     End If
  472.     If Page <> "" Then
  473.         label2.Caption = "Page:  " & Page
  474.     End If
  475.     If master <> "" Then
  476.         label3.Caption = "Master:  " & master
  477.     End If
  478.  
  479.     DoEvents
  480. End Function
  481.  
  482. Private Sub Form_Load()
  483.     ' Initialize the form.
  484.     '
  485.     formInit frmProgress
  486.     
  487.     ' Center the picture
  488.     imgStndoc.Top = pnlStndoc.Height / 2 - imgStndoc.Height / 2
  489.     imgStndoc.left = pnlStndoc.Width / 2 - imgStndoc.Width / 2
  490.  
  491. End Sub
  492.  
  493. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  494.     End
  495. End Sub
  496.  
  497. Private Sub Form_Resize()
  498.     DoEvents
  499.     'Turn off screen updating
  500.     SetScreenUpdating (False)  'Turn off screen updating
  501.     
  502.     DrawCreate
  503.     
  504. End Sub
  505.  
  506. '   Resize shape to fit in grid
  507. '
  508. Private Sub GridFit(row, col, shape As Visio.shape)
  509.     Dim shapeWidth As Visio.Cell    ' cell object
  510.     Dim shapeHeight As Visio.Cell   ' cell object
  511.     Dim gridWidth
  512.     Dim gridHeight
  513.     Dim LabelHeight
  514.     Dim aspectRatio
  515.  
  516.     ' General computations
  517.     '
  518.     Set shapeWidth = shape.Cells("Width")
  519.     Set shapeHeight = shape.Cells("Height")
  520.  
  521.     LabelHeight = 0
  522.     If gDoc.properties = True Then
  523.         LabelHeight = gPage.LabelHeight
  524.     End If
  525.  
  526.     gridWidth = gGrid.ColWidth - 2 * gPage.GridMargin
  527.     gridHeight = gGrid.RowHeight - LabelHeight - 2 * gPage.GridMargin
  528.  
  529.     ' Is the shape too big for the grid
  530.     '
  531.     If shapeWidth <= gridWidth And shapeHeight <= gridHeight Then
  532.         Exit Sub      ' nothing to do
  533.     End If
  534.  
  535.     ' Resize shape to fit in grid
  536.     '
  537.     aspectRatio = 1
  538.     If shapeHeight <> 0 Then
  539.         aspectRatio = shapeWidth / shapeHeight
  540.     End If
  541.  
  542.     '   Adjust height
  543.     '
  544.     If shapeHeight > gridHeight Then
  545.         shapeHeight.FormulaForce = gridHeight
  546.         If shapeWidth > 0 Then
  547.             shapeWidth.FormulaForce = aspectRatio * gridHeight
  548.         End If
  549.     End If
  550.  
  551.     '   Adjust width
  552.     '
  553.     If shapeWidth > gridWidth Then
  554.         shapeWidth.FormulaForce = gridWidth
  555.         If shapeHeight > 0 Then
  556.             shapeHeight.FormulaForce = gridWidth / aspectRatio
  557.         End If
  558.     End If
  559.  
  560. End Sub
  561.  
  562. ' Position shape in grid
  563. '
  564. Private Sub GridPos(row, col, shape As Visio.shape)
  565.     Dim X
  566.     Dim Y
  567.  
  568.     X = gGridArray(row, col).left + gGrid.ColWidth / 2
  569.     Y = gGridArray(row, col).Bottom + gGrid.RowHeight / 2
  570.     If gDoc.properties = True Then
  571.         Y = Y - gPage.LabelHeight / 2
  572.     End If
  573.     shape.SetCenter X, Y
  574. End Sub
  575.  
  576. Private Sub ProgressGauge(ByVal percent As Integer)
  577.     Dim X As Single
  578.     Dim Y As Single
  579.     Dim t As String
  580.  
  581.     ' Set coordinates for the right end of the rectangle
  582.     ' that displays the progress bar.
  583.     '
  584.     'y = Picture1.ScaleHeight
  585.     'x = percent * Picture1.ScaleWidth / 100
  586.     
  587.     ' Draw the rectangle
  588.     '
  589.     'Picture1.Line (0, 0)-(x, y), QBColor(1), BF
  590.     'Picture1.Line (x, 0)-(Picture1.ScaleWidth, y), QBColor(7), BF
  591.  
  592.     ' Center and draw the text
  593.     '
  594.     't = percent & "%"
  595.     'Picture1.CurrentY = (Picture1.ScaleHeight - Picture1.TextHeight(t)) / 2
  596.     'Picture1.CurrentX = (Picture1.ScaleWidth - Picture1.TextWidth(t)) / 2
  597.     
  598.     Panel3D1.FloodPercent = percent
  599.     If percent > 45 Then
  600.         'Picture1.ForeColor = QBColor(1)
  601.         Panel3D1.ForeColor = &HFFFFFF
  602.     'Else
  603.         'Picture1.ForeColor = RGB(255, 255, 255)
  604.     End If
  605.     'Picture1.Print t
  606. End Sub
  607.  
  608. Private Sub SetScreenUpdating(bUpdate As Integer)
  609.  
  610.     If g_appVisio.Version < 2.1 Then
  611.         Exit Sub
  612.     Else
  613.        g_appVisio.ScreenUpdating = bUpdate
  614.     End If
  615.  
  616. End Sub
  617.  
  618.