frmwaterratecount_dateinput.frm

自来水公司的一个管理系统

VERSION 5.00
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.Form frmWaterrateCount_DateInput 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "计费月份"
   ClientHeight    =   1770
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4350
   Icon            =   "frmWaterrateCount_DateInput.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1770
   ScaleWidth      =   4350
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame1 
      Caption         =   "计费月份"
      ForeColor       =   &H00800000&
      Height          =   900
      Left            =   150
      TabIndex        =   4
      Top             =   135
      Width           =   3960
      Begin MSMask.MaskEdBox txtYear 
         Height          =   300
         Left            =   240
         TabIndex        =   0
         Top             =   345
         Width           =   1095
         _ExtentX        =   1931
         _ExtentY        =   529
         _Version        =   393216
         MaxLength       =   4
         Mask            =   "9999"
         PromptChar      =   " "
      End
      Begin VB.ComboBox cboMonth 
         Height          =   300
         ItemData        =   "frmWaterrateCount_DateInput.frx":0442
         Left            =   1770
         List            =   "frmWaterrateCount_DateInput.frx":0444
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   345
         Width           =   990
      End
      Begin VB.Label Label1 
         Caption         =   "年"
         Height          =   210
         Index           =   2
         Left            =   1455
         TabIndex        =   6
         Top             =   405
         Width           =   210
      End
      Begin VB.Label Label1 
         Caption         =   "月份"
         Height          =   210
         Index           =   3
         Left            =   2805
         TabIndex        =   5
         Top             =   405
         Width           =   435
      End
   End
   Begin VB.CommandButton cmdCancle 
      Caption         =   "放弃"
      Height          =   360
      Left            =   1080
      TabIndex        =   3
      Top             =   1230
      Width           =   960
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   360
      Left            =   135
      TabIndex        =   2
      Top             =   1230
      Width           =   960
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      Index           =   1
      X1              =   105
      X2              =   4185
      Y1              =   1125
      Y2              =   1125
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000003&
      Index           =   0
      X1              =   105
      X2              =   4170
      Y1              =   1110
      Y2              =   1110
   End
End
Attribute VB_Name = "frmWaterrateCount_DateInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public strReturmYear As String        '返回值-用水时段年
Public strReturmMonth As String        '返回值-用水时段月
Public blnReturnHaveRate    As Boolean '已经计费标志

Private Sub cmdCancle_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Dim strYm As String
    Dim bytReturnFlag As Byte
    Dim strSQL As String
    Dim lngRecordNum As Long    '记录数
    Dim strPYm As String        '上月年月字符串
    Dim btyReturnFlag As Byte
    
    '不能输入本年大于本月份的月份
    If Val(Me.txtYear.Text) = Year(Date) And Me.cboMonth.ListIndex + 1 > Month(Date) Then
        Warning "月份不能大于本月!!!"
        Exit Sub
    End If
    strYm = Trim(Me.txtYear.Text) & Me.cboMonth.Text
    If Detect(strYm) = 2 Then '该月为已往月份且已经计过费了
        Warning "该月份已经计过费了，不允许再次进行计费操作！！！"
        Exit Sub
    ElseIf Detect(strYm) = 1 Then '该月已经计过费了,但  是最近一个月的月份
        btyReturnFlag = MsgBox("该月份已经计过费了，是否确定需要重新计费？" & Chr(13) & Chr(13) & "如果重新计费，则系统将只对尚未打印发票(或发票被作废)的用户进行重计费！", vbYesNo + vbDefaultButton2 + vbExclamation, "警告")
        If btyReturnFlag = vbNo Then
            Exit Sub
        Else
            blnReturnHaveRate = True    '允许重新计费，但设置了标志（计费处理过程不一样）
        End If
    ElseIf GetCurJFYm() = "" Then
        Warning "得到当前计费月份出错！！！"
        Exit Sub
    ElseIf strYm <> GetCurJFYm() Then
        Warning "该月份不允许进行计费操作！！！"
        Exit Sub
    Else
        blnReturnHaveRate = False    '尚未计费
    End If
    strReturmYear = Trim(Me.txtYear.Text)
    strReturmMonth = Me.cboMonth.Text

    Unload Me
End Sub

Private Sub Form_Load()
    MoveToCenter gMainFormRefer, Me
    
    '初始化模块返回变量
    strReturmYear = ""
    strReturmMonth = ""
    blnReturnHaveRate = False
    
    txtYear.Text = Trim(Str(Year(Date)))
    cboMonth.AddItem ("01")
    cboMonth.AddItem ("02")
    cboMonth.AddItem ("03")
    cboMonth.AddItem ("04")
    cboMonth.AddItem ("05")
    cboMonth.AddItem ("06")
    cboMonth.AddItem ("07")
    cboMonth.AddItem ("08")
    cboMonth.AddItem ("09")
    cboMonth.AddItem ("10")
    cboMonth.AddItem ("11")
    cboMonth.AddItem ("12")
    cboMonth.ListIndex = Month(Date) - 1
End Sub

Private Function Detect(ByVal strYm As String) As Byte
    '-------------------------
    '功能：  在计费表(WaterRate)中查询是否已经存在指定月份的计费数据，如果已经有了且是以往月份的则不允许再输入水表读数了，否则如果有但是最近一月的则还可以再输入
    '参数：  strYm 指定的年月  格式：YYYYMM
    '返回值: 0 不存在，尚未计费
    '        1 已经存在，但 是最近一个月的月份
    '        2 已经存在，且 是以往月的月份
    '用法:
    '建立:   2001/5/29 by  pc
    '修改:
    '修改内容:
    '-------------------------
    Dim strSQL As String
    Dim lngNumberOfRecord As Long
    Dim strTmp As String
    
    strSQL = "select Count(*) from WaterRate where Ym='" & strYm & "'"
    lngNumberOfRecord = gConnect.Execute(strSQL).Fields(0).value
    If lngNumberOfRecord = 0 Then
        Detect = 0
    Else
        strSQL = "select Max(Ym) from WaterRate"
        strTmp = gConnect.Execute(strSQL).Fields(0).value
        If strTmp = strYm Then
            Detect = 1
        Else
            Detect = 2
        End If
    End If
End Function

Private Function GetCurJFYm() As String
'得到当前所处的水费计费年月
    Dim strSQL As String
    Dim strTmpString As String
    Dim adoTmpRS As ADODB.Recordset
    
    strSQL = "select max(Ym) from WaterRate"
    On Error GoTo ErrHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    If IsNull(adoTmpRS.Fields(0)) Then
        '如果计费表为空，则当前年月就是当前的计费年月
        strTmpString = Trim(Str(Month(Date)))
        strTmpString = String(2 - Len(strTmpString), "0") & strTmpString
        strTmpString = Trim(Str(Year(Date))) & strTmpString
    Else
        '如果计费表不为空,则表中最大的计费年月的下个月就是当前的计费年月
        strTmpString = adoTmpRS.Fields(0).value
        strTmpString = NextYm(strTmpString)
    End If
    GetCurJFYm = strTmpString
    
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    
    Exit Function
    '-------错误处理---------
ErrHandleExe:
    On Error GoTo 0
    GetCurJFYm = ""
    
End Function

Private Sub txtYear_GotFocus()
    Call AutoSelectText(txtYear)
End Sub

Private Sub txtYear_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtYear_LostFocus()
    If Trim(Me.txtYear.Text) = "" Then
        Warning "日期格式输入错误!!!"
        Me.txtYear.SetFocus
        Exit Sub
    End If
    If Val(Me.txtYear.Text) < 1900 Or Val(Me.txtYear.Text) > 9999 Then
        Warning "日期格式输入错误!!!"
        Me.txtYear.SetFocus
        Exit Sub
    End If
End Sub

Private Sub cboMonth_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub