Page History
...
Source Code ActiveX Example 3- Reusable Part AXOBJECTB
* Reusable Part AXOBJECTB
Function Options(*DIRECT)
Begin_Com Role(*EXTENDS #PRIM_OBJT)
Attribute Class(#PRIM_ATTR.AX_TYPELIB) Guid('{9606E0AB-DCC2-426D-8ABE-EEFFB05F5F07}') Typelibname('LANSA_AXOBJECTB_LIB')
Attribute Class(#PRIM_ATTR.AX_CLASS) Guid('{4261A3BF-BD23-4955-997F-FE4E0EA19999}') Progid('LANSA.AXOBJECTB')
Attribute Class(#PRIM_ATTR.AX_IN_INTERFACE) Guid('{972B0B94-0740-46D7-AD6F-9BC2142F2A01}') Basedispid(0)
Attribute Class(#PRIM_ATTR.AX_EVT_INTERFACE) Guid('{A61429A8-0B19-4788-BF8F-8D075B505EE5}') Basedispid(0)
* employee object
Define_Com Class(#axobjecta) Name(#Employee) Reference(*dynamic)
* Collection of employees
Define_Com Class(#prim_lcol<#axobjecta>) Name(#Employees)
* Collection Iterator
Define_Com Class(#prim_lcit<#axobjecta>) Name(#itrEmployees) Reference(*dynamic)
Define_Com Class(#AXOBJECTA) Name(#AXOBJECTA)
Define_Pty Name(uEmployees) Get(*COLLECTION #employees)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(0) Name('uEmployees')
Define_Pty Name(uCurrentEmployee) Get(*reference #employee)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(6) Name('uCurrentEmployee')
Mthroutine Name(uSetCurrentEmployee)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(4) Name('uSetCurrentEmployee')
Define_Map For(*input) Class(#std_num) Name(#index)
Define_Map For(*RESULT) Class(#prim_boln) Name(#uDirty)
Set Com(#uDirty) Value(#com_false)
Set_Ref Com(#employee) To(#employees.item<#index.value>)
If_Ref Com(#employee) Is(*null)
Set Com(#uDirty) Value(#com_true)
Endif
Endroutine
Mthroutine Name(uGetNextEmployee)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(8) Name('uGetNextEmployee')
Define_Map For(*RESULT) Class(#prim_boln) Name(#uDirty)
Define_Com Class(#prim_boln) Name(#EmployeeExists)
Set Com(#udirty) Value(#com_false)
If_Ref Com(#itremployees) Is_Not(*null)
Invoke Method(#itrEmployees.MoveNext) Result(#employeeexists)
If Cond('#employeeexists = #com_true')
Set_Ref Com(#Employee) To(#itremployees.Current)
If_Ref Com(#Employee) Is(*null)
Set Com(#uDirty) Value(#com_true)
Endif
Else
Set Com(#udirty) Value(#com_true)
Endif
Else
Set Com(#udirty) Value(#com_true)
Endif
If Cond('#uDirty = #com_true')
Set_Ref Com(#Employee) To(*null)
Endif
Endroutine
Mthroutine Name(uGetAllEmployees) Help('Get all employees')
...
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(1) Name('uGetAllEmployees')
Define_Map For(*output) Class(#prim_boln) Name(#uDirty)
Invoke Method(#employees.RemoveAll)
Select Fields(#EMPNO) From_File(PSLMST2)
Set_Ref Com(#employee) To(*create_as #axobjecta)
Invoke Method(#Employee.uLoadEmployee) Uempno(#empno)
Invoke Method(#Employees.Insert) Item(#employee)
Endselect
Invoke Method(#Employees.CreateIterator) Result(#itrEmployees)
If Cond('#employees.itemcount > 0')
Set Com(#uDirty) Value(#com_false)
Else
Set Com(#uDirty) Value(#com_true)
Endif
Endroutine
Mthroutine Name(uGetDepartEmployees) Help('Get an individual employee')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(2) Name('uGetDepartEmployees')
Define_Map For(*input) Class(#deptment) Name(#uDepartment)
Define_Map For(*output) Class(#prim_boln) Name(#uDirty)
Change Field(#DEPTMENT) To(#uDepartment)
Invoke Method(#employees.RemoveAll)
Select Fields(#EMPNO) From_File(PSLMST1) With_Key(#DEPTMENT)
Set_Ref Com(#employee) To(*create_as #axobjecta)
Invoke Method(#Employee.uLoadEmployee) Uempno(#empno)
Invoke Method(#Employees.Insert) Item(#employee)
Endselect
Invoke Method(#Employees.CreateIterator) Result(#itrEmployees)
If Cond('#employees.itemcount > 0')
Set Com(#uDirty) Value(#com_false)
Else
Set Com(#uDirty) Value(#com_true)
Endif
Endroutine
End_Com
Source Code ActiveX Example 3 - Visual Basic - Object
VERSION 5.00
Begin VB.Form Form1
Caption = "Case 3 - VB"
ClientHeight = 8325
...
ClientLeft = 60
ClientTop = 345
ClientWidth = 4650
LinkTopic = "Form1"
ScaleHeight = 8325
ScaleWidth = 4650
StartUpPosition = 3 'Windows Default
Begin MSComctlLib.ListView lvwemployees
Height = 3015
Left = 360
TabIndex = 15
Top = 840
Width = 3975
_ExtentX = 7011
_ExtentY = 5318
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.ComboBox StatusMsgBox
BackColor = &H80000013&
Height = 315
Left = 120
Style = 2 'Dropdown List
TabIndex = 14
Top = 7920
...
Width = 4455
End
Begin VB.CommandButton cmdback
Caption = "Back"
Enabled = 0 'False
Height = 375
Left = 1080
Style = 1 'Graphical
TabIndex = 13
Top = 4080
Width = 1095
End
Begin VB.CommandButton cmdforward
Caption = "Forward"
Enabled = 0 'False
Height = 375
Left = 2520
Style = 1 'Graphical
...
TabIndex = 12
Top = 4080
Width = 1095
End
Begin VB.Frame frmEmployeeDetails
Caption = "Employee Details"
Height = 3015
Left = 360
TabIndex = 3
Top = 4680
Width = 3975
Begin VB.CommandButton cmdUpdate
Caption = "Update"
Enabled = 0 'False
Height = 375
Left = 1560
TabIndex = 11
Top = 2400
Width = 1095
End
Begin VB.TextBox uSalary
BeginProperty DataFormat
Type = 1
Format = "0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
...
FirstWeekOfYear = 0
LCID = 3081
SubFormatType = 1
EndProperty
Height = 350
Left = 1560
MaxLength = 11
TabIndex = 7
Text = "Salary"
Top = 1800
Width = 1215
End
Begin VB.TextBox uGiveName
Height = 350
Left = 1560
TabIndex = 6
Text = "Give Name"
Top = 840
Width = 1815
End
Begin VB.TextBox uSurname
Height = 345
Left = 1560
TabIndex = 5
Text = "Surname"
Top = 1320
Width = 1815
End
Begin VB.TextBox uNumber
BackColor = &H80000013&
Enabled = 0 'False
Height = 350
Left = 1560
TabIndex = 4
...
TabStop = 0 'False
Top = 360
Width = 1215
End
Begin VB.Label lblSalary
Caption = "Salary:"
Height = 345
Left = 240
TabIndex = 10
Top = 1800
Width = 855
...
End
Begin VB.Label LblName
Caption = "Name:"
Height = 225
Left = 240
TabIndex = 9
Top = 840
Width = 855
End
Begin VB.Label lblnumber
Caption = "Number:"
...
Height = 375
Left = 240
TabIndex = 8
Top = 360
...
Width = 735
End
...
End
Begin VB.CommandButton cmdSearch
Caption = "Search"
Default = -1 'True
Height = 375
Left = 2880
TabIndex = 2
Top =
...
240
Width = 1215
End
Begin VB.TextBox uDepartment
Height = 350
Left = 1800
TabIndex = 1
Text = "ADM"
Top = 240
Width = 495
End
Begin VB.Label lblDepartment
Caption = "Department:"
Height = 350
Left = 480
TabIndex = 0
Top = 240
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId =
...
True
Attribute VB_Exposed = False
Source Code ActiveX Example 3 - Visual Basic - Code
Option Explicit
Public Session As LANSA_ACTIVEX_LIB.Session
Dim axobjecta As LANSA_AXOBJECTA_LIB.axobjecta
Dim axobjectb As LANSA_AXOBJECTB_LIB.axobjectb
Dim gbDirty As Boolean
Dim gbDepartment As String * 3
Dim lvwindex As Long
Private Sub Form_Load()
' login to LANSA using default user, password and session location
If Session Is Nothing Then
Call ConnectToLansa("<user name>", "<password>", "<session.cfg path>")
End If
Set axobjecta = Session.CreateComponent("AXOBJECTA")
Set axobjectb = Session.CreateComponent("AXOBJECTB")
' dynamically create columns for list view
MakeColumns
GetEmployees ("")
End Sub
Private Sub GetEmployees(ByVal gbDepartment)
...
StatusMsgBox.Clear
StatusMsgBox.AddItem ("Building Employee List")
' build collection of all employees for initial display
If gbDepartment = "" Then
' build collection of all employees
Call axobjectb.uGetAllEmployees(gbDirty)
Else
Call axobjectb.uGetDepartEmployees(gbDepartment, gbDirty)
End If
StatusMsgBox.Clear
...
If UCase(gbDirty) = True Then ' if returned in error
StatusMsgBox.AddItem ("Error when building list")
Else:
NewAddListItems ' add items to list
StatusMsgBox.AddItem ("Employees selected")
...
End If
End Sub
Private Sub cmdSearch_Click()
cmdback.Enabled
...
= False
cmdforward.Enabled = False
StatusMsgBox.Clear
StatusMsgBox.AddItem ("Building Employees for Department")
' build collection of all employees for initial display
Call axobjectb.uGetDepartEmployees(uDepartment, gbDirty)
If gbDirty = True Then
StatusMsgBox.AddItem ("Department not found")
' clear list view
lvwemployees.ListItems.Clear
...
Else:
' add items to list
NewAddListItems ' add items to list
StatusMsgBox.AddItem (Str$(axobjectb.uEmployees.ItemCount) + " Employees selected")
End If
End Sub
Private Sub NewAddListItems()
Dim employeeli As ListItem
Dim employeesi As ListSubItem
Dim employeeobject As LANSA_AXOBJECTA_LIB.axobjecta
On Error GoTo ErrorHandler
...
' clear list view
lvwemployees.ListItems.Clear
gbDirty = axobjectb.uGetNextEmployee
Do While gbDirty = False
lvwindex = lvwindex + 1
Set employeeobject = axobjectb.uCurrentEmployee
Set employeeli = lvwemployees.ListItems.Add(, _
employeeobject.uNumber)
Call employeeli.ListSubItems.Add(, "surname", employeeobject.uSurname)
Call employeeli.ListSubItems.Add(, "department", employeeobject.uDepartment)
Call employeeli.ListSubItems.Add(, "givenname", employeeobject.uGiveName)
Call employeeli.ListSubItems.Add(, "salary", employeeobject.uSalary)
gbDirty = axobjectb.uGetNextEmployee
Loop
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub
Private Sub lvwemployees_ItemClick(ByVal Item As ListItem)
On Error GoTo ErrorHandler
Dim employeeli As ListItem
...
cmdback.Enabled = True
cmdforward.Enabled = True
cmdUpdate.Enabled = True
...
Set employeeli = lvwemployees.SelectedItem
lvwindex = Item.Index
Call GetEmployee(lvwindex)
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub
...
Private Sub GetEmployee(lvwindex)
Dim employeeobject As LANSA_AXOBJECTA_LIB.axobjecta
On Error GoTo ErrorHandler
Call axobjectb.uSetCurrentEmployee(lvwindex)
Set employeeobject = axobjectb.uCurrentEmployee
uNumber = employeeobject.uNumber
uSurname = employeeobject.uSurname
uGiveName = employeeobject.uGiveName
uSalary = employeeobject.uSalary
Exit Sub ' Exit to avoid handler.
...
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub
Private Sub cmdback_Click()
...
If lvwindex > 1 Then
lvwindex = lvwindex - 1
GetEmployee (lvwindex)
End If
End Sub
Private Sub cmdforward_Click()
If lvwindex < lvwemployees.ListItems.Count Then
lvwindex = lvwindex + 1
End If
GetEmployee (lvwindex)
End Sub
Private Sub cmdUpdate_Click()
Dim Status As String
Dim employeeobject As LANSA_AXOBJECTA_LIB.axobjecta
On Error GoTo ErrorHandler
If uSalary = "" Then uSalary = 0
Set employeeobject = axobjectb.
...
uCurrentEmployee
With employeeobject
.uGiveName = uGiveName
.uSurname = uSurname
.uSalary = uSalary
End With
Status = employeeobject.uSaveEmployee
' Clear the Messages from the Message Combo
StatusMsgBox.Clear
If (Status = "OK") Then
MsgBox ("Successfully updated " + employeeobject.uNumber)
Else
Call ShowMessages(Status, employeeobject)
MsgBox ("Error Updating " + employeeobject.uNumber + " : " + Status)
End If
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub
Private Sub ShowMessages(ByRef Status As String, ByRef employeeobject As LANSA_AXOBJECTA_LIB.axobjecta)
...
Dim msgField As Object
On Error GoTo ErrorHandler
For Each msgField In employeeobject.uMessages
StatusMsgBox.AddItem (msgField.Value())
Next
' Select the first entry in the combo box
If (StatusMsgBox.ListCount = 0) Then
StatusMsgBox.AddItem ("Status = '" + Status + "'")
End If
StatusMsgBox.ListIndex = 0
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub
...
Private Sub MakeColumns()
' Clear the ColumnHeaders collection.
lvwemployees.ColumnHeaders.Clear
' Add four ColumnHeaders.
lvwemployees.ColumnHeaders.Add , , "",
...
0
lvwemployees.ColumnHeaders.Add , , "Surname", 1500
lvwemployees.ColumnHeaders.Add , , "Department"
lvwemployees.ColumnHeaders.Add , , "Given Name"
lvwemployees.ColumnHeaders.Add , , "Salary"
lvwemployees.View = lvwReport
...
End Sub
Private Sub ConnectToLansa(ByVal username As String, ByVal password As String, ByVal txtlocation As String)
On Error GoTo ErrorHandler
...
Set Session = New LANSA_ACTIVEX_LIB.Session
' Set the session configuration file
Session.ConfigFile = txtlocation
Call Session.SetConnectParam("USER", username)
Call Session.SetConnectParam("PSPW", password)
Call Session.Connect
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub