frmpurchaseorder.frm

金算盘软件代码

'        GoTo ErrHandle
'    End If
'    If lblField(3).Caption = "" Then
'        strTemp = "制单日期"
'        GoTo ErrHandle
'    End If
'    If lblField(2).Caption = "" Then
'        strTemp = "单据号"
'        GoTo ErrHandle
'    End If
'    If blnReceiptNoRepeat(lblField(2).Caption, 25, lblField(1).Caption, clsBill.lngNowID) Then
'        MessageBox Me.hWnd, "单据号重复不能存盘!", "输入错误", MB_SYSTEMMODAL + MB_ICONEXCLAMATION
'        Exit Sub
'    End If
'    If lblField(0).Caption = "" Then
'        strTemp = "供货单位"
'        GoTo ErrHandle
'    End If
'    If lblTitle(1).Caption = "" Then
'        strTemp = "供货地址"
'        GoTo ErrHandle
'    End If
'    If lblTitle(3).Caption = "" Then
'        strTemp = "收货地址"
'        GoTo ErrHandle
'    End If
'    If lblField(12).Caption = "" Then
'        strTemp = "付款条件"
'        GoTo ErrHandle
'    End If
'    For i = 1 To grdCol.Rows - 1
''        If grdCol.TextMatrix(i, 1) = "" Then
''            strTemp = "商品名称及规格"
''            GoTo ErrHandle
''        End If
'        If clsBill.blnNotNullRow(i) Then
'            If grdCol.TextMatrix(i, 3) = "" Then
'                strTemp = "数量"
'                GoTo ErrHandle
'            End If
'            If grdCol.TextMatrix(i, 4) = "" Then
'                strTemp = "单价"
'                GoTo ErrHandle
'            End If
'            If grdCol.TextMatrix(i, 7) = "" Then
'                strTemp = "原币金额"
'                GoTo ErrHandle
'            End If
'            If grdCol.TextMatrix(i, 8) = "" Then
'                strTemp = "本币金额"
'                GoTo ErrHandle
'            End If
'        End If
'    Next
'
'    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(3).Caption), lblField(2).Caption, 0)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(3).Caption), lblField(2).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, C2lng(ReceiptTypeID), 1, CStr(clsBill.lngNowID), lngTmp, BillRePrintRight(1)) 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, C2lng(ReceiptTypeID), 1, CStr(clsBill.lngNowID), lngTmp, BillRePrintRight(1)) 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 CmdStatus_Click()
    If clsBill.lngNowID = 0 Then
       clsBill.ShowMsgOther Me.hwnd, "本张" & lblCaption.Caption & "没有执行，不能查看执行情况！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "执行情况"
       GoTo EndProc
    End If
    Dim frmTmp As Form
    Set frmTmp = New frmPSOderInfo
    With frmTmp
        .PSOrder clsBill.lngNowID, Format(clsBill.dblTotalOfCol(9), clsBill.strCurDec), True
    End With
EndProc:
    Set frmTmp = Nothing
End Sub


Private Sub Form_Activate()
    If mclsMainControl Is Nothing Then
        Exit Sub
    End If
    SetHelpID Me.HelpContextID
    gclsSys.CurrFormName = Me.hwnd
    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
    clsBill.UpdateMainEditMenu
    clsBill.AdjustQuantityDone
    clsBill.SetBlnSelceted
    If blnFirstIn Then
        blnFirstIn = False
    Else
        Form_Resize
    End If
    If (Me.Left + Me.width) < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
    clsBill.ReSetFocus
End Sub

Public Sub ResponseMessage()
    Dim vntMessage As Variant
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgAccount Then '接收到科目改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
        End If
        If vntMessage = Message.msgCustomer Then  '接收到单位改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            clsBill.setRefer 1
        End If
        If vntMessage = Message.msgItem Then   '接收到商品改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            clsBill.setRefer 2
        End If
        If vntMessage = 31 Then
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            clsBill.ReGetBillNO
        End If
    Next
End Sub
'Private Sub grdCol_EnterCell()
'    clsBill.grdCol_EnterCell
'End Sub

Private Sub grdCol_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
        clsBill.bytRegion = FGrid1
        Exit Sub
    End If

    clsBill.GrdCol_Mouseup Button, Shift, x, y
End Sub

Private Sub grdCol_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim closeLeft As Single
    Dim i As Integer
    
    If GrdCol.LeftCol > 12 Then Exit Sub
    closeLeft = GrdCol.ColWidth(1)
    For i = GrdCol.LeftCol To 11
        closeLeft = closeLeft + GrdCol.ColWidth(i)
    Next
    If x > closeLeft And x < closeLeft + GrdCol.ColWidth(12) And y > GrdCol.RowHeight(0) Then
'        使用自定义光标
        GrdCol.MousePointer = 99
    Else
'        使用默认光标
        GrdCol.MousePointer = flexDefault
    End If
End Sub

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

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 Not frmMain.ActiveForm Is Me Then
         On Error Resume Next
        Me.SetFocus
    End If
    If Not blnEdit And Button <> vbRightButton Then Exit Sub
    clsBill.LblBack_MouseUp Button
    
End Sub

Private Sub LblBack_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 lblField_Change(Index As Integer)
    If Index = 0 Then lblField(0).ToolTipText = lblField(0).Caption
    If Index = 1 Then lblField(1).ToolTipText = lblField(1).Caption
End Sub

Private Sub lblField_MouseDown(Index As Integer, 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.Field_MouseUp Index, Button, x, y
End Sub


Private Sub lblField_MouseUp(Index As Integer, 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 lblFieldCaption_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not blnEdit Then Exit Sub
    clsBill.Field_MouseUp Index, Button, x, y
End Sub

Private Sub lblHead_Change(Index As Integer)
    
    If Index = 5 Then
        refTmpID_Change
    End If
End Sub


Private Sub lblHead_MouseDown(Index As Integer, 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
    Select Case Button
        Case vbRightButton
'            clsBill.bytRegion = FHead
'            clsBill.bytIndex = Index
'            clsBill.UpdateMainEditMenu
            Form_MouseDown Button, Shift, x, y
            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
End Sub

Private Sub lblInput_Click(Index As Integer)
    
'    clsBill.picLblInput_Getfocus Index
End Sub


Private Sub lblHead_MouseUp(Index As Integer, 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 LblMemo_Click(Index As Integer)
    If Not blnEdit Then Exit Sub
    clsBill.Memo_Click Index
End Sub

Private Sub lblTitle_Change(Index As Integer)
    lblTitle(Index).ToolTipText = lblTitle(Index).Caption
End Sub

Private Sub lblTitle_Click(Index As Integer)
    If Not blnEdit Then Exit Sub
    clsBill.lblTitle_Click Index, True
End Sub


Private Sub mclsMainControl_FilePrint()
    CmdPrint_Click
End Sub

Private Sub mclsMainControl_FilePrintReceipt()
    If clsBill.blnIsChanged Then
        If SaveBill() = False Then Exit Sub
    End If
    frmPrintReceipt.ShowfrmPrintReceipt 23

End Sub

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)