Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/crwdemo/setformu.frm

Visual Basic Form | 1995-12-05 | 5.9 KB | 191 lines

VERSION 2.00
Begin Form SetFormula
   BackColor       =   &H00C0C0C0&
   Caption         =   "Formulas"
   ClientHeight    =   3780
   ClientLeft      =   1410
   ClientTop       =   1935
   ClientWidth     =   7800
   Height          =   4470
   Left            =   1350
   LinkTopic       =   "Form3"
   ScaleHeight     =   4428.806
   ScaleMode       =   0  'User
   ScaleWidth      =   7800
   Top             =   1305
   Width           =   7920
   Begin TextBox Text5
      Height          =   375
      Left            =   2520
      TabIndex        =   11
      Top             =   240
      Width           =   2655
   End
   Begin SSPanel StatusBar
      Alignment       =   1  'Left Justify - MIDDLE
      BorderWidth     =   1
      Height          =   405
      Left            =   0
      TabIndex        =   2
      Top             =   3390
      Width           =   7815
   End
   Begin TextBox Text4
      Height          =   375
      Left            =   2520
      TabIndex        =   3
      Top             =   2190
      Width           =   5055
   End
   Begin TextBox Text3
      Height          =   375
      Left            =   2520
      TabIndex        =   9
      Top             =   1680
      Width           =   5055
   End
   Begin CommandButton Command5
      Caption         =   "Set Selection Formula"
      Height          =   375
      Left            =   360
      TabIndex        =   8
      Top             =   2160
      Width           =   2055
   End
   Begin CommandButton Command4
      Caption         =   "Get Selection Formula"
      Height          =   375
      Left            =   360
      TabIndex        =   7
      Top             =   1680
      Width           =   2055
   End
   Begin CommandButton Command3
      Caption         =   "Set Formula"
      Height          =   375
      Left            =   360
      TabIndex        =   6
      Top             =   1200
      Width           =   2055
   End
   Begin CommandButton Command2
      Caption         =   "Close"
      Height          =   375
      Left            =   360
      TabIndex        =   5
      Top             =   2640
      Width           =   2055
   End
   Begin CommandButton Command1
      Caption         =   "Get Formula"
      Height          =   375
      Left            =   360
      TabIndex        =   4
      Top             =   750
      Width           =   2055
   End
   Begin TextBox Text2
      Height          =   405
      Left            =   2520
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   1200
      Width           =   5055
   End
   Begin TextBox Text1
      Height          =   405
      Left            =   2520
      TabIndex        =   0
      Top             =   720
      Width           =   5055
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Enter Formula Name"
      Height          =   255
      Left            =   360
      TabIndex        =   10
      Top             =   240
      Width           =   2055
   End
   Begin Menu MenuFile
      Caption         =   "&File"
      Begin Menu MenuFileExit
         Caption         =   "&Exit"
      End
   End
Dim FormulaName As String
Dim SelectFormula As String
Sub Command1_Click ()
  Dim FormulaText As String
  Dim Formula As String
  Dim TextHandle As Integer, TextLength As Integer
  FormulaName = Text5.Text + Chr$(0)
  If Text5.Text = "" Then
    MsgBox "There is no formula to retrieve. Please enter a formula name."
  Else
    If PEGetFormula(JobNum, FormulaName, TextHandle, TextLength) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PEGetFormula Error #: " + Str(ErrorCode) + " - " + RCode
    End If
    ' Allocate memory for string
    Formula = String(TextLength, " ")
    If PEGetHandleString(TextHandle, Formula, TextLength) = False Then
     ' Handle error
      RCode = GetErrorString(JobNum)
      MsgBox "PEGetHandleString Error #: " + Str(ErrorCode) + " - " + RCode
    Else
      Text1.Text = Formula
      SETFORMULA!StatusBar.Caption = "The formula " + Text5.Text + " has been retrieved as ---> " + Text1.Text
    End If
  End If
End Sub
Sub Command2_Click ()
 Unload Me
End Sub
Sub Command3_Click ()
'Set formula to pass to crystal Reports
'Notice that the string pointer must be embedded in quotes
'the formula name does not have quote surrounding it and does not include
'the @ sign as shown in Crystal Reports
  FormName = Text5.Text + Chr(0)
  If Text5.Text = "" Then
    MsgBox "There is no formula to retrieve. Please enter a formula name."
  Else
    If Text2.Text = "" Then
      MsgBox "You have to enter a formula before you can set one."
    Else
      If PESetFormula(JobNum, FormName, Text2.Text) = False Then
       MsgBox ("Setting the Formula has failed")
      Else
        SETFORMULA!StatusBar.Caption = "The formula " + Text5.Text + " has been set to --->" + Text2.Text
      End If
    End If
  End If
End Sub
Sub Command4_Click ()
  Dim SelectFormula As String
  Dim TextHandle As Integer, TextLength As Integer
  If PEGetSelectionFormula(JobNum, TextHandle, TextLength) = False Then
     MsgBox ("Cannnot get Selection Formula")
  End If
  ' Allocate memory for string
  SelectFormula = String(TextLength, " ")
  If PEGetHandleString(TextHandle, SelectFormula, TextLength) = False Then
    MsgBox ("Cannot get Handle String")
  Else
    Text3.Text = SelectFormula
    SETFORMULA!StatusBar.Caption = "The Selection formula has been retrieved"
  End If
End Sub
Sub Command5_Click ()
  If PESetSelectionFormula(JobNum, Text4.Text) = False Then
    MsgBox ("Cannot Set Selection Formula")
  Else
    SETFORMULA!StatusBar.Caption = "The Selection formula has been Set"
  End If
End Sub
Sub MenuFileExit_Click ()
 Unload Me
End Sub