frmitemlist.frm

金算盘软件代码

    Dim intSortCol As Integer
    
    If mblnComboxNoClick Then Exit Sub
    mclsList(sstTypAct.Tab).ReGetColCaption
    With mclsList(sstTypAct.Tab).FlexGrid
        .Redraw = False
        For i = 1 To .Cols - 1
            If .TextMatrix(0, i) = cboFindKind.Text Then
                If .RowHeight(.Row) > 0 Then strFind = .TextMatrix(.Row, i)
                mclsList(sstTypAct.Tab).FixrowSortBold i
                Exit For
            End If
       Next
    End With
    
    If mclsList(sstTypAct.Tab).FlexGrid.Rows > 1 Then
       If txtfind.Text = strFind Then
          txtFind_Change
       Else
          txtfind.Text = strFind
       End If
    End If
    mclsList(sstTypAct.Tab).FlexGrid.Redraw = True
  '  mclsList(sstTypAct.Tab).FlexGrid.SetFocus
End Sub




Private Sub mclsMainControl_ChildActive()
     Dim vntMessage As Variant
     
     SetHelpID Me.HelpContextID
     gclsSys.CurrFormName = Me.hwnd
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        Select Case vntMessage
            Case Message.msgItemType
                '接收到部门雇员改变消息
                  ToolRefresh 0
                  mclsMainControl.Messages.Remove CStr(vntMessage) '清除部门雇员改变消息
            Case Message.msgItem
                    ToolRefresh 2
                    #If conTest = 1 Then
                        ToolRefresh 5
                    #End If
                    mclsMainControl.Messages.Remove CStr(vntMessage)
            Case Message.msgItemNature
                    ToolRefresh 1
                    
                    mclsMainControl.Messages.Remove CStr(vntMessage)
            Case Message.msgTax    '接收到部门雇员改变消息
                    ToolRefresh 3
                    mclsMainControl.Messages.Remove CStr(vntMessage) '
            Case Message.msgPosition    '接收到部门雇员改变消息
                    ToolRefresh 4
                    mclsMainControl.Messages.Remove CStr(vntMessage) '
        End Select
    Next
    mclsMainControl.Messages.Clear
    UpdateMenuStatus
End Sub

Private Sub mclsMainControl_EditColumn()
    With sstTypAct
        If mclsList(.Tab).ListSet.ShowListSet(intViewID(.Tab)) Then
            blnIsLoad(.Tab) = False
            sstTypAct_Click .Tab
        End If
    End With
End Sub

Private Sub mclsMainControl_EditFilter()
    '筛选
    Dim blnFlage(5) As Boolean
    
With sstTypAct
'    If Not mblnIsSaveListset(.Tab) Then
'        If Not FindlngViewID(intViewID(.Tab)) Then mclsList(.Tab).ListSet.SaveList
'        mblnIsSaveListset(.Tab) = True
'    End If
    If mclsList(.Tab).ListSet.ListID < 1 Then mclsList(.Tab).ListSet.SaveList
    Filter.ShowFilter mclsList(.Tab).ListSet.ListID, 1, , , , , blnFlage(.Tab)
    If Not blnFlage(.Tab) Then Exit Sub
    mclsList(.Tab).SaveListSet
    mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
    mclsList(.Tab).FlexGrid.Cols = 0
    Set datItem(.Tab).Resultset = GetList(.Tab)
    If Not datItem(.Tab).Resultset.EOF Then datItem(.Tab).Resultset.MoveLast
    datItem(.Tab).Resultset.Close
    'Set datItem(.Tab).Recordset = Nothing
    mclsList(.Tab).SetFlexGrid
    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList(.Tab).InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList(.Tab).DoShowAll False
    
End With
End Sub

Private Sub mclsMainControl_EditNotepad()
  '记事簿
    Dim strCode As String
    Dim strName As String
    Dim recCurre As rdoResultset
    Dim i As Integer
    Dim strResult As String
    Dim strSql As String
    Set recCurre = GetbyListID(sstTypAct.Tab, ListID(sstTypAct.Tab))
    With mclsList(sstTypAct.Tab).FlexGrid
        Select Case sstTypAct.Tab
            Case 2
               If .Row > 0 Then
                    For i = 0 To mclsList(sstTypAct.Tab).ListSet.FixColumns - 1
                        If .TextMatrix(0, i + 2) = "商品编码" Or .TextMatrix(0, i + 2) = "商品编码↑" Or .TextMatrix(0, i + 2) = "商品编码↓" Then
                            strCode = .TextMatrix(.Row, i + 2)
                        ElseIf .TextMatrix(0, i + 2) = "商品名称" Or .TextMatrix(0, i + 2) = "商品名称↑" Or .TextMatrix(0, i + 2) = "商品名称↓" Then
                            strName = .TextMatrix(.Row, i + 2)
                        End If
                    Next i
                End If
                strResult = frmNotePad.EditCard("商品劳务", strCode, strName, recCurre!strNotes)
                If strResult = "" Then Exit Sub
                strSql = "Update Item Set strNotes='" & strResult & "'Where lngItemID=" & ListID(sstTypAct.Tab)
            Case 4
                If .Row > 0 Then
                    For i = 0 To mclsList(sstTypAct.Tab).ListSet.FixColumns - 1
                        If .TextMatrix(0, i + 2) = "货位编码" Or .TextMatrix(0, i + 2) = "货位编码↑" Or .TextMatrix(0, i + 2) = "货位编码↓" Then
                            strCode = .TextMatrix(.Row, i + 2)
                        ElseIf .TextMatrix(0, i + 2) = "货位名称" Or .TextMatrix(0, i + 2) = "货位名称↑" Or .TextMatrix(0, i + 2) = "货位名称↓" Then
                            strName = .TextMatrix(.Row, i + 2)
                        End If
                    Next i
                End If
                strResult = frmNotePad.EditCard("商品货位", strCode, strName, recCurre!strNotes)
                If strResult = "" Then Exit Sub
                strSql = "Update Position Set strNotes='" & strResult & "'Where lngPositionID=" & ListID(sstTypAct.Tab)
        End Select
    End With
    gclsBase.ExecSQL (strSql)
End Sub

Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Set MyPrintSet = New PrintClass
    With sstTypAct
        Select Case .Tab
            Case 0
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 22, "商品类型 " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 1
                MyPrintSet.PrintList gclsBase.BaseDB, mclsList(sstTypAct.Tab).FlexGrid, 66, "商品性质 " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 2
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 61, "商品劳务 " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 3
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 91, "商品税率 " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 4
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 24, "商品货位 " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 5
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 88, "商品库存 " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        End Select
    End With
    Set MyPrintSet = Nothing
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    Select Case intIndex
           Case 0
'                mclsMainControl_ReportQuick
'           'Case 1
'
'           Case 2
                Report.ShowListReport 306, 326
           Case 1
                'ItemTable
                Report.ShowListReport 77, 131
           Case 2
                Report.ShowListReport 313, 333
        #If conVersionType <> 16 Then
           Case 3
                Report.ShowListReport 83, 137
        #End If
    End Select
    
End Sub

'职员一览表
'Private Sub DepartTable()
'
'End Sub

'商品劳务一览表
Private Sub ItemTable()
    Report.ShowListReport 77, 131
End Sub

'快捷报表
Private Sub mclsMainControl_ReportQuick()

End Sub

Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    'Debug.Print "hookWhere:"; Msg & " " & wParam & " " & lParam
    mclsList(sstTypAct.Tab).HookProc Msg, wParam, lParam, mclsSubClass
End Sub

Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)
        
        MinMax.ptMinTrackSize.x = 500
        MinMax.ptMinTrackSize.y = 250
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub



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

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

Private Sub msgItemNature_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgItemNature
        If Button = vbLeftButton Then
'            If chkShowAll.Value = 1 And .ColSel > 0 And .MouseRow > 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 msgItemType_DblClick()
       With msgItemType
            If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
               mclsMainControl_EditEdit
            End If
       End With
       
End Sub

'单击FLEXGRID停用列,停用或启用当前记录
Private Sub msgItemType_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    
    With msgItemType
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

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

Private Sub msgItem_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgItem
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgItem_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgItem
        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 msgPostion_DblClick()
    With msgPostion
        If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
           mclsMainControl_EditEdit
        End If
   End With
End Sub

Private Sub msgPostion_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     With msgPostion
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgPostion_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgPostion
        If .Rows > 1 Then
            If .MouseCol = 1 And .MouseRow <> 0 Then
                .MousePointer = vbCustom
            Else
                 .MousePointer = vbDefault
            End If
        Else
            .MousePointer = vbDefault
        End If
    End With
End Sub

Private Sub msgPostion_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgPostion
        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 msgStock_DblClick()
    Dim intPasteCol As Integer
    
    intPasteCol = GetCol("外库数量", 5)
   
    With msgStock
        
        If .Row < 1 Then Exit Sub
        If .MouseCol = intPasteCol Then
            clePaste.Left = .ColPos(intPasteCol) + 170
            clePaste.top = .RowPos(.Row) + 500
            If .ColPos(intPasteCol) + .ColWidth(intPasteCol) < .width - 60 Then
                clePaste.width = .ColWid