frmcustomlist.frm

金算盘软件代码

                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
  End With
End Sub

Private Sub msgCustom1_DblClick()
    With msgCustom1
            If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
               mclsMainControl_EditEdit
            End If
       End With
End Sub

Private Sub msgCustom1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    
    With msgCustom1
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustom1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustom1
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
  End With
End Sub

Private Sub msgCustom2_DblClick()
    With msgCustom2
            If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
               mclsMainControl_EditEdit
            End If
       End With
End Sub

Private Sub msgCustom2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     Dim blnCancel As Boolean
    With msgCustom2
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustom2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
     With msgCustom2
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
  End With
End Sub

Private Sub msgCustom3_DblClick()
    With msgCustom3
        If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
            mclsMainControl_EditEdit
        End If
    End With
End Sub

Private Sub msgCustom3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    
    With msgCustom3
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustom3_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
     With msgCustom3
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
  End With
End Sub

Private Sub sstCustom_Click(PreviousTab As Integer)
    Dim i As Integer
    
    With sstCustom
        For i = 0 To 5
            Set mclsList(i).Again = Nothing
            mclsList(i).FlexGrid.TabStop = False
        Next
        mclsList(.Tab).FlexGrid.TabStop = True
        Set mclsList(.Tab).Again = cmdAgain
        mclsList(.Tab).FlexNoChange = True
        mclsList(.Tab).FindNoChange = True
       
         '改变钩子对象的作用窗体
        mclsSubClass.hwnd = mclsList(.Tab).FlexGrid.hwnd
        If Not blnIsLoad(.Tab) Then
            mclsList(.Tab).FlexGrid.Redraw = False
            '得到列表记录集
            mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
            
            mclsList(.Tab).InitFlexGrid
            
            Set datCustom(.Tab).Resultset = GetList(.Tab)
            
            If Not datCustom(.Tab).Resultset.EOF Then datCustom(.Tab).Resultset.MoveLast
            datCustom(.Tab).Resultset.Close
           ' Set datCustom(.Tab).Recordset = Nothing
            mclsList(.Tab).SetFlexGrid
           
            '初始化查找复合列表框
            mclsList(.Tab).InitcboFindKind
            '重画窗体
             mclsList(.Tab).FlexGrid.Redraw = False
           ' RedrawForm
            '定位到第一行
            With mclsList(.Tab).FlexGrid
                If .Rows > 1 Then
                    mclsList(sstCustom.Tab).FlexNoChange = False
                    .Row = 1
                    mclsList(sstCustom.Tab).FlexNoChange = True
                End If
                .col = 0
                .ColSel = .Cols - 1
            End With
            mclsList(.Tab).DoShowAll False
            
            '重画列表线
           ' mclsList(.Tab).gridLineRefresh
            
            UpdateMenuStatus
            blnIsLoad(.Tab) = True
            mclsList(.Tab).FlexGrid.Redraw = True
        Else
            '恢复查找复合列表项
            mblnComboxNoClick = True
            mclsList(.Tab).InitcboFindKind
            mblnComboxNoClick = False
            
            '恢复查找内容
            If mclsList(.Tab).FlexGrid.Rows > 1 And mclsList(.Tab).FlexGrid.ColSel > 0 Then
                txtFind.Text = mclsList(.Tab).FlexGrid.TextMatrix(mclsList(.Tab).FlexGrid.Row, mclsList(.Tab).SortCol)
            Else
                txtFind.Text = ""
            End If
            UpdateMenuStatus
        End If
        
        '恢复“全部显示”复选框
        mblnCheckNoChange = True
        chkShowall.Value = IIf(mclsList(.Tab).ShowAll, 1, 0)
        mblnCheckNoChange = False
'
        RedrawForm
        mclsList(.Tab).FlexNoChange = False
        mclsList(.Tab).FindNoChange = False
    End With
End Sub

'
'查找内容 TextBox 控件
'
Private Sub txtFind_Change()
    mclsList(sstCustom.Tab).TextFind txtFind.Text
End Sub

'
' FLEXGRID控件
'
'双击FLEXGRID调用卡片
Private Sub msgPaymentMethod_DblClick()
    With mclsList(sstCustom.Tab).FlexGrid
    If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
        mclsMainControl_EditEdit
    End If
    End With
End Sub

'恢复“停用”列光标
Private Sub msgCustom5_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   With msgCustom5
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
  End With
End Sub

'
'响应主控对象事件
'
'编辑卡片
Private Sub mclsMainControl_EditEdit()
    Dim lngID As Long
    lngID = ListID(sstCustom.Tab)
    Me.Enabled = False
    If lngID > 0 Then
        If CheckIDUsed("Custom" & sstCustom.Tab, "lngCustomID", lngID) Then
'            frmDefineListCard.EditCard Left(sstCustom.Caption, Len(sstCustom.Caption) - 4), lngID
            frmDefineCard.EditCard Left(sstCustom.Caption, Len(sstCustom.Caption) - 4), lngID, vbModal
            Set frmDefineCard = Nothing
        Else
            ShowMsg 0, "该自定项目不存在,不能进行修改！", _
                   vbExclamation + MB_TASKMODAL, "修改自定项目"
            ToolRefresh sstCustom.Tab
        End If
    End If
    Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
'    frmDefineListCard.AddCard Left(sstCustom.Caption, Len(sstCustom.Caption) - 4)
    frmDefineCard.AddCard Left(sstCustom.Caption, Len(sstCustom.Caption) - 4), vbModal
    Set frmDefineCard = Nothing
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
'    Dim lngID As Long
'    Dim recRecordset As Recordset
'
'    lngID = ListID(sstCustom.Tab)
''    If mIsShowCard Then
''        If lngID = frmPaymentMethodCard.PaymentMethodID Then
''            MsgBox "不能删除当前编辑的付款方式！", vbExclamation
''            frmPaymentMethodCard.SetFocus
''            Exit Sub
''        End If
''    End If
'
'    Set recRecordset = GetByListID(sstCustom.Tab, lngID)
'    If recRecordset.RecordCount = 0 Then    '当前付款方式已被其他用户删除
'        mclsMainControl_ToolRefresh
'    Else
'
'        If IsUsePaymentMethodID(lngID) Then
''            Select Case sstCustom.Tab
''                Case 0:
'                    MessageBox Me.hWnd, "当前选定的自定项目" & sstCustom.Tab & "正在使用，不能删除！", "部门删除提示", &H40&
''                Case 1:
''                    MessageBox Me.hWnd, "当前选定的职员正在使用，不能删除！", "职员删除提示", &H40&
'            'End Select
'        Else
''            If sstCustom.Tab = 0 Then
''               If recRecordset!blnIsdetail Then
''                  If DelByPaymentMethodID(lngID, sstCustom.Tab) Then
''                     msgCustom0.RowHeight(msgCustom0.Row) = 0
''                     msgCustom0.RowData(msgCustom0.Row) = 1
''                     mclsList(0).SetFlexRow
''                  End If
''               Else
''                  ShowMsg hWnd, "对不起，只有末级部门才能删除！", vbCritical
''               End If
''            Else
''               If DelByPaymentMethodID(lngID, 1) Then
''                  msgCustom1.RowHeight(msgCustom1.Row) = 0
''                  msgCustom1.RowData(msgCustom1.Row) = 1
''                  mclsList(1).SetFlexRow
''               End If
''            End If
''        End If
'        Select Case sstCustom.Tab
'            Case 0
'               If DelOperator(recRecordset!blnIsDetail, msgCustom0, 0, lngID) Then gclsSys.SendMessage CStr(Me.hWnd), Message.msgCustom1
'
'            Case 1
'               If DelOperator(recRecordset!blnIsDetail, msgCustom1, 1, lngID) Then gclsSys.SendMessage CStr(Me.hWnd), Message.msgCustom2
'
'            Case 2
'               If DelOperator(recRecordset!blnIsDetail, msgCustom2, 2, lngID) Then gclsSys.SendMessage CStr(Me.hWnd), Message.msgCustom3
'
'            Case 3
'               If DelOperator(recRecordset!blnIsDetail, msgCustom3, 3, lngID) Then gclsSys.SendMessage CStr(Me.hWnd), Message.msgCustom4
'
'            Case 4
'               If DelOperator(recRecordset!blnIsDetail, msgCustom4, 4, lngID) Then gclsSys.SendMessage CStr(Me.hWnd), Message.msgCustom5
'
'            Case 5
'               If DelOperator(recRecordset!blnIsDetail, msgCustom5, 5, lngID) Then gclsSys.SendMessage CStr(Me.hWnd), Message.msgCustom6
'
'        End Select
'    End If
'End If
'    recRecordset.Close
    Dim lngID As Long
    lngID = ListID(sstCustom.Tab)
    Dim intOldRow As Integer
    If mIsShowCard Then
'        If lngID = frmDefineListCard.getID And lngID > 0 Then
        If lngID = frmDefineCard.getID And lngID > 0 Then
            MsgBox "不能删除当前编辑的自定义项目！", vbExclamation
'            frmDefineListCard.Show
'            frmDefineListCard.ZOrder 0
            frmDefineCard.EditCard Left(sstCustom.Caption, Len(sstCustom.Caption) - 4), lngID, vbModal
            Set frmDefineCard = Nothing
            Exit Sub
        End If
    End If
    intOldRow = mclsList(sstCustom.Tab).FlexGrid.Row
'   If frmDefineListCard.DelCard(Left(sstCustom.Caption, Len(sstCustom.Caption) - 4), ListID(sstCustom.Tab)) Then
    If frmDefineCard.DelCard(Left(sstCustom.Caption, Len(sstCustom.Caption) - 4), ListID(sstCustom.Tab)) Then
        UpDatePreFlage
        With mclsList(sstCustom.Tab).FlexGrid
            .RowHeight(intOldRow) = 0
            .RowData(intOldRow) = 1
        End With
        mclsList(sstCustom.Tab).SetFlexRow
        Select Case sstCustom.Tab
            Case 0
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom1
            Case 1
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom2
            Case 2
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom3
            Case 3
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom4
            Case 4
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom5
            Case 5
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom6
        End Select
    End If
    Unload frmDefineCard
    Set frmDefineCard = Nothing
    UpdateMenuStatus
    'If Not frmDefineListCard.Visible Then
'    Unload frmDefineListCard
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
'    With sstCustom
'         If UpdateListInActive(.Tab, ListID(.Tab), Not L