frmpurchaseorder.frm

金算盘软件代码

Private Sub cmbInput_Click()
       
    If Not blnEdit Then Exit Sub
    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
'    Debug.Print "CLICK"
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    clsBill.Form_KeyDown KeyCode, Shift
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    clsBill.Form_KeyUp KeyCode, Shift
    If KeyCode = 93 Then
        If Not Me.ActiveControl Is GrdCol And clsBill.bytRegion <> FGrid Then
            MakeListEditMenu
            clsBill.MenuVisible = True
            PopupMenu frmMain.mnuListEdit
            clsBill.MenuVisible = False
        Else
            MakeListActivityMenu
            clsBill.MenuVisible = True
            PopupMenu frmMain.mnuListActivity
            clsBill.MenuVisible = False
        End If
    ElseIf KeyCode = vbKeyPageUp Then
        If Shift = vbCtrlMask Then
            cmdButton_Click 1
        End If
    ElseIf KeyCode = vbKeyPageDown Then
        If Shift = vbCtrlMask Then
            cmdButton_Click 0
        End If
    ElseIf KeyCode = 13 Then
        If Shift = vbCtrlMask Then
            cmdButton_Click 4
        End If
    End If
    
End Sub


Private Sub Form_Load()
    SetDtm
'    Me.Hide
'    Me.Left = -30000
    blnFirstIn = True
    blnNoClick = False
    If blnIsLoading = False Then
        MsgForm.PleaseWait
    End If
    If Not IsCanDo(EditNO(1)) Then
        cmdButton(7).Enabled = False
    End If
    
'   -------------------------------
    ReceiptTypeID = 1    '采购订单ID
'   -------------------------------
        
    Dim i As Integer
    
    Set clsBill = New clsOrder
    clsBill.strOrderName = "Purchase"
    clsBill.ReceiptTypeID = ReceiptTypeID
    Set clsBill.Form = Me
    
    blnNotResize = True
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    LoadFormSetting Me
    blnNotResize = False
'    SetHelpID 40002
    
    FirstReceiptTypeIDAndName ReceiptTypeID, lgID, srName
    lblHead(2).Tag = lgID
    lblHead(3).Caption = srName
    Set GrdCol.MouseIcon = Utility.GetFormResPicture(2001, 2)
'    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
        frmListPurchaseOrder.IAmCLosed
        Set clsBill = Nothing
        Set mclsMainControl = Nothing      '主控对象
        Unload Me
        Exit Sub
    End If


    If Not ChangeSaveNote() Then
        Cancel = True
        gblnCancel = True
        Exit Sub
    End If
    SaveColWidthDefault Me
    Set clsBill = Nothing
    Utility.UnLoadFormResPicture Me
    Utility.RemoveFormResPicture 2001
    
    gclsSys.MainControls.Remove Me
'    gclsSys.CurrFormName = ""
    frmListPurchaseOrder.IAmCLosed
    Unload Me
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 i As Long
    
    If chkPrint(1).Value = 0 Then
        'Me.Refresh
        If chkPrint(2).Visible Then
            chkPrint(2).Enabled = True
        End If
        '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
        For i = 1 To GrdCol.Rows - 1
            If clsBill.rowIsDone(i) Then Exit For
        Next
        If i = GrdCol.Rows Then
            i = clsBill.ShowMsgOther(Me.hwnd, "本张" & lblCaption.Caption & "保存后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "作废单据")
        Else
        If clsBill.ShowMsgOther(Me.hwnd, "本张" & lblCaption.Caption & "已经执行，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL, "作废单据") = vbNo Then
                Exit Sub
            End If
        End If
        If i = vbNo Then
            Exit Sub
        Else
            clsBill.blnChangeEvent = False
            chkPrint(1).Value = 1
            clsBill.blnChangeEvent = True
        End If
        If chkPrint(2).Visible Then
            chkPrint(2).Enabled = False
        End If
'        Me.PaintPicture Utility.GetFormResPicture(1024, 0), _
'                lblCaption.Left + lblCaption.Width + 30, LblBack.top
'        Utility.RemoveFormResPicture (1024)
        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)
    Dim i As Integer
    If Not clsBill.blnChangeEvent Then
        Exit Sub
    End If
    
    If Index > 0 And Not IsCanDo(EditNO(C2lng(lblHead(2).Tag))) Then Exit Sub
    If Not clsBill.CHK_CLICK(Index) Then
        Exit Sub
    End If
    Select Case Index
        Case 0
            chkPrint0_Click
        Case 1
            chkPrint1_Click
        Case 2
            If Not clsBill.blnChangeEvent Then Exit Sub
            If chkPrint(2).Value = 1 Then
                For i = 1 To GrdCol.Rows - 1
                    If clsBill.blnNotNullRow(i) Then
                        GrdCol.TextMatrix(i, 12) = "√"
                    End If
                Next
'                clsBill.SetColblnReadonly 12, True
            Else
                 For i = 1 To GrdCol.Rows - 1
                    GrdCol.TextMatrix(i, 12) = ""
                Next
'                clsBill.SetColblnReadonly 12, False
            End If
    End Select
End Sub

Private Sub cmdButton_Click(Index As Integer)
    Debug.Print "ClickTime:" & vbTab & Time
    If blnNoClick Then
        Exit Sub
    End If
    blnNoClick = True
    If Index <> 5 Then
        If Not clsBill.cmdButton_Click(Index) Then
            GoTo EndProc
        End If
    End If
    Select Case Index
        Case 1
            CmdPrev_Click
            Debug.Print "EndTime:" & vbTab & Time
        Case 0
            cmdNext_Click
            Debug.Print "EndTime:" & vbTab & Time
        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
            CmdStatus_Click
        Case 7
            If ChangeSaveNote() Then
                Dim i As Long
                clsBill.blnIsChanged = False
                i = frmMakeOrder.ShowMe()
                If i <> 0 Then
                    ShowAOldBill i
                End If
            End If
        Case 8
            CmdNote_Click
        Case 9
            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(3).Caption), lblField(2).Caption, 3)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(3).Caption), lblField(2).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(3).Caption), lblField(2).Caption, 2)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(3).Caption), lblField(2).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(3).Caption), lblField(2).Caption, 1)
        Else
            lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(3).Caption), lblField(2).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
            blnEdit = IsCanDo(EditNO(C2lng(lblHead(2).Tag)))
            clsBill.mblnEdit = blnEdit
    '        clsBill.GetANewBill C2Lng(lblHead(5 - 1).Tag), C2Lng(lblHead(3 - 1).Tag), lblField(2).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 CmdNote_Click()
    showNotePad C2lng(lblHead(0).Tag)
End Sub

'Private Sub CmdOk_Click()
'    Dim strTemp As String
'    Dim i As Integer
'
'    If lblHead(1).Caption = "" Then
'        strTemp = "单位"
'        GoTo ErrHandle
'    End If
'    If lblHead(5).Caption = "" Then
'        strTemp = "模板"