home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pc3270sa.zip / vbdde / fgtrmrct.frm < prev    next >
Text File  |  2002-02-28  |  11KB  |  361 lines
  1. VERSION 4.00
  2. Begin VB.Form FormGetTrimRect 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Get Trim Rectangle"
  5.    ClientHeight    =   5784
  6.    ClientLeft      =   2892
  7.    ClientTop       =   2040
  8.    ClientWidth     =   6144
  9.    BeginProperty Font 
  10.       name            =   "MS Sans Serif"
  11.       charset         =   0
  12.       weight          =   700
  13.       size            =   7.8
  14.       underline       =   0   'False
  15.       italic          =   0   'False
  16.       strikethrough   =   0   'False
  17.    EndProperty
  18.    ForeColor       =   &H80000008&
  19.    Height          =   6108
  20.    Left            =   2844
  21.    LinkMode        =   1  'Source
  22.    LinkTopic       =   "Form2"
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    ScaleHeight     =   5784
  26.    ScaleWidth      =   6144
  27.    ShowInTaskbar   =   0   'False
  28.    Top             =   1764
  29.    Width           =   6240
  30.    Begin VB.TextBox TrimRectDataText 
  31.       BackColor       =   &H00C0FFFF&
  32.       BeginProperty Font 
  33.          name            =   "IBM3270"
  34.          charset         =   0
  35.          weight          =   400
  36.          size            =   9.6
  37.          underline       =   0   'False
  38.          italic          =   0   'False
  39.          strikethrough   =   0   'False
  40.       EndProperty
  41.       ForeColor       =   &H00FF0000&
  42.       Height          =   2652
  43.       Left            =   240
  44.       Locked          =   -1  'True
  45.       MultiLine       =   -1  'True
  46.       ScrollBars      =   3  'Both
  47.       TabIndex        =   17
  48.       TabStop         =   0   'False
  49.       Top             =   2400
  50.       Width           =   5676
  51.    End
  52.    Begin VB.Frame Frame1 
  53.       Caption         =   "Trim Rectangle Data"
  54.       Height          =   3012
  55.       Left            =   120
  56.       TabIndex        =   18
  57.       Top             =   2160
  58.       Width           =   5892
  59.    End
  60.    Begin VB.ComboBox SessionIdList 
  61.       BackColor       =   &H00FFFFC0&
  62.       ForeColor       =   &H00000000&
  63.       Height          =   288
  64.       ItemData        =   "FGTRMRCT.frx":0000
  65.       Left            =   1200
  66.       List            =   "FGTRMRCT.frx":0052
  67.       Sorted          =   -1  'True
  68.       Style           =   2  'Dropdown List
  69.       TabIndex        =   2
  70.       Top             =   360
  71.       Width           =   492
  72.    End
  73.    Begin VB.CommandButton ExitDlg 
  74.       Cancel          =   -1  'True
  75.       Caption         =   "E&xit"
  76.       Height          =   372
  77.       Left            =   4320
  78.       TabIndex        =   16
  79.       Top             =   5280
  80.       Width           =   852
  81.    End
  82.    Begin VB.CommandButton Execute 
  83.       Caption         =   "&Execute"
  84.       Default         =   -1  'True
  85.       Height          =   372
  86.       Left            =   960
  87.       TabIndex        =   15
  88.       Top             =   5280
  89.       Width           =   876
  90.    End
  91.    Begin VB.Frame TrimFrame 
  92.       Caption         =   "Trim Rect Setting"
  93.       ForeColor       =   &H80000008&
  94.       Height          =   1212
  95.       Left            =   2040
  96.       TabIndex        =   4
  97.       Top             =   720
  98.       Width           =   3852
  99.       Begin VB.TextBox TrimLRColumnText 
  100.          BackColor       =   &H00FFFFC0&
  101.          ForeColor       =   &H00404040&
  102.          Height          =   288
  103.          Left            =   3072
  104.          TabIndex        =   14
  105.          Text            =   "80"
  106.          Top             =   840
  107.          Width           =   420
  108.       End
  109.       Begin VB.TextBox TrimLRRowText 
  110.          BackColor       =   &H00FFFFC0&
  111.          ForeColor       =   &H00000000&
  112.          Height          =   288
  113.          Left            =   3072
  114.          TabIndex        =   12
  115.          Text            =   "24"
  116.          Top             =   480
  117.          Width           =   420
  118.       End
  119.       Begin VB.TextBox TrimTLColumnText 
  120.          BackColor       =   &H00FFFFC0&
  121.          ForeColor       =   &H00000000&
  122.          Height          =   288
  123.          Left            =   1152
  124.          TabIndex        =   9
  125.          Text            =   "1"
  126.          Top             =   840
  127.          Width           =   420
  128.       End
  129.       Begin VB.TextBox TrimTLRowText 
  130.          BackColor       =   &H00FFFFC0&
  131.          ForeColor       =   &H00000000&
  132.          Height          =   288
  133.          Left            =   1152
  134.          TabIndex        =   7
  135.          Text            =   "1"
  136.          Top             =   480
  137.          Width           =   420
  138.       End
  139.       Begin VB.Label TrimLabel6 
  140.          Caption         =   "Column"
  141.          ForeColor       =   &H80000008&
  142.          Height          =   252
  143.          Left            =   2208
  144.          TabIndex        =   13
  145.          Top             =   840
  146.          Width           =   780
  147.       End
  148.       Begin VB.Label TrimLabel5 
  149.          Caption         =   "Row"
  150.          ForeColor       =   &H80000008&
  151.          Height          =   252
  152.          Left            =   2208
  153.          TabIndex        =   11
  154.          Top             =   480
  155.          Width           =   780
  156.       End
  157.       Begin VB.Label TrimLabel4 
  158.          Caption         =   "&Lower right corner"
  159.          ForeColor       =   &H80000008&
  160.          Height          =   252
  161.          Left            =   2112
  162.          TabIndex        =   10
  163.          Top             =   240
  164.          Width           =   1644
  165.       End
  166.       Begin VB.Label TrimLabel3 
  167.          Caption         =   "Column"
  168.          ForeColor       =   &H80000008&
  169.          Height          =   252
  170.          Left            =   288
  171.          TabIndex        =   8
  172.          Top             =   840
  173.          Width           =   780
  174.       End
  175.       Begin VB.Label TrimLabel2 
  176.          Caption         =   "Row"
  177.          ForeColor       =   &H80000008&
  178.          Height          =   252
  179.          Left            =   288
  180.          TabIndex        =   6
  181.          Top             =   480
  182.          Width           =   780
  183.       End
  184.       Begin VB.Label TrimLabel1 
  185.          Caption         =   "&Top left corner"
  186.          ForeColor       =   &H80000008&
  187.          Height          =   252
  188.          Left            =   192
  189.          TabIndex        =   5
  190.          Top             =   240
  191.          Width           =   1452
  192.       End
  193.    End
  194.    Begin VB.CheckBox TrimCheck 
  195.       Caption         =   "&SpecifyTrim Rectangle"
  196.       ForeColor       =   &H80000008&
  197.       Height          =   252
  198.       Left            =   2040
  199.       TabIndex        =   3
  200.       Top             =   360
  201.       Width           =   3372
  202.    End
  203.    Begin VB.Frame Frame2 
  204.       Caption         =   "Input Parameters"
  205.       Height          =   1932
  206.       Left            =   120
  207.       TabIndex        =   0
  208.       Top             =   120
  209.       Width           =   5892
  210.       Begin VB.Label Label1 
  211.          Caption         =   "Session &Id"
  212.          Height          =   252
  213.          Left            =   120
  214.          TabIndex        =   1
  215.          Top             =   240
  216.          Width           =   972
  217.       End
  218.    End
  219. End
  220. Attribute VB_Name = "FormGetTrimRect"
  221. Attribute VB_Creatable = False
  222. Attribute VB_Exposed = False
  223.  
  224. Private Sub ChangTrimRectGroup(Status As Integer)
  225.    TrimFrame.Enabled = Status
  226.    TrimLabel1.Enabled = Status
  227.    TrimLabel2.Enabled = Status
  228.    TrimLabel3.Enabled = Status
  229.    TrimLabel4.Enabled = Status
  230.    TrimLabel5.Enabled = Status
  231.    TrimLabel6.Enabled = Status
  232.    TrimTLRowText.Enabled = Status
  233.    TrimTLColumnText.Enabled = Status
  234.    TrimLRRowText.Enabled = Status
  235.    TrimLRColumnText.Enabled = Status
  236. End Sub
  237.  
  238. Private Sub Execute_Click()
  239. On Error GoTo ErrHandler
  240.    FunctionComp = True
  241.    
  242.    OldMousePointer = MousePointer
  243.    MousePointer = 11 ' Hour Glass Mouse Pointer
  244.  
  245.    DisplayType$ = GetDisplayType$(SessionIdList.Text)
  246.    
  247.    If DisplayType$ = "NONE" Then
  248.       MousePointer = OldMousePointer
  249.       MsgBox MSG_INVALID_PSID + SessionIdList.Text, 48, MSG_SAMPLE_PROG
  250.       Exit Sub
  251.    End If
  252.  
  253.    If TrimCheck.Value = 0 Then
  254.      If GetTrimRectangleCoords(SessionIdList.Text, TLCol, TLRow, BRCol, BRRow) = "Closed" Then
  255.        MousePointer = OldMousePointer
  256.        MsgBox "Either" & Chr$(13) & Chr$(10) & Chr$(9) & "1) specify Trim Rectangle on this form" & Chr$(13) & Chr$(10) & "or" & Chr$(9) & " 2) select Trim Rectangle on session."
  257.        Exit Sub
  258.      End If
  259.    End If
  260.    
  261.    temp$ = LTrim$(RTrim$(SessionIdList.Text))
  262.    If Len(temp$) > 0 Then
  263.       Topic$ = "Session" + temp$
  264.    Else
  265.       MousePointer = OldMousePointer
  266.       MsgBox MSG_PARA_ERROR, 48, MSG_SAMPLE_PROG
  267.       Exit Sub
  268.    End If
  269.  
  270.    If TrimCheck.Value = CHECKED Then
  271.       Item$ = GetTrimItem()
  272.       If Len(Item$) = 0 Then
  273.          MsgBox MSG_PARA_ERROR, 48, MSG_SAMPLE_PROG
  274.          MousePointer = OldMousePointer
  275.          Exit Sub
  276.       End If
  277.    Else
  278.       Item$ = "TRIMRECT"
  279.    End If
  280.    
  281.    rc = DoEvents()              'If you use VisualBasic V2.0, call
  282.                                 'DoEvents function each time before
  283.                                 'starting DDE conversation.
  284.    TrimRectDataText.LinkTimeout = -1
  285.    TrimRectDataText.LinkTopic = APPLICATION_NAME + "|" + Topic$
  286.    TrimRectDataText.LinkMode = COLD
  287.    TrimRectDataText.LinkItem = Item$
  288.    TrimRectDataText.LinkRequest
  289.    TrimRectDataText.LinkMode = NONE
  290.       
  291.    MousePointer = OldMousePointer
  292.    If FunctionComp = True Then
  293.       MsgBox MSG_FUNCTION_COMP, 64, MSG_SAMPLE_PROG
  294.       EndStatus$ = MSG_OK
  295.    Else
  296.       MsgBox MSG_DDE_ERROR, 48, MSG_SAMPLE_PROG
  297.       EndStatus$ = MSG_NG
  298.    End If
  299.    TempLogData$ = Time$ + ":Get Trim Rectangle : " + EndStatus$ + Chr$(13) + Chr$(10) + Chr$(9)
  300.    TempLogData$ = TempLogData$ + MSG_APPLICATION + APPLICATION_NAME + """" + Chr$(13) + Chr$(10) + Chr$(9)
  301.    TempLogData$ = TempLogData$ + MSG_TOPIC + """" + Topic$ + """" + Chr$(13) + Chr$(10) + Chr$(9)
  302.    TempLogData$ = TempLogData$ + MSG_ITEM + """" + Item$ + """" + Chr$(13) + Chr$(10)
  303.    LogData$(LogEnd) = TempLogData$
  304.    UpdateLogPointer
  305.    Loged = True
  306.    Exit Sub
  307.  
  308. ErrHandler:
  309.    FunctionComp = False
  310.    Resume Next
  311. End Sub
  312.  
  313. Private Sub ExitDlg_Click()
  314.     Hide
  315. End Sub
  316.  
  317. Private Function GetTrimItem() As String
  318.    Dim TopLeftRow As String
  319.    Dim TopLeftColumn As String
  320.    Dim LowRightRow As String
  321.    Dim LowRightColumn As String
  322.  
  323.    TopLeftRow = RTrim$(LTrim$(TrimTLRowText.Text))
  324.    TopLeftColumn = RTrim$(LTrim$(TrimTLColumnText.Text))
  325.    LowRightRow = RTrim$(LTrim$(TrimLRRowText.Text))
  326.    LowRightColumn = RTrim$(LTrim$(TrimLRColumnText.Text))
  327.    
  328.    If (Len(TopLeftRow) > 0) And (Len(TopLeftColumn) > 0) And (Len(LowRightRow) > 0) And (Len(LowRightColumn) > 0) Then
  329.       GetTrimItem = "TRIMRECT(" + TopLeftRow + "," + TopLeftColumn + "," + LowRightRow + "," + LowRightColumn + ")"
  330.    Else
  331.       GetTrimItem = ""
  332.    End If
  333. End Function
  334.  
  335. Private Sub Form_Load()
  336.   SessionIdList.ListIndex = 0
  337. End Sub
  338.  
  339. Private Sub TrimCheck_Click()
  340.    If TrimCheck.Value = CHECKED Then
  341.       ChangTrimRectGroup (True)
  342.    Else
  343.       ChangTrimRectGroup (False)
  344.    End If
  345. End Sub
  346.  
  347. Private Sub UpdateLogPointer()
  348.     LogEnd = LogEnd + 1
  349.     If LogEnd = MAXLOGNUM + 1 Then
  350.        LogEnd = 0
  351.     End If
  352.  
  353.     If LogTop = LogEnd Then
  354.        LogTop = LogTop + 1
  355.        If LogTop = MAXLOGNUM + 1 Then
  356.           LogTop = 0
  357.        End If
  358.     End If
  359. End Sub
  360.  
  361.