Main Form - Forms Designer Code

Image via Wikipedia

For this code set, I once again checked with my IT colleague. It is readily available in .NET platform, this so-called Windows Forms Designer Code - but for VB6, you have to go to the file directory, right click on the file (.frm, in this case), then Open With 'Notepad'. Below is the code.

Now why am I so interested in getting this code set?

Many years ago, when I switched to VB .NET 2003, I happen to get a form corrupted, but I was already having a hunch on what use this 'forms designed code' is for, so I saved a copy of it. A corrupted form, having so many controls built into it, now that's some headache that won't go away in a day!

Since I can't view the form in the 'View form' mode, I viewed the code, removed everything, then did a copy-and-paste of the 'forms designer' code. If you are following this, you can guess what happened.

The form was reconstructed magically!

So that is what is keeping me interested in this 'forms designer code'. This is one of those lifelines as a software developer.


----------
VERSION 5.00
Begin VB.Form frmMain
Caption = "Call Procedure PINS List Generator"
ClientHeight = 10140
ClientLeft = 60
ClientTop = 450
ClientWidth = 13095
LinkTopic = "Form1"
ScaleHeight = 10140
ScaleWidth = 13095
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text12
Height = 285
Left = 600
TabIndex = 31
Text = "WG7OFERVAB_1ST-AT-W-00"
Top = 2160
Width = 2655
End
Begin VB.TextBox Text11
Height = 285
Left = 600
TabIndex = 30
Text = "CS42L58-CWZR/A1-WW-W-00"
Top = 1800
Width = 2655
End
Begin VB.TextBox Text10
Height = 285
Left = 3360
TabIndex = 29
Text = "JC7CDPKV_D_ST_MBI-AT-W-00"
Top = 2160
Width = 2655
End
Begin VB.TextBox Text9
Height = 285
Left = 3360
TabIndex = 28
Text = "ADL5502ACB7-J019Z-WW-W-00"
Top = 1800
Width = 2655
End
Begin VB.TextBox Text8
Height = 285
Left = 1560
TabIndex = 27
Text = "FRE003RSPR-NI-AT-W-00"
Top = 1440
Width = 3135
End
Begin VB.TextBox Text7
Height = 285
Left = 1560
TabIndex = 26
Text = "EL8176FIZ-T7-WW-W-00"
Top = 1080
Width = 3135
End
Begin VB.TextBox Text6
Height = 285
Left = 3360
TabIndex = 25
Text = "WP-CU-IPD-SP-09-EI_1X"
Top = 3000
Width = 2175
End
Begin VB.TextBox Text5
Height = 285
Left = 3360
TabIndex = 24
Text = "WP-CU-IPD-BB-09-EI_1X"
Top = 2640
Width = 2175
End
Begin VB.TextBox Text4
Height = 285
Left = 1080
TabIndex = 23
Text = "WP-CU-IPD-FC-08-EI_1X"
Top = 3000
Width = 2175
End
Begin VB.TextBox txtStatus0a
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 480
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 22
Top = 6720
Width = 4815
End
Begin VB.TextBox txtStatus0
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 480
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 19
Top = 7320
Width = 4815
End
Begin VB.TextBox txtStatus4
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1335
Left = 6690
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 4320
Width = 5775
End
Begin VB.TextBox txtStatus3
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Left = 7050
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 8
Top = 1680
Width = 5415
End
Begin VB.TextBox txtStatus2
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 450
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 9120
Width = 4815
End
Begin VB.TextBox Text3
Height = 285
Left = 1560
TabIndex = 6
Text = "BF561KBCT-H33G600Z_M1-AT-B-00"
Top = 720
Width = 3135
End
Begin VB.TextBox txtStatus1
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3375
Left = 5730
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 5
Top = 6240
Width = 6735
End
Begin VB.TextBox Text2
Height = 285
Left = 1080
TabIndex = 4
Text = "EW-E1RDL-BB-03_2Y-I"
Top = 2640
Width = 2175
End
Begin VB.TextBox Text1
Height = 285
Left = 1560
TabIndex = 3
Text = "M0724-K2_DUMMYDEV_UBM-EW-0-EQ"
Top = 360
Width = 3135
End
Begin VB.TextBox tbxCallProcName
Height = 375
Left = 1710
TabIndex = 2
Text = "WP-CU-IPD-SP-09-EI_1X"
Top = 3990
Width = 3375
End
Begin VB.CommandButton btnGetFlowListing
Caption = "Get Flow Listing"
Height = 375
Left = 2400
TabIndex = 1
Top = 4455
Width = 1815
End
Begin VB.Label Label6
Caption = "Get Active Prcd ID"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 510
TabIndex = 21
Top = 5280
Width = 1575
End
Begin VB.Label lblTPQuery0
BorderStyle = 1 'Fixed Single
Caption = "TP Query"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 480
TabIndex = 20
Top = 5640
Width = 4815
End
Begin VB.Label lblPrcdID
Caption = "PrcdID: "
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2520
TabIndex = 18
Top = 5280
Width = 3375
End
Begin VB.Label lblPinsCount
Caption = "Pins Count:"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 11040
TabIndex = 17
Top = 5880
Width = 1455
End
Begin VB.Label lblTPQuery4
BorderStyle = 1 'Fixed Single
Caption = "TP Query"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 6690
TabIndex = 16
Top = 3480
Width = 5775
End
Begin VB.Label lblTPQuery3
BorderStyle = 1 'Fixed Single
Caption = "TP Query"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 7050
TabIndex = 15
Top = 720
Width = 5415
End
Begin VB.Label lblTPQuery2
BorderStyle = 1 'Fixed Single
Caption = "TP Query"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 450
TabIndex = 14
Top = 8400
Width = 4815
End
Begin VB.Label Label4
Caption = "Get Prod Status"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 13
Top = 8040
Width = 1935
End
Begin VB.Label Label3
Caption = "Get PINS 5xx Series"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 7080
TabIndex = 12
Top = 360
Width = 2895
End
Begin VB.Label Label2
Caption = "Get Full PINS Data Set"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 6720
TabIndex = 11
Top = 3120
Width = 2895
End
Begin VB.Label Label1
Caption = "Processed Result"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 5760
TabIndex = 10
Top = 5880
Width = 1695
End
Begin VB.Label lblCallProcHeader
Caption = "Enter Call Proc to capture flow listing:"
Height = 255
Left = 1710
TabIndex = 0
Top = 3630
Width = 2895
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim PROMIS_LOGIN As String
Dim QueryStatus As String
Dim sCommand As String
Dim sQueue As String
Dim thisActivePrcdID As String
Const username As String = "STATSAPP"
Const password As String = "STATSAPP"
Const PROMIS_HEADER As String = "1C"
Const PROMIS_HEADER_SIZE As Integer = 8
Const PROMIS_COMMAND_SIZE As Integer = 40
Dim PipeIndex As Integer
Dim IntStr As String
Dim IntStr2 As String
Dim myCurrPinsDataSet(300, 7) As String


Private Sub btnGetFlowListing_Click()
txtStatus0.Text = ""
txtStatus0a.Text = ""
lblTPQuery0 = ""
txtStatus1.Text = ""
lblTPQuery2 = ""
txtStatus2.Text = ""
lblTPQuery3 = ""
txtStatus3.Text = ""
lblTPQuery4 = ""
txtStatus4.Text = ""
Me.lblPinsCount = "Pins Count: "
GetPinsData (Me.tbxCallProcName.Text)
End Sub

Private Sub Form_Load()
Dim status As Long
' Always call pams_exit on startup. This avoids
' leaving open connections if the app is stopped
' from VB run-mode without detaching.
'
status = pams_exit()

#If MessageQ_Server Then
txtStatus1.Text = "MessageQ Server environment"
#Else
txtStatus1.Text = "MessageQ Client environment"
#End If
End Sub


Function GetPinsData(ByVal myProcName As String) As Integer
Dim status As Long
Dim ReturnedData As Integer
'
GetPins500Series = 0
ReturnedData = 0
' attach Q
status = DmqAttachQ()
If (status <> 1) Then
' error attaching Q
txtStatus1.Text = "Error attaching Q"
Else
' means status is OK
' put msg
' query: "GetActivePrVersion"
QueryStatus = ""
Sleep (100)
Call PutMsg4(myProcName, "GetActivePrVersion", lblTPQuery0)
' get Msg
Sleep (100)
QueryStatus = GetMsg4(txtStatus0a)
' assign a default value for the Prcd Name
thisActivePrcdID = myProcName
' process the data
If (InStr(QueryStatus, "SUCCESS") > 0) Then
ReturnedData = Me.CleanSingleColumnTPResult(QueryStatus, txtStatus0)
If (ReturnedData > 0) Then
lblPrcdID = "PrcdID: " & txtStatus0.Text
thisActivePrcdID = txtStatus0.Text
Else
thisActivePrcdID = myProcName
End If
End If
' put Msg
' query: "CheckProdStatus"
QueryStatus = ""
Sleep (100)
Call PutMsg4(thisActivePrcdID, "CheckProdStatus", lblTPQuery2)
' get Msg
Sleep (100)
QueryStatus = GetMsg4(txtStatus2)
' put Msg
' query: "GetPins500Series"
QueryStatus = ""
Sleep (200) ' safe number, especially when the # of rows is increasing
Call PutMsg4(thisActivePrcdID, "GetPins500Series", lblTPQuery3)
' get Msg
Sleep (300) ' safe number, especially when the # of rows is increasing
QueryStatus = GetMsg4(txtStatus3)
' put Msg
' query: "GetFullPINSSet"
QueryStatus = ""
Sleep (400) ' safe number, especially when the # of rows is increasing
Call PutMsg4(thisActivePrcdID, "GetFullPINSSet", lblTPQuery4)
' get Msg
Sleep (500) ' safe number, especially when the # of rows is increasing
QueryStatus = GetMsg4(txtStatus4)
' process the data
If (InStr(QueryStatus, "SUCCESS") > 0) Then
GetPinsData = CleanCurrPinsDataSet(QueryStatus, txtStatus1)
If (GetPinsData > 0) Then
' show the full data set
'MsgBox ("Number of PINS is " & GetPinsData)
Me.lblPinsCount = "Pins Count: " & GetPinsData
End If
End If
End If
' detach Q, whether failed or succeeded
DmqExit
' clean up the msg, and return how many are captured
End Function

Sub PutMsg4(ByVal DataBuffer As String, ByVal ComType As String, ByVal thisLabel As Label)
Dim status As Long
Dim MsgArea As String * 4096

PutMsg.SrcTarget.Group = 1
PutMsg.SrcTarget.Queue = 4
PutMsg.Class = 0
PutMsg.Type = 0
PutMsg.timeout = 60000
PutMsg.MsgAreaSize = Len(MsgArea)

MsgArea = Compose1(DataBuffer, ComType)
thisLabel = MsgArea

status = DmqPutMsg(PutMsg, MsgArea)
End Sub

Function GetMsg4(ByVal thisControl As TextBox) As String
Dim status As Long
Dim MsgArea As String * 8192
thisControl.Text = ""
GetMsg.timeout = 900
GetMsg.MsgAreaSize = Len(MsgArea)
status = DmqGetMsg(GetMsg, MsgArea)
If (status = PAMS__NOMOREMSG) Then
thisControl.Text = thisControl.Name + ": " + DmqStatusText(status)
ElseIf (status = PAMS__SUCCESS) Then
thisControl.Text = thisControl.Name + ": " + MsgArea
Else
thisControl.Text = thisControl.Name + ": " + "GetMsg status: " + DmqStatusText(status)
End If
GetMsg4 = MsgArea
End Function

Function Compose1(ByVal DataBuffer As String, ByVal ComType As String) As String
PROMIS_LOGIN = "USERID " + username + "|PWD " + password + "|"
Compose1 = ""
Select Case ComType
Case "GetActivePrVersion"
VarProds = "LOWID " & DataBuffer & "|HIGHID " & DataBuffer & "|"
sCommand = "PROPRCD_LIST"
sQueue = VarProds + "FROM PRCDSET|" & _
"WHERE PRODSTATUS EQ 'A' AND ACTIVEFLAG EQ 'A'|" & _
"SHOW EXTERN(PRCDID)|"
Case "GetPins500Series"
VarProds = "PRCDID " + DataBuffer + "|"
sCommand = "PROPRCD_GETPRCD_INSTRUCTIONS"
sQueue = VarProds + "NUMBERINSTRUCTIONS 100|FROM PINSSET|" & _
"WHERE (PINSINSTNUM GE '500.000' AND PINSINSTNUM LT '595.000')|" & _
"SHOW PINSINSTNUM|SHOW INSTTYPE|SHOW STAGE|SHOW EXECUTERECPID|" & _
"SHOW LOCATIONID|SHOW CALLPRCDID|"
Case "GetFullPINSSet"
VarProds = "PRCDID " + DataBuffer + "|"
sCommand = "PROPRCD_GETPRCD_INSTRUCTIONS"
sQueue = VarProds + "NUMBERINSTRUCTIONS 300|FROM PINSSET|" & _
"SHOW PINSINSTNUM|SHOW INSTTYPE|SHOW EXECUTERECPID|SHOW STAGE|" & _
"SHOW LOCATIONID|SHOW CALLPRCDID|"
Case "CheckProdStatus"
VarProds = "PRCDID " + DataBuffer + "|"
sCommand = "PROPRCD_GETPRCD_HEADER"
sQueue = VarProds + "SHOW PRCD.PRODSTATUS|"
End Select
Compose1 = Me.FormQuery(sCommand, sQueue)
End Function

Public Function FormQuery(ByVal sCommand As String, ByVal sQueue As String) As String
FormQuery = PROMIS_HEADER & Space(PROMIS_HEADER_SIZE - Len(PROMIS_HEADER)) & _
Trim(sCommand) & Space(PROMIS_COMMAND_SIZE - Len(Trim(sCommand))) & _
"|" & PROMIS_LOGIN & sQueue & "END|"
End Function

Public Function CleanSingleColumnTPResult(ByVal thisReplyMsg As String, ByVal thisTextBox As TextBox) As Integer
Dim thisBuffer As String
Dim thisCntr As Integer
thisBuffer = ""
thisCntr = 0
CleanSingleColumnTPResult = 0
thisTextBox.Text = ""
'
PipeIndex = InStr(1, thisReplyMsg, "|")
IntStr = Right(thisReplyMsg, (Len(thisReplyMsg)) - PipeIndex)
PipeIndex = InStr(1, IntStr, "|")
thisCntr = Left(IntStr, (PipeIndex - 1))
'
If (thisCntr <> "0") Then
For i = 0 To (thisCntr - 1)
IntStr2 = Right(IntStr, (Len(IntStr)) - PipeIndex)
PipeIndex = InStr(1, IntStr2, "|")
thisBuffer = Left(IntStr2, PipeIndex - 1)
IntStr = IntStr2
myCurrPinsDataSet(i, 0) = thisBuffer
thisTextBox.Text = thisBuffer
Next
CleanSingleColumnTPResult = thisCntr
Else
CleanSingleColumnTPResult = 0
End If
End Function

Public Function CleanCurrPinsDataSet(ByVal thisReplyMsg As String, ByVal thisTextBox As TextBox) As Integer
Dim thisBuffer As String
Dim thisCntr As Integer
thisBuffer = ""
thisCntr = 0
CleanCurrPinsDataSet = 0
thisTextBox.Text = ""
'
PipeIndex = InStr(1, thisReplyMsg, "|")
IntStr = Right(thisReplyMsg, (Len(thisReplyMsg)) - PipeIndex)
PipeIndex = InStr(1, IntStr, "|")
thisCntr = Left(IntStr, (PipeIndex - 1))
'
If (thisCntr <> "0") Then
For i = 0 To (thisCntr - 1)
For j = 0 To 5
IntStr2 = Right(IntStr, (Len(IntStr)) - PipeIndex)
PipeIndex = InStr(1, IntStr2, "|")
thisBuffer = Left(IntStr2, PipeIndex - 1)
IntStr = IntStr2
If (j = 0) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 1) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 2) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 3) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 4) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 5) Then
myCurrPinsDataSet(i, j) = thisBuffer
End If
Next
Next
CleanCurrPinsDataSet = thisCntr
' do the textbox population here, so main code is clean
' current data set:
' 0 - Inst Num (7 chars, into 8)
' 1 - Inst Type (2 chars, into 3)
' 2 - Exec Recipe (5 chars, into 6)
' 3 - Stage (max 10 chars, into 11)
' 4 - LocationID (max 10 chars, into 11)
' 5 - Call Prcd (max 32 chars, into 33)
Dim tmpPinsBfr As String
' assign the header in the Textbox
thisTextBox.Text = "InstNum -Ityp -Recipe - StageID - LocationID - Call Procedure Name " & vbCrLf & _
"======= -==== -====== - ======= - ========== - =================== " & vbCrLf
For i = 0 To (thisCntr - 1)
For j = 0 To 5
If (j = 0) Then
thisTextBox.Text = thisTextBox.Text & myCurrPinsDataSet(i, j)
ElseIf (j = 1) Then
thisTextBox.Text = thisTextBox.Text & " - " & myCurrPinsDataSet(i, j)
ElseIf (j = 2) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(6 - Len(tmpPinsBfr))
ElseIf (j = 3) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(11 - Len(tmpPinsBfr))
ElseIf (j = 4) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(11 - Len(tmpPinsBfr))
ElseIf (j = 5) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(33 - Len(tmpPinsBfr)) & vbCrLf
End If
Next
Next
Else
CleanCurrPinsDataSet = 0
End If
End Function
----------