frmstartperiod.frm

金算盘软件代码

    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"
    If Me.Visible = False Then Exit Sub
    If blnNotResize Then
        blnNotResize = False
        Exit Sub
    End If
    clsBill.Form_Resize
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next
    If gclsBase Is Nothing Then Exit Sub
    If clsBill Is Nothing Then Exit Sub
    If UnloadMode = vbFormControlMenu Then
        If blnNotRaiseEvents Then
            Cancel = 1
            gblnCancel = True
            Exit Sub
        End If
    End If
    If UnloadMode = vbFormControlMenu Then
        If clsBill Is Nothing Then Exit Sub
        clsBill.cmdButton_Click 0
    End If
    
    If Not ChangeSaveNote() Then
        Cancel = 1
        gblnCancel = True
        Exit Sub
    End If
    
    blnNotRaiseEvents = True
    Me.Visible = False
    gclsSys.MainControls.Remove Me
    frmPayableList.IAmCLosed
    Set clsLst = Nothing
    Set clsBill = Nothing
    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()
    If blnNotRaiseClick = True Then Exit Sub
    If Not clsBill.blnChangeEvent Then
        GoTo XXXX
    End If
    If chkPrint(1).Value = 0 Then
        GoTo XXXX
    Else
        blnNotRaiseClick = True
        chkPrint(1).Value = 0
        blnNotRaiseClick = False
        
        If clsLst.BeforeDelete(True, clsBill.lngNowID, C2lng(lblHead(2).Tag), lblCaption.Caption) <> 1 Then
            Exit Sub
        End If
        If ShowMsg(Me.hWnd, "本张" & lblCaption.Caption & "保存后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "保存单据") = vbNo Then
            Exit Sub
        End If
        
        blnNotRaiseClick = True
        chkPrint(1).Value = 1
        blnNotRaiseClick = False
XXXX:
        
        With Me.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
    
    End If
    
End Sub

Private Sub chkPrint_Click(Index As Integer)
    If blnNotRaiseEvents 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 Then Exit Sub
    blnNotRaiseEvents = True
    clsBill.blnKeyDown = False
    If Index = 5 Then
        CmdCancel_Click
        blnNotRaiseEvents = False
        Exit Sub
    End If
    If clsBill.cmdButton_Click(Index) = False Then
        blnNotRaiseEvents = False
        Exit Sub
    End If
    Select Case Index
        Case 0
            cmdNext_Click
        Case 1
            CmdPrev_Click
        Case 2
            cmdHome_Click
        Case 3
            CmdEnd_Click
        Case 4
            If BillSave Then
                clsBill.blnIsChanged = False
                Unload Me
                Exit Sub
            End If
        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()
    blnNotRaiseEvents = False
    clsBill.blnIsChanged = False
    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()
    Dim lngID As Long
    lngID = clsBill.lngNowID
    If Not BillSave() Then Exit Sub
    Dim i As Integer
    
    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
        ShowANewTypeBill C2lng(lblHead(2).Tag)
        Exit Sub
    Else
        ShowAOldBill lngID
    End If
End Sub

Private Function BillSave() As Boolean
    If clsBill.blnIsChanged = False Then
        BillSave = True
        Exit Function
    End If
    
    
    Debug.Print "datavalid_begin" & Time
    If Not clsBill.DataValid Then
        BillSave = False
        Exit Function
    End If
    Debug.Print "datavalid_end" & Time
    Dim blnResult As Boolean

    If Me.Visible Then MsgForm.PleaseWait "正在保存单据，请稍候…… "
    
    blnNotRaiseEvents = True
    If clsBill.lngNowID = 0 Then
        blnResult = SaveNewBill()
    Else
        If clsBill.blnMayChange Then
            If BillPublic.lngActivityIsSelected(clsBill.lngNowID, "修改", Me.hWnd) = 0 Then
                blnResult = SaveModifyBill(clsBill.lngNowID)
            Else
                blnResult = False
            End If
        Else  '不可修改的旧单据
            Dim strSql As String
            strSql = "UPDATE ItemActivity SET blnIsPrint=" & IIf(chkPrint(0).Value = 0, 0, 1) & _
                    " WHERE lngActivityID=" & clsBill.lngNowID
            blnResult = gclsBase.ExecSQL(strSql)
        End If
    End If
        
    BillSave = blnResult
    If blnResult Then
        clsBill.blnIsChanged = False
    End If
    Debug.Print "saveEnd<" & Time

    Screen.MousePointer = vbDefault
    blnNotRaiseEvents = False
    Unload MsgForm
End Function

Private Sub CmdPrev_Click()
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    Dim i As Integer
'    For i = 0 To 3
'        cmdButton(i).Enabled = True
'    Next
    lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 0)
'    If lngID = 0 Then
'        cmdButton(2).Enabled = False
'        cmdButton(1).Enabled = False
'        Exit Sub
'    End If
    If lngID <> 0 Then
        ShowAOldBill lngID
    End If
End Sub

Private Sub GrdCol_RowColChange()
    clsBill.GrdCol_RowColChange
End Sub

Private Sub mclsMainControl_EditCopy()
   mclsMainControl_ListEditMenu (3)
End Sub

Private Sub mclsMainControl_EditPaste()
   mclsMainControl_ListEditMenu (4)
End Sub

Private Sub mclsMainControl_FilePrint()
    CmdPrint_Click
End Sub
Private Sub mclsMainControl_FilePrintReceipt()
    If clsBill.lngNowID > 0 Then
        If clsBill.blnIsChanged Then
            If BillSave() = False Then Exit Sub
        End If
    End If
    PrintReceipt C2lng(lblHead(2).Tag)
End Sub


Private Sub CmdPrint_Click()
    Dim blnT As Boolean
    Dim intReturn As Integer
    Dim strMsg As String
    On Error Resume Next
    If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then
        ShowMsg Me.hWnd, "单据为空，没有可打印信息！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "打印单据"
        Exit Sub
    End If
    If clsBill.blnIsChanged Then
        If Len(Trim(lblField(1).Caption)) = 0 Then
            strMsg = "该张" & lblCaption.Caption & "数据已经发生改变，是否需要保存？"
        Else
            strMsg = "“" & lblField(1).Caption & "”号" & lblCaption.Caption _
                & "数据已经发生改变，是否需要保存？"
        End If
'        intReturn = ShowMsg(Me.hwnd, strMsg, MB_YESNOCANCEL + MB_DEFBUTTON1 _
            + MB_ICONQUESTION + MB_SYSTEMMODAL, "打印单据")
'        If intReturn = IDYES Then
            blnT = BillSave()
            If blnT Then
                ShowAOldBill clsBill.lngNowID
            End If

'        End If
    Else
        blnT = True
    End If
    If blnT = False Then
        Exit Sub
    End If
    
    Dim myPrintclass As New PrintClass
    If myPrintclass.PrintReceipt(gclsBase.BaseDB, C2lng(ReceiptTypeID), C2lng(lblHead(2).Tag), CStr(clsBill.lngNowID), clsBill.PrintSetupID, BillRePrintRight(C2lng(lblHead(2).Tag))) Then
'        blnPrinted = True
'        If clsBill.blnMayChange = True And BillRePrintRight(C2lng(lblHead(2).Tag), True) = False Then
'            clsBill.blnMayChange = False
'        End If
'        If cmdButton(6).Enabled And BillRePrintRight(C2lng(lblHead(2).Tag)) = 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
    If frmMain.ActiveForm.Name <> Me.Name Then
        If Me.Visible = False Then Me.Visible = True
        Me.ZOrder 0
    End If
    If cmdButton(6).Enabled And cmdButton(6).Visible Then
        cmdButton(6).SetFocus
    Else
        clsBill.SetAFocus
    End If
End Sub

Private Sub CmdReceive_Click()
    With FrmPayment
        .Show
        .ZOrder
    End With
End Sub

'Private Sub cmdVoucher_Click()
'    ShowMsg Me.hwnd, "Voucher", MB_OK
'End Sub

Private Sub Form_Activate()
    Debug.Print "activate"
    ResponseMessage
    SetHelpID C2lng(Me.HelpContextID)
    gclsSys.CurrFormName = Me.hWnd
    clsBill.UpdateMainEditMenu
    If blnFirstIn Then
        blnFirstIn = False
'        clsBill.SetAFocus
        Exit Sub
    End If
    '--------WAIT WINDOWS---------
    If (Me.Left + Me.width) < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
    '--------------------------------------
    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
    Form_Resize
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

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