frmadjust.frm

金算盘软件代码

    Set clsBill.Form = Me
    
    Me.HelpContextID = 50016
    
    blnNotResize = True
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    blnNotResize = False
    
    curInput.MaxLength = 12
    lblHead(2).Tag = 28  '商品调拨单
'    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()
    Debug.Print "Resize:Width=" & Me.width & ";Height=" & Me.Height
    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
    clsBill.SaveInput2Form
    If Not ChangeSaveNote Then
        gblnCancel = True
        Cancel = 1
        Exit Sub
    End If
    SaveColWidthDefault Me
    gclsSys.MainControls.Remove Me
'    frmListAdjust.RefreshList clsBill.lngNowID
    Set clsLst = Nothing
    Set clsBill = Nothing
'    gclsSys.SendMessage Me.hwnd, 30 + C2lng(lblHead(2).Tag)
    frmListAdjust.IAmCLosed
    Set mclsMainControl = Nothing      '主控对象
    Unload MsgForm
    Unload Me
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
        blnNotRaiseEvents = False
        intYesNo = ShowMsg(Me.hWnd, "该调拨单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "提示信息")
        blnNotRaiseEvents = True
        If intYesNo = IDYES Then
            chkPrint(1).Value = 1
            clsBill.blnIsChanged = True
        End If
        blnNotRaiseEvents = False
    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
            CmdPrint_Click
            clsBill.SetAFocus
    End Select
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

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

Private Sub CmdEnd_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, 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 cmdNext_Click()
    Dim i As Integer
    Dim lngID As Long
    lngID = clsBill.lngNowID
    If clsBill.blnIsChanged Then
        If Not SaveBill() Then Exit Sub
    End If
    If 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
'        clsBill.GetANewBill C2Lng(lblHead(5 - 1).Tag), C2Lng(lblHead(3 - 1).Tag), lblField(1).Caption
        If blnEdit Then ShowANewBill
    Else
        ShowAOldBill lngID
    End If
End Sub

Private Sub cmdOK_Click()
    If SaveBill() Then
        blnNotRaiseEvents = False
        Unload Me
    End If
    blnNotRaiseEvents = False
End Sub

Private Sub CmdPrev_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, 0)
    lngID = ItemAcIDOther(lngID)
    If lngID = 0 Then
'        cmdButton(1).Enabled = False
'        cmdButton(2).Enabled = False
        Exit Sub
    End If
    ShowAOldBill lngID
End Sub

Private Sub GrdCol_RowColChange()
    clsBill.GrdCol_RowColChange
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 28
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
    
    If clsBill.blnIsChanged Then
'        ShowMsg Me.hwnd, "请保存此单据后再打印！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "提示"
'        Exit Sub
        Dim intReturnID As Integer
        intReturnID = 6 'ShowMsg(Me.hwnd, "此单据还没有保存，是否先保存再打印？", MB_ICONQUESTION + MB_YESNO + MB_SYSTEMMODAL, "警告信息")
        If intReturnID = 6 Then
            If Not SaveBill Then
                Exit Sub
            End If
            ShowAOldBill clsBill.lngNowID
        Else
            Exit Sub
        End If
    End If
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    If myPrintclass.PrintReceipt(gclsBase.BaseDB, -1, 28, CStr(clsBill.lngNowID), getPrintIDofTemplateID(C2lng(lblHead(5).Tag)), BillRePrintRight(28)) Then
        blnPrinted = True
        If clsBill.blnMayChange = True And BillRePrintRight(28, True) = False Then
            clsBill.blnMayChange = False
        End If
        If cmdButton(6).Enabled And BillRePrintRight(28) = False Then
            cmdButton(6).Enabled = False
        End If
        If WanNeng Then
            tblReceipt.Buttons(7).Enabled = cmdButton(6).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
    Debug.Print "Activate:width=" & Me.width & ";Height=" & Me.Height
    ResponseMessage
    If lblHead(4).Tag = "" Or lblHead(4).Tag = 0 Then
        lblHead(4).Tag = 1
        'lblHead(5).Caption = 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

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

Public Sub ResponseMessage()
    Dim vntMessage As Variant
    Dim lngOldID As Long
    
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgItem Then  '接收到科目改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            lngOldID = refInput1.ID
            clsBill.AddReferOfItem
            refInput1.SeekId lngOldID
        End If
    Next
End Sub

Private Sub grdCol_GotFocus()
'    If clsBill.bytRegion <> FGrid And clsBill.bytRegion <> FPicture Then
'        chkPrint(chkPrint.Count - 1).SetFocus
'    End If
End Sub

'Private Sub grdCol_EnterCell()
'    clsBill.grdCol_EnterCell
'End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents = True Then Exit Sub
    blnNotRaiseEvents = True
    clsBill.GrdCol_Mouseup Button, Shift, x, y
    If Button = vbRightButton Then
        MakeListActivityMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListActivity
        If clsBill Is Nothing Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
        clsBill.blnNotRespondKeyPress = False
    End If
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False

End Sub

Private Sub grdCol_Scroll()
    clsBill.grdCol_Scroll
End Sub

'Private Sub imgPicDown_Click(Index As Integer)
'        clsBill.picLblInput_Getfocus Index, True
'End Sub

Private Sub LblBack_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents = True Then Exit Sub
    clsBill.LblBack_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 lblField_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents = True Then Exit Sub