frmoperator.frm

金算盘软件代码

            & lngID & ",'" & refOperatorGroup.Text & "')"
        gclsBase.BaseDB.Execute strSql
    Else
        refOperatorGroup.Text = ""
    End If
    If lngID <> 0 Then mlngOperatorGroupID = lngID
    setlistbox refOperatorGroup, 29, mlngOperatorGroupID
    mblnIsChanged = True
    mblnIsExist = False
End Sub

Private Sub refOperatorGroup_LostFocus()
    refOperatorGroup.MoveFocus
End Sub

Private Sub sstRight_Click(PreviousTab As Integer)
    Dim b As Byte
    
    If sstRight.Tab = 0 Then
        msgAuth.TabStop = True
        cboRightGroup.TabStop = True
        Label1(5).Enabled = True
        txtUser(3).TabStop = True
        cmdOK(4).TabStop = True
        cmdOK(5).TabStop = True
        Label1(6).Enabled = False
        Label1(7).Enabled = False
        For b = 0 To 3
            cmdSel(b).TabStop = False
            If b < 2 Then lstA(b).TabStop = False
        Next b
        SetButtonTabIndex cmdOK(5).TabIndex + 1
    Else
        msgAuth.TabStop = False
        cboRightGroup.TabStop = False
        Label1(5).Enabled = False
        txtUser(3).TabStop = False
        cmdOK(4).TabStop = False
        cmdOK(5).TabStop = False
        Label1(6).Enabled = True
        Label1(7).Enabled = True
        For b = 0 To 3
            cmdSel(b).TabStop = True
            If b < 2 Then lstA(b).TabStop = True
        Next b
        SetButtonTabIndex lstA(1).TabIndex + 1
    End If
End Sub

Private Sub SetButtonTabIndex(ByVal TabIndex As Integer)
    cmdOK(0).TabIndex = TabIndex + 1
    cmdOK(1).TabIndex = cmdOK(0).TabIndex + 1
    If cmdOK(2).Visible Then
        cmdOK(2).TabIndex = cmdOK(1).TabIndex + 1
        chkStop.TabIndex = cmdOK(2).TabIndex + 1
    Else
        chkStop.TabIndex = cmdOK(1).TabIndex + 1
    End If
End Sub

Private Sub tvwRight_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeySpace Then tvwRight_NodeClick tvwRight.SelectedItem
End Sub

Private Sub tvwRight_NodeClick(ByVal Node As msComctlLib.Node)
    Dim i As Integer, NodX As msComctlLib.Node
    Static strKey As String
    
    If strKey <> Node.Key Then
        strKey = Node.Key
        Exit Sub
    End If
    If Node.Key = "Root" Then
        If Node.iMage = "FULL" Then
            For Each NodX In tvwRight.Nodes
                NodX.iMage = "EMPTY"
            Next NodX
        Else
            For Each NodX In tvwRight.Nodes
                NodX.iMage = "FULL"
            Next NodX
        End If
    Else
        If Node.iMage = "FULL" Then
            Node.iMage = "EMPTY"
        Else
            Node.iMage = "FULL"
        End If
        For Each NodX In tvwRight.Nodes
            If NodX.Key <> "Root" And NodX.iMage = "FULL" Then i = i + 1
        Next NodX
        If i = tvwRight.Nodes.Count - 1 Then
            tvwRight.Nodes("Root").iMage = "FULL"
        ElseIf i = 0 Then
            tvwRight.Nodes("Root").iMage = "EMPTY"
        Else
            tvwRight.Nodes("Root").iMage = "HALF"
        End If
    End If
    If Not mblnIsInit Then cmdOK(4).Enabled = (Trim(txtUser(3).Text) <> "")
End Sub

Private Sub txtUser_Change(Index As Integer)
    If ContainErrorChar(txtUser(Index).Text, "'`~""?/.|,;^&!@#$") Then
        BKKEY txtUser(Index).hwnd
    End If
    cmdOK(4).Enabled = (Trim(txtUser(3).Text) <> "" _
        And txtUser(3).Text <> cboRightGroup.Text)
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Function SaveCard() As Boolean
    Dim i As Integer, recOperator As rdoResultset, strSql As String
    
    SaveCard = False
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    
    If mblnIsExist Then GoTo ErrHandle
    If Not CheckUserPass Then GoTo ErrHandle
    If cmdOK(4).Enabled Then cmdOK(4).Value = True
    If Not mblnGroupNameOK Then GoTo ErrHandle
    If mblnIsNew Then
        mlngOpID = GetNewID("Operator")
        strSql = "INSERT INTO Operator(lngOperatorID,strOperatorName,strPassword," _
            & "blnIsInActive,lngOperatorGroupID,blnIsSystem,blnAllAccount) VALUES" _
            & "(" & mlngOpID & ",'" & txtUser(0).Text & "','" & txtUser(1).Text & "'," _
            & chkStop.Value & "," & mlngOperatorGroupID _
            & "," & IIf(mlngOperatorGroupID = 1, 1, 0) & "," & chkA.Value & ")"
        If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
'        strSql = "SELECT * FROM Operator WHERE strOperatorName='" & txtUser(0).Text & "'"
'        Set recOperator = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'        mlngOpID = recOperator!lngOperatorID
    Else
        strSql = "UPDATE Operator SET strOperatorName='" & txtUser(0).Text _
            & "',strPassword='" & txtUser(1).Text & "',blnIsInActive=" _
            & chkStop.Value & ",blnAllAccount=" & chkA.Value _
            & ",lngOperatorGroupID=" & mlngOperatorGroupID & ",blnIsSystem=" _
            & IIf(mlngOperatorGroupID = 1, 1, 0) & " WHERE lngOperatorID=" & mlngOpID
        If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    End If
    
    With msgAuth
    For i = 1 To .Rows - 1
        If .TextMatrix(i, 1) <> "" Then
            If .TextMatrix(i, 4) > "0" Then
                If .TextMatrix(i, 1) <> .TextMatrix(i, 4) Then
                    strSql = "UPDATE OperatorRight SET lngRightGroupID=" _
                        & .TextMatrix(i, 4) & " WHERE lngOperatorID=" & mlngOpID _
                        & " AND lngRightGroupID=" & .TextMatrix(i, 1)
                Else
                    strSql = ""
                End If
            Else
                strSql = "DELETE FROM OperatorRight WHERE lngOperatorID=" _
                    & mlngOpID & " AND lngRightGroupID=" & .TextMatrix(i, 1)
            End If
        Else
            If .TextMatrix(i, 4) > "0" Then
                strSql = "INSERT INTO OperatorRight (lngOperatorID," _
                    & "lngRightGroupID) VALUES (" & mlngOpID _
                    & "," & .TextMatrix(i, 4) & ")"
            Else
                strSql = ""
            End If
        End If
        If strSql <> "" Then
            If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
        End If
    Next i
    End With
    If mblnSetActive Then
        If Not SetActive Then GoTo ErrHandle
    End If
    If Not SaveAccountRight Then GoTo ErrHandle
    InitOperatorAccount mlngOpID
    gclsBase.BaseWorkSpace.CommitTrans
    mblnIsChanged = False
    SaveCard = True
    gclsSys.SendMessage hwnd, msgright
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function

Private Function SetActive() As Boolean
    Dim i As Integer, iAll(1 To 11) As Integer, iSel(1 To 11) As Integer
    Dim recSet As rdoResultset, strActive(1 To 11) As String, strSql As String
    Dim strTitle(1 To 11) As String
    
    SetActive = False
    For i = 1 To 11
        iSel(i) = 0
    Next i
    strTitle(1) = "商品销售"
    strTitle(2) = "商品采购"
    strTitle(3) = "应收应付"
    strTitle(4) = "库存业务"
    strTitle(5) = "现金银行"
    strTitle(6) = "工资核算"
    strTitle(7) = "固定资产"
    strTitle(8) = "总分类帐"
    strTitle(9) = "企业资料"
    strTitle(10) = "领导查询"
    strTitle(11) = "财务分析"
    iAll(1) = 7
    iAll(2) = 7
    iAll(3) = 4
    iAll(4) = 13
    iAll(5) = 4
    iAll(6) = 2
    iAll(7) = 3
    iAll(8) = 5
    iAll(9) = 10
    iAll(10) = -1
    iAll(11) = -1
    strSql = "SELECT RightGroupDetail.lngRightID AS lngRightID FROM OperatorRight " _
        & "INNER JOIN RightGroupDetail ON " _
        & "OperatorRight.lngRightGroupID=RightGroupDetail.lngRightGroupID " _
        & "WHERE operatorright.lngOperatorID=" & mlngOpID & " ORDER BY lngRightID"
    Set recSet = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Do Until recSet.EOF
        Select Case recSet!lngRightID
        '商品销售
        Case 68, 69
            If InStr(1, strActive(1), "销售订单") = 0 Then
                strActive(1) = strActive(1) & "," & "销售订单"
                iSel(1) = iSel(1) + 1
            End If
'        Case 70, 71
        Case 70, 214
            If InStr(1, strActive(1), "商品销售") = 0 Then
                strActive(1) = strActive(1) & "," & "商品销售"
                iSel(1) = iSel(1) + 1
            End If
'        Case 72, 73
        Case 215, 73
            If InStr(1, strActive(1), "直运销售") = 0 Then
                strActive(1) = strActive(1) & "," & "直运销售"
                iSel(1) = iSel(1) + 1
            End If
        Case 82, 83, 84, 85
            If InStr(1, strActive(1), "分期收款发出商品") = 0 Then
                strActive(1) = strActive(1) & "," & "分期收款发出商品"
                iSel(1) = iSel(1) + 1
            End If
        Case 74, 75, 76, 77, 78, 79, 80, 81
            If InStr(1, strActive(1), "委托代销") = 0 Then
                strActive(1) = strActive(1) & "," & "委托代销"
                iSel(1) = iSel(1) + 1
            End If
        Case 124, 125
            If InStr(1, strActive(1), "销售发票") = 0 Then
                strActive(1) = strActive(1) & "," & "销售发票"
                iSel(1) = iSel(1) + 1
            End If
        Case 86
            If InStr(1, strActive(1), "销售凭证") = 0 Then
                strActive(1) = strActive(1) & "," & "销售凭证"
                iSel(1) = iSel(1) + 1
            End If
        '商品采购
        Case 50, 51
            If InStr(1, strActive(2), "采购订单") = 0 Then
                strActive(2) = strActive(2) & "," & "采购订单"
                iSel(2) = iSel(2) + 1
            End If
'        Case 52, 53
        Case 212, 213
            If InStr(1, strActive(2), "商品采购") = 0 Then
                strActive(2) = strActive(2) & "," & "商品采购"
                iSel(2) = iSel(2) + 1
            End If
        Case 54, 55
            If InStr(1, strActive(2), "直运采购") = 0 Then
                strActive(2) = strActive(2) & "," & "直运采购"
                iSel(2) = iSel(2) + 1
            End If
        Case 56, 57, 58, 59, 60, 61
            If InStr(1, strActive(2), "受托代销") = 0 Then
                strActive(2) = strActive(2) & "," & "受托代销"
                iSel(2) = iSel(2) + 1
            End If
        Case 64, 65
            If InStr(1, strActive(2), "采购分摊") = 0 Then
                strActive(2) = strActive(2) & "," & "采购分摊"
                iSel(2) = iSel(2) + 1
            End If
        Case 62, 63
            If InStr(1, strActive(2), "采购发票") = 0 Then
                strActive(2) = strActive(2) & "," & "采购发票"
                iSel(2) = iSel(2) + 1
            End If
        Case 66
            If InStr(1, strActive(2), "采购凭证") = 0 Then
                strActive(2) = strActive(2) & "," & "采购凭证"
                iSel(2) = iSel(2) + 1
            End If
        '应收应付
        Case 36, 37
            If InStr(1, strActive(3), "应收业务") = 0 Then
                strActive(3) = strActive(3) & "," & "应收业务"
                iSel(3) = iSel(3) + 1
            End If
        Case 38
            strActive(3) = strActive(3) & "," & "应收计息"
            iSel(3) = iSel(3) + 1
        Case 39, 40
            If InStr(1, strActive(3), "应付业务") = 0 Then
                strActive(3) = strActive(3) & "," & "应付业务"
                iSel(3) = iSel(3) + 1
            End If
        Case 41
            strActive(3) = strActive(3) & "," & "往来凭证"
            iSel(3) = iSel(3) + 1
        '库存业务
        Case 96, 97
            If InStr(1, strActive(4), "自制入库") = 0 Then
                strActive(4) = strActive(4) & "," & "自制入库"
                iSel(4) = iSel(4) + 1
            End If
        Case 98, 99
            If InStr(1, strActive(4), "其他入库") = 0 Then
                strActive(4) = strActive(4) & "," & "其他入库"
                iSel(4) = iSel(4) + 1
            End If
        Case 100, 101
            If InStr(1, strActive(4), "领用出库") = 0 Then
                strActive(4) = strActive(4) & "," & "领用出库"
                iSel(4) = iSel(4) + 1
            End If
        Case 102, 103
            If InStr(1, strActive(4), "其他出库") = 0 Then
                strActive(4) = strActive(4) & "," & "其他出库"
                iSel(4) = iSel(4) + 1
            End If
        Case 104, 105, 106, 107, 108, 109
            If InStr(1, strActive(4), "委托加工") = 0 Then
                strActive(4) = strActive(4) & "," & "委托加工"
                iSel(4) = iSel(4) + 1
            End If
        Case 88, 89
            If InStr(1, strActive(4), "商品调拨") = 0 Then
                strActive(4) = strActive(4) & "," & "商品调拨"
                iSel(4) = iSel(4) + 1
            End If
        Case 90, 91
            If InStr(1, strActive(4), "商品调价") = 0 Then
                strActive(4) = strActive(4) & "," & "商品调价"
                iSel(4) = iSel(4) + 1
            End If
        Case 92, 93, 128, 129, 130, 131
            If InStr(1, strActive(4), "商品盘点") = 0 Then
                strActive(4) = strActive(4) & "," & "商品盘点"
                iSel(4) = iSel(4) + 1
            End If
        Case 94, 95
            If InStr(1, strActive(4), "拆卸组装") = 0 Then
                strActive(4) = strActive(4) & "," & "拆卸