resume.frm

Visual Basic 6 大学教程的代码

VERSION 5.00
Begin VB.Form imgImage 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Fig. 13.9: Demonstrating the Call Stack"
   ClientHeight    =   3510
   ClientLeft      =   2370
   ClientTop       =   1485
   ClientWidth     =   5895
   LinkTopic       =   "Form1"
   ScaleHeight     =   3510
   ScaleWidth      =   5895
   Begin VB.OptionButton optSelect 
      Caption         =   "four"
      Height          =   255
      Index           =   4
      Left            =   120
      TabIndex        =   5
      Top             =   3000
      Width           =   1215
   End
   Begin VB.OptionButton optSelect 
      Caption         =   "three"
      Height          =   255
      Index           =   3
      Left            =   120
      TabIndex        =   4
      Top             =   2640
      Width           =   1215
   End
   Begin VB.OptionButton optSelect 
      Caption         =   "two"
      Height          =   255
      Index           =   2
      Left            =   120
      TabIndex        =   3
      Top             =   2280
      Width           =   1215
   End
   Begin VB.OptionButton optSelect 
      Caption         =   "one"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   2
      Top             =   1920
      Width           =   1215
   End
   Begin VB.OptionButton optSelect 
      Caption         =   "cmdGo_Click"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   1
      Top             =   1560
      Width           =   1335
   End
   Begin VB.CommandButton cmdBegin 
      Caption         =   "Go"
      Height          =   495
      Left            =   2280
      TabIndex        =   0
      Top             =   2760
      Width           =   1215
   End
   Begin VB.Label lblCurrErrHandler 
      Caption         =   "Current Enabled Error Handler:"
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   1320
      Width           =   2295
   End
   Begin VB.Label lblID 
      Caption         =   "four"
      Height          =   255
      Index           =   4
      Left            =   5040
      TabIndex        =   11
      Top             =   720
      Width           =   375
   End
   Begin VB.Label lblID 
      Caption         =   "three"
      Height          =   255
      Index           =   3
      Left            =   3840
      TabIndex        =   10
      Top             =   720
      Width           =   375
   End
   Begin VB.Label lblID 
      Caption         =   "two"
      Height          =   255
      Index           =   2
      Left            =   2640
      TabIndex        =   9
      Top             =   720
      Width           =   375
   End
   Begin VB.Label lblID 
      Caption         =   "one"
      Height          =   255
      Index           =   1
      Left            =   1440
      TabIndex        =   8
      Top             =   720
      Width           =   375
   End
   Begin VB.Label lblID 
      Caption         =   "cmdGo_Click"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   7
      Top             =   720
      Width           =   1215
   End
   Begin VB.Label lblLocation 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   2760
      TabIndex        =   6
      Top             =   1200
      Width           =   2655
   End
   Begin VB.Image imgImage 
      Height          =   615
      Index           =   4
      Left            =   4920
      Top             =   240
      Width           =   855
   End
   Begin VB.Image imgImage 
      Height          =   615
      Index           =   3
      Left            =   3720
      Top             =   240
      Width           =   855
   End
   Begin VB.Image imgImage 
      Height          =   615
      Index           =   2
      Left            =   2520
      Top             =   240
      Width           =   855
   End
   Begin VB.Image imgImage 
      Height          =   615
      Index           =   1
      Left            =   1320
      Top             =   240
      Width           =   855
   End
   Begin VB.Image imgImage 
      Height          =   495
      Index           =   0
      Left            =   120
      Top             =   240
      Width           =   855
   End
End
Attribute VB_Name = "imgImage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Fig. 13.9
' Resume and the call stack
Option Explicit             ' General declaration
Dim mFlags(4) As Boolean    ' General declaration

Private Sub Form_Load()
   Call initializeFlags
   optSelect(4).Value = True
End Sub

Private Sub initializeFlags()
   Dim x As Integer
   
   For x = LBound(mFlags) To UBound(mFlags)
      mFlags(x) = False
      imgImage(x).Picture = LoadPicture("d:\images\" & _
                                        "ch13\resume1.gif")
   Next x
   
End Sub

Private Sub setFlag(n As Integer)
   Call initializeFlags
   mFlags(n) = True
End Sub

Private Sub cmdBegin_Click()
   
   If mFlags(0) Then
      On Error GoTo handler
   Else
      On Error GoTo 0  ' Disable error handler
   End If
   
   Call one     ' Call procedure one
   Exit Sub     ' handler's Resume Next executes here
   
handler:
   lblLocation.Caption = "Error handled in cmdBegin_Click"
   imgImage(0).Picture = LoadPicture("d:\images\" & _
                                     "ch13\resume3.gif")
   Resume Next  ' Exit Sub statement
End Sub

Private Sub one()
   
   If mFlags(1) Then
      On Error GoTo handlerOne
   Else
      On Error GoTo 0  ' Disable error handler
   End If
   
   Call two    ' Call procedure two
   Exit Sub    ' handlerOne's Resume Next executes here
   
handlerOne:
   lblLocation.Caption = "Error handled in one"
   imgImage(1).Picture = LoadPicture("d:\images\" & _
                                     "ch13\resume3.gif")
   Resume Next    ' Exit Sub statement
End Sub

Private Sub two()
   
   If mFlags(2) Then
      On Error GoTo handlerTwo
   Else
      On Error GoTo 0  ' Disable error handler
   End If
   
   Call three   ' Call procedure three
   Exit Sub     ' handlerTwo's Resume Next executes here
   
handlerTwo:
   lblLocation.Caption = "Error handled in two"
   imgImage(2).Picture = LoadPicture("d:\images\" & _
                                     "ch13\resume3.gif")
   Resume Next  ' Exit Sub statement
End Sub

Private Sub three()
   Dim x As Integer
   
   If mFlags(3) Then
      On Error GoTo handlerThree
   Else
      On Error GoTo 0  ' Disable error handler
   End If
   
   x = four()  ' Call function four
   Exit Sub    ' handlerThree's Resume Next executes here
   
handlerThree:
   lblLocation.Caption = "Error handled in three"
   imgImage(3).Picture = LoadPicture("d:\images\" & _
                                     "ch13\resume3.gif")
   Resume Next  ' Exit Sub statement
End Sub

Private Function four() As Integer

   If mFlags(4) Then
      On Error GoTo handlerFour
   Else
      On Error GoTo 0  ' Disable error handler
   End If
   
   ' Draw image representing function raising error
   imgImage(4).Picture = LoadPicture("d:\images\" & _
                                     "ch13\resume2.gif")
   
   Err.Raise Number:=6       ' Cause Overflow Error
   Print "This is NEVER printed!!!"
handlerFour:
   lblLocation.Caption = "Error handled in four"
   imgImage(4).Picture = LoadPicture("d:\images\" & _
                                     "ch13\resume3.gif")
End Function

Private Sub cmdGo_LostFocus()
   lblLocation.Caption = ""     ' Clear Label
End Sub

Private Sub optSelect_Click(Index As Integer)
   Call setFlag(Index)
End Sub