frmr_p.frm

金算盘软件代码

            If gclsBase.ExecSQL(strSql) Then
                BillSave = True
                clsBill.blnIsChanged = False
            End If
            'BillSave = SaveModifyBill(clsBill.lngNowID)
        End If
    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(ReceiptType, C2Date(lblField(2).Caption), lblField(1).Caption, 0, , True)
'    If lngID = 0 Then
'        cmdButton(2).Enabled = False
'        cmdButton(1).Enabled = False
'        Exit Sub
'    End If
    If lngID <> 0 Then
        ShowAOldBill ReceiptType, lngID
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If ReceiptType = 40 Then
        If Not frmR(0) Is Nothing Then
            Set frmR(0) = Nothing
        End If
    ElseIf ReceiptType = 39 Then
        If Not frmR(1) Is Nothing Then
            Set frmR(1) = Nothing
        End If
    End If
End Sub

Private Sub grdCol_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With GrdCol
        Debug.Print .MouseRow
        If y <= .RowHeight(0) Then
            .MousePointer = vbDefault
        ElseIf .RowIsVisible(.Rows - 1) Then
            If y > .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) Then
                .MousePointer = vbDefault
            ElseIf .MouseCol = 0 Then
                .MousePointer = vbCustom
            Else
                .MousePointer = vbDefault
            End If
        ElseIf .MouseCol = 0 And .MouseRow < .Rows Then
            .MousePointer = vbCustom
        Else
            .MousePointer = vbDefault
        End If
    End With
End Sub

Private Sub GrdCol_RowColChange()
    clsBill.GrdCol_RowColChange
End Sub

Private Sub lblNote_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Select Case Button
       Case vbRightButton
            clsBill.UpdateMainEditMenu
       Case vbLeftButton
            If Index = 0 Or Index = 2 Then
                clsBill.Note_Click Index, False
            Else
                If x >= lblNote(Index).width - 255 And _
                   x <= lblNote(Index).width And _
                   y >= 0 And _
                   y <= lblNote(Index).Height Then
                    clsBill.Note_Click Index, True
                Else
                    clsBill.Note_Click Index, False
                End If
            End If
    End Select
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 Me.ReceiptType + 100
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 ReceiptType, clsBill.lngNowID
            End If

'        End If
    Else
        blnT = True
    End If
    If blnT = False Then
        Exit Sub
    End If
    
    Dim myPrintclass As New PrintClass
    myPrintclass.PrintReceipt gclsBase.BaseDB, -7, C2lng(ReceiptType), CStr(clsBill.lngNowID), clsBill.PrintSetupID, BillRePrintRight(ReceiptType)
    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(8).Enabled And cmdButton(8).Visible Then cmdButton(8).SetFocus
End Sub

Private Sub CmdReceive_Click()
    '筛选
    Dim lngViewId As Long
    Dim lngListID As Long
    Dim blnFlage As Boolean
    Dim strFrom As String
    Dim strCon As String
    Dim strSql As String
    Dim recTmp As rdoResultset
    On Error GoTo ErrH
'    If ReceiptType = 39 Then
        lngViewId = 1207
'    Else
'        lngViewId = 1208
'    End If
    strSql = "SELECT * FROM List WHERE lngViewID=" & lngViewId
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    If recTmp.EOF Then
        recTmp.AddNew
        recTmp!lngViewId = lngViewId
        recTmp!lngOperatorID = gclsBase.OperatorID
        recTmp!strListName = "采购付款/销售收款"
        recTmp!lngListID = GetNewID("List")
        lngListID = recTmp!lngListID
        recTmp.Update
    Else
        lngListID = recTmp!lngListID
    End If
    recTmp.Close
    Set recTmp = Nothing
    strCon = Filter.ShowFilter(lngListID, 1, , , , , blnFlage)
    If Not blnFlage Then Exit Sub
'    If strCon <> "" Then
'        strSql = "SELECT * FROM View1 WHERE lngViewID=" & lngViewId
'        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'        If recTmp.EOF Then
'            strFrom = ""
'        Else
'            strFrom = recTmp!strViewSQL & " WHERE "
'            strFrom = strFrom & recTmp!StrViewWhere.GetChunk(4000)
'        End If
'        recTmp.Close
'        Set recTmp = Nothing
'    End If
'    If Trim(strFrom) = "" Or Trim(strCon = "") Then
'        strCondition = ""
'    Else
'        strCondition = "SELECT ItemActivity.lngActivityID FROM " & strFrom & " AND " & strCon
'    End If
    If Trim(strCon) = "" Then
        strCondition = ""
    Else
        strCondition = strCon
    End If
    Change
    Exit Sub
ErrH:
    
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
    MakeListEditMenu
    If Button = vbRightButton Then
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        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 LblBack_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    If Button = vbRightButton Then
        clsBill.LblBack_MouseUp
        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 Then Exit Sub
    clsBill.Field_MouseUp Index, Button, x, y
    
    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
    End If
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False

End Sub

Private Sub lblFieldCaption_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    clsBill.Field_MouseUp Index, Button, x, y
    blnNotRaiseEvents = True
    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
    End If
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub lblHead_Change(Index As Integer)
    Select Case Index
        Case 5
            refTmpID_Change
    End Select
End Sub
Public Sub Change()
        lblField(0).Caption = strDetailMsg(C2lng(lblHead(0).Tag))
        If C2lng(lblHead(0).Tag) = 0 Then
            cmdButton(7).Enabled = False
        Else
            cmdButton(7).Enabled = True
        End If
        If WanNeng Then
            tblReceipt.Buttons(ToolBarIndex(7, Me.Name)).Enabled = cmdButton(7).Enabled
        End If
        GrdCol.Rows = 1
        clsBill.ClearRowProperty
        clsBill.CustomerORCurrencyChange C2lng(lblHead(0).Tag), clsBill.getFieldID(12), clsBill.lngNowID, lblField(2).Caption
        clsBill.WriteTotalRow
End Sub

Private Sub lblHead_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnNotRaiseEvents Then Exit Sub
    Select Case Button
        Case vbRightButton
            clsBill.UpdateMainEditMenu
            MakeListEditMenu
            clsBill.blnNotRespondKeyPress = True
            PopupMenu frmMain.mnuListEdit
            If clsBill Is Nothing Then
                blnNotRaiseEvents = False
                Exit Sub
            End If
            clsBill.blnNotRespondKeyPress = False
            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
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub LblMemo_Click(Index As Integer)
    If blnNotRaiseEvents Then Exit Sub
    clsBill.Memo_Click Index
    blnNotRaiseEvents = True
    DoEvents