2.28.2.20 ソースコード ActiveX 例 1 - フォームの表示

準備作業」で説明されている、セッション設定ファイル (Session.cfg) を作成、挿入します。

case1

ソースコード ActiveX 例 1 - Visual LANSA のソース

  

Function Options(*DIRECT)
BEGIN_COM ROLE(*EXTENDS #PRIM_FORM) BORDERICONS(SystemMenu) CAPTION('Employee Details (LANSA)') CLIENTHEIGHT(144) CLIENTWIDTH(376) HEIGHT(171) LAYOUTMANAGER(#FWLM_1) LEFT(254) TOP(472) WIDTH(384)
Attribute Class(#PRIM_ATTR.AX_TYPELIB) Guid('{385B3936-74A3-4700-AA82-D7D9BEE8EA46}') TypeLibName('LANSA_AXFORMA_LIB')
Attribute Class(#PRIM_ATTR.AX_CLASS) Guid('{BB00E891-AA66-4DAA-ACC8-7B026B934A78}') ProgId('LANSA.AXFORMA')
Attribute Class(#PRIM_ATTR.AX_IN_INTERFACE)  Guid('{503CD2F3-340E-48B0-867B-D10667D1E57A}') BaseDispId(0)
Attribute Class(#PRIM_ATTR.AX_EVT_INTERFACE)  Guid('{22D638D0-B9E0-4FAE-99E3-EA39F884EC97}') BaseDispId(0)
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_1) DIRECTION(TopToBottom) MARGINBOTTOM(10) MARGINLEFT(10) MARGINRIGHT(10) MARGINTOP(10)
DEFINE_COM CLASS(#EMPNO.Visual) NAME(#EMPNO) DISPLAYPOSITION(1) ENABLED(False) HEIGHT(19) LEFT(10) PARENT(#COM_OWNER) READONLY(True) TABPOSITION(1) TOP(10) USEPICKLIST(False) WIDTH(209)
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_1) MANAGE(#EMPNO) PARENT(#FWLM_1)
DEFINE_COM CLASS(#SURNAME.Visual) NAME(#SURNAME) DISPLAYPOSITION(3) HEIGHT(19) LEFT(10) PARENT(#COM_OWNER) TABPOSITION(2) TOP(68) USEPICKLIST(False) WIDTH(324)
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_2) MANAGE(#SURNAME) PARENT(#FWLM_1)
DEFINE_COM CLASS(#GIVENAME.Visual) NAME(#GIVENAME) DISPLAYPOSITION(2) HEIGHT(19) LEFT(10) PARENT(#COM_OWNER) TABPOSITION(3) TOP(39) USEPICKLIST(False) WIDTH(324)
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_3) MANAGE(#GIVENAME) PARENT(#FWLM_1)
DEFINE_COM CLASS(#SALARY.Visual) NAME(#SALARY) DISPLAYPOSITION(4) HEIGHT(19) LEFT(10) PARENT(#COM_OWNER) TABPOSITION(4) TOP(97) USEPICKLIST(False) WIDTH(278)
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_4) MANAGE(#SALARY) PARENT(#FWLM_1)

Define_Evt Name(uEmployeeFound)
Attribute Class(#PRIM_ATTR.AX_EVT_MEMBER) Dispid(0) Name('uEmployeeFound')
Define_Map For(*input) Class(#io$sts) Name(#uResult)
Define_Pty Name(uEmployeeGiveName) Get(*auto #givename) Set(*auto #givename)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(0) Name('uEmployeeGiveName')
Define_Pty Name(uEmployeeSurname) Get(*auto #surname)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(1) Name('uEmployeeSurname')
Define_Pty Name(uEmployeeSalary) Get(*auto #salary) Set(*auto #salary)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(2) Name('uEmployeeSalary')

Mthroutine Name(uShowEmployee)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(3) Name('uShowEmployee')
Define_Map For(*input) Class(#empno) Name(#i_empno)

Change Field(#EMPNO) To(#I_EMPNO)
Fetch Fields(#SURNAME #GIVENAME #SALARY) From_File(PSLMST) With_Key(#EMPNO)
Signal Event(uEmployeeFound) Uresult(#io$sts)

Endroutine

Mthroutine Name(uClose)
Attribute Class(#PRIM_ATTR.AX_IN_MEMBER) Dispid(4) Name('uClose')
Invoke Method(#COM_OWNER.CloseForm)
Endroutine

End_Com

 

ソースコード ActiveX 例 1 - Visual Basic - オブジェクト

 


VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Case 1 - VB"
   ClientHeight    =   4425
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5835
   LinkTopic       =   "Form1"
   ScaleHeight     =   4425
   ScaleWidth      =   5835
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdClose 
      Caption         =   "Close Visual LANSA"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4320
      TabIndex        =   10
      Top             =   3480
      Width           =   1095
   End
   Begin VB.CommandButton cmdUpdate 
      Caption         =   "Update"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4320
      TabIndex        =   9
      Top             =   2760
      Width           =   1095
   End
   Begin VB.Frame frmEmployeeDetails 
      Caption         =   "Employee Details"
      Height          =   2295
      Left            =   120
      TabIndex        =   3
      Top             =   1680
      Width           =   3975
      Begin VB.TextBox UemployeeSalary 
         BeginProperty DataFormat 
            Type            =   1
            Format          =   "0"
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   3081
            SubFormatType   =   1
         EndProperty
         Height          =   350
         Left            =   1680
         TabIndex        =   6
         Text            =   "Salary"
         Top             =   1560
         Width           =   1215
      End
      Begin VB.TextBox UemployeeGiveName 
         Height          =   350
         Left            =   1680
         TabIndex        =   5
         Text            =   "Give Name"
         Top             =   360
         Width           =   1815
      End
      Begin VB.TextBox UemployeeSurname 
         Height          =   345
         Left            =   1680
         TabIndex        =   4
         Text            =   "Surname"
         Top             =   960
         Width           =   1815
      End
      Begin VB.Label lblSalary 
         Caption         =   "Salary:"
         Height          =   345
         Left            =   240
         TabIndex        =   8
         Top             =   1560
         Width           =   855
      End
      Begin VB.Label LblName 
         Caption         =   "Name:"
         Height          =   345
         Left            =   240
         TabIndex        =   7
         Top             =   360
         Width           =   855
      End
   End
   Begin VB.TextBox uEmployeeNumber 
      Height          =   350
      Left            =   1920
      TabIndex        =   1
      Text            =   "A1012"
      Top             =   1080
      Width           =   735
   End
   Begin VB.CommandButton cmdShowEmployee 
      Caption         =   "Show"
      Default         =   -1  'True
      Height          =   350
      Left            =   4320
      TabIndex        =   0
      ToolTipText     =   "Invoke Visual LANSA method to retrieve employee details"
      Top             =   2040
      Width           =   1095
   End
   Begin VB.Label lblexplanation 
      Caption         =   "Demonstrates the essentials of how to expose properties, events and methods"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   11
      Top             =   240
      Width           =   5295
   End
   Begin VB.Label LblEmployee 
      Caption         =   "Employee Number:"
      Height          =   345
      Left            =   360
      TabIndex        =   2
      Top             =   1080
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

 

ソースコード ActiveX 例 1 - Visual Basic - コード

 

Option Explicit
Public Session    As LANSA_ACTIVEX_LIB.Session

Private Sub AXFORMA_uEmployeeFound(ByVal uResult As String)
On Error GoTo ErrorHandler

If uResult = "OK" Then
    cmdUpdate.Enabled = True
    cmdClose.Enabled = True
    UemployeeGiveName = AXFORMA.UemployeeGiveName
    UemployeeSurname = AXFORMA.UemployeeSurname
    UemployeeSalary = AXFORMA.UemployeeSalary
    Call AXFORMA.ShowForm
Else
    UemployeeGiveName = "Not Found"
    UemployeeSurname = "Not Found"
    UemployeeSalary = 0
End If

Exit Sub      ' Exit to avoid handler.
ErrorHandler:' Error-handling routine.
    MsgBox ("Error :"+ Err.Description)
End Sub

Private Sub cmdClose_Click()

Call AXFORMA.uClose
' Unload AXFORMA

End Sub

Private Sub cmdShowEmployee_Click()
On Error GoTo ErrorHandler

' pass the employee number to the vl component method.
    Call AXFORMA.uShowEmployee(uEmployeeNumber)
    
Exit Sub      ' Exit to avoid handler.
ErrorHandler:' Error-handling routine.
    MsgBox ("Error :"+ Err.Description)
End Sub


Private Sub cmdUpdate_Click()

AXFORMA.UemployeeGiveName = UemployeeGiveName
' notice surname has been set as readonly in the Visual LANSA component
' AXFORMA.UemployeeSurname = UemployeeSurname
If UemployeeSalary = "" Then UemployeeSalary = 0
AXFORMA.UemployeeSalary = UemployeeSalary

End Sub

Private Sub Form_Load()
On Error GoTo ErrorHandler

' 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
' now add your component to the current session
    Call Session.AddComponent(AXFORMA.object)
            
Exit Sub      ' Exit to avoid handler.
ErrorHandler:' Error-handling routine.
    MsgBox ("Error :"+ Err.Description)
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

Private Sub Form_Unload(Cancel As Integer)

    Set Session = Nothing

End Sub