View Source

[ |../../index.htm#lansa/l4wdeva_example3.htm]
現在地:

ソースコード ActiveX 例 3 - コンポーネントをビジネスオブジェクトとして利用

ソースコード ActiveX 例 3 - Visual LANSA のソース
再利用可能パーツ「AXOBJECTA」
再利用可能パーツ「AXOBJECTB」
ソースコード ActiveX 例 3 - 再利用可能パーツ AXOBJECTA

再利用可能パーツ AXOBJECTA
Function Options(*DIRECT)
Begin_Com Role(*EXTENDS #PRIM_OBJT)
Attribute Class(#PRIM_ATTR.AX_TYPELIB) Guid('{F86172A5-3FF2-4864-869A-8B1A435C65CA}') TypeLibName('LANSA_AXOBJECTA_LIB')
Attribute Class(#PRIM_ATTR.AX_CLASS) Guid('{4FD69BDC-F4F5-4AB2-8869-9708CA6AE921}') ProgId('LANSA.AXOBJECTA')
Attribute Class(#PRIM_ATTR.AX_IN_INTERFACE) Guid('{BA8C64E0-5654-472F-92DA-255D6DC8B999}') BaseDispId(0)
Attribute Class(#PRIM_ATTR.AX_EVT_INTERFACE) Guid('{AEC6E7D2-D3C9-48B0-8056-C96B7BCE13B5}') BaseDispId(0)
*
Define_Com Class(#prim_lcol<#skilcode>) Name(#SkillsCollection) Help('collection of skills for employee')
DEFINE_COM CLASS(#skilcode) NAME(#tmpSkill) reference(*dynamic)
Define_Com Class(#AXOBJECTB) Name(#AXOBJECTB)
Define_Pty Name(uSkills) Get(*COLLECTION #SkillsCollection)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(0) Name('uSkills')
プロパティメッセージ
DEFINE_PTY NAME(uMessages) GET(*Collection #vMessages) HELP('Message Accessor')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(1) Name('uMessages')
Define_Com Class(#prim_lcol<#STD_TEXTL>) Name(#vMessages)
*Property LastMessage
Define_Pty Name(uLastMessage) Get(*auto #vLastMessage)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(2) Name('uLastMessage')
DEFINE_COM CLASS(#STD_TEXTL) NAME(#vLastMessage) reference(*dynamic)
Property LastStaus
Define_Pty Name(uLastStatus) Get(*auto #vLastStatus)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(3) Name('uLastStatus')
Define_Com Class(#STD_TEXT) Name(#vLastStatus)
*
個人の詳細
Define_Pty Name(uGiveName) Get(*auto #givename) Set(*auto #givename) Help('Given (first) name')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(4) Name('uGiveName')
Define_Pty Name(uSurname) Get(*auto #surname) Set(*auto #surname) Help('Surname')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(5) Name('uSurname')
Address Details
Define_Pty Name(uAddress1) Get(*auto #Address1) Set(*auto #Address1) Help('Number and Street')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(6) Name('uAddress1')
Define_Pty Name(uAddress2) Get(*auto #Address2) Set(*auto #Address2) Help('Suburb')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(7) Name('uAddress2')
Define_Pty Name(uAddress3) Get(*auto #Address3) Set(*auto #Address3) Help('City')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(8) Name('uAddress3')
Define_Pty Name(uPostCode) Get(*auto #PostCode) Set(*auto #PostCode) Help('Postcode')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(9) Name('uPostCode')
連絡先
Define_Pty Name(uBusinessPhone) Get(*auto #PhoneBus) Set(*auto #PhoneBus) Help('Business Phone')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(10) Name('uBusinessPhone')
Define_Pty Name(uHomePhone) Get(*auto #PhoneHme) Set(*auto #PhoneHme) Help('Home phone')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(11) Name('uHomePhone')
その他
Define_Pty Name(uDepartment) Get(*auto #deptment) Set(*auto #deptment) Help('Department Number')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(12) Name('uDepartment')
Define_Pty Name(uSection) Get(*auto #Section) Set(*auto #Section) Help('Section Code')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(13) Name('uSection')
Define_Pty Name(uSalary) Get(*auto #Salary) Set(*auto #Salary) Help('Yearly Salary')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(14) Name('uSalary')
Define_Pty Name(uNumber) Get(*auto #empno) Set(*auto #empno) Help('Number')
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(15) Name('uNumber')
*
Mthroutine Name(uLoadEmployee)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(17) Name('uLoadEmployee')
Define_Map For(*input) Class(#empno) Name(#uEmpno)

Change Field(#EMPNO) To(#uEMPNO)
Fetch Fields(*ALL) From_File(PSLMST) With_Key(#EMPNO)
If_Status Is(*OKAY)
Invoke Method(#com_owner.uLoadSkills) Uempno(#empno)
Endif

Endroutine

Mthroutine Name(uSaveEmployee)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(18) Name('uSaveEmployee')
Define_Map For(*RESULT) Class(#io$sts) Name(#O_STATUS)

UPDATE FIELDS(*ALL *excluding #empno) IN_FILE(PSLMST) WITH_KEY(#EMPNO) IO_ERROR(*NEXT) VAL_ERROR(*NEXT)

Set Com(#O_STATUS) Value(#io$sts)

Execute Subroutine(SETLASTMSG)

Endroutine

Mthroutine Name(uLoadSkills)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(19) Name('uLoadSkills')
Define_Map For(*input) Class(#empno) Name(#UEmpno)

Change Field(#EMPNO) To(#uEMPNO)
Invoke Method(#SkillsCollection.RemoveAll)

Select Fields(#SKILCODE) From_File(PSLSKL) With_Key(#EMPNO)
Set_Ref #tmpskill to(*create_As #skilcode)
Set Com(#tmpSkill) Value(#skilcode)
Invoke Method(#SkillsCollection.Insert) Item(#tmpSkill)
Endselect

Endroutine
SETLMSG が最後のメッセージを保存
*
組み込み関数を使ってメッセージを取得 GET_MESSAGE
*
メッセージは MthRoutine に出入りした後にクリアされるため、
サブルーチン内で起動すること
*
以下は仮のエラーメカニズムで、さらに良い例は後で追加される予定
Subroutine Name(SETLASTMSG)
Define Field(#LASTMSG) Type(*CHAR) Length(80)
Define Field(#RETCODE) Type(*CHAR) Length(2)

Invoke Method(#vMessages.RemoveAll)
Set Com(#vLastStatus) Value(IO$STS)

If_Status Is_Not(*OKAY)
Use Builtin(GET_MESSAGE) To_Get(#RETCODE #LASTMSG)
DoWhile Cond('#RETCODE = OK')
set_Ref #vlastmessage to(*create_as #std_textl)
Set Com(#vLastMessage) Value(#LASTMSG)
Invoke Method(#vMessages.Insert) Item(#vLastMessage)
Use Builtin(GET_MESSAGE) To_Get(#RETCODE #LASTMSG)
Endwhile
Endif

Endroutine

End_Com
ソースコード ActiveX 例 3 - 再利用可能パーツ AXOBJECTB
再利用可能パーツ 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

ソースコード ActiveX 例 3 - Visual Basic - オブジェクト
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
ソースコード ActiveX 例 3 - Visual Basic - コード
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

[ |../../index.htm#lansa/l4wdeva_example3.htm]

ソースコード ActiveX 例 3 - コンポーネントをビジネス オブジェクトとして利用

ソースコード ActiveX 例 3 - コンポーネントをビジネスオブジェクトとして利用