frmadjustprice.frm

金算盘软件代码

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

Public Sub ResponseMessage()
    Dim vntMessage As Variant
    Dim lngOldID As Long
    
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgItem Then  '接收到科目改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            lngOldID = refInput1.ID
            clsBill.AddReferOfItem
            refInput1.SeekId lngOldID
        End If
    Next
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents = True Then Exit Sub
    blnNotRaiseEvents = True
    clsBill.GrdCol_Mouseup Button, Shift, x, y
    If Button = vbRightButton Then
        MakeListActivityMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListActivity
        If clsBill Is Nothing Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
        clsBill.blnNotRespondKeyPress = False
    End If
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub GrdCol_RowColChange()
    clsBill.GrdCol_RowColChange
End Sub

Private Sub grdCol_Scroll()
    clsBill.grdCol_Scroll
End Sub

Private Sub LblBack_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents = True Then Exit Sub
    clsBill.LblBack_MouseUp
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        If clsBill Is Nothing Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
        clsBill.blnNotRespondKeyPress = False
        blnNotRaiseEvents = True
        DoEvents
        blnNotRaiseEvents = False
    End If
End Sub

Private Sub lblField_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents = True Then Exit Sub
    blnNotRaiseEvents = True
    clsBill.Field_MouseUp Index, Button, x, y
    
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        If clsBill Is Nothing Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
        clsBill.blnNotRespondKeyPress = False
    End If
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub


Private Sub lblFieldCaption_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents = True Then Exit Sub
    blnNotRaiseEvents = True
    clsBill.Field_MouseUp Index, Button, x, y
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        If clsBill Is Nothing Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
        clsBill.blnNotRespondKeyPress = False
    End If
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
    
End Sub

Private Sub lblHead_Change(Index As Integer)
    If Index = 5 Then
        If lblHead(5).Caption <> "" Then
            refTmpID_Change
        End If
    End If
End Sub


Private Sub lblHead_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents = True Then Exit Sub
    Select Case Button
        Case vbRightButton
            clsBill.UpdateMainEditMenu
            MakeListEditMenu
            clsBill.blnNotRespondKeyPress = True
            PopupMenu frmMain.mnuListEdit
            If clsBill Is Nothing Then
                blnNotRaiseEvents = False
                Exit Sub
            End If
            clsBill.blnNotRespondKeyPress = False
            Exit Sub
        Case vbLeftButton
            If (Index \ 2) * 2 = Index Then Exit Sub
            If x >= lblHead(Index).width - clsBill.DropButtonWidth And _
               x <= lblHead(Index).width And _
               y >= 0 And _
               y <= lblHead(Index).Height Then
                clsBill.Head_Click Index, True
            Else
                clsBill.Head_Click Index, False
            End If
            clsBill.UpdateMainEditMenu
    End Select
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub LblMemo_Click(Index As Integer)
    If blnNotRaiseEvents = True Then Exit Sub
    clsBill.Memo_Click Index
End Sub

Private Sub mclsMainControl_ChildActive()
    SetHelpID C2lng(Me.HelpContextID)
    ResponseMessage
    gclsSys.CurrFormName = Me.hwnd
    clsBill.UpdateMainEditMenu
    If WanNeng Then
        tblReceipt.Refresh
    End If
End Sub

Private Sub mclsMainControl_EditDel()
   mclsMainControl_ListEditMenu (1)
End Sub

Private Sub mclsMainControl_EditDelLine()
    mclsMainControl_ListActivityMenu (1)
End Sub

Private Sub mclsMainControl_EditInActive()
    If chkPrint(1).Value <> 0 Then
        chkPrint(1).Value = 0
    Else
        chkPrint(1).Value = 1
    End If
End Sub

Private Sub mclsMainControl_EditInsLine()
    mclsMainControl_ListActivityMenu (0)
End Sub

Private Sub mclsMainControl_EditNew()
   mclsMainControl_ListEditMenu (0)
End Sub

Private Sub mclsMainControl_EditShowAll()
    If chkPrint(0).Value <> 0 Then
        chkPrint(0).Value = 0
    Else
        chkPrint(0).Value = 1
    End If
End Sub

Private Sub mclsMainControl_EditShowList()
    ShowRelationList
End Sub

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String, strMsg1(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    clsBill.CHK_CLICK 0
    strMsg1(0) = "确实要删除该条商品调价单记录吗?"
    strMsg1(1) = "确实要删除该条已经作废商品调价单记录吗?"
    strMsg1(2) = "该张商品调价单已经收款,删除将要影响对应的收款单记录,确实要删除该条调价单记录吗?"
    strMsg1(3) = "该张商品调价单已经生成记帐凭证,不能删除!"
    strMsg1(4) = "该张商品调价单已经生成记帐凭证,不能修改!"
    Select Case intIndex
        Case 0  '插入记录
            clsBill.InsertARow
            GrdCol.col = 1
            clsBill.grdCol_EnterCell
            MakeListActivityMenu
        Case 1  '删除记录
            If chkPrint(1).Value = True Then
                intYesNo = ShowMsg(Me.hwnd, strMsg1(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
            Else
                intYesNo = ShowMsg(Me.hwnd, strMsg1(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
            End If
            If intYesNo = IDYES Then
                If GrdCol.Row >= 1 Then
                    If GrdCol.Rows = 2 Then
                        GrdCol.Rows = 1
                    Else
                        GrdCol.RemoveItem GrdCol.Row
                    End If
                End If
                clsBill.blnIsChanged = True
                clsBill.grdCol_EnterCell
                clsBill.WriteTotalRow
           Else
                clsBill.SetAFocus
           End If
            MakeListActivityMenu
        Case 2  'bar
        Case 3  '复制记录
            clsBill.CopyARow
            MakeListActivityMenu
            clsBill.SetAFocus
        Case 4  '粘贴记录
            clsBill.PasteARow
            MakeListActivityMenu
            clsBill.SetAFocus
        Case 5  'Bar
        Case 6  '搜索
            frmTreeFind.ShowFind
        Case 7  '查询缺号
            frmBillNo.ShowTypeID C2lng(lblHead(3 - 1).Tag) 'ReceiptTypeID
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(99, clsBill.lngNowID)
            End If
            clsBill.SetAFocus
    End Select
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    strMsg(0) = "确实要删除该张商品调价单全部记录吗?"
    strMsg(1) = "确实要删除该张已经作废商品调价单全部记录吗?"
    strMsg(2) = "该张商品调价单已经收款,删除将要影响对应的收款单记录,确实要删除该张调价单全部记录吗?"
    strMsg(3) = "该张商品调价单已经生成记帐凭证,不能删除!"
    strMsg(4) = "该张商品调价单已经生成记帐凭证,不能修改!"
    Select Case intIndex
        Case 0  '插入单据
            clsBill.CHK_CLICK 9
            If clsBill.blnIsChanged Then
                If ChangeSaveNote = False Then Exit Sub
            ElseIf clsBill.lngNowID = 0 Then
                Exit Sub
            End If
            ShowANewBill
'            clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
        Case 1  '删除单据
            Dim mclsAdjust  As New clsAdjust
            If Not mclsAdjust.DeleteAdjustPrice(clsBill.lngNowID) Then Exit Sub
            clsBill.blnIsChanged = False
            cmdNext_Click
'            ShowANewBill
            gclsSys.SendMessage Me.hwnd, 59
        Case 2  'BAR
        Case 3  '复制单据
            clsBill.SaveBillToCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 4  '粘贴单据
            clsBill.LoadBillFromCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 5  'BAR
        Case 6  '搜索
            frmTreeFind.ShowFind
        Case 7  '查询单据缺号
            frmBillNo.ShowTypeID C2lng(lblHead(3 - 1).Tag) 'ReceiptTypeID
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(99, clsBill.lngNowID)
            End If
            clsBill.SetAFocus
        Case 8  '模板表体列宽恢复
            ModifyColWidthDefault Me
            clsBill.TemplateChange C2lng(lblHead(4).Tag)
            clsBill.SetAFocus
        Case 10 '筛选
            mclsMainControl_EditFilter
        Case 11 'lIST
            mclsMainControl_ReceiptList
        Case 12 'go
            mclsMainControl_ReceiptPosition
        Case 13
            mclsMainControl_FilePrintReceipt
    End Select
End Sub
Private Sub mclsMainControl_ReceiptList()
    CallBillList 29
End Sub
Private Sub mclsMainControl_EditFilter()
    CallBillList 29, True
End Sub

Private Sub mclsMainControl_ReceiptPosition()
    BuildCancelBill False
End Sub
'单据冲销
Private Sub BuildCancelBill(Optional ByVal GenCancel As Boolean = True)
    Dim lngOldID As Long
    
    clsBill.blnKeyDown = False
    If ChangeSaveNote() = False Then
        Exit Sub
    End If
    If GenCancel Then
        lngOldID = frmWriteOffBill.WriteOffBill(29, clsBill.lngNowID, Me.hwnd, , clsBill.intAccountYear, clsBill.bytAccountPeriod)
    Else
        lngOldID = frmWriteOffBill.SeekBill(29, clsBill.lngNowID, Me.hwnd, , clsBill.intAccountYear, clsBill.bytAccountPeriod)
    End If
    If lngOldID = 0 Then
    Else
        ShowAOldBill lngOldID
    End If
End Sub

Private Sub refTmpID_Change()
    clsBill.TemplateChange C2lng(lblHead(4).Tag)
End Sub

Private Sub SaveAdjust(recTmp As rdoResultset)
        With recTmp
            !intYear = clsBill.intAccountYear
            !bytPeriod = clsBill.bytAccountPeriod
            !strReceiptNo = SubStr(strAlphaOfStr(LTrim(lblField(1).Caption)), 1, 6)
            If IsNull(!strReceiptNo) Then
                !strReceiptNo = " "
            ElseIf !strReceiptNo = "" Then
                !strReceiptNo = " "
            End If
            !lngReceiptNo = C2Dbl(strDigitOfStr(LTrim(lblField(1).Caption)))
             !lngTemplateID = C2lng(lblHead(5 - 1).Tag) '模板ID
             !lngEmployeeID = clsBill.getFieldID(3)   '人员ID
             !lngDepartmentID = clsBill.getFieldID(4)   '部门