frmaccountlistcard.frm

金算盘软件代码

            chkSuit.Enabled = True
            For i = 1 To 5
                chkAid(i).Enabled = True
            Next i
            Label1(2).Enabled = True
        ElseIf intAcn = 5 Then
            optCheck(0).Value = True
            optCheck(0).Enabled = False
            optCheck(1).Enabled = False
            optCheck(2).Enabled = False
            chkSuit.Value = 0
            chkSuit.Enabled = False
            Frame1.Enabled = False
            For i = 0 To 5
                chkAid(i).Value = 0
                chkAid(i).Enabled = False
            Next i
            Label1(2).Enabled = False
            chkQuantity.Value = 0
            chkQuantity.Enabled = False
        Else
            Frame1.Enabled = True
            For i = 0 To 2
                optCheck(i).Enabled = True
'                optCheck(i).Value = False
            Next
'            optCheck(0).Value = True
            chkSuit.Enabled = False
            
            For i = 0 To 5
                chkAid(i).Enabled = True
                chkAid(i).Value = 0
            Next i
            Label1(2).Enabled = True
            'chkAid(0).Value = 0
            chkQuantity.Enabled = True
            chkQuantity.Value = 0
        End If
        If chkQuantity.Value = 1 Then
           txtAccount(2).Enabled = True
           txtAccount(2).BackColor = &H80000005
        Else
           txtAccount(2).Text = ""
           txtAccount(2).Enabled = False
           txtAccount(2).BackColor = &H80000004
        End If
        If chkQuantity.Enabled = True Then
           Label1(5).Enabled = True
        Else
           Label1(5).Enabled = False
        End If
        If optCheck(0).Value = True Then
           chkSuit.Enabled = False
        Else
           chkSuit.Enabled = True
        End If
    End If
End Sub

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

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

Private Sub chkQuantity_Click()
    
    If chkQuantity.Value = 1 Then
        txtAccount(2).Enabled = True
        txtAccount(2).BackColor = &H80000005
        Label5.Enabled = True
    Else
        txtAccount(2).Text = ""
        txtAccount(2).Enabled = False
        txtAccount(2).BackColor = &H80000004
        Label5.Enabled = False
    End If
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub chkStop_Click()
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub chkSuit_Click()
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub cmdOK_Click(Index As Integer)
    Dim strCode As String
    
    Select Case Index
    Case 0
        If SaveCard Then Unload Me
    Case 1
        Unload Me
    Case 2
        If SaveCard Then
            mblnIsChanged = False
            strCode = Trim(txtAccount(0).Text)
'            mlngAccountID = 0
            mblnIsNew = True
            InitCard cboAccount(0).ItemData(cboAccount(0).ListIndex)
            txtAccount(0).Text = GetNextCode(strCode)
            txtAccount(0).SetFocus
            txtAccount(0).SelStart = 0
            txtAccount(0).SelLength = Len(txtAccount(0).Text)
        End If
    End Select
        
End Sub

Private Sub SetForm()
    Label1(1).top = 504
    Label1(2).Left = 240
    Label1(2).top = 3060
    Label1(3).Left = 240
    Label1(3).top = 1890
    Label2.top = 960
    Label4.top = 1380
    txtAccount(1).top = 514
    cboAccount(0).top = 931
    cboAccount(0).Width = txtAccount(1).Width
    cboAccount(1).top = 1350
    cboAccount(1).Width = txtAccount(1).Width
    optDirection(0).Left = 360
    optDirection(0).top = 2310
    optDirection(1).Left = 3030
    optDirection(1).top = 2310
    chkAid(0).Left = 360
    chkAid(0).top = 3480
    chkAid(1).Left = 1695
    chkAid(1).top = 3480
    chkAid(2).Left = 3030
    chkAid(2).top = 3480
    Frame1.Visible = False
    optCheck(0).Visible = False
    optCheck(0).TabStop = False
    optCheck(1).Visible = False
    optCheck(1).TabStop = False
    optCheck(2).Visible = False
    optCheck(2).TabStop = False
    chkSuit.Visible = False
    chkSuit.TabStop = False
    Label1(5).Visible = False
    chkQuantity.Visible = False
    chkQuantity.TabStop = False
    Label5.Visible = False
    txtAccount(2).Visible = False
    txtAccount(2).TabStop = False
    chkAid(3).Visible = False
    chkAid(3).TabStop = False
    chkAid(4).Visible = False
    chkAid(4).TabStop = False
    chkAid(5).Visible = False
    chkAid(5).TabStop = False
End Sub

Private Sub Form_Activate()
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub Form_Load()
    Dim iStep As Integer
    Me.Hide
    Me.Left = -30000
    MsgForm.PleaseWait
    SetHelpID Me.hwnd, 30001
    frmAccountList.IsShowCard(0) = True
'    #If conVersionType = 8 Then
        iStep = (chkAid(5).top - chkAid(0).top) / 4
        chkAid(3).Visible = False
        chkAid(1).top = chkAid(0).top + iStep
        chkAid(2).top = chkAid(1).top + iStep
        chkAid(4).top = chkAid(2).top + iStep
        chkAid(5).top = chkAid(4).top + iStep
'    #Else
        #If conVersionType = 4 Then
            SetForm
        #End If
'    #End If
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
End Sub

Private Sub Form_Paint()
    #If conVersionType = 4 Then
        FrameBox hwnd, 120, 1980, 120 + 4305, 1980 + 885
        FrameBox hwnd, 120, 3150, 120 + 4305, 3150 + 885
    #Else
        FrameBox hwnd, 90, 3200, 2565 + 90, 945 + 3120
        FrameBox hwnd, 2850, 920, 1545 + 2850, 885 + 840
        FrameBox hwnd, 2850, 1900, 1545 + 2850, 2235 + 1830
    #End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intResponse As Integer
    
    If UnloadMode = vbFormControlMenu Then
       If mblnIsChanged Then
          If mblnIsNew = False Then
             intResponse = ShowMsg(0, "当前会计科目已被修改，是否保存？", vbQuestion + vbYesNoCancel + MB_TASKMODAL, Caption)
          Else
             intResponse = ShowMsg(0, "当前新增的会计科目是否保存？", vbQuestion + vbYesNoCancel + MB_TASKMODAL, Caption)
          End If
          If intResponse = vbYes Then
             Cancel = Not SaveCard()
          ElseIf intResponse = vbCancel Then
             Cancel = True
          End If
       End If
    End If
     If Not Cancel Then mblnIsChanged = False
End Sub

Private Sub Form_Resize()
'    If Me.Left + Me.Width < 0 Or Me.Left > Screen.Width Then
'       Me.Left = 300
'    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frmAccountList.IsShowCard(0) = False
    'Set mclsHook = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub


'Private Sub mclsHook_OnMessage(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCancel As Long)
'    If hWnd = optCheck(2).hWnd And Msg = WM_LBUTTONDOWN Then
'        optCheck_Click 2
'    End If
'    bCancel = False
'End Sub


Private Sub optCheck_Click(Index As Integer)
   If Index = 0 Then
      If optCheck(0).Value = True Then
         chkSuit.Value = 0
      End If
   End If
   chkSuit.Enabled = Not optCheck(0).Value
End Sub

Private Sub optCheck_KeyPress(Index As Integer, KeyAscii As Integer)
    If Index = 2 And Chr(KeyAscii) = " " Then
       frmSelCur.mlngAccountID = IIf(mblnIsNew, 0, mlngAccountID)
        frmSelCur.mstrAccountCodeName = Trim$(txtAccount(0).Text) _
            & " - " & Trim$(txtAccount(1).Text)
        frmSelCur.AccountListCardIsUsed = True
        frmSelCur.Show vbModal
    End If
End Sub

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

Private Sub optCheck_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
     If Index = 2 And optCheck(2).Value Then
        frmSelCur.mlngAccountID = IIf(mblnIsNew, 0, mlngAccountID)
        frmSelCur.mstrAccountCodeName = Trim$(txtAccount(0).Text) _
            & " - " & Trim$(txtAccount(1).Text)
        frmSelCur.AccountListCardIsUsed = True
        frmSelCur.Show vbModal
        If Not mblnSelCur Then
            If mblnOAllCur Then
                optCheck(1).Value = True
                optCheck(1).SetFocus
            ElseIf Not mblnOPartCur Then
                optCheck(0).Value = True
                optCheck(0).SetFocus
            End If
        End If
    End If
End Sub

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

Private Sub txtAccount_Change(Index As Integer)
    Dim strSource As String, strErr As String
    
    On Error Resume Next
    strSource = Trim$(txtAccount(Index).Text)
    If Index = 0 Then
        strErr = "'""|?/`~\.>,<;;:!@#$%^&*=+"
    Else
        strErr = "'""|?/`~\.>,-<;;:!@#$%^&*=+"
    End If
    If mblnIsInit Then
        If ContainErrorChar(strSource, strErr) Then
            BKKEY txtAccount(Index).hwnd, vbKeyEnd
            BKKEY txtAccount(Index).hwnd
        End If
    Else
        If ContainErrorChar(strSource, strErr) Then
            BKKEY txtAccount(Index).hwnd
        End If
        mblnIsChanged = True
    End If
    If Index = 0 Then
'        iNature = 5
'        If Len(txtAccount(0).Text) > 0 Then
'            If Left(txtAccount(0).Text, 1) < 7 And Left(txtAccount(0).Text, 1) > 0 Then
'                iNature = Left(txtAccount(0).Text, 1) - 1
'            End If
'        End If
        cboAccount(0).ListIndex = CInt(Left(txtAccount(0).Text, 1)) - 1
    End If
End Sub

Private Sub txtAccount_LostFocus(Index As Integer)
    Dim recAcn As rdoResultset, i As Integer
    Dim strPCode As String, strSql As String
    
    If Index = 0 Then
        strPCode = CodePrefix(Trim$(txtAccount(0).Text))
        If mstrPre = strPCode Then Exit Sub
        If strPCode = "" Then
            i = cboAccount(0).ListIndex
            If i <> -1 Then
                cboAccount(0).Enabled = True
               ' cboAccount(1).Enabled = True
            End If
            Exit Sub
        Else
            strSql = "SELECT * FROM Account WHERE strAccountCode='" & strPCode & "'"
            Set recAcn = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
            If Not recAcn.EOF Then
'                For i = 0 To cboAccount(0).ListCount - 1
'                    If Abs(recAcn!lngAccountTypeID) = Abs(cboAccount(0).ItemData(i)) Then Exit For
'                Next i
'                If cboAccount(0).Enabled Then cboAccount(0).ListIndex = i
                If cboAccount(1).Enabled Then cboAccount(1).Text = AccountX(recAcn("lngAccountNatureID"), 1)
                cboAccount(0).Enabled = False
                'cboAccount(1).Enabled = False
                optDirection(0).Value = (recAcn!intDirection = 1)
                optDirection(1).Value = Not optDirection(0).Value
            Else
                cboAccount(0).Enabled = True
                'cboAccount(1).Enabled = True
            End If
            recAcn.Close
        End If
        If mblnIsNew Then
           cboAccount(1).Enabled = True
        Else
           If CodeIsDetail("Account", "strAccountCode", txtAccount(0).Text) Then
              cboAccount(1).Enabled = Not mblnAcntNEdit
           Else
              cboAccount(1).Enabled = False
           End If
        End If
        
    End If
End Sub

Private Sub UpdateVoucherAccount()
    Dim strSql As String
    Dim recVoucher As rdoResultset
    Dim txtCode As String
    Dim strDebit As String, strCredit As String
    
    txtCode = " " & Trim(txtAccount(0).Text)
    If UCase(Trim(mstrCode)) = UCase(Trim(txtCode)) Then Exit Sub
    If mstrCode <> "" Then
       strSql = "select strDebitAccountCode,strCreditAccountCode from voucher"
       Set recVoucher = gclsBase.BaseDB.OpenResultset(strSql, dbOpenDynaset)
       With recVoucher
            If .RowCount > 0 Then
               .MoveLast
               .MoveFirst
               Do Until .EOF
                    strDebit = " " & .rdoColumns(0)
                    strCredit = " " & .rdoColumns(1)
                    strDebit = strReplace(strDebit, " " & mstrCode, txtCode)
                    strDebit = LTrim(strDebit)
                    strCredit = strReplace(strCredit, " " & mstrCode, txtCode)
                    strCredit = LTrim(strCredit)
                    .Edit
                    .rdoColumns(0) = strDebit
                    .rdoColumns(1) = strCredit
                    .Update
                    .MoveNext
               Loop
            End If
       End With
    End If
End Sub