frmcostprice.frm

金算盘软件代码

'    cmdButton(4).ToolTipText = "快捷键：Ctrl+Enter"
'    cmdButton(5).ToolTipText = "快捷键：Esc"
    blnFirstIn = True
    blnNoClick = False
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    MsgForm.PleaseWait
    
'   -------------------------------
    ReceiptTypeID = 11    '入库成本ID
'   -------------------------------
            
    Dim i As Integer
        
    Set clsBill = New CostPrice
    clsBill.ReceiptTypeID = ReceiptTypeID
    Set clsBill.Form = Me
    
    blnNotResize = True
'    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    LoadFormSetting Me
    blnNotResize = False
'    SetHelpID 10251
    
    FirstReceiptTypeIDAndName ReceiptTypeID, lgID, srName
    lblHead(2).Tag = lgID
    lblHead(3).Caption = srName
   

'    grdCol.CellAlignment = flexAlignLeftCenter
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not frmMain.ActiveForm Is Me Then
        On Error Resume Next
        Me.SetFocus
    End If
    If Not blnEdit And Button <> vbRightButton Then Exit Sub
    clsBill.Form_MouseUp Button
    
End Sub
'窗体尺寸变化处理程序

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.MenuVisible = True
        PopupMenu frmMain.mnuListEdit
        clsBill.MenuVisible = False
    End If

End Sub

Private Sub Form_Resize()
    If clsBill Is Nothing Then Exit Sub
    If Not blnNotResize Then clsBill.Form_Resize
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    If gclsSys Is Nothing Or clsBill Is Nothing Then
        Set clsBill = Nothing
        Unload Me
        Unload MsgForm
        
        
        frmListCostPrice.IAmCLosed
    Else
        If Not ChangeSaveNote() Then
            Cancel = True
            gblnCancel = True
            Exit Sub
        End If
        SaveColWidthDefault Me
        Set clsBill = Nothing
        gclsSys.MainControls.Remove Me
    '    gclsSys.CurrFormName = ""
        Unload Me
        frmListCostPrice.IAmCLosed
    End If
End Sub

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

Private Sub chkPrint1_Click()
    If Not clsBill.blnChangeEvent Then Exit Sub
    Dim intYesNo As Integer
    
    If chkPrint(1).Value = 0 Then
        'Me.Refresh
        'GrdCol.Refresh
        RefreshRect Me.hwnd, lblCaption.Left + lblCaption.width, grdCol.top + grdCol.RowHeight(0), lblCaption.Left + lblCaption.width + 151 * Screen.TwipsPerPixelX, grdCol.top + grdCol.RowHeight(0) + 70 * Screen.TwipsPerPixelY
        If IsCanDo(EditNO(C2lng(lblHead(2).Tag))) Then
            blnEdit = True
            clsBill.mblnEdit = blnEdit
        End If
        
    Else
        clsBill.blnChangeEvent = False
        chkPrint(1).Value = 0
        clsBill.blnChangeEvent = True
        If clsBill.lngNowID <> 0 Then
            If blnBillIsClosed(32, clsBill.lngNowID) Then
                 clsBill.ShowMsgOther Me.hwnd, "本张入库成本单已经结帐，不能作废！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "作废单据"
                 chkPrint(1).Value = 0
                 Exit Sub
            End If
            intYesNo = clsBill.ShowMsgOther(Me.hwnd, "本张已经分摊的" & lblCaption.Caption & "保存后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "作废单据")
        Else
            intYesNo = clsBill.ShowMsgOther(Me.hwnd, "本张" & lblCaption.Caption & "保存后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "作废单据")
        End If
        If intYesNo = vbNo Then
            chkPrint(1).Value = 0
            Exit Sub
        End If
        clsBill.blnChangeEvent = False
        chkPrint(1).Value = 1
        clsBill.blnChangeEvent = True
        DrawAIcon grdCol.hwnd, lblCaption.Left + lblCaption.width, grdCol.RowHeight(0), 1024
        Utility.RemoveFormResPicture (1024)
        
        blnEdit = False
        clsBill.mblnEdit = blnEdit
    End If
    clsBill.UpdateMainEditMenu
'    frmMain.mnuEditInActive.Checked = chkPrint(1).Value
End Sub

Private Sub chkPrint_Click(Index As Integer)
    If Index > 0 And Not IsCanDo(EditNO(C2lng(lblHead(2).Tag))) Then Exit Sub
    clsBill.CHK_CLICK Index
    Select Case Index
        Case 0
            chkPrint0_Click
        Case 1
            chkPrint1_Click
        Case 2  '错误
        Case 3  '冲销
    End Select
End Sub

Private Sub cmdButton_Click(Index As Integer)
    If blnNoClick Then
        Exit Sub
    End If
    blnNoClick = True
'    If Not blnEdit Then Exit Sub
    
    If clsBill.cmdButton_Click(Index) = False Then
      blnNoClick = False
      Exit Sub
    End If
    Select Case Index
        Case 1
            CmdPrev_Click
        Case 0
            cmdNext_Click
        Case 2
            cmdHome_Click
        Case 3
            CmdEnd_Click
        Case 4
            If SaveBill() Then
                DoEvents
                blnNoClick = False
                Unload Me
                Exit Sub
            End If
        Case 5
            blnNoClick = False
            CmdCancel_Click
            Exit Sub
        Case 6
            CmdSelect_Click
        Case 7
            CmdPrint_Click
    End Select
EndProc:
    If Index <> 5 Then
        DoEvents
        blnNoClick = False
        If Not clsBill Is Nothing Then
            clsBill.ReSetFocus
        End If
    End If
End Sub

Private Sub CmdCancel_Click()
    clsBill.blnIsChanged = False
    Unload Me
End Sub

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

Private Sub cmdHome_Click()
    
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    If blnView Then
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 2)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 2, C2lng(lblmemo(lblmemo.Count - 1).Tag))
    End If
    If lngID = 0 Then Exit Sub
    ShowAOldBill lngID
End Sub

Private Sub cmdNext_Click()
    If clsBill.lngNowID <> 0 Then
        If clsBill.blnIsChanged Then
            If Not SaveBill() Then Exit Sub
        End If
        Dim lngID As Long
        If blnView Then
            lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 1)
        Else
            lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 1, C2lng(lblmemo(lblmemo.Count - 1).Tag))
        End If
    
        If lngID < 1 And clsBill.lngNowID <> 0 Then
            If Not IsCanDo(EditNO(C2lng(lblHead(2).Tag))) Then Exit Sub
    '        clsBill.GetANewBill C2Lng(lblHead(5 - 1).Tag), C2Lng(lblHead(3 - 1).Tag), lblField(1).Caption
            ShowANewBill
            Exit Sub
        ElseIf lngID > 0 Then
            ShowAOldBill lngID
        End If
    Else
        If clsBill.blnIsChanged Then
            If Not SaveBill() Then Exit Sub
        End If
        ShowANewBill
    End If
End Sub

'Private Sub CmdOk_Click()
'    Dim i As Integer
'    Dim strTemp As String
'
'    If lblHead(4).Tag < 1 Then
'        strTemp = "模板"
'        GoTo ErrHandle
'    End If
'    If Trim(lblField(1).Caption) = "" Then
'        strTemp = "单据号"
'        GoTo ErrHandle
'    End If
'    If blnReceiptNoRepeat(lblField(2).Caption, 32, lblField(1).Caption, clsBill.lngNowID) Then
'        MessageBox Me.hWnd, "单据号重复不能存盘!", "输入错误", MB_SYSTEMMODAL + MB_ICONEXCLAMATION
'        Exit Sub
'    End If
'    If Trim(lblField(2)) = "" Then
'        strTemp = "制单日"
'        GoTo ErrHandle
'    End If
'    For i = 1 To grdCol.Rows - 1
'        If Trim(grdCol.TextMatrix(i, 4)) <> "" Then GoTo Pass1
'    Next
'    strTemp = "成本价"
'    GoTo ErrHandle
'Pass1:
'    If clsBill.lngNowID = 0 Then
'        SaveNewBill
'    Else
'        SaveModifyBill clsBill.lngNowID
'    End If
'    Exit Sub
'ErrHandle:
'    strTemp = strTemp & "不能为空！"
'    clsbill.showmsgother Me.hWnd, strTemp, MB_ICONEXCLAMATION + MB_OK, "错误信息"
'End Sub

Private Sub CmdPrev_Click()
    
'    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    If blnView Then
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 0)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 0, C2lng(lblmemo(lblmemo.Count - 1).Tag))
    End If
    If lngID = 0 Then Exit Sub
    ShowAOldBill lngID
End Sub

Private Sub CmdPrint_Click()
    If clsBill.blnIsChanged Then
        If Not SaveBill() Then Exit Sub
    End If
    If clsBill.lngNowID = 0 Then
        clsBill.ShowMsgOther Me.hwnd, "单据为空，无可打印信息！", MB_OK + MB_SYSTEMMODAL + MB_ICONINFORMATION, "打印单据"
        Exit Sub
    End If

    
    If clsBill.blnIsPrinted Then
      If clsBill.blnPrintPrintedBill Then
         If clsBill.ShowMsgOther(Me.hwnd, "本张" & lblCaption.Caption & "已经打印，您确实要打印吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "打印单据") = vbNo Then
            Exit Sub
         End If
      Else
         clsBill.ShowMsgOther Me.hwnd, "本张" & lblCaption.Caption & "已经打印，不能再打印！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "打印单据"
         Exit Sub
      End If
    End If
          
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    Dim blnTmp As Boolean
    Dim lngTmp As Long
    lngTmp = getPrintIDofTemplateID(C2lng(lblHead(4).Tag), blnTmp)
    If blnTmp Then
      If myPrintclass.PrintSameItemReceipt(gclsBase.BaseDB, -5, 32, CStr(clsBill.lngNowID), lngTmp, BillRePrintRight(32)) Then
         If chkPrint(0).Value <> 0 Then
            clsBill.blnChangeEvent = False
            chkPrint(0).Value = 0
            clsBill.blnChangeEvent = True
         End If
         clsBill.blnIsPrinted = True
      End If
   Else
      If myPrintclass.PrintReceipt(gclsBase.BaseDB, -5, 32, CStr(clsBill.lngNowID), lngTmp, BillRePrintRight(32)) Then
         If chkPrint(0).Value <> 0 Then
            clsBill.blnChangeEvent = False
            chkPrint(0).Value = 0
            clsBill.blnChangeEvent = True
         End If
         clsBill.blnIsPrinted = True
      End If
   End If
    Set myPrintclass = Nothing

End Sub


Private Sub Form_Activate()
    If mclsMainControl Is Nothing Then
        Exit Sub