frmaccountlist.frm

金算盘软件代码

        mclsList(intTab).FlexGrid.HighLight = flexHighlightNever
        cmdAgain.Enabled = False
    Else
        mclsList(intTab).FlexGrid.HighLight = flexHighlightAlways
        cmdAgain.Enabled = True
    End If
    mclsList(intTab).ShowAll = True
    Set GetList = recRecordset
End Function
Public Function ShowList(ByVal lngID As Long, Optional intTab As Integer = 0) As Boolean
    Dim intCount As Integer
    Dim strSortField As String
    Dim strSortDec As String
    Dim Strsql As String
    Dim recTemp As Recordset
    Dim strofFrom As String
    Dim strofWhere As String
    Me.Show
    Me.ZOrder 0
    With mclsList(intTab).ListSet
        '得到排序字段
        For intCount = 1 To .Columns
            If .ColumnOrderType(intCount) <> 0 Then
                strSortField = .ColumnFieldName(intCount)
                strSortDec = .ColumnDesc(intCount)
                Exit For
            End If
        Next
        If intCount > .Columns Then
            ShowList = False
            Exit Function
        End If
        strofFrom = .FromOfSql
        strofWhere = .WhereOfSql
    End With
    '根据lngID得到排序字段值
    Strsql = "Select " & strSortField & " As " & strSortDec
    If strofWhere <> "" Then
        strofWhere = " where " & strofWhere & "and Account.lngaccountID=" & lngID
    Else
        strofWhere = " where Account.lngAccountID=" & lngID
    End If
        
    Strsql = Strsql & strofFrom & strofWhere
    Set recTemp = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenForwardOnly)
    With recTemp
        If .RecordCount > 0 Then
            txtFind.Text = recTemp(strSortDec)   '查找
            With mclsList(intTab).FlexGrid
                If .TextMatrix(.Row, 0) = lngID Then      '是否找到
                    ShowList = True
                Else
                    ShowList = False
                End If
            End With
        Else
            ShowList = False
        End If
        .Close
    End With
End Function
'卡片

Public Property Let IsShowCard(ByVal Index As Integer, vNewValue As Boolean)
   mIsShowCard(Index) = vNewValue
End Property
Public Property Get IsShowCard(ByVal Index As Integer) As Boolean
   IsShowCard(Index) = mIsShowCard(Index)
End Property
'按照部门职员ID提取记录
Public Function GetByListID(ByVal intTab As Integer, ByVal lngID As Long) As Recordset
    Dim recRecordset As Recordset
    Dim Strsql As String
    Strsql = "Select * From Account Where lngAccountID = " & lngID
        
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    Set GetByListID = recRecordset
End Function

'按照部门职员ID更新停用标志
Private Function UpdateListInActive(ByVal intTab As Integer, ByVal lngID As Long, ByVal blnIsInActive As Boolean) As Boolean
    Dim Strsql As String
    Strsql = "UPDATE Account SET blnIsInActive = " & blnIsInActive & " WHERE lngAccountID = " & lngID
    UpdateListInActive = gclsBase.ExecSQL(Strsql)
End Function

'删除部门职员ID指定记录
Private Function DelByPaymentMethodID(ByVal lngID As Long, ByVal intTab As Integer) As Boolean
    Dim Strsql As String
    Strsql = "Delete * From Account WHERE lngAccountID = " & lngID
    DelByPaymentMethodID = gclsBase.ExecSQL(Strsql)
End Function

'判断部门职员ID是否使用
Private Function IsUsePaymentMethodID(ByVal lngID As Long) As Boolean
    Dim recRecordset As Recordset
    Dim Strsql As String
    Strsql = "Select lngAccountID From VoucherDetail Where lngAccountID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    IsUsePaymentMethodID = (recRecordset.RecordCount >= 1)
    recRecordset.Close
End Function

' 部门职员ID
Public Property Get ListID(ByVal intTab As Integer) As Long
    With mclsList(intTab).FlexGrid
        ListID = CLng(.TextArray(.Row * .Cols))
    End With
End Property

' 部门职员停用标志
Public Property Get ListIsInActive(ByVal intTab As Integer) As Boolean
    If chkShowAll.Value Then
        With mclsList(intTab).FlexGrid
            ListIsInActive = Not (.TextArray(.Row * .Cols + 1) = "")
        End With
    Else
        ListIsInActive = False
    End If
End Property

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsNotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    
    
    With mclsList(sstCustom.Tab).FlexGrid
        If .Rows > 1 And .ColSel <> 0 And .RowHeight(.Row) > 0 Then
            blnIsNotEmpty = True
        Else
            blnIsNotEmpty = False
        End If
    End With
        With frmMain
            .mnuEditCopy.Enabled = blnIsNotEmpty
            .mnuEditEdit.Enabled = blnIsNotEmpty
            .mnuEditNew.Enabled = True
            .mnuEditDel.Enabled = blnIsNotEmpty
            .mnuEditInActive.Enabled = blnIsNotEmpty
            .mnuEditShowAll.Checked = chkShowAll.Value
            .mnuEditShowAll.Enabled = True
            .mnuEditUse.Enabled = blnIsNotEmpty
            .mnuEditSearch.Enabled = True
            .mnuEditColumn.Enabled = True
            .mnuEditFilter.Enabled = True
            .mnuFilePrint.Enabled = True
            .mnuReportQuick.Enabled = blnIsNotEmpty
            .mnuToolRefresh.Enabled = True
        End With
    If mclsList(sstCustom.Tab).FlexGrid.ColSel = 0 Then  '无当前选定行
        blnFindNoChange = mclsList(sstCustom.Tab).FindNoChange
        mclsList(sstCustom.Tab).FindNoChange = True
        txtFind.Text = ""
        mclsList(sstCustom.Tab).FindNoChange = blnFindNoChange
        cmdAgain.Enabled = False
    End If
    
End Sub

'重画Form
Private Sub RedrawForm()
    
    With sstCustom
        .Left = ListFormLeft
        .Width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ssTabUpAreaHeight - ListDownAreaHeight
    End With
    
    '重画MS FlexGrid 控件
    With mclsList(sstCustom.Tab).FlexGrid
        .Left = ListGridLeft
        .Width = sstCustom.Width - ListGridLeft - ListGridRight
        .Height = sstCustom.Height - sstCustom.TabHeight - ListGridTop - ListGridBottom
    End With
    
    '重画其余控件
    txtFind.Width = Me.ScaleWidth - txtFind.Left - ListFormBottom - cmdAgain.Width - 15
    cmdAgain.Left = txtFind.Left + txtFind.Width
    cmdEAR(0).top = Me.ScaleHeight - cmdEAR(0).Height - ListFormBottom
    cmdEAR(1).top = cmdEAR(0).top
   
    chkShowAll.top = cmdEAR(0).top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.Width - ListFormBottom
End Sub




'命令控件数组
Private Sub cmdEAR_Click(Index As Integer)
    Dim PosX, PosY As Integer
    Dim intCol As Integer
    Dim strAccountName As String
    Dim intFlag As Integer
    Dim recTemplete As Recordset
    PosX = cmdEAR(Index).Left
    PosY = cmdEAR(Index).top + cmdEAR(Index).Height
    With frmMain
        Select Case Index
               Case 0
                    MakeListEditMenu
                    PopupMenu .mnuListEdit, , PosX, PosY
              
               Case 1
                    With mclsList(sstCustom.Tab).FlexGrid
                        If .Row > 0 Then
                            Set recTemplete = GetByListID(sstCustom.Tab, ListID(sstCustom.Tab))
                        'intCol = GetCol("科目名称")
                        
                             strAccountName = recTemplete!strAccountName '.TextMatrix(.Row, intCol)
                             'intCol = GetCol("科目性质")
                             'If .Row > 0 Then
                             intFlag = recTemplete!lngAccountNatureID '.TextMatrix(.Row, intCol)
                        End If
                    End With
                    MakeListReportMenu strAccountName
                    Select Case intFlag
                           Case 1, 2
                                .mnuListReportMenu(0).Caption = "日记帐:" & Mid(.mnuListReportMenu(0).Caption, 4)
                           Case Else
                                .mnuListReportMenu(0).Caption = "明细帐:" & Mid(.mnuListReportMenu(0).Caption, 4)
                    End Select
                    PopupMenu .mnuListReport, , PosX, PosY
'                    MakeListReportMenu (getDepEmp())
'                    PopupMenu .mnuListReport, , PosX, PosY
        End Select
    End With
End Sub

'取部门职员
Private Function getDepEmp() As String
    Dim strDepEmp As String
    
    
    Select Case sstCustom.Tab
            Case 0
                strDepEmp = GetNameStr(msgCustom0, "自定项目名称")
            Case 1
                strDepEmp = GetNameStr(msgCustom1, "自定项目名称")
            Case 2
                strDepEmp = GetNameStr(msgCustom2, "自定项目名称")
            Case 3
               strDepEmp = GetNameStr(msgCustom3, "自定项目名称")
            Case 4
                strDepEmp = GetNameStr(msgCustom4, "自定项目名称")
            Case 5
                strDepEmp = GetNameStr(msgCustom5, "自定项目名称")
    End Select
    getDepEmp = strDepEmp
    
End Function




'
'窗体 Form 控件
'
Private Sub Form_Load()
    Dim intCount As Integer
    Dim i As Integer
    Dim intSortCol As Integer
    Dim intResponse As Integer
    SetHelpID Me.hwnd, 10006
   ' InitsstCustom
    '部门职员列表窗体初始化
    Debug.Print "Load Start: ", Timer
    
    intViewID(0) = 6
    intViewID(1) = 385
    intViewID(2) = 386
    intViewID(3) = 387
    intViewID(4) = 388
    intViewID(5) = 389
    For i = 0 To 5
        Set mclsList(i) = New list
        Set mclsList(i).FindKind = cboFindKind
        'Set mclsList(i).Again = cmdAgain
        Set mclsList(i).Find = txtFind
    Next
    Set mclsList(0).FlexGrid = msgCustom0
    Set mclsList(1).FlexGrid = msgCustom1
    Set mclsList(2).FlexGrid = msgCustom2
    Set mclsList(3).FlexGrid = msgCustom3
    Set mclsList(4).FlexGrid = msgCustom4
    Set mclsList(5).FlexGrid = msgCustom5
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
  
    
    '设置钩子对象
    Set mclsSubClass = New SubClass32.SubClass

    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_MOUSEMOVE) = True
    
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    
    If sstCustom.Tab = 0 Then
        sstCustom_Click 0
    Else
        sstCustom.Tab = 0
    End If
   
Debug.Print "Load End: ", Timer
    
End Sub

'右键菜单
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        MakeListEditMenu
        PopupMenu frmMain.mnuListEdit
    End If
End Sub

Private Sub Form_Paint()
    DrawInSertLine Me.hwnd, ListFormLeft, 500, Me.Width - 2 * (ListFormLeft + ListFormRight), 500
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu Then
       Select Case True
            Case mIsShowCard(0) '科目卡片
                ShowMsg Me.hwnd, "请先关闭会计科目卡片！", vbCritical, "会计科目关闭提示"
                Cancel = True
                frmAccountListCard.Show
                frmAccountListCard.ZOrder 0
            Case mIsShowCard(1) '期初余额
                ShowMsg Me.hwnd, "请先关闭期初余额卡片！", "期初余额关闭提示", &H40&
                Cancel = True
                frmAccountInit.Show
        End Select
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim intCount As Integer
    For intCount = 0 To sstCustom.Tabs - 1
        If blnIsLoad(intCount) Then
            mclsList(intCount).SaveListSet
        End If
        blnIsLoad(intCount) = False
    Next
    If mIsShowCard(0) Then Unload frmAccountListCard
    If mIsShowCard(1) Then Unload frmAccountInit
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

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

Private Sub Form_Activate()
    
    On Error Resume Next
    mclsMainControl_ChildActive
    gclsSys.CurrFormName = Me.hwnd
    mclsList(sstCustom.Tab).FlexGrid.SetFocus
    mclsList(sstCustom.Tab).FlexGrid.Redraw = True
    
End Sub
'
'显示全部记录/未停用记录 CheckBox 控件
'
Private Sub chkShowAll_Click()
  
    With sstCustom
        mclsList(.Tab).FlexGrid.Redraw = False
        mclsList(.Tab).DoShowAll chkShowAll.Value
        mclsList(.Tab).FlexGrid.Redraw = True
    End With
    'cboFindKind_Click
     UpdateMenuStatus
End Sub

'
'查找条件类型 ComboBox 控件
'
Private Sub cboFindKind_Click()
    Dim i As Integer
    Dim intWidth As Integer
    Dim strFind As String
    Dim intSortCol As Integer
    
    If mblnComboxNoClick Then Exit Sub
    With mclsList(sstCustom.Tab).FlexGrid
        .Redraw = False
        For i = 1 To .Cols - 1
            If .TextMatrix(0, i) = cboFindKind.Text Then
                strFind = .TextMatrix(.Row, i)
                mclsList(sstCustom.Tab).FixrowSortBold i
                Exit For
            End If
       Next
    End With
    
    If mclsList(sstCustom.Tab).FlexGrid.Rows > 1 Then
       If txtFind.Text = strFind Then
          txtFind_Change
       Else
          txtFind.Text = strFind
       End If
    End If
    mclsList(sstCustom.Tab).FlexGrid.Redraw = True
  '  mclsList(sstTypAct.Tab).FlexGrid.SetFocus
End Sub


Private Sub mclsMainControl_ChildActive()
     Dim vntMessage As Variant
     gclsSys.CurrFormName = Me.hwnd
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        ToolRefresh sstCustom.Tab
        mclsMainControl.Messages.Remove CStr(vntMessage) '清除部门雇员改变消息
    Next
    mclsMainControl.Messages.Clear
End Sub

Private Sub mclsMainControl_EditColumn()