frmvocherno.frm

金算盘软件代码

VERSION 5.00
Object = "{D252F124-F62C-11D1-9ABD-444553540000}#1.0#0"; "GADATE.DLL"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmVoucherNo 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "凭证编号查询"
   ClientHeight    =   4245
   ClientLeft      =   30
   ClientTop       =   315
   ClientWidth     =   6255
   FillStyle       =   0  'Solid
   Icon            =   "frmVocherNo.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4245
   ScaleWidth      =   6255
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOK 
      Caption         =   "编号整理(&S)"
      Default         =   -1  'True
      Height          =   345
      Index           =   2
      Left            =   5040
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1022"
      Top             =   1350
      UseMaskColor    =   -1  'True
      Width           =   1185
   End
   Begin VB.CommandButton cmdOK 
      Height          =   345
      Index           =   1
      Left            =   5040
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1022"
      Top             =   900
      UseMaskColor    =   -1  'True
      Width           =   1185
   End
   Begin GACALENDARLibCtl.SpinEdit spinMonth 
      Height          =   315
      Left            =   1890
      OleObjectBlob   =   "frmVocherNo.frx":000C
      TabIndex        =   2
      Top             =   90
      Width           =   675
   End
   Begin GACALENDARLibCtl.SpinEdit spinYear 
      Height          =   315
      Left            =   600
      OleObjectBlob   =   "frmVocherNo.frx":00AB
      TabIndex        =   1
      Top             =   90
      Width           =   825
   End
   Begin VB.ListBox lischa 
      Height          =   3300
      Left            =   120
      TabIndex        =   6
      Top             =   450
      Width           =   4815
   End
   Begin VB.CommandButton cmdOK 
      Height          =   345
      Index           =   0
      Left            =   5040
      Picture         =   "frmVocherNo.frx":014A
      Style           =   1  'Graphical
      TabIndex        =   3
      Tag             =   "1022"
      Top             =   450
      UseMaskColor    =   -1  'True
      Width           =   1185
   End
   Begin MSComctlLib.StatusBar stbButton 
      Align           =   2  'Align Bottom
      Height          =   315
      Left            =   0
      TabIndex        =   8
      Top             =   3930
      Width           =   6255
      _ExtentX        =   11033
      _ExtentY        =   556
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   8414
         EndProperty
      EndProperty
   End
   Begin VB.Label lab2 
      Caption         =   "期间"
      Height          =   255
      Left            =   1485
      TabIndex        =   7
      Top             =   120
      Width           =   375
   End
   Begin VB.Label lab1 
      Caption         =   "年度"
      Height          =   255
      Left            =   195
      TabIndex        =   0
      Top             =   120
      Width           =   375
   End
End
Attribute VB_Name = "frmVoucherNo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'缺号查询
'作者:诸涛
'方法:ShowTypeID(lngReceiptIDq)
'入口参数:lngReceiptIDq,单列ID
Option Explicit
Const lngReceiptTypeID1 = 41
Dim Year1 As Integer, Month1 As Integer
Dim bz As Boolean
Dim sDate As Date, eDate As Date
Dim dtmStartDate As Date, dtmEndDate As Date, PeriodNum As Integer
Dim lngZds As Integer, lngQhs As Integer, lngZfs As Integer
Dim blnIsCanDo As Boolean
'lngZds '总单数、lngQhs  缺号数  lngZfs   作废数
'lngReceiptIDq:单列ID


Private Sub cmdOK_Click(index As Integer)
    If index = 0 Then
        Unload Me
    ElseIf index = 1 Then
        Dim mTable As TableObj
        Dim i As Long
        Set mTable = New TableObj
        With mTable
    '          .hwnd = Me.hwnd
             .ClipCell = 1
             .FixedRows = 1
             .Cols = 1
             .Rows = lischa.ListCount + 1
             '.ResizeCol = 1
             .SetBorder 0, -1, 1 + 2
            
             For i = 0 To 0
                .ColWidth(i) = Screen.width / Screen.TwipsPerPixelX
             Next i
             .SetCellPattern 0, 0, 0, .Cols - 1, 0, RGB(255, 255, 0), -1, -1
'             .SetColBorder 0, .Cols - 1, 1, RGB(128, 128, 128), 2
             .SetCellDataType 1, 0, .Rows, 0, 8, -1, -1, -1
             
             .CellFormula(0, 0) = "凭证缺号表（年度：" & SpinYear.Value & "期间：" & spinMonth.Value & "）"
             
             For i = 1 To lischa.ListCount - 1
                 .CellFormula(i, 0) = lischa.list(i)
             Next i
'            .PrintPreview
            .PrintTable
        End With
        Set mTable = Nothing
    ElseIf index = 2 Then
        ReCode
    End If
End Sub

Private Sub Form_Activate()
    SetHelpID C2lng(Me.HelpContextID)
End Sub

Private Sub Form_Load()
    Dim str As String
    Me.HelpContextID = 10202
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    cmdOK(0).Picture = Utility.GetFormResPicture(1022, 0)
    cmdOK(1).Picture = Utility.GetFormResPicture(1012, 0)
    bz = True
    Year1 = gclsBase.AccountYear
    Month1 = gclsBase.Period
    If Year1 = 0 Then Year1 = gclsBase.FYearOfDate(gclsBase.BaseDate)
    If Month1 = 0 Then Month1 = gclsBase.PeriodOfDate(gclsBase.BaseDate)
'----------------------------------
'设置控件的最大值和初始化其TEXT内容
    Dim y1 As Integer
    Dim y2 As Integer
    Call GetStartAndEndYear(y1, y2)
    SpinYear.Max = y2
    SpinYear.Min = y1
    
    blnIsCanDo = IsCanDo(461)
    cmdOK(2).Enabled = blnIsCanDo
    
    Call GetBaseStartAndEndPeriod(gclsBase.AccountYear, dtmStartDate, dtmEndDate, PeriodNum)
    spinMonth.Max = PeriodNum '+ gclsBase.PeriodOfDate(dtmStartDate) - 1
    spinMonth.Min = gclsBase.PeriodOfDate(dtmStartDate)
    spinMonth.Text = Format(Month1, "0#")
    SpinYear.Text = Format(Year1, "####")
'---------------------------------
    str = "单据号查询_记帐凭证"
    SpinYear.Enabled = True
    spinMonth.Enabled = True
    
    Me.Caption = str
    
End Sub


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

Private Sub SqlRecMaxNo()
    
    If Year1 <= 0 Then Exit Sub
    If Month1 <= 0 Then Exit Sub
    Dim recSql As rdoResultset
    Dim str As String
    Dim strReceiptNo1 As String
    Dim lngReceiptNO1 As Long
    lischa.Clear
    stbButton.Panels(1).Text = "编号查询"
            lngZds = 0: lngQhs = 0: lngZfs = 0
            str = "intYear=" & Year1 & " and  bytPeriod=" & Month1 & " and  lngReceiptTypeID=41 and strReceiptNo <> ' '  order by lngReceiptTypeID,strReceiptNO"
            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
            lischa.AddItem BillPublic.ReceiptTypeIdToName(lngReceiptTypeID1)
            With recSql
            .MoveFirst
            '取前缀,最大编号
            Do While Not .EOF
                    If IsNull(!strReceiptNo) Then
                        strReceiptNo1 = ""
                    Else
                        strReceiptNo1 = !strReceiptNo
                    End If
                    lngReceiptNO1 = !lngReceiptNo
                    sqlactivity strReceiptNo1, lngReceiptNO1, lngReceiptTypeID1  '前缀，最大编号，单据类型
                    .MoveNext
            Loop
            lischa.AddItem "---------------------------------------------------------"
             
            lischa.AddItem "合计：   总单数: " & (lngZds - lngQhs) & "   缺号数: " & lngQhs & "   作废数: " & lngZfs
       
            lischa.AddItem " "
            .Close
            End With
            Set recSql = Nothing
            stbButton.Panels(2).Text = "结束"
            
            If blnIsCanDo Then
                 If lngQhs = 0 Then
                    cmdOK(2).Enabled = False
                 ElseIf gclsBase.PeriodIsClosed(Year1, Month1) Then
                     cmdOK(2).Enabled = False
                 Else
                     cmdOK(2).Enabled = True
                 End If
            Else
                cmdOK(2).Enabled = False
            End If
'            .MoveNext
'          Loop
'          .Close
'          End With
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控制作废数
     Dim strName As String
     Dim strCode As String
     Call BillPublic.IdToCodeAndName(xVoucherType, C2lng(strAlp1), strCode, strName)
        
        str1 = "SELECT intVoucherNO,blnIsVoid FROM Voucher WHERE intVoucherNO > 0 and lngVoucherTypeID=" & C2lng(strAlp1) & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY intVoucherNO"
        Set recNo = gclsBase.BaseDB.OpenResultset(str1, rdOpenForwardOnly)
        If recNo Is Nothing Then Exit Sub
        If recNo.EOF Then
            recNo.Close
            Exit Sub
        End If
        If strAlp1 = "" Then
            strfg1 = "凭证字:" & "无 " & "     最大凭证字号   " & Format(strDig1, "00##")
        Else
            strfg1 = "凭证字:" & strCode & Space(8 - IIf(Len(strName) > 8, 6, Len(strName))) & "最大凭证字号   " & strCode & "-" & Format(strDig1, "00##")
        End If
        lischa.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 = strCode & 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 = "                   作废   " & strCode & "-" & c
                            Else
                                strfg1 = "                   作废   " & strCode & "-" & c & " 到 " & strCode & "-" & d
                            End If
                            lischa.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 = "                   缺号   " & strCode & "-" & Format(a, "00##") & " 到 " & strCode & "_" & Format(b, "00##")
                        lischa.AddItem strfg1
                         
                        bz2 = False
                    Else '不连号进入
                        If bz2 Then
                            If a = b Then
                                strfg1 = "                   缺号   " & strCode & "-" & Format(a, "00##")
                            Else
                                strfg1 = "                   缺号   " & strCode & "-" & Format(a, "00##") & " 到 " & strCode & "-" & Format(b, "00##")
                            End If