frmbillno.frm

金算盘软件代码

    If blnDate Then
        spinYear.Min = 1900
        spinMonth.Min = 1
    Else
        '设置控件的最大值和初始化其TEXT内容
            Dim y1 As Integer
            Dim y2 As Integer
            Call GetStartAndEndYear(y1, y2)
            spinYear.Max = y2
            spinYear.Min = y1
            
            Call GetBaseStartAndEndPeriod(gclsBase.AccountYear, dtmStartDate, dtmEndDate, PeriodNum)
            spinMonth.Max = PeriodNum '+ gclsBase.PeriodOfDate(dtmStartDate) - 1
            spinMonth.Min = gclsBase.PeriodOfDate(dtmStartDate)
        '---------------------------------
    End If
    Year1 = gclsBase.AccountYear
    Month1 = gclsBase.Period
    If Year1 = 0 Then Year1 = gclsBase.FYearOfDate(gclsBase.BaseDate)
    If Month1 = 0 Then Month1 = gclsBase.PeriodOfDate(gclsBase.BaseDate)
    
    
    Select Case lngReceiptTypeID1
        Case 36, 37, 38 '应收单
            blnIsCanDo = IsCanDo(462)
        Case 34, 35 '应付单
            blnIsCanDo = IsCanDo(463)
        Case 39, 40 '现金银行
            blnIsCanDo = IsCanDo(464)
        Case 2 To 11, 43, 46, 47, 52 '采购单据
            blnIsCanDo = IsCanDo(465)
        Case 13 To 14, 17 To 24, 45 '销售单据
            blnIsCanDo = IsCanDo(466)
        Case 28, 29, 30, 31, 42 '库存单据
            blnIsCanDo = IsCanDo(467)
        Case 15, 16, 26, 44 '委托单据
            blnIsCanDo = IsCanDo(468)
        Case Else
            blnIsCanDo = True
    End Select
    cmdOK(1).Enabled = blnIsCanDo
    
    Select Case lngReceiptTypeID1
        Case 42 To 47, 52
            spinYear.Text = ""
            spinMonth.Text = ""
            lab1.Visible = False
            lab2.Visible = False
            spinYear.Visible = False
            spinMonth.Visible = False
            Lstcha.Move Lstcha.Left, lab1.top, Lstcha.width, Me.ScaleHeight - 6 * Screen.TwipsPerPixelY - stbButton.Height
        Case Else
            spinMonth.Text = Format(Month1, "0#")
            spinYear.Text = Format(Year1, "####")
    End Select
    Me.Caption = str
    Me.KeyPreview = True
    Me.top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.width - Me.width) / 2
End Sub


Private Sub Form_Unload(Cancel As Integer)
   Utility.RemoveFormResPicture 139
   Utility.RemoveFormResPicture 1022
End Sub

Private Sub SqlRecMaxNo()
    
    Dim recSql As rdoResultset
    Dim str As String
    Dim strReceiptNo1 As String
    Dim lngReceiptNO1 As Long
    Lstcha.Clear
    stbButton.Panels(1).Text = "编号查询"
     
     lngZds = 0: lngQhs = 0: lngZfs = 0
    If blnDate = False Then
        str = "intYear=" & Year1 & " and  bytPeriod=" & Month1 & " and  lngReceiptTypeID=" & lngReceiptTypeID1 & " order by strReceiptNO"
    Else
        str = "lngReceiptTypeID=" & lngReceiptTypeID1 & " ORDER BY strReceiptNO"
    End If
     Set recSql = gclsBase.BaseDB.OpenResultset("SELECT strReceiptNo,lngReceiptNo FROM receiptMaxNO WHERE " & str, rdOpenStatic)
     If recSql Is Nothing Then
         Exit Sub
     End If
     If recSql.EOF Then
         recSql.Close
         Set recSql = Nothing
         Exit Sub
     End If
     Lstcha.AddItem ReceiptTypeIdToName(lngReceiptTypeID1)
     With recSql
     .MoveFirst
     '取前缀,最大编号
     Do While Not .EOF
             If IsNull(!strReceiptNo) Then
                 strReceiptNo1 = ""
             Else
                 strReceiptNo1 = !strReceiptNo
                 strReceiptNo1 = Trim(strReceiptNo1)
             End If
             lngReceiptNO1 = !lngReceiptNo
             sqlactivity strReceiptNo1, lngReceiptNO1, lngReceiptTypeID1  '前缀，最大编号，单据类型
             .MoveNext
     Loop
     Lstcha.AddItem "---------------------------------------------------------"
      
     Lstcha.AddItem "合计：   总单数: " & (lngZds - lngQhs) & "   缺号数: " & lngQhs & "   作废数: " & lngZfs

     Lstcha.AddItem " "
     .Close
     End With
     Set recSql = Nothing
    If blnIsCanDo Then
        If lngQhs = 0 Then
            cmdOK(1).Enabled = False
        ElseIf gclsBase.PeriodIsClosed(Year1, Month1) Then
            cmdOK(1).Enabled = False
        Else
            cmdOK(1).Enabled = True
        End If
    Else
        cmdOK(1).Enabled = False
    End If
    stbButton.Panels(2).Text = "结束"
End Sub

'前缀,最大编号,单据类型ID
Private Sub sqlactivity(strAlp1 As String, strDig1 As Long, lngRTID As Long)
     Dim recNo As rdoResultset
     Dim str1 As String
     Dim i As Integer
     Dim strfg1 As String
     Dim blnQu As Boolean
     Dim a As Integer, b As Integer, c As Integer, d As Integer
     'a,b   控制缺号    ；C、D控制作废数
     Dim bz1 As Boolean, bz2 As Boolean, bz3 As Boolean, bz4 As Boolean
     'bz1,bz2   控制缺号    ；bz3、bz4控制作废数
    If strAlp1 = "" Then strAlp1 = " "
        If lngRTID = 1 Then '采购订单
            str1 = "SELECT lngReceiptNO,blnIsVoid FROM PurchaseOrder where strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
        ElseIf lngRTID = 12 Then '销售订单
            str1 = "SELECT lngReceiptNO,blnIsVoid FROM SaleOrder where strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
        ElseIf lngRTID = 32 Then '入库成本
            str1 = "SELECT lngReceiptNO,blnIsVoid FROM CostPrice where strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
        ElseIf lngRTID = 33 Then '商品盘点
            str1 = "SELECT lngReceiptNO,blnIsVoid FROM StockTaking where strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
        ElseIf lngRTID >= 34 And lngRTID <= 40 Then '业务
            str1 = "SELECT lngReceiptNO,blnIsVoid FROM Activity where lngReceiptTypeID=" & lngRTID & " and strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
        ElseIf lngRTID = 42 Or lngRTID = 43 Or lngRTID = 44 Or lngRTID = 45 Or lngRTID = 46 Or lngRTID = 47 Or lngRTID = 52 Then
            str1 = "SELECT lngReceiptNO,blnIsVoid FROM ItemActivity where lngReceiptTypeID=" & lngRTID & " and strReceiptNO='" & strAlp1 & "'" & " ORDER BY lngReceiptNO"
        ElseIf lngRTID >= 57 And lngRTID <= 63 Then
            str1 = "SELECT lngReceiptNO,blnIsVoid FROM " & TableName(lngRTID) & " where " & " strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
        Else '商品业务
            str1 = "SELECT lngReceiptNO,blnIsVoid FROM ItemActivity where lngReceiptTypeID=" & lngRTID & " and strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
        End If
        Set recNo = gclsBase.BaseDB.OpenResultset(str1, rdOpenForwardOnly)
        If strAlp1 = "" Then
            strfg1 = "前缀:" & "无 " & "     最大单据号   " & Format(strDig1, "00##")
        Else
            strfg1 = "前缀:" & strAlp1 & Space(8 - Len(strAlp1)) & "最大单据号   " & strAlp1 & Format(strDig1, "00##")
        End If
        Lstcha.AddItem strfg1
        bz1 = True
        bz2 = False
        bz3 = True
        bz4 = False
        With recNo
        For i = 1 To CInt(strDig1)
            If i \ 300 = i / 300 Then stbButton.Panels(2).Text = strAlp1 & Format$(i, "0000")
ReJustice:
            If recNo.EOF Then
                blnQu = True
            ElseIf recNo(0) < i Then
                recNo.MoveNext
                GoTo ReJustice
            ElseIf recNo(0) = i Then
                blnQu = False
            ElseIf recNo(0) > i Then
                blnQu = True
            End If
            If blnQu Then
                 lngQhs = lngQhs + 1    '缺号数
                 If bz4 Then
                            If c = d Then
                                strfg1 = "                   作废   " & strAlp1 & Format(c, "00##")
                            Else
                                strfg1 = "                   作废   " & strAlp1 & Format(c, "00##") & " 到 " & strAlp1 & Format(d, "00##")
                            End If
                            Lstcha.AddItem strfg1

                            bz4 = False
                 End If
                 If bz1 Then '第一次进入
                    a = i
                    b = i
                    bz1 = False
                    bz2 = True
                 Else
                    If (b = i - 1) And (b <> (strDig1 - 1)) Then
                        b = i '如果连号
                    ElseIf b = strDig1 - 1 Then '连号如果为最后记录
                        b = i
                        strfg1 = "                   缺号   " & strAlp1 & Format(a, "00##") & " 到 " & strAlp1 & Format(b, "00##")
                        Lstcha.AddItem strfg1
                         
                        bz2 = False
                    Else '不连号进入
                        If bz2 Then
                            If a = b Then
                                strfg1 = "                   缺号   " & strAlp1 & Format(a, "00##")
                            Else
                                strfg1 = "                   缺号   " & strAlp1 & Format(a, "00##") & " 到 " & strAlp1 & Format(b, "00##")
                            End If
                            Lstcha.AddItem strfg1
                             
                        End If
                        a = i
                        b = i
                        If i = strDig1 Then '不连号最后记录
                            strfg1 = "                   缺号   " & strAlp1 & Format(a, "00##")
                            Lstcha.AddItem strfg1
                             
                            bz2 = False
                        Else: bz2 = True
                        End If
                        
                    End If
                 End If
            Else
                If !blnIsVoid <> 0 Then
                    lngZfs = lngZfs + 1
                    If bz2 Then
                        If a = b Then
                            strfg1 = "                   缺号   " & strAlp1 & a
                        Else
                            strfg1 = "                   缺号   " & strAlp1 & a & " 到 " & strAlp1 & b
                        End If
                        Lstcha.AddItem strfg1

                        bz2 = False
                    End If
                    If bz3 Then
                        c = i
                        d = i
                        bz3 = False
                        bz4 = True
                    Else
                        If (d = i - 1) And (d <> (strDig1 - 1)) Then
                            d = i
                        ElseIf d = strDig1 - 1 Then
                            d = i
                            strfg1 = "                   作废   " & strAlp1 & Format(c, "00##") & " 到 " & strAlp1 & Format(d, "00##")
                            Lstcha.AddItem strfg1

                            bz4 = False
                        Else
                            If bz4 Then
                                If c = d Then
                                    strfg1 = "                   作废   " & strAlp1 & Format(c, "00##")
                                Else: strfg1 = "                   作废   " & strAlp1 & Format(c, "00##") & " 到 " & strAlp1 & Format(d, "00##")
                                End If
                                Lstcha.AddItem strfg1

                            End If
                            c = i
                            d = i
                            If i = strDig1 Then
                               strfg1 = "                   作废   " & strAlp1 & Format(c, "00##")
                               Lstcha.AddItem strfg1

                               bz4 = False
                            Else: bz4 = True
                            End If
                        End If
                    End If
                End If
            End If
          
        Next i
        lngZds = lngZds + i - 1 '总单数
        If bz2 Then
            If a = b Then
                strfg1 = "                   缺号   " & strAlp1 & Format(a, "00##")
            Else
                strfg1 = "                   缺号   " & strAlp1 & Format(a, "00##") & " 到 " & strAlp1 & Format(b, "00##")
            End If
            Lstcha.AddItem strfg1
             
        End If
        If bz4 Then
            If c = d Then
                strfg1 = "                   作废   " & strAlp1 & Format(c, "00##")
            Else
                strfg1 = "                   作废   " & strAlp1 & Format(c, "00##") & " 到 " & strAlp1 & Format(d, "00##")
            End If
            Lstcha.AddItem strfg1

        End If
        End With
endpiont: