frmselcur.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmSelCur 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "选择核算币种"
   ClientHeight    =   3240
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5865
   HelpContextID   =   30055
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3240
   ScaleWidth      =   5865
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdok 
      Caption         =   "删除币种(&D)"
      Height          =   315
      Index           =   4
      Left            =   2760
      TabIndex        =   13
      Top             =   2850
      Width           =   1155
   End
   Begin VB.CommandButton cmdok 
      Caption         =   "修改币种(&E)"
      Height          =   315
      Index           =   3
      Left            =   1425
      TabIndex        =   12
      Top             =   2850
      Width           =   1155
   End
   Begin VB.CommandButton cmdok 
      Caption         =   "新增币种(&N)"
      Height          =   315
      Index           =   2
      Left            =   90
      TabIndex        =   11
      Top             =   2850
      Width           =   1155
   End
   Begin VB.CommandButton cmdSel 
      Caption         =   "<<"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   336
      Index           =   3
      Left            =   1980
      MaskColor       =   &H00000000&
      TabIndex        =   5
      Top             =   2100
      UseMaskColor    =   -1  'True
      Width           =   576
   End
   Begin VB.CommandButton cmdSel 
      Caption         =   "<"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   336
      Index           =   2
      Left            =   1980
      MaskColor       =   &H00000000&
      TabIndex        =   4
      Top             =   1725
      UseMaskColor    =   -1  'True
      Width           =   576
   End
   Begin VB.CommandButton cmdSel 
      Caption         =   ">>"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   336
      Index           =   1
      Left            =   1980
      MaskColor       =   &H00000000&
      TabIndex        =   3
      Top             =   1350
      UseMaskColor    =   -1  'True
      Width           =   576
   End
   Begin VB.CommandButton cmdSel 
      Caption         =   ">"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   336
      Index           =   0
      Left            =   1980
      MaskColor       =   &H00000000&
      TabIndex        =   2
      Top             =   975
      UseMaskColor    =   -1  'True
      Width           =   576
   End
   Begin VB.ListBox lstCur 
      Height          =   1860
      Index           =   1
      Left            =   2730
      TabIndex        =   7
      Top             =   750
      Width           =   1620
   End
   Begin VB.ListBox lstCur 
      Height          =   1860
      Index           =   0
      Left            =   180
      TabIndex        =   1
      Top             =   750
      Width           =   1620
   End
   Begin VB.CommandButton cmdok 
      Cancel          =   -1  'True
      Height          =   315
      Index           =   1
      Left            =   4590
      Style           =   1  'Graphical
      TabIndex        =   9
      Tag             =   "1002"
      Top             =   885
      UseMaskColor    =   -1  'True
      Width           =   1155
   End
   Begin VB.CommandButton cmdok 
      Height          =   315
      Index           =   0
      Left            =   4590
      Style           =   1  'Graphical
      TabIndex        =   8
      Tag             =   "1001"
      Top             =   450
      UseMaskColor    =   -1  'True
      Width           =   1155
   End
   Begin VB.Label lblAccount 
      AutoSize        =   -1  'True
      Caption         =   "会计科目:"
      Height          =   180
      Index           =   2
      Left            =   150
      TabIndex        =   10
      Top             =   90
      Width           =   810
   End
   Begin VB.Label lblAccount 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      Caption         =   "已选栏目(&T)"
      Height          =   180
      Index           =   1
      Left            =   2820
      TabIndex        =   6
      Tag             =   "2407"
      Top             =   420
      Width           =   990
   End
   Begin VB.Label lblAccount 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      Caption         =   "可选栏目(&S)"
      Height          =   180
      Index           =   0
      Left            =   180
      TabIndex        =   0
      Tag             =   "2406"
      Top             =   420
      Width           =   990
   End
End
Attribute VB_Name = "frmSelCur"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''
'设置核算币种窗体
'
'作者:苏涛
'
'日期:1998.6.23
'
'接口：引入：科目卡片窗体的AccountID,AccountCodeName
'
''''''''''''''''''''''''''''''''''''''

Option Explicit
Option Compare Text

'Private WithEvents mclsMainControl As MainControl
Public mlngAccountID As Long
Public mstrAccountCodeName As String
Private marrSelCur() As Long        '已选科目币种ID
Private marrUnSelCur() As Long      '可选科目币种ID
Private marrSelList() As String     '已选科目币种名称
Private marrUnSelList() As String   '可选科目币种名称
Private mListIsChanged As Boolean
Private mListCardIsUsed As Boolean
Private mCurrencyName As String
Private mblnIsAll As Boolean

Public Property Let CurrencyName(ByVal vNewValue As String)
    mCurrencyName = vNewValue
End Property
'
Public Property Get arrcurid() As Variant
    arrcurid = marrSelCur
End Property

Public Property Let arrcurid(ByVal vNewValue As Variant)
    marrSelCur = vNewValue
End Property

Public Property Let arrcurCode(ByVal vNewValue As Variant)
    marrSelList = vNewValue
End Property

Public Property Get arrUncurid() As Variant
    arrUncurid = marrUnSelCur
End Property

Public Property Let arrUncurid(ByVal vNewValue As Variant)
    marrUnSelCur = vNewValue
End Property

Public Property Let arrUncurCode(ByVal vNewValue As Variant)
    marrUnSelList = vNewValue
End Property

'
Private Sub cmdOK_Click(Index As Integer)
    Dim i As Integer
    
    Select Case Index
           Case 0
                If lstCur(1).ListCount > 0 Then
                   ReDim marrSelCur(0 To lstCur(1).ListCount - 1)
                   ReDim marrSelList(0 To lstCur(1).ListCount - 1)
                   
                   For i = 0 To lstCur(1).ListCount - 1
                       marrSelCur(i) = lstCur(1).ItemData(i)
                       marrSelList(i) = lstCur(1).list(i)
                   Next i
                Else
                   ShowMsg Me.hwnd, "已选币种中必须有一个币种！", vbExclamation + MB_TASKMODAL, Me.Caption
                   lstCur(0).SetFocus
                   Exit Sub
'                   ReDim marrSelCur(0)
'                   ReDim marrSelList(0)
'
'                   marrSelCur(0) = 0
'                   marrSelList(0) = ""
                End If
                
                If lstCur(0).ListCount > 0 Then
                   ReDim marrUnSelCur(0 To lstCur(0).ListCount - 1)
                   ReDim marrUnSelList(0 To lstCur(0).ListCount - 1)
                   
                   For i = 0 To lstCur(0).ListCount - 1
                       marrUnSelCur(i) = lstCur(0).ItemData(i)
                       marrUnSelList(i) = lstCur(0).list(i)
                   Next i
                 Else
                   ReDim marrUnSelCur(0)
                   ReDim marrUnSelList(0)
                   
                   marrUnSelCur(0) = 0
                   marrUnSelList(0) = ""
                End If
                If frmSelCur.AccountListCardIsUsed = True Then
'                   frmAccountListCard.mblnSelCur = True
                Else
                   frmAccountCard.mblnSelCur = True
                End If
                frmSelCur.AccountListCardIsUsed = False
                Unload Me
           Case 1
                frmSelCur.AccountListCardIsUsed = False
                Unload Me
           Case 2
                frmCurrencyCard.AddCard mCurrencyName, vbModal
                AddListItem
                RefreshButton
           Case 3
                If lstCur(0).ListIndex = -1 Then
                   Exit Sub
                Else
                   frmCurrencyCard.EditCard lstCur(0).ItemData(lstCur(0).ListIndex), vbModal
                   EditListItem
                End If
           Case 4
                If lstCur(0).ListIndex = -1 Then
                   Exit Sub
                Else
                   If frmCurrencyCard.DelCard(lstCur(0).ItemData(lstCur(0).ListIndex), frmSelCur.hwnd) Then
                      lstCur(0).RemoveItem (lstCur(0).ListIndex)
                      lstCur(0).ListIndex = lstCur(0).ListCount - 1
                      RefreshButton
                   Else
                      Exit Sub
                   End If
                End If
    End Select
    
End Sub


'修改币种
Private Sub EditListItem()
    Dim i As Integer
    Dim strSql As String
    Dim reccur As rdoResultset
    
    strSql = "select strCurrencyName,blnIsInActive from Currencys where lngCurrencyID=" & lstCur(0).ItemData(lstCur(0).ListIndex)
    Set reccur = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic)
    If reccur.EOF Then Exit Sub
    If reccur!blnIsInActive Then