frmselcur.frm

金算盘软件代码

       lstCur(0).RemoveItem (lstCur(0).ListIndex)
       lstCur(0).ListIndex = lstCur(0).ListCount - 1
       RefreshButton
       Exit Sub
    End If
    lstCur(0).list(lstCur(0).ListIndex) = reccur!strCurrencyName
    reccur.Close
End Sub

'增加币种
Private Sub AddListItem()
    Dim strSql As String
    Dim reccur As rdoResultset
    Dim i As Integer
    
    strSql = "SELECT * FROM Currencys WHERE currencys.blnIsInActive=0"
    Set reccur = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not reccur.EOF Then lstCur(0).Clear
    Do Until reccur.EOF
             For i = 0 To lstCur(1).ListCount - 1
                 If reccur!lngCurrencyID = lstCur(1).ItemData(i) Then
                    Exit For
                 End If
             Next
             If i = lstCur(1).ListCount Then
                lstCur(0).AddItem reccur!strCurrencyName
                lstCur(0).ItemData(lstCur(0).NewIndex) = reccur!lngCurrencyID
             End If
             reccur.MoveNext
    Loop
    If lstCur(0).ListCount > 0 Then
       mListIsChanged = True
       lstCur(0).ListIndex = 0
       mListIsChanged = False
    End If
    reccur.Close
End Sub

Private Sub cmdSel_Click(Index As Integer)
    Dim i As Integer
    Dim list As Integer
    
    Select Case Index
    Case 0
        i = lstCur(0).ListIndex
        If i = -1 Then Exit Sub
        lstCur(1).AddItem lstCur(0).list(i)
        lstCur(1).ItemData(lstCur(1).NewIndex) = lstCur(0).ItemData(i)
        lstCur(0).RemoveItem i
        mListIsChanged = True
        lstCur(1).ListIndex = lstCur(1).NewIndex
        mListIsChanged = False
        If lstCur(0).ListCount > 0 Then
           mListIsChanged = True
           lstCur(0).ListIndex = lstCur(0).ListCount - 1
           mListIsChanged = False
        Else
           lstCur(1).SetFocus
        End If
    Case 1
        For i = 0 To lstCur(0).ListCount - 1
            lstCur(1).AddItem lstCur(0).list(i)
            lstCur(1).ItemData(lstCur(1).NewIndex) = lstCur(0).ItemData(i)
        Next
        lstCur(0).Clear
        mListIsChanged = True
        lstCur(1).ListIndex = 0
        mListIsChanged = False
    Case 2
        i = lstCur(1).ListIndex
        If i = -1 Then Exit Sub
        If lstCur(1).ListCount < 1 Then Exit Sub
        If Card.AccountCurrencyIsUsed(mlngAccountID, lstCur(1).ItemData(i)) Then
           cmdSel(2).Enabled = False
           Exit Sub
        End If
        lstCur(0).AddItem lstCur(1).list(i)
        lstCur(0).ItemData(lstCur(0).NewIndex) = lstCur(1).ItemData(i)
        lstCur(1).RemoveItem i
        If lstCur(1).ListCount > 0 Then
            mListIsChanged = True
            lstCur(1).ListIndex = lstCur(1).ListCount - 1
            mListIsChanged = False
        End If
        mListIsChanged = True
        lstCur(0).ListIndex = lstCur(0).NewIndex
        mListIsChanged = False
    Case 3
        list = lstCur(1).ListCount
        For i = (list - 1) To 0 Step -1
            If Not Card.AccountCurrencyIsUsed(mlngAccountID, lstCur(1).ItemData(i)) Then
               lstCur(0).AddItem lstCur(1).list(i)
               lstCur(0).ItemData(lstCur(0).NewIndex) = lstCur(1).ItemData(i)
               lstCur(1).RemoveItem i
            End If
        Next
    End Select
    RefreshButton
End Sub

Private Sub SetCurrencyAll()
    Dim strSql As String
    Dim reccur As rdoResultset
    
    strSql = "SELECT Currencys.* FROM Currencys WHERE " _
                     & " currencys.blnIsInActive=false"
    Set reccur = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Do Until reccur.EOF
       lstCur(1).AddItem reccur!strCurrencyName
       lstCur(1).ItemData(lstCur(1).NewIndex) = reccur!lngCurrencyID
       reccur.MoveNext
    Loop
    If lstCur(1).ListCount > 0 Then
       mListIsChanged = True
       lstCur(1).ListIndex = 0
       mListIsChanged = False
    End If
    reccur.Close
End Sub
Private Sub SetRMB()
    Dim i As Integer
    Dim intCount As Integer
    
    intCount = 0
    If lstCur(0).ListCount = 0 Then Exit Sub
    For i = 0 To lstCur(0).ListCount - 1
        If lstCur(0).ItemData(i) = 1 Then
           intCount = 1
           Exit For
        End If
    Next
    If intCount = 0 Then Exit Sub
    If Card.AccountCurrencyIsUsed(mlngAccountID, lstCur(0).ItemData(i)) Then
       lstCur(1).AddItem lstCur(0).list(i), 0
       lstCur(1).ItemData(lstCur(1).NewIndex) = 1
       lstCur(0).RemoveItem (i)
    End If
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOK(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    
    On Error GoTo ErrHandle
'    SetHelpID Me.hwnd, 30055
    Utility.LoadFormResPicture Me
    If frmSelCur.AccountListCardIsUsed = True Then
'       If frmAccountListCard.mblnSelCur = True Then
'          InitListFirst
'       Else
'          InitListSecond
'       End If
    Else
       If frmAccountCard.mblnSelCur = True Then
          InitListFirst
       Else
          InitListSecond
       End If
    End If

    lblAccount(2).Caption = lblAccount(2).Caption & mstrAccountCodeName
    SetRMB
    RefreshButton
    If lstCur(0).ListCount = 0 Then
'       lstCur(1).SetFocus
       lstCur(1).ListIndex = 0
    Else
'       lstCur(0).SetFocus
       lstCur(0).ListIndex = 0
    End If
    Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub
Private Sub InitListFirst()
    Dim i As Integer
    
    For i = 0 To UBound(arrcurid)
        lstCur(1).AddItem marrSelList(i)
        lstCur(1).ItemData(lstCur(1).NewIndex) = arrcurid(i)
    Next
    If lstCur(1).ListCount > 0 Then
       mListIsChanged = True
       lstCur(1).ListIndex = 0
       mListIsChanged = False
    End If
    If UBound(arrUncurid) >= 0 Then
       For i = 0 To UBound(arrUncurid)
           If marrUnSelList(i) <> "" Then
              lstCur(0).AddItem marrUnSelList(i)
              lstCur(0).ItemData(lstCur(0).NewIndex) = marrUnSelCur(i)
           End If
       Next
       If lstCur(0).ListCount > 0 Then
          mListIsChanged = True
          lstCur(0).ListIndex = 0
          mListIsChanged = False
       End If
    End If
End Sub

Private Sub InitListSecond()
        Dim strSql As String
        Dim recAcntCur As rdoResultset
        Dim reccur As rdoResultset
     
       strSql = "SELECT Currencys.* FROM Currencys,AccountCurrency WHERE " _
               & "Currencys.lngCurrencyID=AccountCurrency.lngCurrencyID AND " _
               & "AccountCurrency.lngAccountID=" & mlngAccountID
       Set recAcntCur = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
           
       Do Until recAcntCur.EOF
          lstCur(1).AddItem recAcntCur!strCurrencyName
          lstCur(1).ItemData(lstCur(1).NewIndex) = recAcntCur!lngCurrencyID
          recAcntCur.MoveNext
       Loop
             
       strSql = "SELECT Currencys.* FROM Currencys WHERE lngCurrencyID NOT IN " _
             & "(SELECT lngCurrencyID FROM AccountCurrency WHERE " _
             & "AccountCurrency.lngAccountID=" & mlngAccountID & ")" _
             & " and Currencys.blnIsInActive=0"
       Set reccur = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
       Do Until reccur.EOF
          lstCur(0).AddItem reccur!strCurrencyName
          lstCur(0).ItemData(lstCur(0).NewIndex) = reccur!lngCurrencyID
          reccur.MoveNext
       Loop
       If lstCur(0).ListCount > 0 Then
          mListIsChanged = True
          lstCur(0).ListIndex = 0
          mListIsChanged = False
       End If
       reccur.Close
       If lstCur(1).ListCount > 0 Then
          mListIsChanged = True
          lstCur(1).ListIndex = 0
          mListIsChanged = False
       End If
       recAcntCur.Close
End Sub

Private Sub RefreshButton()
    If mListIsChanged = True Then Exit Sub
    If lstCur(0).ListCount = 0 Then
        cmdSel(1).Enabled = False
    Else
        cmdSel(1).Enabled = True
    End If
    If lstCur(0).ListIndex = -1 Then
        cmdSel(0).Enabled = False
        cmdOK(3).Enabled = False
        cmdOK(4).Enabled = False
    Else
        cmdSel(0).Enabled = True
        cmdOK(3).Enabled = True
        cmdOK(4).Enabled = True
    End If
   
    If lstCur(1).ListCount < 1 Or intCount() < 1 Then
        cmdSel(3).Enabled = False
    Else
        cmdSel(3).Enabled = True
    End If
    If lstCur(1).ListIndex < 0 Then
        cmdSel(2).Enabled = False
    ElseIf Card.AccountCurrencyIsUsed(mlngAccountID, lstCur(1).ItemData(lstCur(1).ListIndex)) Then
        cmdSel(2).Enabled = False
    Else
        cmdSel(2).Enabled = True
    End If
End Sub
Private Function intCount() As Integer
    Dim i As Integer
    Dim list As Integer
    
    intCount = 0
    list = lstCur(1).ListCount
    For i = (list - 1) To 0 Step -1
        If Not Card.AccountCurrencyIsUsed(mlngAccountID, lstCur(1).ItemData(i)) Then
           intCount = 1
           Exit Function
        End If
    Next
End Function

Private Sub Form_Paint()
    FrameBox hwnd, 90, 470, 4455, 2275 + 450
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.UnLoadFormResPicture Me
    frmSelCur.AccountListCardIsUsed = False
    blnIsAll = False
End Sub

Private Sub lstCur_Click(Index As Integer)
    RefreshButton
End Sub

Private Sub lstCur_DblClick(Index As Integer)
    If Index = 0 Then
        cmdSel_Click 0
    Else
        cmdSel_Click 2
    End If
End Sub

Public Property Get AccountListCardIsUsed() As Variant
    AccountListCardIsUsed = mListCardIsUsed
End Property

Public Property Let AccountListCardIsUsed(ByVal vNewValue As Variant)
       mListCardIsUsed = vNewValue
End Property

Public Property Get blnIsAll() As Boolean
       blnIsAll = mblnIsAll
End Property

Public Property Let blnIsAll(ByVal vNewValue As Boolean)
       mblnIsAll = vNewValue
End Property