frmlistsales.frm

金算盘软件代码

'    datGrid.Resultset.Close
'    Debug.Print "Sale Form_load Start:" & time
'    mclsList.SetFlexGrid
'
''    HideColOfMe Me
'    '初始化查找复合列表框
'    mclsList.InitcboFindKind
'    mclsList.FlexNoChange = False
'    mclsList.FindNoChange = False
'
'    '设置第一行为选定行
'    With grdList
'        If .Rows > 1 Then grdList.Row = 1
'        .col = 0
'        .ColSel = .Cols - 1
'    End With
'    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
    '设置钩子对象
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hwnd = grdList.hwnd
    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 intFormType = 20 Then
'        chkShowAll.Visible = False
'        chkShowAll.Enabled = False
'    End If
    Unload MsgForm
     Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload MsgForm
         Unload Me
    End If
End Sub

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

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'    If UnloadMode = vbFormControlMenu And lngFormHwnd(intFormType + 2) > 0 Then
'        cMsgBox "请先关闭" & strTypeName & "的编辑窗口 ！"
'        Cancel = True
'        frmEdit.Show
'        frmEdit.ZOrder 0
'    End If
    If mblnFinish Then Cancel = 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    If mclsList.ListSet.ListID < 1 Then
        mclsList.SaveListSet
        DefaultWhere intFormType, mclsList.ListSet.ListID
    Else
        mclsList.SaveListSet
    End If
    Filter.DelSelectedCond mclsList.ListSet.ListID, 1 '删除过滤条件
    blnMenuBuilded = False
    Set mclsSubClass = Nothing
    Set mclsSubClassform = Nothing
    Set mclsList = Nothing
    Set mclsSales = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    Select Case intFormType
    Case 11 '商品销售
        frmMain.mnuTaskSale.Tag = 0
    Case 12 '直运销售
        frmMain.mnuTaskDirectSale.Tag = 0
    Case 13 '代销出库
        frmMain.mnuTaskLendOut.Tag = 0
    Case 14 '代销结算
        frmMain.mnuTaskLendSale.Tag = 0
    Case 15 '加工出库
        frmMain.mnuInventoryEntrustOut.Tag = 0
    Case 16 '分期出库
        frmMain.mnuTaskStageOut.Tag = 0
    Case 17 '分期结算
        frmMain.mnuTaskStageSale.Tag = 0
    Case 18 '销售发票
        frmMain.mnuTaskSaleInvoice.Tag = 0
    Case 19 '领用出库
        frmMain.mnuInventoryOut.Tag = 0
    Case 20 '成本调整
        frmMain.mnuInventoryCostAdjust.Tag = 0
    Case 21 '盘亏出库
        frmMain.mnuInventoryCheckDown.Tag = 0
    Case 22 '其它出库
        frmMain.mnuInventoryOtherOut.Tag = 0
    End Select
'    Set frmStockSales(intFormType + 2) = Nothing
    Set frmEdit = Nothing
End Sub

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

Private Sub Form_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    If KeyAscii = vbKeyEscape Then
        Unload Me
    ElseIf KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_Activate()
    
    
    'grdList.SetFocus
    SetHelpID Me.HelpContextID
    grdList.Redraw = True
    strOldMenuCaption = frmMain.mnuEditInActive.Caption
    frmMain.mnuEditInActive.Caption = "作废(&H)"
    frmMain.mnuEditShowAll.Caption = "全部显示(&W)"
    MakeListEditMenu
    MakeListEditMenu
    MakeListReportMenu
    gclsSys.CurrFormName = Me.hwnd
    mclsMainControl_ChildActive
    UpdateMenuStatus
    blnMenuBuilded = True
    frmMain.mnuEditSearch.Enabled = False
    If (Me.Left + Me.width < 0 Or Me.Left > Screen.width) Then Me.Left = 300
    If Me.WindowState = 1 Then Me.WindowState = 0
End Sub

'响应消息
Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    
    SetHelpID Me.HelpContextID
    If gclsBase.OperatorID <> lngOldOperatorID Then '系统重新登录（更换了操作员）
        lngOldOperatorID = gclsBase.OperatorID
        Select Case intFormType
        Case 11 '商品销售
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_11) '判断有无编辑权限
        Case 12 '直运销售
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_12)
        Case 13 '代销出库
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_13)
        Case 14 '代销结算
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_14)
        Case 15 '加工出库
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_15)
        Case 16 '分期出库
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_16)
        Case 17 '分期结算
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_17)
        Case 18 '销售发票
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_18)
        Case 19 '领用出库
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_19)
        Case 20 '成本调整
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_20)
        Case 21 '盘亏出库
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_21)
        Case 22 '其它出库
            blnEdit = IsCanDo(frmRightsID.frmListSalesID_22)
        End Select
    End If
'响应消息:
'        msgReceipt13 = 43                            '商品销售
'        msgReceipt14 = 44                            '直运销售
'        msgReceipt15 = 45                            '代销出库
'        msgReceipt16 = 46                            '代销结算
'        msgReceipt17 = 47                            '加工出库
'        msgReceipt18 = 48                            '分期出库
'        msgReceipt19 = 49                            '分期结算
'        msgReceipt20 = 50                            '销售发票
'        msgReceipt21 = 51                            '领用出库
'        msgReceipt22 = 52                            '成本调整
'        msgReceipt23 = 53                            '盘亏出库
'        msgReceipt24 = 54                            '其他出库
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = 32 + intFormType Then
            mclsMainControl_ToolRefresh
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除消息
        End If
    Next
    mclsMainControl.Messages.Clear
    UpdateMenuStatus
End Sub

Private Sub Form_Deactivate()
    frmMain.mnuEditInActive.Caption = strOldMenuCaption
    blnMenuBuilded = False
    frmMain.mnuEditSearch.Enabled = False
    frmMain.mnuFilePrintReceipt.Enabled = False
    frmMain.SetEditUnEnabled
End Sub

'查找条件类型 ComboBox 控件
Private Sub cboFindKind_Click()
    Dim i As Integer
    Dim intWidth As Integer
    Dim strFind As String
    Dim intSortCol As Integer
    mclsList.ReGetColCaption
    With grdList
        .Redraw = False
        For i = 1 To .Cols - 1
            If .TextMatrix(0, i) = cboFindKind.Text Then
                '保存新排序列内容
                If .RowHeight(.Row) = 0 Then
                    strFind = ""
                Else
                    strFind = .TextMatrix(.Row, i)
                End If
                '重新排序
                mclsList.FixrowSortBold i
                Exit For
            End If
       Next
    End With
    
    '恢复以前选定行
    If grdList.Rows > 1 Then
        If txtFind.Text = strFind Then
            txtFind_Change
        Else
            txtFind.Text = strFind
        End If
    End If
    grdList.Redraw = True
End Sub

Private Sub txtFind_Change()
    mclsList.TextFind txtFind.Text
End Sub

Private Sub txtFind_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim intSelLen As Integer
'    If txtFind.Text = "" Then Exit Sub
    If KeyCode = 8 Then
        Debug.Print txtFind.Text
        intSelLen = txtFind.SelLength
        If txtFind.SelStart > 1 Then
            txtFind.SelStart = txtFind.SelStart - 1
            txtFind.SelLength = intSelLen + 1
        End If
    End If
End Sub

Private Sub grdList_DblClick()
    If grdList.Row > 0 And grdList.MouseRow > 0 And grdList.ColSel > 0 And grdList.MouseCol > 1 Then
        bDblClick = True
        'If frmMain.mnuEditEdit.Enabled = False Then Exit Sub
        mclsMainControl_EditEdit
    End If
End Sub

'弹出右键菜单
Private Sub grdlist_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    With grdList
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

'鼠标左键弹起时，更新菜单
Private Sub grdList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With grdList
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    mclsMainControl_EditInActive
                End If
            End If
            UpdateMenuStatus
        End If
    End With
End Sub

'显示全部记录/未停用记录 CheckBox 控件
Private Sub chkShowAll_Click()
    grdList.Redraw = False
    mclsList.DoShowAll chkShowAll.Value
    grdList.Redraw = True
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    UpdateMenuStatus
End Sub

Private Sub cmdEdit_Click()
    UpdateMenuStatus
    PopupMenu frmMain.mnuListEdit, , cmdEdit.Left, cmdEdit.top + cmdEdit.Height
End Sub

Private Sub cmdReport_Click()
    MakeListReportMenu
    PopupMenu frmMain.mnuListReport, , cmdReport.Left, cmdReport.top + cmdReport.Height
End Sub

'/////////////////////////////////////////////////////////////////////////////////
'////////
'////////
'////////                            按纽菜单
'////////
'////////
'/////////////////////////////////////////////////////////////////////////////////

Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    Dim i As Integer
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        For i = 1 To 14
            Load .mnuListEditMenu(i)
        Next i