t_watercarrw.bas

停车场源代码。集成了很多功能

Attribute VB_Name = "T_WaterCarRW"


'将网格填补标题,计算每个网格的宽度(挂失、恢复)
Public Sub LoadGrid(Cntl As Control)
     With Cntl
        .Cols = 11
        .AllowUserResizing = flexResizeColumns
        .FixedCols = 0
        .RowHeightMin = 280
        .Rows = 2
        .Row = 0
        .ColWidth(0) = 1
         For i = 1 To 10
            .Col = (i)
            .ColAlignment(i) = 4
         Next
         .Col = 1
         .Text = "卡号"
         .Col = 2
         .Text = "卡类"
         .Col = 3
         .Text = "持卡人"
         .Col = 4
         .Text = "车牌号码"
         .Col = 5
         .Text = "部门"
         .Col = 6
         .Text = "有效起日"
         .Col = 7
         .Text = "结束日期"
         .Col = 8
         .Text = "储值额"
         .Col = 9
         .Text = "车况"
         .Col = 10
         .Text = "车位"
      End With
    With Cntl
        .ColWidth(1) = .Width * 0.0808
        .ColWidth(2) = .Width * 0.1
        .ColWidth(3) = .Width * 0.1
        .ColWidth(4) = .Width * 0.1
        .ColWidth(5) = .Width * 0.1
        .ColWidth(6) = .Width * 0.12
        .ColWidth(7) = .Width * 0.12
        .ColWidth(8) = .Width * 0.09
        .ColWidth(9) = .Width * 0.075
        .ColWidth(10) = .Width * 0.075
    End With
End Sub

'TextBox控件的BUG补丁
Function VailText(KeyIn As Integer, VaildateString As String, Editable As Boolean) As Integer
    Dim VaildateList As String
    Dim KeyOut As Integer
    If Editable = True Then
        VaildateList = UCase(VaildateString) & Chr(8)
    Else
        VaildateList = UCase(VaildateString)
    End If
    If InStr(1, VaildateList, UCase(Chr(KeyIn)), 1) > 0 Then
        KeyOut = KeyIn
    Else
        KeyOut = 0
        Beep
    End If
    VailText = KeyOut
End Function

'算出卡号
Public Function ClassCardsOn(MStr As String, LongToShort As Integer, Flag As Boolean) As String
    Dim CardsON As String
    If Flag = True Then
       '选择卡长的类型
        Select Case LongToShort
               Case 1   '卡号长为四位
                    CardsON = Left(MStr, 4)
               Case 2   '卡号长为五位
                    CardsON = String(5 - Len(Trim(T_frmMenu.Jsykt_1.HexToDec(Left(MStr, 4)))), "0") + Trim(T_frmMenu.Jsykt_1.HexToDec(Left(MStr, 4)))
               Case 3   '卡号长为六位
                    CardsON = T_frmMenu.Jsykt_1.Short2Long(Left(MStr, 6))
        End Select
    Else
        Select Case LongToShort
               Case 1
                    CardsON = Left(MStr, 4)
               Case 2
                    CardsON = String(4 - Len(Hex(Left(MStr, 5))), "0") + Hex(Left(MStr, 5))  '将卡转换成四位的字符数
               Case 3
                    CardsON = T_frmMenu.Jsykt_1.Long2Short(MStr)
        End Select
    End If
    ClassCardsOn = CardsON
End Function


'把最终的卡上的余额写入发行库中
Public Sub UpdateICIssue(CardsON As String, CardMoney As String)
   Dim myRs As New ADODB.Recordset
   Cmd.CommandType = adCmdText
   Cmd.CommandText = "UPDATE VICIssue SET 车场卡上余额=" & Format(Val(CardMoney), "####.00") & " Where 卡号='" & CardsON & "' and left(开通子系统,1)='1'"
   Set myRs = Cmd.Execute
   Set myRs = Nothing
End Sub