frmadjustprice.frm

金算盘软件代码

Attribute mclsMainControl.VB_VarHelpID = -1
Dim lgID As Long
Dim srName As String
Dim srCode As String
Dim blnNotResize As Boolean
Dim blnIsCanEventChk_Click As Boolean       '确定在LOADBILL时是否激活CHK——CLICK事件
Dim lngVoucherID As Long
Dim blnEdit As Boolean  '填制权限
Dim blnView As Boolean  '查询权限
Dim blnNotRaiseEvents As Boolean  '不响应按键事件标志
Dim dblFacter As Double
Dim blnIsLoading As Boolean '正在引入数据标志
Private blnFirstIn As Boolean '首次进入窗体（从SHOWANEWTYPEBILL和showaoldbill)标志
Private blnPrinted As Boolean '已打印标志


Private Sub cmbInput_Click()
    clsBill.SaveInput2Form
    If clsBill.bytRegion = FHead Then
        Dim lngID As Long
        Dim lngT As Long
        Dim strT As String
        Dim strC As String
        lngID = BillPublic.ReceiptNameToTypeID(cmbInput.Text)
        lngT = FirstId(xTemplatE, lngID)
        Call BillPublic.IdToCodeAndName(xTemplatE, lngT, strC, strT)
        lblHead(4).Tag = lngT
        lblHead(5).Caption = strT
    End If
End Sub

Private Sub cmdButton_GotFocus(Index As Integer)
'    clsBill.InputCtrInvisible
'    clsBill.bytRegion = FcmdButton
'    clsBill.bytIndex = Index

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    clsBill.Form_key_Down KeyCode
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If blnNotRaiseEvents Then Exit Sub
    Dim CtrDown As Integer
    If KeyCode = 93 Then
        If clsBill.bytRegion = FGrid Or clsBill.bytRegion = FGrid1 Or clsBill.bytRegion = FPicture Then
            GrdCol_Mouseup vbRightButton, 0, 0, 0
        Else
            Form_MouseUp vbRightButton, 0, 0, 0
        End If
        Exit Sub
    End If
    CtrDown = Shift And vbCtrlMask
    If CtrDown > 0 Then
        Select Case KeyCode
            Case 33     'Ctr+PageUp
                cmdButton_Click 1
            Case 34    'Ctl-PageDown
                cmdButton_Click 0
            Case 13    'ctr_Enter
                cmdButton_Click 4
        End Select
        Debug.Print KeyCode
'    ElseIf KeyCode = 27 Then 'ESCAPE
'        cmdButton_Click 5
    Else
        clsBill.Form_KeyDown KeyCode, Shift
    End If
End Sub

Private Sub Form_Load()
'   -------------------------------
    ReceiptTypeID = 9    '商品调价单ID
'   -------------------------------
    Dim i As Integer
    lblHead(2).Tag = 29
    Set clsBill = New itemAdjust
    clsBill.ReceiptTypeID = ReceiptTypeID
    Set clsBill.Form = Me
    
    Me.HelpContextID = 10250
    blnNotResize = True
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    blnNotResize = False
    
    lblHead(2).Tag = 29  '商品调价单
    
'    Me.Hide
'    Me.Left = -30000
    If blnIsLoading = False Then MsgForm.PleaseWait
    If clsBill Is Nothing Then Exit Sub
    clsBill.AddReferOfItem
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents = True Then Exit Sub
    clsBill.Form_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 Form_Resize()
    If Not blnNotResize Then clsBill.Form_Resize
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If gclsSys Is Nothing Then Exit Sub
    If clsBill Is Nothing Then Exit Sub
    If UnloadMode = vbFormControlMenu Then
        If blnNotRaiseEvents = True Then
            gblnCancel = True
            Cancel = 1
            Exit Sub
        End If
    End If
    If clsBill.blnIsChanged Then
        If Not ChangeSaveNote Then
            gblnCancel = True
            Cancel = 1
            Exit Sub
        End If
    End If
    SaveColWidthDefault Me
    gclsSys.MainControls.Remove Me
    
'    frmListAdjustPrice.RefreshList clsBill.lngNowID
    Set mclsMainControl = Nothing
    Set clsBill = Nothing
    Unload MsgForm
    Unload Me
    frmListAdjustPrice.IAmCLosed
End Sub

Private Sub chkPrint0_Click()
    clsBill.blnIsChanged = True
'    frmMain.mnuEditShowAll.Checked = chkPrint(0).Value
End Sub

Private Sub chkPrint1_Click()
    Dim intYesNo As Integer
    If chkPrint(1).Value = 1 And blnIsCanEventChk_Click Then
        blnNotRaiseEvents = True
        chkPrint(1).Value = 0
        intYesNo = ShowMsg(Me.hwnd, "该调价单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "提示信息")
        If intYesNo = IDYES Then
            chkPrint(1).Value = 1
            clsBill.blnIsChanged = True
        End If
        blnNotRaiseEvents = False
    Else
        clsBill.blnIsChanged = True
    End If
    With GrdCol
        RefreshRect .hwnd, .Left + (.width - 140 * Screen.TwipsPerPixelX) \ 2, .RowHeight(0) + (.Height - .RowHeight(0) - 70 * Screen.TwipsPerPixelY) \ 2, .Left + (.width - 140 * Screen.TwipsPerPixelX) \ 2 + 140 * Screen.TwipsPerPixelX, .RowHeight(0) + (.Height - .RowHeight(0) - 70 * Screen.TwipsPerPixelY) \ 2 + 70 * Screen.TwipsPerPixelY
    End With
    clsBill.SetAFocus

End Sub

Private Sub chkPrint_Click(Index As Integer)
    If blnNotRaiseEvents = True Then Exit Sub
    clsBill.CHK_CLICK Index
    Select Case Index
        Case 0
            chkPrint0_Click
        Case 1
            chkPrint1_Click
    End Select
End Sub

Private Sub cmdButton_Click(Index As Integer)
    If blnNotRaiseEvents = True Then Exit Sub
    blnNotRaiseEvents = True
    clsBill.blnKeyDown = False
    If Index <> 5 Then
        clsBill.cmdButton_Click Index
        If clsBill.bytRegion <> FcmdButton Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
    End If
    Select Case Index
        Case 0
            cmdNext_Click       '下一张
        Case 1
            CmdPrev_Click       '上一张
        Case 2
            cmdHome_Click       '最前
        Case 3
            CmdEnd_Click        '最后
        Case 4
            cmdOK_Click         '确定
            Exit Sub
        Case 5
            CmdCancel_Click     '取消
            Exit Sub
        Case 6 '关联凭证
            Dim lngID As Long
            lngID = ActivityIdToVoucherId(clsBill.lngNowID, True)
            FrmVoucher.ShowAOldBill lngID
        Case 7
            CmdPrint_Click      '打印
            clsBill.SetAFocus
    End Select
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub cmdOK_Click()
    If SaveBill() Then
        blnNotRaiseEvents = False
        Unload Me
    End If
    blnNotRaiseEvents = False
End Sub
Private Sub CmdCancel_Click()
    If clsBill.lngNowID = 0 Then
        clsBill.intAccountYear = gclsBase.FYearOfDate(gclsBase.BaseDate)
        clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(gclsBase.BaseDate)
        blnMaxNODecrease clsBill.intAccountYear, clsBill.bytAccountPeriod, 29, strAlphaOfStr(lblField(1).Caption), BillPublic.strDigitOfStr(lblField(1).Caption)
    End If
    clsBill.blnIsChanged = False
    blnNotRaiseEvents = False
    Unload Me
End Sub

Private Sub CmdPrev_Click()
    Dim i As Integer
    If Not ChangeSaveNote Then Exit Sub
    Dim lngID As Long
    lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 0)
    If lngID <= 0 Then
        Exit Sub
    End If
    ShowAOldBill lngID
End Sub

Private Sub cmdNext_Click()
    Dim lngID As Long
    lngID = clsBill.lngNowID
    If clsBill.blnIsChanged Then
        If Not SaveBill() Then Exit Sub
        If clsBill.lngNowID = 0 Then
            Exit Sub
        End If
    ElseIf clsBill.lngNowID = 0 Then
        Exit Sub
    End If
    If lngID > 0 Then
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 1)
    End If
    If lngID < 1 Then
        If blnEdit Then ShowANewBill
    Else
        ShowAOldBill lngID
    End If
End Sub

Private Sub CmdEnd_Click()
    If Not ChangeSaveNote Then Exit Sub
    Dim lngID As Long
    lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 3)
    If lngID = 0 Then Exit Sub
    ShowAOldBill lngID
End Sub

Private Sub cmdHome_Click()
    Dim i As Integer
    If Not ChangeSaveNote Then Exit Sub
'    For i = 0 To 3
'        cmdButton(i).Enabled = True
'    Next i
    Dim lngID As Long
    lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 2)
    If lngID = 0 Then
'        cmdButton(1).Enabled = False
'        cmdButton(2).Enabled = False
        Exit Sub
    End If
    ShowAOldBill lngID
End Sub

Private Sub mclsMainControl_FilePrint()
    CmdPrint_Click
End Sub
Private Sub mclsMainControl_FilePrintReceipt()
    If clsBill.lngNowID > 0 Then
        If clsBill.blnIsChanged Then
            If SaveBill() = False Then Exit Sub
        End If
    End If
    PrintReceipt 29
End Sub

Private Sub CmdPrint_Click()
    If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then
        ShowMsg Me.hwnd, "单据为空，无可打印信息！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "提示"
        Exit Sub
    ElseIf GrdCol.Rows <= 1 Then
        ShowMsg Me.hwnd, "单据体为空，不能打印！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "提示"
        Exit Sub
    End If

    Dim intReturnID As Integer
    If clsBill.blnIsChanged Then
        If Not SaveBill Then
            Exit Sub
        End If
        ShowAOldBill clsBill.lngNowID
    End If
    If clsBill.lngNowID <= 0 Then Exit Sub

    clsBill.blnMayChange = False '旧调价单不允许修改
    
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    If myPrintclass.PrintReceipt(gclsBase.BaseDB, C2lng(lblHead(2).Tag), C2lng(lblHead(2).Tag), CStr(clsBill.lngNowID), getPrintIDofTemplateID(C2lng(lblHead(5).Tag)), BillRePrintRight(29)) Then
        If cmdButton(7).Enabled And BillRePrintRight(C2lng(lblHead(2).Tag)) = False Then
            cmdButton(7).Enabled = False
        End If
        If WanNeng Then
            tblReceipt.Buttons(8).Enabled = cmdButton(7).Enabled
        End If
        clsBill.UpdateMainEditMenu
    End If
    Set myPrintclass = Nothing
    clsBill.SetAFocus
End Sub

Private Sub Form_Activate()
    SetHelpID C2lng(Me.HelpContextID)
    gclsSys.CurrFormName = Me.hwnd
    clsBill.UpdateMainEditMenu
    If blnFirstIn Then
        blnFirstIn = False
        Exit Sub
    End If
    ResponseMessage
    If lblHead(4).Tag = "" Or lblHead(4).Tag = 0 Then
        lblHead(4).Tag = 1
        IdToCodeAndName xTemplatE, C2lng(lblHead(4).Tag), " ", lblHead(5).Caption
    End If
    Form_Resize
    If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
End Sub