frmadjustcost.frm

金算盘软件代码

End Sub


Private Sub Form_Load()
'   -------------------------------
    ReceiptTypeID = 5    '受托调价单ID
'   -------------------------------
    lblHead(2).Tag = 25
    Dim i As Integer
    
    Set clsBill = New AdjustCost
    clsBill.ReceiptTypeID = ReceiptTypeID
    Set clsBill.Form = Me
    
    blnNotResize = True
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    LoadFormSetting Me
    blnNotResize = False
    SetHelpID Me.hwnd, 11003
'    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 blnEdit Then
        clsBill.Form_MouseUp
    End If
    If Button = vbRightButton Then
        MakeListEditMenu
        PopupMenu frmMain.mnuListEdit
    End If
End Sub
'窗体尺寸变化处理程序

Private Sub Form_Resize()
    If grdCol.Visible = False Then Exit Sub
    If Not blnNotResize Then clsBill.Form_Resize
End Sub

Private Sub Form_Unload(Cancel As Integer)
'    If clsBill.blnIsChanged Then
        If Not ChangeSaveNote() Then
            Cancel = True
            Exit Sub
        End If
        SaveColWidthDefault Me
'    End If
    gclsSys.MainControls.Remove Me
'    gclsSys.CurrFormName = ""
    frmListConsignee.IAmCLosed
    
    Set clsBill = Nothing
    Set mclsMainControl = Nothing      '主控对象
    Unload Me
'    Set Me = Nothing
End Sub

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

Private Sub chkPrint1_Click()
    If Not clsBill.blnChangeEvent Then Exit Sub
    If chkPrint(1).Value = 0 Then
        LblBack.Refresh
        If IsCanDo(EditNO(C2Lng(lblHead(2).Tag))) Then
            blnEdit = True
        End If
    Else
'        If IsVoucher_ItemActivity(clsBill.lngNowID) Then
'            ShowMsg Me.hwnd, "本张" & lblCaption.Caption & "已经生成记帐凭证，不能作废！", MB_OK + MB_ICONEXCLAMATION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "作废单据"
'            chkPrint(1).Value = 0
'            Exit Sub
'        End If
        clsBill.blnChangeEvent = False
        chkPrint(1).Value = 0
        clsBill.blnChangeEvent = True
        If ShowMsg(Me.hwnd, "本张" & lblCaption.Caption & "保存后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "作废单据") = vbNo Then
            Exit Sub
        End If
        clsBill.blnChangeEvent = False
        chkPrint(1).Value = 1
        clsBill.blnChangeEvent = True
        Me.PaintPicture Utility.GetFormResPicture(1024, 0), _
                lblCaption.Left + lblCaption.Width + 2 * Screen.TwipsPerPixelX, _
                LblBack.top + 2 * Screen.TwipsPerPixelY
        Utility.RemoveFormResPicture (1024)
        blnEdit = False
    End If
    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
    End Select
End Sub

Private Sub cmdButton_Click(Index As Integer)
    clsBill.cmdButton_Click Index
    Select Case Index
        Case 1
            CmdPrev_Click
        Case 0
            cmdNext_Click
        Case 2
            cmdHome_Click
        Case 3
            CmdEnd_Click
        Case 4
               If SaveBill() Then
                    Unload Me
                End If
        Case 5
            CmdCancel_Click
        Case 6
            If clsBill.lngNowID <> 0 Then
                Dim lngID As Long
                lngID = ActivityIdToVoucherId(clsBill.lngNowID, True)
                frmVoucher.ShowAOldBill lngID
            End If
        Case 7
            CmdNote_Click
        Case 8
            CmdPrint_Click
            
    End Select
End Sub
Private Sub CmdCancel_Click()
    Unload Me
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()
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    lngID = lngOtherBill(C2Lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 2)
    If lngID = 0 Then Exit Sub
    ShowAOldBill lngID
End Sub

Private Sub cmdNext_Click()
    If clsBill.blnIsChanged Then
        If Not SaveBill() Then Exit Sub
    ElseIf clsBill.lngNowID = 0 Then
        Exit Sub
    End If
'    If clsBill.lngNowID = 0 Then
'        Exit Sub
'    End If
    Dim lngID As Long
     lngID = lngOtherBill(C2Lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 1)

    If lngID < 1 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
    Else
        ShowAOldBill lngID
    End If
End Sub

Private Sub CmdNote_Click()
    showNotePad C2Lng(lblHead(0).Tag)
End Sub
Private Sub CmdPrev_Click()
    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
    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 Exit Sub
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    myPrintclass.PrintReceipt gclsBase.BaseDB, C2Lng(ReceiptTypeID), CStr(clsBill.lngNowID)
    Set myPrintclass = Nothing
End Sub

Private Sub Form_Activate()
    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
    Form_Resize
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
    Next

End Sub
Private Sub grdCol_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    clsBill.BuildNoteMsg
    If blnEdit Then
        clsBill.grdCol_MouseUp Button, Shift, x, y
    End If
    If Button = vbRightButton Then
        MakeListActivityMenu
        PopupMenu frmMain.mnuListActivity
    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 blnEdit And Button <> vbRightButton Then Exit Sub
    clsBill.LblBack_MouseUp
    If Button = vbRightButton Then
        MakeListEditMenu
        PopupMenu frmMain.mnuListEdit
    End If
End Sub

Private Sub lblField_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not blnEdit And Button <> vbRightButton Then Exit Sub
    clsBill.Field_MouseUp Index, Button, x, y
    
    If Button = vbRightButton Then
        MakeListEditMenu
        PopupMenu frmMain.mnuListEdit
    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)
    Select Case Index
        Case 5
            refTmpID_Change
        Case 1
            lblField(0).Caption = strDetailMsg(C2Lng(lblHead(0).Tag))
    End Select
End Sub


Private Sub lblHead_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not blnEdit And Button <> vbRightButton Then Exit Sub
    Select Case Button
        Case vbRightButton
            clsBill.bytRegion = FHead
            clsBill.bytIndex = Index
            clsBill.UpdateMainEditMenu
           MakeListEditMenu
            PopupMenu frmMain.mnuListEdit
            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 lblmemo_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not blnEdit And Button <> vbRightButton Then Exit Sub
    Select Case Button
        Case vbRightButton
            clsBill.bytRegion = FFooter
            clsBill.bytIndex = Index
            clsBill.UpdateMainEditMenu
            MakeListEditMenu
            PopupMenu frmMain.mnuListEdit
            Exit Sub
        Case vbLeftButton
'            If Index = 3 Then
'                    If X >= lblmemo(Index).Width - clsBill.DropButtonWidth And _
'                       X <= lblmemo(Index).Width And _
'                       y >= 0 And _
'                       y <= lblmemo(Index).Height Then
'                        clsBill.Memo_Click Index, True
'                    Else
'                        clsBill.Memo_Click Index, False
'                    End If
'            Else
                clsBill.Memo_Click Index
'            End If
            clsBill.UpdateMainEditMenu
    End Select
End Sub
Private Sub lblNote_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not blnEdit And Button <> vbRightButton Then Exit Sub
    If Index < 2 Then Exit Sub
    Select Case Button
        Case vbRightButton
            clsBill.bytRegion = FNote
            clsBill.bytIndex = Index
            clsBill.UpdateMainEditMenu
            MakeListEditMenu
            PopupMenu frmMain.mnuListEdit
            Exit Sub
        Case vbLeftButton