PC World Komputer 1997 February/PCWK0297.iso/envelop/envelop.6/Tools/Bootcamp/concepts/trycatch/trycatch.eto

Text File | 1996-07-08 | 14KB | 456 lines

Type ExceptionForm From SampleMasterForm
  Dim Label1 As New Label
  Dim BtnTest1 As New Button
  Dim Label2 As New Label
  Dim OptThrowPoint1 As New OptionButton
  Dim OptThrowPoint2 As New OptionButton
  Dim OptThrowPoint3 As New OptionButton
  Dim Label3 As New Label
  Dim Label4 As New Label
  Dim Label5 As New Label
  Dim BtnTest2 As New Button
  Dim LblNotFound As New Label
  Dim LblTooFewArguments As New Label
  Dim LblFileNotFound As New Label
  Dim LblTooManyArguments As New Label
  Dim Label6 As New Label
  Dim LblTestReThrow As New Label
  Dim LblCatchPoint1 As New Label
  Dim LblCatchPoint2 As New Label
  Dim LblCatchPoint3 As New Label
  Dim Label11 As New Label
  Dim BtnTest3 As New Button
  Dim Label8 As New Label
  Dim BtnTest4 As New Button
  Dim Label9 As New Label
  Dim Label10 As New Label
  Dim LblNumberTooSmall As New Label
  Dim LblNumberTooLarge As New Label
  Dim LblNumberOdd As New Label
  Dim LblNumberEven As New Label
  Dim ChkDebugTrap As New CheckBox

  ' METHODS for object: ExceptionForm
  Sub BtnTest1_Click()
    ' Reset the standard colors
    OptThrowPoint1.ForeColor = -1
    OptThrowPoint2.ForeColor = -1
    OptThrowPoint3.ForeColor = -1
    ' Execute the Example
    TestThrow
  End Sub

  Sub BtnTest2_Click()
    ' Reset the standard colors
    LblTooFewArguments.ForeColor = -1
    LblTooManyArguments.ForeColor = -1
    LblNotFound.ForeColor = -1
    LblFileNotFound.ForeColor = -1
    ' Test routine for generating system exceptions
    TestSystemException
  End Sub

  Sub BtnTest3_Click()
    ' Reset the standard colors
    LblTestReThrow.ForeColor = -1
    LblCatchPoint1.ForeColor = -1
    LblCatchPoint2.ForeColor = -1
    LblCatchPoint3.ForeColor = -1
    ' Execute the example
    TestReThrow
  End Sub

  Sub BtnTest4_Click()
    ' Reset the standard colors
    LblNumberTooSmall.ForeColor = -1
    LblNumberTooLarge.ForeColor = -1
    LblNumberOdd.ForeColor = -1
    LblNumberEven.ForeColor = -1
    ' Execute the TestUserException Sub
    TestUserException
  End Sub

  Sub CatchPoint1
    Try
      CatchPoint2
    Catch TooFewArguments
      LblCatchPoint1.ForeColor = 255
      InfoBox.Message("", "CatchPoint1: There were too few arguments.")
    End Try
  End Sub

  Sub CatchPoint2
    Try
      CatchPoint3
    Catch TooManyArguments
      LblCatchPoint2.ForeColor = 255
      InfoBox.Message("", "CatchPoint2: There were too many arguments.")
    End Try
  End Sub

  Sub CatchPoint3
    Try
      GenerateSystemException
    Catch NotFound(error_description as String)
      LblCatchPoint3.ForeColor = 255
      InfoBox.Message("", "CatchPoint3: The test function cannot find '" & error_description & "'")
    End Try
  End Sub

  Sub ChkDebugTrap_Click()
    Dim on As Integer

    on = (ChkDebugTrap.Value = "Checked")
    Debugger.TrapInterpretiveExceptions = on
    Debugger.TrapSystemExceptions = on

  End Sub

  Sub GenerateSystemException
    Dim random_number as Integer
    random_number = int(4 * rnd() + 1)
    Select Case random_number
      Case 1
        ' Too few arguments are sent to this function
        AngleArc(12.5)
      Case 2
        ' Too many arguments are sent to this function
        AngleArc(12.5, 11.6, 2.0, 0.0, 45.0, 60.0)
      Case 3
        ' This function invokes an identifier, radius, which
        ' cannot be found
        AngleArc(12.5, 11.6, radius, 0.0, 45.0)
      Case 4
        ' try and open a file that does not exist
        TextFile.FileName = "envelop.test"
        TextFile.Open(True)
    End Select

  End Sub

  Sub GenerateUserException
    Dim random_number as Integer
    random_number = int(4 * rnd() + 1)
    Select Case random_number
      Case 1
        ' This number is too small
        Throw NumberTooSmall(1)
      Case 2
        ' This number is even
        ' No arguements are being passed back
        Throw NumberEven
      Case 3
        ' This number is odd
        ' We throw the an execption titled "NumberOdd"
        ' with several arguments of different data types
        Throw NumberOdd(3.0, "$5.75")
      Case 4
        ' This number is too large
        Throw NumberTooLarge("4")
    End Select

  End Sub

  Sub ResetApplication_Click
    ' Reset Example 1.
    ' Reset the standard colors
    OptThrowPoint1.ForeColor = -1
    OptThrowPoint2.ForeColor = -1
    OptThrowPoint3.ForeColor = -1

    ' Clear the option buttons
    OptThrowPoint1.Value = False
    OptThrowPoint2.Value = False
    OptThrowPoint3.Value = False

    ' Reset Example 2.
    ' Reset the standard colors
    LblTooFewArguments.ForeColor = -1
    LblTooManyArguments.ForeColor = -1
    LblNotFound.ForeColor = -1
    LblFileNotFound.ForeColor = -1

    ' Reset Example 3.
    ' Clear the label colors
    LblTestReThrow.ForeColor = -1
    LblCatchPoint1.ForeColor = -1
    LblCatchPoint2.ForeColor = -1
    LblCatchPoint3.ForeColor = -1

    ' Reset Example 4.
    ' Reset the standard colors
    LblNumberTooSmall.ForeColor = -1
    LblNumberTooLarge.ForeColor = -1
    LblNumberOdd.ForeColor = -1
    LblNumberEven.ForeColor = -1

    ' Set exception trapping off by default
    ChkDebugTrap.Value = "Unchecked"
  End Sub

  Sub TestReThrow
    ' This illustrates how various routines can catch certain exceptions
    ' and handle them separately.  Exceptions not caught go up the stack
    ' for further evaluation and handling.

    Try
      CatchPoint1
    Catch
      ' Catch any exception that was not previously caught and rethrow
      ' the exception.  The only exception that can reach this
      ' point is the unhandled exception for a file not being found
      LblTestReThrow.ForeColor = 255
      Throw
    End Try

  End Sub

  Sub TestSystemException
    ' Try a function which will generate a system exception
    ' and in the catch block you would implement code to recover
    ' from the situation.
    Try
      GenerateSystemException
    Catch TooFewArguments
      LblTooFewArguments.ForeColor = 255
      InfoBox.Message("", "Too few arguments were submitted.")
    Catch TooManyArguments
      LblTooManyArguments.ForeColor = 255
      InfoBox.Message("", "Too many arguments were submitted.")
    Catch NotFound(error_description as String)
      LblNotFound.ForeColor = 255
      InfoBox.Message("", "The test function cannot find '" & error_description & "'")
    Catch FileError
      LblFileNotFound.ForeColor = 255
      InfoBox.Message("", "The file was not found.")
    End Try
  End Sub

  Sub TestThrow
    Try
      ThrowPoint1
    Catch TestThrowError(error_location As String)
      InfoBox.Message("", "I was thrown from '" & error_location & "'")
    End Try
  End Sub

  Sub TestUserException
    Try
      GenerateUserException
    Catch NumberTooSmall(i As Integer)
      LblNumberTooSmall.ForeColor = 255
      InfoBox.Message("", "The number '" & i & "' generated is too small.")
    Catch NumberTooLarge(s As String)
      LblNumberTooLarge.ForeColor = 255
      InfoBox.Message("", "The number '" & s & "' generated is too large.")
    Catch NumberOdd(f as Single, c as Currency)
      LblNumberOdd.ForeColor = 255
      InfoBox.Message("", "The number '" & f & "' generated is worth " & c)
    Catch NumberEven
      LblNumberEven.ForeColor = 255
      InfoBox.Message("", "I think the number generated was even.")
    End Try
  End Sub

  Sub ThrowPoint1
    If OptThrowPoint1.Value Then
      OptThrowPoint1.ForeColor = 255
      Throw TestThrowError("ThrowPoint1")
    Else
      OptThrowPoint1.ForeColor = 32768
      ThrowPoint2
    End If
  End Sub

  Sub ThrowPoint2
    If OptThrowPoint2.Value = True Then
      OptThrowPoint2.ForeColor = 255
      Throw TestThrowError("ThrowPoint2")
    Else
      OptThrowPoint2.ForeColor = 32768
      ThrowPoint3
    End If
  End Sub

  Sub ThrowPoint3
    If OptThrowPoint3.Value = True Then
      OptThrowPoint3.ForeColor = 255
      Throw TestThrowError("ThrowPoint3")
    Else
      OptThrowPoint3.ForeColor = 32768
    End If
  End Sub

End Type

Begin Code
' Reconstruction commands for object: ExceptionForm
'
  With ExceptionForm
    .Caption := "Exception Handling Examples"
    .Move(3855, 1770, 9405, 6900)
    .SampleDir := "C:\ENVELOP\bootcamp\concepts\trycatch\"
    .SampleName := "trycatch"
    With .Label1
      .Caption := "1. Nested Throw Example"
      .ForeColor := 16711680
      .ZOrder := 2
      .Move(150, 750, 2850, 300)
    End With  'ExceptionForm.Label1
    With .BtnTest1
      .Caption := "Test 1"
      .ZOrder := 3
      .Move(3750, 750, 900, 300)
    End With  'ExceptionForm.BtnTest1
    With .Label2
      .Caption := "Sub TestThrow"
      .ZOrder := 4
      .Move(450, 1200, 1800, 300)
    End With  'ExceptionForm.Label2
    With .OptThrowPoint1
      .Caption := "Sub ThrowPoint1"
      .ZOrder := 5
      .Move(750, 1650, 2100, 300)
    End With  'ExceptionForm.OptThrowPoint1
    With .OptThrowPoint2
      .Caption := "Sub ThrowPoint2"
      .ZOrder := 6
      .Move(1050, 2100, 2100, 300)
    End With  'ExceptionForm.OptThrowPoint2
    With .OptThrowPoint3
      .Caption := "Sub ThrowPoint3"
      .ZOrder := 7
      .Move(1350, 2550, 1950, 300)
    End With  'ExceptionForm.OptThrowPoint3
    With .Label3
      .Caption := "2. Multiple Catch Example"
      .ForeColor := 16711680
      .ZOrder := 8
      .Move(5100, 750, 3000, 300)
    End With  'ExceptionForm.Label3
    With .Label4
      .Caption := "Sub GenerateSystemException"
      .ZOrder := 9
      .Move(5700, 1650, 3150, 300)
    End With  'ExceptionForm.Label4
    With .Label5
      .Caption := "Sub TestSystemException"
      .ZOrder := 10
      .Move(5400, 1200, 2700, 300)
    End With  'ExceptionForm.Label5
    With .BtnTest2
      .Caption := "Test 2"
      .ZOrder := 11
      .Move(8250, 750, 900, 300)
    End With  'ExceptionForm.BtnTest2
    With .LblNotFound
      .Caption := "NotFound"
      .ZOrder := 12
      .Move(6450, 2625, 1050, 300)
    End With  'ExceptionForm.LblNotFound
    With .LblTooFewArguments
      .Caption := "TooFewArguments"
      .ForeColor := 255
      .ZOrder := 13
      .Move(6450, 2025, 1950, 300)
    End With  'ExceptionForm.LblTooFewArguments
    With .LblFileNotFound
      .Caption := "FileNotFound"
      .ZOrder := 14
      .Move(6450, 2925, 1350, 300)
    End With  'ExceptionForm.LblFileNotFound
    With .LblTooManyArguments
      .Caption := "TooManyArguments"
      .ZOrder := 15
      .Move(6450, 2325, 1950, 300)
    End With  'ExceptionForm.LblTooManyArguments
    With .Label6
      .Caption := "3. Nested Catch/ReThrow Example"
      .ForeColor := 16711680
      .ZOrder := 16
      .Move(150, 3450, 3450, 300)
    End With  'ExceptionForm.Label6
    With .LblTestReThrow
      .Caption := "Sub TestReThrow"
      .ZOrder := 17
      .Move(450, 3900, 1950, 300)
    End With  'ExceptionForm.LblTestReThrow
    With .LblCatchPoint1
      .Caption := "Sub CatchPoint1"
      .ZOrder := 18
      .Move(900, 4350, 1650, 300)
    End With  'ExceptionForm.LblCatchPoint1
    With .LblCatchPoint2
      .Caption := "Sub CatchPoint2"
      .ZOrder := 19
      .Move(1425, 4800, 1650, 300)
    End With  'ExceptionForm.LblCatchPoint2
    With .LblCatchPoint3
      .Caption := "Sub CatchPoint3"
      .ForeColor := 255
      .ZOrder := 20
      .Move(1800, 5250, 1650, 300)
    End With  'ExceptionForm.LblCatchPoint3
    With .Label11
      .Caption := "Sub GenerateSystemException"
      .ZOrder := 21
      .Move(2250, 5700, 3075, 300)
    End With  'ExceptionForm.Label11
    With .BtnTest3
      .Caption := "Test 3"
      .ZOrder := 22
      .Move(3750, 3450, 900, 300)
    End With  'ExceptionForm.BtnTest3
    With .Label8
      .Caption := "4. User Exception Example"
      .ForeColor := 16711680
      .ZOrder := 23
      .Move(5100, 3450, 2700, 300)
    End With  'ExceptionForm.Label8
    With .BtnTest4
      .Caption := "Test 4"
      .ZOrder := 24
      .Move(8250, 3450, 900, 300)
    End With  'ExceptionForm.BtnTest4
    With .Label9
      .Caption := "Sub TestUserException"
      .ZOrder := 25
      .Move(5550, 3900, 2400, 300)
    End With  'ExceptionForm.Label9
    With .Label10
      .Caption := "Sub GenerateUserException"
      .ZOrder := 26
      .Move(5700, 4350, 2850, 300)
    End With  'ExceptionForm.Label10
    With .LblNumberTooSmall
      .Caption := "NumberTooSmall"
      .ZOrder := 27
      .Move(6450, 4800, 2100, 300)
    End With  'ExceptionForm.LblNumberTooSmall
    With .LblNumberTooLarge
      .Caption := "NumberTooLarge"
      .ZOrder := 28
      .Move(6450, 5100, 2100, 300)
    End With  'ExceptionForm.LblNumberTooLarge
    With .LblNumberOdd
      .Caption := "NumberOdd"
      .ZOrder := 29
      .Move(6450, 5400, 2100, 300)
    End With  'ExceptionForm.LblNumberOdd
    With .LblNumberEven
      .Caption := "NumberEven"
      .ZOrder := 30
      .Move(6450, 5700, 2100, 300)
    End With  'ExceptionForm.LblNumberEven
    With .ChkDebugTrap
      .Caption := " Toggle this 'on' to see the Debugger stop when an exception is thrown."
      .ForeColor := 16711680
      .ZOrder := 1
      .Move(150, 150, 9000, 300)
    End With  'ExceptionForm.ChkDebugTrap
    With .helpfile
      .FileName := "C:\ENVELOP\bootcamp\concepts\trycatch\trycatch.hlp"
    End With  'ExceptionForm.helpfile
  End With  'ExceptionForm
End Code