VERSION 5.00
Begin VB.Form InitialForm 
   Appearance      =   0  'Flat
   BackColor       =   &H00808000&
   Caption         =   "Microsoft Visual Basic V 6.0 <=> Micro Focus NetExpress V 3.1"
   ClientHeight    =   6090
   ClientLeft      =   1110
   ClientTop       =   1500
   ClientWidth     =   9210
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H00000000&
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6090
   ScaleWidth      =   9210
   Begin VB.TextBox txtUsage 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Enabled         =   0   'False
      ForeColor       =   &H00400000&
      Height          =   495
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   23
      TabStop         =   0   'False
      Text            =   "INITIALF.frx":0000
      Top             =   5520
      Width           =   5175
   End
   Begin VB.CommandButton btnCallSubPassFp 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Subroutine Call COBOLDLL.GETFLPSB Pass ByRef Integer, ByRef Single"
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   1200
      Width           =   7455
   End
   Begin VB.CommandButton btnCallSubPassLng 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Subroutine Call COBOLDLL.GETLNGSB Pass ByRef Integer, ByRef Long"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   7455
   End
   Begin VB.CommandButton btnCallSubCOBOLDL5 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Subroutine Call COBOLDL5.COBOLDL5 Pass thru to COBOLDL6 and CBLDL6EP"
      Height          =   375
      Left            =   120
      TabIndex        =   10
      Top             =   5040
      Width           =   7455
   End
   Begin VB.CommandButton btnCallCBLDLL4 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Subroutine Call COBOLDL4.COBOLDL4 and Read Record From Indexed File"
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   4560
      Width           =   7455
   End
   Begin VB.CommandButton btnCallSubPassThru 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Subroutine Call COBOLDLL.CBLDLLPT Pass Thru to COBOLDL3.CBLDL3EP"
      Height          =   375
      Left            =   120
      TabIndex        =   8
      Top             =   4080
      Width           =   7455
   End
   Begin VB.CommandButton btnCallSubReadRec 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Subroutine Call COBOLDLL.CBLDLLEP and Read Record from Indexed File"
      Height          =   375
      Left            =   120
      TabIndex        =   7
      Top             =   3600
      Width           =   7455
   End
   Begin VB.CommandButton btnCallFuncPassFlS 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Function Call COBOLDLL.FXLNSTRF Pass ByVal Integer, ByVal String * 8"
      Height          =   375
      Left            =   120
      TabIndex        =   6
      Top             =   3120
      Width           =   7455
   End
   Begin VB.CommandButton btnCallFuncPassStr 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Function Call COBOLDLL.FDLSTRFN Pass ByVal Integer, ByVal String"
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Top             =   2640
      Width           =   7455
   End
   Begin VB.CommandButton btnCallFuncPassCur 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Function Call COBOLDLL.FDLCURFN Pass ByRef Currency"
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   2160
      Width           =   7455
   End
   Begin VB.CommandButton btnCallFuncPassInt 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Function Call COBOLDLL.FDLINTFN Pass ByRef Integer, ByRef User Defined Type"
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   1680
      Width           =   7455
   End
   Begin VB.CommandButton btnCallSubPassInt 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Subroutine Call COBOLDLL.GETINTSB Pass ByRef Integer, ByRef Integer"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   7455
   End
   Begin VB.CommandButton btnQuitApplication 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Quit"
      Height          =   375
      Left            =   8280
      TabIndex        =   12
      Top             =   5520
      Width           =   855
   End
   Begin VB.Label lblFile4 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   8040
      TabIndex        =   22
      Top             =   5040
      Width           =   1095
   End
   Begin VB.Label lblFile3 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   8040
      TabIndex        =   21
      Top             =   4560
      Width           =   1095
   End
   Begin VB.Label lblFile2 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   8040
      TabIndex        =   20
      Top             =   4080
      Width           =   1095
   End
   Begin VB.Label lblFile1 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   8040
      TabIndex        =   19
      Top             =   3600
      Width           =   1095
   End
   Begin VB.Label lblFp 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   8040
      TabIndex        =   18
      Top             =   1200
      Width           =   1095
   End
   Begin VB.Label lblLong 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   8040
      TabIndex        =   17
      Top             =   720
      Width           =   1095
   End
   Begin VB.Label lblFLString 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   8040
      TabIndex        =   16
      Top             =   3120
      Width           =   1095
   End
   Begin VB.Label lblVarString 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   8040
      TabIndex        =   15
      Top             =   2640
      Width           =   1095
   End
   Begin VB.Label lbldollarAmount 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   8040
      TabIndex        =   14
      Top             =   2160
      Width           =   1095
   End
   Begin VB.Label lblInteger2 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   8040
      TabIndex        =   13
      Top             =   1680
      Width           =   1095
   End
   Begin VB.Label lblInteger 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H00800000&
      Height          =   255
      Left            =   8040
      TabIndex        =   11
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "InitialForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'The Click Procedure for The btnCallCBLDLL4 Object in
'The InitialForm Form. COBOLDL4 passes no parameters and
'returns no parameters. It's purpose is to demonstrate that
'a different DLL can be called to access a file and how to
'compile and link the DLL. Refer to COBOLDL4.CBL, DOIT.BAT
'and COBOLDL4.RSP.
Private Sub btnCallCBLDLL4_Click()
  DisableAllControls   'Protect your DLL!
  Call COBOLDL4        'Call the DLL by name, it has no
                       'Entry Point other than the beginning
                       'of the Procedure Division. The DLL
                       'will locate the file, open, read
                       'and close the file.
  lblFile3.Caption = "Seen That!"
  enableAllControls    'Back to Business
End Sub

'The Click Procedure for The btnCallFuncPassCur Object in
'The InitialForm Form. Here we pass off a Currency amount.
'The FDLCURFN Function checks the Currency Amount to ensure
'it is within the limits for COBOL, sets the return status
'for the Function, and for a value within limits adds $1 to
'the Currency Amount.
Private Sub btnCallFuncPassCur_Click()
  DisableAllControls   'Protect your DLL!
  dollarAmount = 75.5  'Initialize dollar amount.
  If FDLCURFN(dollarAmount) Then
                       'Update Caption to value returned.
    lbldollarAmount.Caption = dollarAmount
  Else
                       'Update Caption to reflect Failure!
    lbldollarAmount.Caption = "Call Failed!"
  End If
  enableAllControls     'Back to Business
End Sub

'The Click Procedure for The btnCallFuncPassFlS Object in
'The InitialForm Form. FXLNSTRF returns a modified value in
'the fixedLengthString. The String Length is passed to
'permit COBOLDLL to verify that it is the proper length.
Private Sub btnCallFuncPassFlS_Click()
  DisableAllControls   'Protect your DLL!
  fixedLengthString = "RSTUVXYZ" 'Initialize String.
  integerData = Len(fixedLengthString) 'Get String Length.
  If FXLNSTRF(integerData, fixedLengthString) Then
                       'Update Caption to value returned.
    lblFLString.Caption = fixedLengthString
  Else
                       'Update Caption to reflect Failure!
    lblFLString.Caption = "Call Failed!"
  End If
  enableAllControls    'Back to Business
End Sub

'The Click Procedure for The btnCallFuncPassInt Object in
'The IntialForm Form. An integer is passed and a string is
'returned in integerString.mockString.
Private Sub btnCallFuncPassInt_Click()
  DisableAllControls   'Protect your DLL!
  integerData = 5      'Initialize integerData.
  If FDLINTFN(integerData, integerString) Then
                       'Update Caption to value returned.
    lblInteger2.Caption = integerString.mockString
  Else
                       'Update Caption to reflect Failure!
    lblInteger2.Caption = "Call Failed!"
  End If
  enableAllControls    'Back to Business
End Sub

'The Click Procedure for The btnCallFuncPassStr Object in
'The InitialForm Form. FDLSTRFN returns a modified value in
'the variableLengthString. The String length is passed to
'ensure the COBOL processing does not corrupt adjacent
'variables in Visual Basic's memory.
Private Sub btnCallFuncPassStr_Click()
  DisableAllControls   'Protect your DLL!
  variableLengthString = "VWXYZ" 'Initialize String.
  integerData = Len(variableLengthString) 'Get String Length.
  If FDLSTRFN(integerData, variableLengthString) Then
                       'Update Caption to value returned.
    lblVarString.Caption = variableLengthString
  Else
                       'Update Caption to reflect Failure!
    lblVarString.Caption = "Call Failed!"
  End If
  enableAllControls    'Back to Business
End Sub

'The Click Procedure for The btnCallCBLDLL5 Object in
'The InitialForm Form. COBOLDL5 passes no parameters and
'returns no parameters. It's purpose is to demonstrate that
'a different DLL can be called, which in turn calls another
'DLL that accesses a file and how to compile and link the
'DLLs. Refer to COBOLDL5.CBL, COBOLDL6.CBL, DOIT.BAT,
'COBOLDL5.RSP and COBOLDL6.RSP.
Private Sub btnCallSubCOBOLDL5_Click()
  DisableAllControls  'Protect Your DLL!
  Call COBOLDL5       'Call the DLL by name, it has no
                      'Entry Point other than the beginning
                      'of the Procedure Division. This DLL
                      'will call another DLL that will
                      'locate the file, open, read and
                      'close the file.
  lblFile4.Caption = "Boring!"
  enableAllControls   'Back to Business
End Sub

Private Sub btnCallSubPassFp_Click()
'The Click Procedure for The btnCallSubPassFp Object in
'The InitialForm Form. GETFLPSB returns a random value if
'the floating point value passed is numeric.
  DisableAllControls   'Protect your DLL!
  DLLSubStatus = False 'Set False to determine if call
                       'succeeds.
  fpData = 4.13        'Value must be numeric.
  Call GETFLPSB(DLLSubStatus, fpData)
  If DLLSubStatus Then 'Did the Call Succeed?
                       'Update Caption to value returned.
    lblFp.Caption = fpData
  Else                 'The Call Failed!
                       'Update Caption to reflect Failure!
    lblFp.Caption = "Call Failed!"
  End If
  enableAllControls    'Back to Business
End Sub

'The Click Procedure for The btnCallSubPassInt Object in
'The InitialForm Form. GETINTSB returns a random value if
'the integer value passed is numeric.
Private Sub btnCallSubPassInt_Click()
  DisableAllControls   'Protect your DLL!
  DLLSubStatus = False 'Set False to determine if call
                       'succeeds.
  integerData = 0      'Must be numeric.
  Call GETINTSB(DLLSubStatus, integerData)
  If DLLSubStatus Then 'Did the Call Succeed?
                       'Update Caption to value returned.
    lblInteger.Caption = integerData
  Else                 'The Call Failed!
                       'Update Caption to reflect Failure!
    lblInteger.Caption = "Call Failed!"
  End If
  enableAllControls    'Back to Business
End Sub

Private Sub btnCallSubPassLng_Click()
'The Click Procedure for The btnCallSubPassLng Object in
'The InitialForm Form. GETLNGSB returns a random value if
'the long value passed is numeric.
  DisableAllControls   'Protect your DLL!
  DLLSubStatus = False 'Set False to determine if the call
                       'succeeds.
  longData = 0
  Call GETLNGSB(DLLSubStatus, longData)
  If DLLSubStatus Then 'Did the Call Succeed?
                       'Update Caption to value returned.
    lblLong.Caption = longData
  Else                 'The Call Failed!
                       'Update Caption to reflect Failure!
    lblLong.Caption = "Call Failed!"
  End If
  enableAllControls    'Back to Business
End Sub

'The Click Procedure for The btnCallSubPassThru Object in
'The InitialForm Form. CBLDLLPT passes no parameters and
'returns no parameters. It's purpose is to demonstrate how
'to navigate thru a DLL into another DLL, access a file and
'compile and link the DLL. Refer to COBOLDL3.CBL, DOIT.BAT
'and COBOLDL3.RSP.
Private Sub btnCallSubPassThru_Click()
  DisableAllControls    'Protect your DLL!
  Call CBLDLLPT         'Call Entry Point in COBOLDLL.DLL
                        'that passes control to another DLL
                        '(COBOLDL3.DLL) which will locate
                        'the data file, open, read and
                        'close the file.
  lblFile2.Caption = "Done That!"
  enableAllControls     'Back to Business
End Sub

'The Click Procedure for The btnCallSubReadRec Object in
'The InitialForm Form. CBLDL3EP passes no parameters and
'returns no parameters. It's purpose is to demonstrate how
'to access a file and compile and link the DLL that will
'accomplish the file processing. Refer to COBOLDLL.CBL,
'DOIT.BAT and COBOLDLL.RSP. If you're reading this while in
'debug, you will need to copy IDXFILE.* into your Visual
'Basic subDirectory.
Private Sub btnCallSubReadRec_Click()
  DisableAllControls  'Protect your DLL!
  Call CBLDLLEP       'Call Entry Point in COBODLL.DLL that
                      'Locate the data file, open, read and
                      'close the file.
  lblFile1.Caption = "Been There!"
  enableAllControls   'Back to Business
End Sub

'The Click Procedure for The btnQuitApplication Object in
'The InitialForm Form. This is where The Application Ends.
Private Sub btnQuitApplication_Click()
  DisableAllControls
  End                   'End Application.
End Sub

Private Sub DisableAllControls()
  btnCallSubPassInt.Enabled = False  'Disable all controls
  btnCallSubPassLng.Enabled = False  'to ensure the call
  btnCallSubPassFp.Enabled = False   'to the DLL does not
  btnCallFuncPassInt.Enabled = False 'get clobbered by an
  btnCallFuncPassCur.Enabled = False 'accidental double
  btnCallFuncPassStr.Enabled = False 'click, or the click
  btnCallFuncPassFlS.Enabled = False 'of another button.
  btnCallSubReadRec.Enabled = False
  btnCallSubPassThru.Enabled = False
  btnCallCBLDLL4.Enabled = False
  btnCallSubCOBOLDL5.Enabled = False
  btnQuitApplication.Enabled = False
                                     'Some of the buttons
                                     'are disabled because
                                     'they access DLLs
                                     'that rely on the
                                     'EXTFH liked into
                                     'COBOLDLL.DLL. So any
                                     'enabled button will
                                     'load COBOLDLL.DLL.
End Sub

Private Sub enableAllControls()
  btnCallSubPassInt.Enabled = True  'Enable all controls,
  btnCallSubPassLng.Enabled = True  'COBOLDLL.DLL is
  btnCallSubPassFp.Enabled = True   'loaded.
  btnCallFuncPassInt.Enabled = True
  btnCallFuncPassCur.Enabled = True
  btnCallFuncPassStr.Enabled = True
  btnCallFuncPassFlS.Enabled = True
  btnCallSubReadRec.Enabled = True
  btnCallSubPassThru.Enabled = True
  btnCallCBLDLL4.Enabled = True
  btnCallSubCOBOLDL5.Enabled = True
  btnQuitApplication.Enabled = True
End Sub

'The Load Procedure of The Form Object for InitialForm,
'the "Start Up Form" for this Application, accomplishes
'essential initialization of key variables.
'The Properties of InitialForm have been adjusted as
'follows: Caption: Microsoft Visual Basic V 3.0 <=> Micro
'Focus COBOL V 3.2.50
'Name: InitialForm
Private Sub Form_Load()
  'These buttons must be disabled because the DLLs they
  'call rely upon the copy of EXTFH in COBOLDLL.DLL, and
  'if it hasn't been loaded they will fail with a RTE 173.
  btnCallCBLDLL4.Enabled = False
  btnCallSubCOBOLDL5.Enabled = False
End Sub

'The Click Procedure for The lbdollarAmount Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lbldollarAmount_Click()
  lbldollarAmount.Caption = "" 'Now I know!
End Sub

'The Click Procedure for The lblFile2 Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lblFile1_Click()
  lblFile1.Caption = ""
End Sub

'The Click Procedure for The lblFile2 Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lblFile2_Click()
  lblFile2.Caption = ""
End Sub

'The Click Procedure for The lblFile3 Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lblFile3_Click()
lblFile3.Caption = ""
End Sub

'The Click Procedure for The lblFile4 Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lblFile4_Click()
  lblFile4.Caption = ""
End Sub

'The Click Procedure for The lblFLString Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lblFLString_Click()
  lblFLString.Caption = "" 'Now I know!
End Sub

'The Click Procedure for The lblFp Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lblFp_Click()
  lblFp.Caption = ""  'Now I know!
End Sub

'The Click Procedure for The lblInteger Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lblInteger_Click()
  lblInteger.Caption = "" 'Now I know!
End Sub

'The Click Procedure for The lblInteger2 Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lblInteger2_Click()
  lblInteger2.Caption = "" 'Now I know!
End Sub

'The Click Procedure for The lblLong Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lblLong_Click()
  lblLong.Caption = ""  'Now I know!
End Sub

'The Click Procedure for The lblVarString Object in The
'InitialForm Form. This Procedure is a by-product of
'defining a Label. I got curiuos about what I could do
'with it so I added the statement to clear the Caption
'when the Label Object is clicked.
Private Sub lblVarString_Click()
  lblVarString.Caption = "" 'Now I know!
End Sub

