home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmSelectStencil
- Appearance = 0 'Flat
- BackColor = &H00C0C0C0&
- BorderStyle = 3 'Fixed Dialog
- ClientHeight = 4455
- ClientLeft = 1035
- ClientTop = 2535
- 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 = &H80000008&
- Height = 4860
- Icon = "SELSTENC.frx":0000
- Left = 975
- LinkTopic = "Form3"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4455
- ScaleWidth = 6480
- Top = 2190
- Width = 6600
- 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 = 2
- Top = 3960
- Width = 1155
- End
- Begin VB.CommandButton cmdNext
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "Next >"
- Default = -1 'True
- 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 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 Threed.SSPanel pnlStndoc
- Height = 3390
- Left = 180
- TabIndex = 3
- Top = 180
- Width = 1950
- _Version = 65536
- _ExtentX = 3440
- _ExtentY = 5980
- _StockProps = 15
- ForeColor = 4210752
- 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 = "SELSTENC.frx":030A
- Top = 0
- Width = 1920
- End
- End
- Begin Threed.SSFrame Frame3D1
- Height = 1095
- Left = 2220
- TabIndex = 1
- Top = 1440
- Width = 4215
- _Version = 65536
- _ExtentX = 7435
- _ExtentY = 1931
- _StockProps = 14
- Caption = "&Select Stencil"
- 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
- Begin VB.ComboBox Combo1
- Appearance = 0 'Flat
- BackColor = &H00FFFFFF&
- 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 = 315
- Left = 120
- Sorted = -1 'True
- Style = 2 'Dropdown List
- TabIndex = 5
- Top = 480
- Width = 3975
- End
- End
- Begin VB.Line Line2
- BorderColor = &H00FFFFFF&
- X1 = 180
- X2 = 6300
- Y1 = 3795
- Y2 = 3795
- End
- Begin VB.Label Label1
- Appearance = 0 'Flat
- BackColor = &H00C0C0C0&
- Caption = "Which stencil do you want to report on? Select a stencil from the list of open stencils."
- 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 = 435
- Left = 2280
- TabIndex = 4
- Top = 240
- Width = 4095
- End
- Attribute VB_Name = "frmSelectStencil"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- Private Sub Cancel_Click()
- End
- End Sub
- Private Sub cmdCancel_Click()
- End
- End Sub
- Private Sub cmdNext_Click()
- If formValid() = True Then
- Hide
- frmSelectLook.Top = Top
- frmSelectLook.left = left
- frmSelectLook.Show
- End If
- End Sub
- Private Sub First_Click()
- Beep
- End Sub
- Private Sub Form_Load()
- Dim stat
- Dim doc As Visio.Document
- Dim docs As Visio.Documents
- Dim i
- Dim template
- ' Make sure Visio is running.
- '
- appConnect
- ' Initialize application.
- '
- appInit
- 'Set initial form position
- Top = (Screen.Height - frmSelectStencil.Height) / 2
- left = (Screen.Width - frmSelectStencil.Width) / 2
- ' Initialize form.
- '
- formInit frmSelectStencil
- ' Center the picture
- imgStndoc.Top = pnlStndoc.Height / 2 - imgStndoc.Height / 2
- imgStndoc.left = pnlStndoc.Width / 2 - imgStndoc.Width / 2
- ' Initialize controls.
- '
- ' first.Enabled = False
- ' previous.Enabled = False
- 'Check if Visio is running in-place
- Call CheckIfInPlace
- ' Fill combo box with the list of open stencils.
- ' It is an error if there are no open stencils.
- '
- Set docs = g_appVisio.Documents
- For i = 1 To docs.Count
- Set doc = docs(i)
- If UCase(Right(doc.Name, 3)) = "VSS" Then
- combo1.AddItem doc.FullName
- End If
- Next
- If combo1.ListCount > 0 Then
- combo1.ListIndex = 0
- Else
- stat = appMessage(ERR_FATAL, ERR_NOSTENCILS)
- End If
- ' Create new document.
- '
- On Error GoTo lblTemplateError
- template = App.Path & "\" & "StnDoc.VST"
- Debug.Print "Template = " & template
- Set gDocDraw = g_appVisio.Documents.Add(template)
- Set gWinDraw = g_appVisio.ActiveWindow
- Exit Sub
- lblTemplateError:
- If InStr(Error, VB_ERROR_STRING_OPENFILES) > 0 Then
- MsgBox ERR_OPENFILES, 48
- Else
- MsgBox ERR_NOTEMPLATE & template & Chr(10) & ERR_NOTEMPLATE2, 48
- End If
- End
- Exit Sub
- End Sub
- Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
- End
- End Sub
- ' Validate form settings.
- Private Function formValid()
- Dim stencil As Visio.Document
- Dim master As Visio.master
- Dim masters As Visio.masters
- Dim pageSheet As Visio.shape ' background page's page sheet
- Dim masterSheet As Visio.shape ' master's page sheet
- Dim masterDrawingScale
- Dim masterPageScale
- Dim pageDrawingScale
- Dim pagePageScale
- Dim drawingScale
- Dim pageScale
- Dim pageWidth
- Dim pageHeight
- Dim stat
- formValid = True ' default return value
- ' Get stencil name
- '
- gDoc.Filename = combo1.text
- ' Get drawing scale and page scale.
- '
- Set stencil = g_appVisio.Documents(gDoc.Filename)
- Set masters = stencil.masters
- If masters.Count = 0 Then
- stat = appMessage(ERR_FATAL, ERR_NOMASTERS)
- End If
- ' We assume that there is at least one master and that
- ' all masters in the stencil have the same scale.
- '
- Set master = masters(1) ' assume all masters have same scale
- Set masterSheet = master.Shapes("ThePage")
- ' Page setup for background page.
- '
- Set gPageBack = gDocDraw.Pages.Item(1)
- gPageBack.Name = STR_BACKGROUND
- gPageBack.Background = True
- ' Set page scale and size for background page.
- '
- Set pageSheet = gPageBack.Shapes("ThePage")
- masterDrawingScale = masterSheet.Cells("DrawingScale").Formula
- masterPageScale = masterSheet.Cells("PageScale").Formula
- pageDrawingScale = pageSheet.Cells("DrawingScale").Formula
- pagePageScale = pageSheet.Cells("PageScale").Formula
- If (masterDrawingScale <> pageDrawingScale Or masterPageScale <> pagePageScale) Then
- ' Drawing Scale = Custom
- pageSheet.Cells("DrawingScaleType").Formula = 3
- pageSheet.Cells("DrawingScale").Formula = masterDrawingScale
- pageSheet.Cells("PageScale").Formula = masterPageScale
- ' Drawing Size = Dimensions
- drawingScale = masterSheet.Cells("DrawingScale")
- pageScale = masterSheet.Cells("PageScale")
- pageHeight = pageSheet.Cells("PageHeight")
- pageWidth = pageSheet.Cells("PageWidth")
- pageSheet.Cells("PageHeight").Formula = pageHeight * drawingScale / pageScale
- pageSheet.Cells("PageWidth").Formula = pageWidth * drawingScale / pageScale
- End If
- End Function
- Private Sub Previous_Click()
- Beep
- End Sub
-