module2.bas

驾驶员考试系统界面不错在98下运行C/S模式

Attribute VB_Name = "Module2"
Public DYsfzh As String
Public Ksjl As String
Public ksJG As String
Public Sub grkscjdy(pre As Preview, Ssql As String) '以后打印
    Const Cols = 100
    Const Rows = 100
    Dim i, J, g, jl, GS, gg, k As Integer
    Dim Msg2, Msg1, Msg3, Msg4, Msg5 As String
    Dim PrintWidth As Single
    Dim PrintHeight As Single
    Dim TextWidth As Single
    Dim BFB As Integer
    Dim yy As String
    Dim dat As Date
    Dim s1, s2 As String
    Dim pic As StdPicture
    Dim strlb() As String
    Dim strdot1 As String
    Dim strdot2 As String
    Dim intdot1() As String
    Dim intdot2() As String
    Dim a(10) As String
    Dim ksjl1(50) As String
    Dim date1(50) As String
    Dim ksjg1(50) As String
    Dim numLine1(50) As Integer
    Dim jls As Integer
    
    Set Res = New ADODB.Recordset
    Res.Open Ssql, Conn
    If Res.EOF And Res.BOF = True Then
        Exit Sub
    Else
        Res.MoveFirst
    End If
    a(0) = Res!Name
    a(1) = Res!sex
    a(2) = Res!sfzh
    a(3) = Res!kszh
    a(4) = Res!cx
    'a(5) = Res!cx
    'a(6) = Res!phone
    
    jls = 0
    Do Until Res.EOF
        If Res!kscj1 <> "" And IsNull(Res!kscj1) = False Then
            ksjl1(jls) = Res!kscj1
            date1(jls) = Res!ksdate1
            numLine1(jls) = Res!cjline1
            ksjg1(jls) = IIf(IsNull(Res!ksJG), "", Res!ksJG)
            jls = jls + 1
        End If
        If Res!kscj2 <> "" And IsNull(Res!kscj2) = False Then
            ksjl1(jls) = Res!kscj2
            date1(jls) = Res!ksdate2
            numLine1(jls) = Res!cjline2
            ksjg1(jls) = IIf(IsNull(Res!ksJG), "", Res!ksJG)
            jls = jls + 1
        End If
        Res.MoveNext
    Loop
    strdot1 = "143,97,92.5,92.5,92.5,96,98,104,107.5,89,89,85,53,90,104,107.5,107.5,111,113,125,143"
    strdot2 = "143,143,154,175,220,177,215,177,220,178,161,148,143,145,161,180,220,175,160,145,145"
    Sstr = "姓  名,性  别,身份证号,准考证号,考试车型,考试成绩,考试日期"
        intdot1 = Split(strdot1, ",")
        intdot2 = Split(strdot2, ",")
        strlb = Split(Sstr, ",")
    With pre
    
    For jl = 0 To jls - 1
        'a(8) = ksjl1(jl)
        a(6) = date1(jl)
        a(5) = ksjg1(jl)
        numLine = numLine1(jl)
        PrintHeight = 200
        PrintWidth = 280
'        .CellSize (PrintWidth / 2 - 30) / Cols, (PrintHeight - 25) / Rows
        .CellSize pritwidth, PrintWidth
        If jl <> 0 Then .NewPage "考试成绩" Else .NewDoc "考试成绩"
        .Caption = "考试成绩" & "打印预览"
        .Orientation = 0
        .ScaleTop = -13
        .ScaleLeft = -15
        .FontBold = True
        .FontSize = 22
        .ForeColor = vbBlack
        .FontName = "宋体"
        If dwmc1 <> "" Then dwmc1 = ""
'         For i = 1 To Len(dwmc)
'            dwmc1 = dwmc1 + " " + Mid(dwmc, i, 1)
'         Next i
        dwmc1 = dwmc
        .TextC 90, 10, dwmc1
        .FontSize = 18
        .TextC 90, 21, "科 目 二 考 试 成 绩 单"
        .FontBold = False
        .FontSize = 12
         TextWidth = 24
        .DrawWidth = 3
        .BoxLine 5, 30, 170, 230
        .DrawWidth = 1
        '.PaintPicture pic, 135, 30, 40, 56
        
        
        For i = 0 To 6
            '名称
            .TextE 18, 30 + 8 * (i + 1), 32, strlb(i)
            '下划线
            .LineU 60, 30 + 8 * (i + 1), 65
            '数据
             .TextC 90, 30 + 8 * (i + 1), a(i)
        Next i
        '车
        Select Case numLine
            Case 1, 20
                Set pic = LoadPicture(App.Path + "\audio\r.ico")
            Case 6, 8, 9, 11, 14
                Set pic = LoadPicture(App.Path + "\audio\lu.ico")
            Case 12, 13
                Set pic = LoadPicture(App.Path + "\audio\l.ico")
            Case 2, 5, 7, 18, 19
                Set pic = LoadPicture(App.Path + "\audio\ru.ico")
            Case 3, 4, 10, 15, 16, 17
                Set pic = LoadPicture(App.Path + "\audio\u.ico")
        End Select
        '画考场
        .DrawWidth = 2.5
        .LineH 50, 120, 95
        .LineH 50, 165, 95
        .LineH 85, 230, 30
        .LineW 85, 165, 85, 230
        .LineW 100, 165, 100, 230
        .LineW 115, 165, 115, 230
        '画杆
        .Arc 85, 165, 1
        .Arc 100, 165, 1
        .Arc 115, 165, 1
        .Arc 85, 230, 1
        .Arc 100, 230, 1
        .Arc 115, 230, 1
        '画考试路线
        .DrawWidth = 1
        If numLine = -1 Then
            .EndDoc
            .Preview
            Exit Sub
        End If
        For i = 0 To numLine - 1
            .LineW intdot1(i), intdot2(i), intdot1(i + 1), intdot2(i + 1)
        Next i
        If numLine < 20 Then
            .ForeColor = RGB(255, 0, 0)
            .DrawStyle = vbDash
            If InStr(a(8), "碰") = 1 Then
                i = Mid(a(8), InStr(a(8), "碰") + 2, 1) - 1
                If i = 0 Then
                    .LineW intdot1(numLine), intdot2(numLine), 85, 165
                    .PaintPicture pic, 80, 160, 12, 12
                End If
                If i = 1 Then
                    .LineW intdot1(numLine), intdot2(numLine), 100, 165
                    .PaintPicture pic, 95, 160, 12, 12
                End If
                If i = 2 Then
                    .LineW intdot1(numLine), intdot2(numLine), 115, 165
                    .PaintPicture pic, 110, 160, 12, 12
                End If
                If i = 3 Then
                    .LineW intdot1(numLine), intdot2(numLine), 85, 230
                    .PaintPicture pic, 80, 225, 12, 12
                End If
                If i = 4 Then
                    .LineW intdot1(numLine), intdot2(numLine), 100, 230
                    .PaintPicture pic, 95, 225, 12, 12
                End If
                If i = 5 Then
                    .LineW intdot1(numLine), intdot2(numLine), 115, 230
                    .PaintPicture pic, 110, 225, 12, 12
                End If
            ElseIf InStr(a(8), "越") = 1 Then
                i = Mid(a(8), InStr(a(8), "越") + 2, 1) - 1
                If i = 0 Then
                    .LineW intdot1(numLine), intdot2(numLine), 90, 118
                    .PaintPicture pic, 88, 120, 11, 12
                End If
                If i = 1 Then
                    If numLine = 0 Then
                        .LineW intdot1(numLine), intdot2(numLine), 107, 165
                        .PaintPicture pic, 105, 160, 12, 12
                    ElseIf numLine < 6 Then
                        .LineW intdot1(numLine), intdot2(numLine), 92, 165
                        .PaintPicture pic, 90, 160, 12, 12
                    Else
                        .LineW intdot1(numLine), intdot2(numLine), 107, 165
                        .PaintPicture pic, 105, 160, 12, 12
                    End If
                End If
                If i = 2 Then
                    If numLine < 7 Then
                        .LineW intdot1(numLine), intdot2(numLine), 92, 230
                        .PaintPicture pic, 90, 223, 12, 12
                    Else
                        .LineW intdot1(numLine), intdot2(numLine), 107, 230
                        .PaintPicture pic, 105, 222, 12, 12
                    End If
                End If
                If i = 3 Then
                    .LineW intdot1(numLine), intdot2(numLine), 85, 195
                    .PaintPicture pic, 80, 190, 12, 12
                End If
                If i = 4 Then
                    .LineW intdot1(numLine), intdot2(numLine), 100, 195
                    .PaintPicture pic, 95, 190, 12, 12
                End If
                If i = 5 Then
                    .LineW intdot1(numLine), intdot2(numLine), 115, 195
                    .PaintPicture pic, 110, 190, 12, 12
                End If
            Else
                Select Case numLine + 1
                    Case 1, 20
                        Set pic = LoadPicture(App.Path + "\audio\r.ico")
                    Case 6, 8, 9, 11, 14
                        Set pic = LoadPicture(App.Path + "\audio\lu.ico")
                    Case 12, 13
                        Set pic = LoadPicture(App.Path + "\audio\l.ico")
                    Case 2, 5, 7, 18, 19
                        Set pic = LoadPicture(App.Path + "\audio\ru.ico")
                    Case 3, 4, 10, 15, 16, 17
                        Set pic = LoadPicture(App.Path + "\audio\u.ico")
                End Select
                .ForeColor = RGB(255, 0, 0)
                .DrawStyle = vbDash
                .LineW intdot1(numLine), intdot2(numLine), intdot1(numLine + 1), intdot2(numLine + 1)
                .PaintPicture pic, intdot1(numLine + 1) - 5, intdot2(numLine + 1) - 5, 12, 12
                .ForeColor = vbBlack
                .DrawStyle = vbSolid
            End If
            .ForeColor = vbBlack
            .DrawStyle = vbSolid
        Else
            .PaintPicture pic, 144, 140, 12, 10
        End If
        .FontSize = 12
       ' .FontBold = True
        '.TextC 120, 240, "结  论："
       ' .TextC 140, 240, a(10)
        '.LineU 130, 240, 20
        .TextC 120, 240, "被考人签字："
       ' .LineU 130, 250, 20
        .TextL 20, 240, "考试员签字："
       ' .FontBold = False
        '.LineU 50, 250, 20
        '.TextL 150, 250, "(签字)"
       ' .TextL 70, 250, "(签字)"
    Next jl
        .EndDoc
        .Preview
    End With
 
End Sub

Public Sub Kscjlxb1(pre As Preview, numLine As Integer, numPL As String) '及时打印的
    
    
    Const Cols = 100
    Const Rows = 100
    Dim i, J, g, jl, GS, gg, k As Integer
    Dim Msg2, Msg1, Msg3, Msg4, Msg5 As String
    Dim PrintWidth As Single
    Dim PrintHeight As Single
    Dim TextWidth As Single
    Dim BFB As Integer
    Dim yy As String
    Dim dat As Date
    Dim s1, s2 As String
    Dim pic As StdPicture
    Dim strlb() As String
    Dim strdot1 As String
    Dim strdot2 As String
    Dim intdot1() As String
    Dim intdot2() As String
    Dim a(9) As String
    Sstr = "select * from person where sfzh='" & DYsfzh & "'"
         
    Set Res = New ADODB.Recordset
    Res.Open Sstr, Conn
    
    
    a(0) = Res!Name
    a(1) = Res!sex
    a(2) = Res!sfzh
    a(3) = Res!kszh
    a(4) = Res!cx
    a(5) = Ksjl
'    a(0) = "后鳞波"
'    a(1) = "男"
'    a(2) = "140406198211230074"
'    a(3) = "可靠棵拉萨开裆裤达到"
'    a(4) = "A1"
'    a(5) = "合格"



   
    a(6) = Format(Now, "yyyy-mm-dd hh:mm:ss")
    strdot1 = "153,107,102.5,102.5,102.5,106,108,114,117.5,99,99,95,63,100,114,117.5,117.5,121,125,135,153"
    strdot2 = "153,153,164,185,230,187,225,187,230,188,170,158,153,155,171,190,230,185,172,155,155"
    Sstr = "姓          名,性          别,身  份  证  号,准  考  证  号,考  试  车  型,考  试  成  绩,考  试  日  期"
        intdot1 = Split(strdot1, ",")
        intdot2 = Split(strdot2, ",")
        strlb = Split(Sstr, ",")
    With Printer
        
        .ScaleMode = 6
        .FontBold = True
        .FontSize = 22
        .ForeColor = vbBlack
        .FontName = "宋体"
         .CurrentX = 36: .CurrentY = 20
'         For i = 1 To Len(dwmc)
            dwmc1 = dwmc '1 + " " + Mid(dwmc, i, 1)
'         Next i
          Printer.Print dwmc1
        .FontSize = 18
         .CurrentX = 69: .CurrentY = 32
         Printer.Print "科 目 二 考 试 成 绩 单"
        .FontBold = flase
        .FontSize = 12
         TextWidth = 24
        .DrawWidth = 12
        Printer.Line (20, 40)-(190, 270), , B
        .DrawWidth = 1
        For i = 0 To 6
            '名称
            .CurrentX = 33: .CurrentY = 38 + 8 * (i + 1)
             Printer.Print strlb(i)
            '下划线
            Printer.Line (75, 43 + 8 * (i + 1))-(140, 43 + 8 * (i + 1))
            '数据
            .CurrentX = 80: .CurrentY = 38 + 8 * (i + 1)
             If i = 6 Then
                 Printer.Print "     " + a(i)
             ElseIf i = 1 Then
                Printer.Print "            " + a(i)
              ElseIf i = 2 Or i = 3 Then
                Printer.Print "   " + a(i)
                
             ElseIf i = 0 Then
                Printer.Print "          " + a(i)
             ElseIf i = 4 Then
                Printer.Print "            " + a(i)
             Else
                 Printer.Print "           " + a(i)
             End If
             
        Next i
        '加载车
        Select Case numLine
            Case 1, 20
                Set pic = LoadPicture(App.Path + "\audio\r.ico")
            Case 6, 8, 9, 11, 14
                Set pic = LoadPicture(App.Path + "\audio\lu.ico")
            Case 12, 13
                Set pic = LoadPicture(App.Path + "\audio\l.ico")
            Case 2, 5, 7, 18, 19
                Set pic = LoadPicture(App.Path + "\audio\ru.ico")
            Case 3, 4, 10, 15, 16, 17
                Set pic = LoadPicture(App.Path + "\audio\u.ico")
        End Select
        .PaintPicture pic, 154, 149, 12, 10
        '画考场
        .DrawWidth = 8
        Printer.Line (30, 130)-(180, 130)
        Printer.Line (60, 180)-(160, 180)
        Printer.Line (95, 240)-(125, 240)
        Printer.Line (110, 180)-(110, 240)
        Printer.Line (95, 180)-(95, 240)
        Printer.Line (125, 180)-(125, 240)
        Printer.Circle (110, 180), 1
        Printer.Circle (110, 240), 1
        Printer.Circle (95, 180), 1
        Printer.Circle (95, 240), 1
        Printer.Circle (125, 180), 1
        Printer.Circle (125, 240), 1
        '画考试路线
        .DrawWidth = 1
        If numLine = -1 Then
            .EndDoc
            Exit Sub
        End If
        For i = 0 To numLine - 1
           Printer.Line (intdot1(i), intdot2(i))-(intdot1(i + 1), intdot2(i + 1))
        Next i
       ' .FontSize = 16
       .FontSize = 12
       ' .CurrentX = 110: .CurrentY = 247