frmfixedmethodcard.frm

金算盘软件代码

    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 Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer

    If UnloadMode = vbFormControlMenu Then
       If mblnIsChanged = True Then
          intMsgReturn = ShowMsg(0, "当前固资变动方式已被修改，是否保存？", _
                 vbQuestion + vbYesNoCancel + MB_TASKMODAL, Me.Caption)
          If intMsgReturn = vbYes Then
             Cancel = Not SaveCard(True)
          ElseIf intMsgReturn = vbCancel Then
             Cancel = True
          End If
       End If
    End If
    If Not Cancel Then mblnIsChanged = False

End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    
    Utility.UnLoadFormResPicture Me
    gclsSys.CurrFormName = ""
    mblnIsCancel = False
    
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 90, 90, 4395, 3285 '画边框
    FrameBox Me.hwnd, 240, 2490, 4185, 3105
End Sub

Private Sub lstMethod_AddNew(Index As Integer)
    Dim lngID As Long
    mblnIsEditAdd = True
    Select Case Index
        Case 0
          lngID = Card.AddCard(Message.msgAccount) ', mstrListTextBuffer(Index))
        Case 1
          lngID = Card.AddCard(msgTemplate, , , 41, , , 0, False)
        Case 2
          lngID = Card.AddCard(Message.msgVoucherType) ', mstrListTextBuffer(Index))
        Case 3
          lngID = Card.AddCard(Message.msgRemark) ', mstrListTextBuffer(Index))
    End Select
    If lngID <> 0 Then mlngListIDBuffer(Index) = lngID
    settlistbox lstMethod(Index), Index
    lstMethod(Index).SeekId mlngListIDBuffer(Index)
    If Index = 2 Then SetTemplate
End Sub

Private Sub lstMethod_Change(Index As Integer)
    If Index = 3 Then
        If ContainErrorChar(lstMethod(3).Text, "'|") Then
           BKKEY lstMethod(3).hwnd
        End If
        mtext = lstMethod(3).Text
    End If
End Sub

Private Sub lstMethod_Delete(Index As Integer)
    Dim blnDel As Boolean
    
    Select Case Index
        Case 0
            blnDel = Card.DelCard(Message.msgAccount, mlngListIDBuffer(Index))
        Case 1
            blnDel = Card.DelCard(Message.msgTemplate, mlngListIDBuffer(Index))
        Case 2
            blnDel = Card.DelCard(Message.msgVoucherType, mlngListIDBuffer(Index))
        Case 3
            If lstMethod(3).ID <> 0 Then
               blnDel = Card.DelCard(Message.msgRemark, mlngListIDBuffer(Index))
            Else
               lstMethod(3).Text = mtext
               Exit Sub
            End If
    End Select
    If blnDel = True Then
        mlngListIDBuffer(Index) = 0
        If Index = 2 Then
            mlngListIDBuffer(1) = 0
            lstMethod(1).Text = ""
        End If
        settlistbox lstMethod(Index), Index
    Else
       lstMethod(Index).SeekId mlngListIDBuffer(Index)
    End If
End Sub

Private Sub lstMethod_Edit(Index As Integer)
     mblnIsEditAdd = True
     lstMethod(Index).SeekId mlngListIDBuffer(Index)
     If Index <> 3 Then
        If mlngListIDBuffer(Index) = 0 Then
           lstMethod(Index).Text = ""
           ShowMsg 0, "当前没有记录，不能修改！", vbExclamation + MB_TASKMODAL, Me.Caption
           lstMethod(Index).SetFocus
           Exit Sub
        End If
     End If
     Select Case Index
        Case 0
            Card.EditCard Message.msgAccount, mlngListIDBuffer(Index)
        Case 1
'            Me.Hide
            Card.EditCard Message.msgTemplate, mlngListIDBuffer(Index), , 41, False
'            Me.Show vbModal
        Case 2
            Card.EditCard Message.msgVoucherType, mlngListIDBuffer(Index)
        Case 3
            If lstMethod(3).ID <> 0 Then
               Card.EditCard Message.msgRemark, mlngListIDBuffer(Index)
            Else
               lstMethod(3).Text = mtext
               Exit Sub
            End If
     End Select
     settlistbox lstMethod(Index), Index
     lstMethod(Index).SeekId mlngListIDBuffer(Index)
     If Index = 2 Then SetTemplate
End Sub

'当第一次进入列表框时，设置它的选项
Private Sub lstMethod_GotFocus(Index As Integer)
'  cmdOkCancel(0).Default = False
'  cmdOkCancel(2).Default = False
'  If Index = 3 Then
'     Exit Sub
  If lstMethod(Index).Referrows <= 1 Then
       settlistbox lstMethod(Index), Index
  End If
End Sub

'设置列表框选项
Private Sub settlistbox(lstSetting As ListText, Index As Integer, Optional lngSeekID As Long = 0)
    Dim strSql As String

    With mfmrFixedMethod
        Select Case Index
            Case 0
                setlistbox lstSetting, 0  ', .lngAccountID
'                lstSetting.SeekCol = "1,2,3"
            Case 1
                setlistbox lstSetting, 12, lngSeekID, , mlngTemplateID    ', .lngTemplateID
'                lstSetting.SeekCol = "1,2"
            Case 2
                setlistbox lstSetting, 13  ', .lngVoucherTypeID
'                lstSetting.SeekCol = "1,2,3"
            Case 3
                setlistbox lstSetting, 14
'                lstSetting.SeekCol = "1,2,3"
               ' lstMethod(3).Text = .strRemark
        End Select
    End With
End Sub

Private Sub InputAgain()
    txtInput(0).SelStart = 0
    txtInput(0).SelLength = StrLen(txtInput(0).Text)
    txtInput(0).SetFocus
End Sub

'根据列表框选择结果来调用卡片或存储调用卡片的参数
Private Sub lstMethod_Choose(Index As Integer)
    
    If mlngListIDBuffer(Index) <> lstMethod(Index).ID Then
       mlngListIDBuffer(Index) = lstMethod(Index).ID
       If Index = 2 Then SetTemplate
    End If
End Sub

Private Sub SetTemplate()
    Dim lngSeekID As Long, recVT As rdoResultset, strSql As String
    
    If mlngListIDBuffer(2) = 0 Then Exit Sub
    strSql = "SELECT strVoucherFormat FROM VoucherType WHERE lngVoucherTypeID=" _
         & mlngListIDBuffer(2)
    Set recVT = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recVT.EOF Then
        Select Case Format(recVT("strVoucherFormat"), "@;0")
        Case "0"
             mlngTemplateID = 41
             lngSeekID = 16
         Case "1"
             mlngTemplateID = 54
             lngSeekID = 178
         Case "2"
             mlngTemplateID = 55
             lngSeekID = 176
         End Select
    End If
     recVT.Close
    settlistbox lstMethod(1), 1, lngSeekID
End Sub

'根据列表框输入信息来调用卡片
Private Sub lstMethod_ItemNotExist(Index As Integer)
    Dim intMsgReturn As Integer
    Dim strSql As String
    Dim blnSQLExec As Boolean

    If mblnIsCancel = True Then Exit Sub
    mblnIsExist = True
    Select Case Index
        Case 0
            intMsgReturn = frmMsgAdd.MsgAddShow("对应科目不存在", "科目列表中没有“" _
                & lstMethod(Index).Text & "”！")
        Case 1
             intMsgReturn = frmMsgAdd.MsgAddShow("凭证模版不存在", "凭证模版列表中没有“" _
                & lstMethod(Index).Text & "”！")
        Case 2
            intMsgReturn = frmMsgAdd.MsgAddShow("凭证类型不存在", "凭证类型列表中没有“" _
                & lstMethod(Index).Text & "”！")
        Case 3
            
            'intMsgReturn = frmMsgAdd.MsgAddShow("凭证摘要不存在", "摘要列表中没有“" _
                & lstMethod(Index).Text & "”！")
    End Select
    Select Case intMsgReturn
        Case vbOK
            mstrListTextBuffer(Index) = lstMethod(Index).Text
            Select Case Index
                Case 0
                    mlngListIDBuffer(Index) = Card.AddCard(Message.msgAccount, mstrListTextBuffer(Index))
                Case 1
'                   Me.Hide
                   mlngListIDBuffer(Index) = Card.AddCard(msgTemplate, mstrListTextBuffer(Index), , 41, , , 0, False)
                   'mlngListIDBuffer(Index) = FrmNewTemplate.AddCard(mstrListTextBuffer(Index), vbModal, 17, 41, 0)
'                   Me.Show vbModal
                Case 2
                   mlngListIDBuffer(Index) = Card.AddCard(Message.msgVoucherType, mstrListTextBuffer(Index))
                Case 3
                   mlngListIDBuffer(Index) = Card.AddCard(Message.msgRemark, mstrListTextBuffer(Index))
            End Select
            settlistbox lstMethod(Index), Index
            lstMethod(Index).SeekId mlngListIDBuffer(Index)
            'lstMethod(Index).Text = mstrListTextBuffer(Index)
        Case vbCancel
            lstMethod(Index).SelStart = 0
            lstMethod(Index).SelLength = StrLen(lstMethod(Index).Text)
            lstMethod(Index).SetFocus
    End Select
    mblnIsExist = False
End Sub

Private Sub lstMethod_LostFocus(Index As Integer)
    Dim lngID As Long
    Dim strSql As String
    Dim recAccount As rdoResultset
    
    If Index = 0 Then
       If mblnIsEditAdd = False Then
          lngID = lstMethod(0).ID 'TextMatrix(lstMethod(0).ReferRow, 1)
          If lngID > 0 Then
             strSql = "select * from Account where lngAccountID=" & lngID & " and blnIsDetail=1"
             Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
             If recAccount.EOF Then
                ShowMsg 0, "“" & lstMethod(0).Text & "“会计科目不是末级科目，请重新选择会计科目！", _
                       vbExclamation + MB_TASKMODAL, Me.Caption
                lstMethod(0).SelStart = 0
                lstMethod(0).SelLength = StrLen(lstMethod(0).Text)
                lstMethod(0).SetFocus
                Exit Sub
             End If
          End If
       End If
    End If
    mblnIsEditAdd = False
    mblnIsChanged = True
'    If mblnAddRecord Then
'       cmdOkCancel(2).Default = True
'    Else
'       cmdOkCancel(0).Default = True
'    End If
End Sub

Private Sub optType_Click(Index As Integer)
    mblnIsChanged = True
End Sub

Private Sub txtInput_Change(Index As Integer)
    If ContainErrorChar(txtInput(Index).Text, "'|") Then
       BKKEY txtInput(Index).hwnd
       Exit Sub
    End If
End Sub

Private Sub txtInput_LostFocus(Index As Integer)
   
'    Dim intMsgReturn As Integer
'
'    If txtInput(Index).Text <> "" Then
'        If ContainErrorChar(txtInput(Index).Text) Then
'            intMsgReturn = ShowMsg(0, "输入非法字符。", _
'                vbExclamation + MB_TASKMODAL, Me.Caption)
'            txtInput(Index).SelStart = 0
'            txtInput(Index).SelLength = strLen(txtInput(Index).Text)
'            txtInput(Index).SetFocus
'        End If