home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
pc3270sa.zip
/
vbdde
/
fgpartps.frm
< prev
next >
Wrap
Text File
|
2002-02-28
|
24KB
|
711 lines
VERSION 4.00
Begin VB.Form FormGetPartialPS
BorderStyle = 3 'Fixed Dialog
Caption = "Get Partial Presentation Space"
ClientHeight = 6420
ClientLeft = 1500
ClientTop = 825
ClientWidth = 8055
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 = 6825
Left = 1440
LinkMode = 1 'Source
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6420
ScaleWidth = 8055
ShowInTaskbar = 0 'False
Top = 480
Width = 8175
Begin VB.TextBox PartialPSDataText
BackColor = &H00C0FFFF&
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "System"
Size = 13.5
Charset = 128
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 405
Left = 3840
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 2
TabStop = 0 'False
Top = 5760
Visible = 0 'False
Width = 396
End
Begin VB.CommandButton ExitDlg
Cancel = -1 'True
Caption = "E&xit"
Height = 372
Left = 5040
TabIndex = 1
Top = 5760
Width = 972
End
Begin VB.CommandButton Execute
Caption = "&Execute"
Default = -1 'True
Height = 375
Left = 2040
TabIndex = 0
Top = 5760
Width = 975
End
Begin TabDlg.SSTab SSTab1
Height = 5535
Left = 120
TabIndex = 3
Top = 120
Width = 7815
_ExtentX = 13785
_ExtentY = 9763
_Version = 393216
Tab = 2
TabHeight = 423
TabCaption(0) = "Input Parameters"
Tab(0).ControlEnabled= 0 'False
Tab(0).Control(0)= "Frame1"
Tab(0).ControlCount= 1
TabCaption(1) = "PS Info and Data"
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "Frame6"
Tab(1).Control(1)= "Frame5"
Tab(1).Control(2)= "Frame4"
Tab(1).Control(3)= "Frame3"
Tab(1).Control(4)= "Frame7"
Tab(1).ControlCount= 5
TabCaption(2) = "Field Info"
Tab(2).ControlEnabled= -1 'True
Tab(2).Control(0)= "Frame8"
Tab(2).Control(0).Enabled= 0 'False
Tab(2).ControlCount= 1
Begin VB.Frame Frame7
Caption = "Partial PS Data"
Height = 4332
Left = -74880
TabIndex = 38
Top = 1080
Width = 7572
Begin VB.TextBox PSDataText
BackColor = &H00C0FFFF&
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "IBM3270"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3972
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 39
Top = 240
Width = 7332
End
End
Begin VB.Frame Frame3
Caption = "Beginning Position"
Height = 612
Left = -74880
TabIndex = 36
Top = 360
Width = 1812
Begin VB.Label BeginLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 37
Top = 240
Width = 1572
End
End
Begin VB.Frame Frame4
Caption = "Length of Data"
Height = 612
Left = -72960
TabIndex = 34
Top = 360
Width = 1812
Begin VB.Label LengthLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 35
Top = 240
Width = 1572
End
End
Begin VB.Frame Frame5
Caption = "Number of Rows"
Height = 612
Left = -71040
TabIndex = 32
Top = 360
Width = 1812
Begin VB.Label RowsLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 33
Top = 240
Width = 1572
End
End
Begin VB.Frame Frame6
Caption = "Number of Columns"
Height = 612
Left = -69120
TabIndex = 30
Top = 360
Width = 1812
Begin VB.Label ColumnsLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 31
Top = 240
Width = 1572
End
End
Begin VB.Frame Frame8
Caption = "Field Information"
Height = 3852
Left = 840
TabIndex = 12
Top = 960
Width = 6132
Begin VB.Frame Frame10
Caption = "Fields"
Height = 2532
Left = 240
TabIndex = 15
Top = 1080
Width = 5652
Begin VB.Frame Frame16
Caption = "Is Protected"
Height = 612
Left = 3840
TabIndex = 27
Top = 1680
Width = 1572
Begin VB.Label IsProtectedLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 28
Top = 240
Width = 1332
End
End
Begin VB.ComboBox FieldCombo
BackColor = &H00C0FFFF&
ForeColor = &H00000000&
Height = 315
ItemData = "FGPARTPS.frx":0000
Left = 600
List = "FGPARTPS.frx":0002
Style = 2 'Dropdown List
TabIndex = 26
Top = 360
Width = 855
End
Begin VB.Frame Frame15
Caption = "Is Modified"
Height = 612
Left = 2040
TabIndex = 24
Top = 1680
Width = 1572
Begin VB.Label IsModifiedLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 25
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame14
Caption = "Pen Detectable"
Height = 612
Left = 240
TabIndex = 22
Top = 1680
Width = 1572
Begin VB.Label PenDectionLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 23
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame13
Caption = "Intensity"
Height = 612
Left = 3840
TabIndex = 20
Top = 840
Width = 1572
Begin VB.Label IntensityLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 21
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame12
Caption = "Type of Data"
Height = 612
Left = 2040
TabIndex = 18
Top = 840
Width = 1572
Begin VB.Label TypeOfDataLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 19
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame11
Caption = "Field Range"
Height = 612
Left = 240
TabIndex = 16
Top = 840
Width = 1572
Begin VB.Label FieldRangeLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 17
Top = 240
Width = 1332
End
End
Begin VB.Label Label8
Caption = "Field"
Height = 252
Left = 120
TabIndex = 29
Top = 360
Width = 492
End
End
Begin VB.Frame Frame9
Caption = "Number of Fields"
Height = 612
Left = 240
TabIndex = 13
Top = 360
Width = 1812
Begin VB.Label NumberLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 14
Top = 240
Width = 1572
End
End
End
Begin VB.Frame Frame1
Caption = "Input Parameters"
ForeColor = &H80000008&
Height = 612
Left = -74760
TabIndex = 4
Top = 840
Width = 7332
Begin VB.TextBox PSFirstPositionText
BackColor = &H00FFFFC0&
ForeColor = &H00000000&
Height = 285
Left = 3480
MaxLength = 4
TabIndex = 8
Text = "0000"
Top = 240
Width = 615
End
Begin VB.TextBox DataLengthText
BackColor = &H00FFFFC0&
ForeColor = &H00000000&
Height = 285
Left = 5400
MaxLength = 4
TabIndex = 7
Text = "1920"
Top = 240
Width = 615
End
Begin VB.CheckBox EOFflag
Caption = "EO&F flag"
ForeColor = &H80000008&
Height = 252
Left = 6120
TabIndex = 6
Top = 240
Width = 1092
End
Begin VB.ComboBox SessionIdList
BackColor = &H00FFFFC0&
ForeColor = &H00000000&
Height = 288
ItemData = "FGPARTPS.frx":0004
Left = 1200
List = "FGPARTPS.frx":0056
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 5
Top = 240
Width = 492
End
Begin VB.Label Label2
Caption = "PS First &Position"
ForeColor = &H80000008&
Height = 252
Left = 2040
TabIndex = 11
Top = 240
Width = 1452
End
Begin VB.Label DataLengthLabel
Caption = "Data &Length"
ForeColor = &H80000008&
Height = 252
Left = 4200
TabIndex = 10
Top = 240
Width = 1212
End
Begin VB.Label Label4
Caption = "Session &Id"
Height = 252
Left = 240
TabIndex = 9
Top = 240
Width = 972
End
End
End
End
Attribute VB_Name = "FormGetPartialPS"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
' Should dynamically base these off of the number of fields.
Dim FieldStarts(0 To 1000) As String
Dim FieldLengths(0 To 1000) As String
Dim FieldAttributes(0 To 1000) As String
Private Sub DataLengthText_Change()
CleanUpNumberText DataLengthText
End Sub
Private Sub EOFflag_Click()
If EOFflag.Value = UNCHECKED Then
DataLengthText.Enabled = True
DataLengthLabel.Enabled = True
Else
DataLengthText.Enabled = False
DataLengthLabel.Enabled = False
End If
End Sub
Private Sub Execute_Click()
On Error GoTo ErrHandler
FunctionComp = True
OldMousePointer = MousePointer
MousePointer = 11 ' Hour Glass Mouse Pointer
DisplayType$ = GetDisplayType$(SessionIdList.Text)
If DisplayType$ = "NONE" Then
MousePointer = OldMousePointer
MsgBox MSG_INVALID_PSID + SessionIdList.Text, 48, MSG_SAMPLE_PROG
Exit Sub
End If
temp$ = LTrim$(RTrim$(SessionIdList.Text))
If Len(temp$) > 0 Then
Topic$ = "Session" + temp$
Else
MousePointer = OldMousePointer
MsgBox MSG_PARA_ERROR, 48, MSG_SAMPLE_PROG
Exit Sub
End If
Item$ = GetPartPSItem()
rc = DoEvents() 'If you use VisualBasic V2.0, call
'DoEvents function each time before
'starting DDE conversation.
PartialPSDataText.LinkTimeout = -1
PartialPSDataText.LinkTopic = APPLICATION_NAME + "|" + Topic$
PartialPSDataText.LinkMode = COLD
PartialPSDataText.LinkItem = Item$
PartialPSDataText.LinkRequest
PartialPSDataText.LinkMode = NONE
MousePointer = OldMousePointer
If FunctionComp = True Then
GetPartialPSInfo
If CInt(NumberLabel.Caption) <> 0 Then
FieldCombo.ListIndex = 0
End If
SSTab1.Tab = 1
MsgBox MSG_FUNCTION_COMP, 64, MSG_SAMPLE_PROG
EndStatus$ = MSG_OK
Else
MsgBox MSG_DDE_ERROR, 48, MSG_SAMPLE_PROG
EndStatus$ = MSG_NG
End If
TempLogData$ = Time$ + ":Get Partial PS : " + EndStatus$ + Chr$(13) + Chr$(10) + Chr$(9)
TempLogData$ = TempLogData$ + MSG_APPLICATION + APPLICATION_NAME + """" + Chr$(13) + Chr$(10) + Chr$(9)
TempLogData$ = TempLogData$ + MSG_TOPIC + """" + Topic$ + """" + Chr$(13) + Chr$(10) + Chr$(9)
TempLogData$ = TempLogData$ + MSG_ITEM + """" + Item$ + """" + Chr$(13) + Chr$(10)
LogData$(LogEnd) = TempLogData$
UpdateLogPointer
Loged = True
Exit Sub
ErrHandler:
FunctionComp = False
Resume Next
End Sub
Private Sub ExitDlg_Click()
Hide
End Sub
Private Function GetPartPSItem() As String
temp$ = RTrim$(LTrim$(PSFirstPositionText.Text))
Temp2$ = RTrim$(LTrim$(DataLengthText.Text))
If EOFflag.Value = CHECKED Then
Temp3$ = "1"
Else
Temp3$ = "0"
End If
GetPartPSItem = "EPS" + "(" + temp$ + "," + Temp2$ + "," + Temp3$ + ")"
End Function
Private Sub UpdateLogPointer()
LogEnd = LogEnd + 1
If LogEnd = MAXLOGNUM + 1 Then
LogEnd = 0
End If
If LogTop = LogEnd Then
LogTop = LogTop + 1
If LogTop = MAXLOGNUM + 1 Then
LogTop = 0
End If
End If
End Sub
Private Sub FieldCombo_Change()
Dim FieldAttribute As Byte
MsgBox "1"
StartOfField = FieldStarts(FieldCombo.Text)
MsgBox "2"
length = FieldLengths(FieldCombo.Text)
MsgBox "3"
EndOfField = StartOfField + length - 1
MsgBox "4"
FieldAttribute = FieldAttributes(FieldCombo.Text)
MsgBox "5"
FieldRangeLabel.Caption = StartOfField & "-" & EndOfField
If FieldAttribute Or &H10& Then
TypeOfDataLabel.Caption = "Numeric"
Else
TypeOfDataLabel.Caption = "AlphaNumeric"
End If
If FieldAttribute Or &H20& Then
IsProtectedLabel.Caption = "Yes"
Else
IsProtectedLabel.Caption = "No"
End If
If ((FieldAttribute Or &HC&) = &H0&) Then
IntensityLabel.Caption = "Normal"
PenDectionLabel.Caption = "No"
ElseIf ((FieldAttribute Or &HC&) = &H4&) Then
IntensityLabel.Caption = "Normal"
PenDectionLabel.Caption = "Yes"
ElseIf ((FieldAttribute Or &HC&) = &H8&) Then
IntensityLabel.Caption = "High"
PenDectionLabel.Caption = "Yes"
Else
IntensityLabel.Caption = "Non-Display"
PenDectionLabel.Caption = "No"
End If
If FieldAttribute Or &H1& Then
IsModifiedLabel.Caption = "Yes"
Else
IsModifiedLabel.Caption = "No"
End If
End Sub
Private Sub FieldCombo_Click()
Dim FieldAttribute As Byte
Dim StartOfField As Integer
Dim length As Integer
Dim EndOfField As Integer
StartOfField = FieldStarts(FieldCombo.Text)
length = FieldLengths(FieldCombo.Text)
EndOfField = StartOfField + length - 1
'MFWU change Asc to be AscB
FieldAttribute = AscB(FieldAttributes(FieldCombo.Text))
FieldRangeLabel.Caption = StartOfField & "-" & EndOfField
If FieldAttribute And &H10& Then
TypeOfDataLabel.Caption = "Numeric"
Else
TypeOfDataLabel.Caption = "AlphaNumeric"
End If
If FieldAttribute And &H20& Then
IsProtectedLabel.Caption = "Yes"
Else
IsProtectedLabel.Caption = "No"
End If
If ((FieldAttribute And &HC&) = &H0&) Then
IntensityLabel.Caption = "Normal"
PenDectionLabel.Caption = "No"
ElseIf ((FieldAttribute And &HC&) = &H4&) Then
IntensityLabel.Caption = "Normal"
PenDectionLabel.Caption = "Yes"
ElseIf ((FieldAttribute And &HC&) = &H8&) Then
IntensityLabel.Caption = "High"
PenDectionLabel.Caption = "Yes"
Else
IntensityLabel.Caption = "Non-Display"
PenDectionLabel.Caption = "No"
End If
If FieldAttribute And &H1& Then
IsModifiedLabel.Caption = "Yes"
Else
IsModifiedLabel.Caption = "No"
End If
End Sub
Private Sub Form_Load()
SessionIdList.ListIndex = 0
End Sub
Private Sub PSFirstPositionText_Change()
CleanUpNumberText PSFirstPositionText
End Sub
Private Sub GetPartialPSInfo()
Dim BeginPosition As Integer
Dim EndPosition As Integer
BeginPosition = 1
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
BeginLabel.Caption = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
BeginPosition = EndPosition + 1
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
LengthLabel.Caption = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
BeginPosition = EndPosition + 1
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
RowsLabel.Caption = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
BeginPosition = EndPosition + 1
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
ColumnsLabel.Caption = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
BeginPosition = EndPosition + 1
PSDataText.Text = Mid(PartialPSDataText.Text, BeginPosition, CInt(LengthLabel.Caption))
BeginPosition = BeginPosition + CInt(LengthLabel.Caption) + 1 + 2 * (CInt(RowsLabel.Caption) - 1)
' +1 for Tab Character and + 1 for each newline character between each row
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
NumberLabel.Caption = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
FieldCombo.Clear
FieldRangeLabel.Caption = ""
TypeOfDataLabel.Caption = ""
IntensityLabel.Caption = ""
PenDectionLabel.Caption = ""
IsModifiedLabel.Caption = ""
If CInt(NumberLabel.Caption) <> 0 Then
For Counter = 1 To CInt(NumberLabel.Caption)
' Field Start
BeginPosition = EndPosition + 1
BeginFieldPosition = BeginPosition
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
FieldStarts(Counter) = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
' Field Length
BeginPosition = EndPosition + 1
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
FieldLengths(Counter) = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
' Field Attribute
BeginPosition = EndPosition + 1
'MFWU change the following line
'EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
EndPosition = BeginPosition + 1
If EndPosition = 0 Then
MsgBox "EndPostion is 0"
End If
'MFWU change Mid to be MidB
FieldAttributes(Counter) = MidB(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
FieldCombo.AddItem Counter
Next Counter
End If
End Sub