frmlistsalesorder.frm

金算盘软件代码

            .mnuEditShowAll.Checked = False
        End If
        If chkShowAll.Enabled = True Then
            .mnuEditShowAll.Enabled = True
        Else
            .mnuEditShowAll.Enabled = False
        End If
        .mnuEditColumn.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        .mnuFilePrintReceipt.Enabled = True
        .mnuReportQuick.Enabled = blnIsnotEmpty
        .mnuToolRefresh.Enabled = True
        
        .mnuEditEdit.Caption = "修改(&E)"
        .mnuEditNew.Caption = "新增(&N)"
        .mnuEditDel.Caption = "删除(&D)"
        .mnuEditInActive.Caption = "作废(&H)"
        .mnuEditShowAll.Caption = "全部显示(&W)"
        .mnuEditInActive.Visible = False
        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0)       '修改
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1)        '新增
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)        '删除
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)       '----
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)   '作废
        .mnuListEditMenu(4).Visible = True
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)    '显示所有/显示非作废
        .mnuListEditMenu(5).Visible = True
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)       '----
        .mnuListEditMenu(6).Visible = True
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(7)     '筛选
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(8)     '栏目设置
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)       '----
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(10)   '刷新
        Utility.CloneMenu .mnuFilePrintReceipt, .mnuListEditMenu(11)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(12)     '打印
    End With
    
    If grdList.ColSel = 0 Then  '无当前选定行
        blnFindNoChange = mclsList.FindNoChange
        mclsList.FindNoChange = True
        txtFind.Text = ""
        mclsList.FindNoChange = blnFindNoChange
        cmdAgain.Enabled = False
    End If
    frmMain.SetToolBar
End Sub

'重画Form
Private Sub RedrawForm()
    
    txtFind.width = Me.ScaleWidth - txtFind.Left - ListFormBottom - cmdAgain.width - 15
    cmdAgain.Left = txtFind.Left + txtFind.width
    cmdEdit.top = Me.ScaleHeight - cmdEdit.Height - ListFormBottom
    cmdReport.top = cmdEdit.top
    chkShowAll.top = cmdEdit.top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.width - ListFormBottom
    With grdList
        .Left = ListFormLeft
        .width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight
    End With
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 mclsMainControl_FilePrintSetup()
    Dim myPrintclass As PrintClass
    
    Set myPrintclass = New PrintClass
    myPrintclass.PrintSetUp gclsBase.BaseDB, mclsList.FlexGrid, , , , 38, Me.Caption & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName '销售订单
    Set myPrintclass = Nothing
End Sub
Private Sub mclsMainControl_FilePrintReceipt()
    frmPrintReceipt.ShowfrmPrintReceipt 24
End Sub
Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    mclsList.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 = 350
        MinMax.ptMinTrackSize.y = 250
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub
'//////////////////////////////////////////////////////////////
'///////        窗体 Form 控件
'//////////////////////////////////////////////////////////////

Private Sub Form_Load()
    Dim i As Integer
    Dim intSortCol As Integer
    
'    Me.Hide
'    Me.Left = -30000
    On Error GoTo ErrHandle
    MsgForm.PleaseWait
    Screen.MousePointer = vbHourglass
    
    '热键帮助(F1)
    Me.HelpContextID = 40003  '24005
    frmMain.mnuTaskSaleOrder.Tag = Me.hwnd
    blnEdit = IsCanDo(frmRightsID.frmListSalesOrderID) '判断有无编辑权限
    
    Set mclsSalesOrder = New clsSalesOrder
    mclsSalesOrder.SethWnd Me.hwnd
    Set theEditForm = FrmSaleOrder
    
    Set mclsList = New list
    mclsList.FlexNoChange = True
    mclsList.FindNoChange = True
    Set mclsList.FlexGrid = grdList
    Set mclsList.FindKind = cboFindKind
    Set mclsList.Find = txtFind
    Set mclsList.Again = cmdAgain

    mclsList.ListSet.ViewId = intViewID
    mclsList.InitFlexGrid
    
'    得到付款条件列表记录集
'    Set datGrid.Resultset = GetList()
'    datGrid.Resultset.Close
'
'    mclsList.SetFlexGrid
'
'    初始化查找复合列表框
'    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
'
'    UpdateMenuStatus
    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
    Unload MsgForm
    Screen.MousePointer = vbDefault
    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
        MakeListEditMenu
        UpdateMenuStatus
        PopupMenu frmMain.mnuListEdit
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'    If UnloadMode = vbFormControlMenu And mIsShowEdit Then
'        cMsgBox "请先关闭销售订单的编辑窗口 ！"
'        Cancel = True
'        theEditForm.SetFocus
'    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    On Error Resume Next
    If mclsList.ListSet.ListID < 1 Then
       mclsList.SaveListSet
       DefaultCurrentDate mclsList.ListSet.ListID, 10521
    Else
       mclsList.SaveListSet
    End If
    blnMenuBuilded = False
    frmMain.mnuTaskSaleOrder.Tag = 0
    Set datGrid.Resultset = Nothing
    Set mclsSubClassform = Nothing
    Set mclsSubClass = Nothing
    Set theEditForm = Nothing
    Set mclsList = Nothing
    Set mclsSalesOrder = Nothing
    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) And Me.WindowState <> 2 Then
        Me.Left = 300
    End If
    RedrawForm
End Sub

Private Sub Form_Activate()
    
    SetHelpID Me.HelpContextID
    If (Me.Left + Me.width) < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
    'grdList.SetFocus
    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
End Sub

Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    SetHelpID Me.HelpContextID
    If gclsBase.OperatorID <> lngOldOperatorID Then '系统重新登录（更换了操作员）
        lngOldOperatorID = gclsBase.OperatorID
        blnEdit = IsCanDo(frmRightsID.frmListSalesOrderID) '判断有无编辑权限
    End If
    
    '响应消息:msgReceipt12 = 42  '销售订单
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgReceipt12 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
    
    With grdList
        .Redraw = False
        mclsList.ReGetColCaption
        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
        intSelLen = txtFind.SelLength
        If txtFind.SelStart > 0 Then txtFind.SelStart = txtFind.SelStart - 1
        txtFind.SelLength = intSelLen + 1
    End If
End Sub

Private Sub grdList_DblClick()
    With grdList
        If .Row > 0 And .RowHeight(.Row) > 0 And .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 Then
            bDblClick = True
            SetCapture theEditForm.hwnd
            mclsMainControl_EditEdit
        End If
    End With
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 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()