module2.bas

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

         'Printer.Print "结  论："
       '   .CurrentX = 135: .CurrentY = 247
       '  Printer.Print ksJG
        ' Printer.Line (130, 252)-(155, 252)
          .CurrentX = 110: .CurrentY = 250
         Printer.Print "被考人签字："
         .FontSize = 12
'          .CurrentX = 135: .CurrentY = 257
'          Printer.Print ksJG
        ' Printer.Line (130, 265)-(155, 265)
        '  .CurrentX = 155: .CurrentY = 257
       '  Printer.Print "(签字)"
           .CurrentX = 30: .CurrentY = 250
          Printer.Print "考试员签字："
'          .CurrentX = 135: .CurrentY = 257
'          Printer.Print ksJG
        ' Printer.Line (50, 265)-(70, 265)
        '  .CurrentX = 70: .CurrentY = 257
        ' Printer.Print "(签字)"
        Printer.EndDoc
    End With
End Sub

Public Sub TJBB(pre As Preview)
 Const Cols = 100
 Const Rows = 100

 Dim PrintWidth As Single
 Dim PrintHeight As Single
 Dim TextWidth As Single
 Dim i As Integer
 Dim Strin As String
 Dim SJS As Integer
 Dim JM As Integer
 Dim SJ, SJ1, SJ2 As Integer
 Dim J As Integer
 Dim k As Integer
 Dim Lg As Integer
 Dim Zc As Integer
 
 If zhcxSql = "" Then
    SJS = 0
 Else
    Sstr = "select * from cx1 where " & zhcxSql
    Set Res = New ADODB.Recordset
    Res.Open Sstr, Conn
    If Res.EOF Then Exit Sub
    Res.MoveFirst
    SJS = 0
    Do Until Res.EOF
       SJS = SJS + 1
       Res.MoveNext
    Loop
    Res.MoveFirst
 End If
 With pre
       If SJS = 0 Then
          TJTJ = "没有校验记录"
       Else
          TJTJ = zhcxTJ
       End If
       If TJTJ = "没有校验记录" Then SJS = 20
       If (SJS Mod 20) = 0 Then JM = SJS / 20 Else JM = SJS \ 20 + 1
       SJ = SJS Mod 20
       For J = 1 To JM
           If J <> 1 Then .NewPage "统计数据" Else .NewDoc "统计数据"
          .CellSize (PrintWidth / 2 - 15 - 15) / Cols, (PrintHeight - 10 - 15) / Rows
          .Orientation = 2
          
          .Caption = "统计数据" & "打印预览"
          .FontBold = True
          .FontSize = 20
          .ForeColor = vbBlack
          .FontName = "宋体"
           TextWidth = 100
          .TextE 82, 15, 100, " 统计数据"
          .FontSize = 10
          If TJTJ = "没有校验记录" Then
            .TextC 265, 28, "共" + "0" + "条记录"
          Else
            .TextC 265, 28, "共" + str(SJS) + "条记录"
          End If
          If Len(TJTJ) < 100 Then
              .TextL 13, 183, "查询条件：" + TJTJ
          Else
              .TextL 13, 183, "查询条件：" + Left(TJTJ, 50)
              .TextL 28, 188, Right(TJTJ, Len(TJTJ) - 50)
          End If
          .TextC 25, 190, Format(Date, "yyyy.mm.dd") + "印制"
          '.FontBold = False
          .FontSize = 13
           PrintWidth = 150
           TextWidth = 24
          
          .DrawWidth = 3
          .LineV 10, 32, 147
          .DrawWidth = 1
          .LineV 40, 32, 147
          .LineV 70, 32, 147
          .LineV 84, 32, 147
          .LineV 93, 32, 147
          .LineV 130, 32, 147
          .LineV 140, 32, 147
          .LineV 150, 32, 147
          .LineV 180, 32, 147
          .LineV 200, 32, 147
          .LineV 232, 32, 147
          .LineV 252, 32, 147
          .LineV 264, 32, 147
          .DrawWidth = 3
          .LineV 280, 32, 147
            
          .TextE 12, 35.5, 28, "身份证号"
          .TextE 42, 35.5, 28, "考试证号"
          .TextE 71, 35.5, 14, "姓名"
          .TextE 84, 35.5, 9, "性别"
          .TextE 94, 35.5, 36, "学习单位"
          .TextE 131, 35.5, 9, "车型"
          .TextE 141, 35.5, 9, "次数"
          .TextE 151, 35.5, 28, "一次成绩"
          .TextE 181, 35.5, 18, "一次日期"
          .TextE 202, 35.5, 28, "二次成绩"
          .TextE 233, 35.5, 18, "二次日期"
          .TextE 253, 35.5, 9, "结论"
          .TextE 266, 35.5, 12, "考官"
        
          
          For i = 0 To 21
              If i = 0 Or i = 21 Then .DrawWidth = 3 Else .DrawWidth = 1
              .LineH 10, 32 + i * 7, 270
              
          Next i
              
          TextWidth = 2
          
       ''''''''''''写入数据
       .FontSize = 9
       
       If J <> JM Then
          SJ1 = 20
       Else
          SJ1 = SJ
       End If
       For i = 1 To SJ1
            .TextE 11, 35.5 + i * 7, 29, IIf(IsNull(Res.Fields(0)), "", Res.Fields(0))
            .TextE 41, 35.5 + i * 7, 29, IIf(IsNull(Res.Fields(1)), "", Res.Fields(1))
            .TextC 77, 35.5 + i * 7, IIf(IsNull(Res.Fields(2)), "", Res.Fields(2))
            .TextC 88.5, 35.5 + i * 7, IIf(IsNull(Res.Fields(3)), "", Res.Fields(3))
            
            .TextC 111, 35.5 + i * 7, IIf(IsNull(Res.Fields(4)), "", Res.Fields(4))
            
            .TextC 135, 35.5 + i * 7, IIf(IsNull(Res.Fields(5)), "", Res.Fields(5))
            .TextC 145, 35.5 + i * 7, IIf(IsNull(Res.Fields(6)), "", Res.Fields(6))
            
            .TextE 152, 35.5 + i * 7, 29, IIf(IsNull(Res.Fields(7)), "", Res.Fields(7))
            
            .TextC 190, 35.5 + i * 7, IIf(IsNull(Res.Fields(8)), "", Res.Fields(8))
            .TextE 202, 35.5 + i * 7, 29, IIf(IsNull(Res.Fields(9)), "", Res.Fields(9))
            .TextC 242, 35.5 + i * 7, IIf(IsNull(Res.Fields(10)), "", Res.Fields(10))
            .TextC 258, 35.5 + i * 7, IIf(IsNull(Res.Fields(11)), "", Res.Fields(11))
            .TextC 272, 35.5 + i * 7, IIf(IsNull(Res.Fields(12)), "", Res.Fields(12))
            Res.MoveNext
       Next i
       Lg = JM
       Zc = J
       If TJTJ = "没有校验记录" Then
            Lg = 1
            Zc = 1
       End If
        .TextC 265, 190, "共" + str(Lg) + "页 第" + str(Zc) + "页"
     Next J
    .FontSize = 10
    .EndDoc
    .Preview
 
 End With
 
End Sub

Public Sub Kscjlxb(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(6) = Format(Now, "yyyy-mm-dd hh:mm:ss")
    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
        PrintHeight = 200
        PrintWidth = 280
'        .CellSize (PrintWidth / 2 - 30) / Cols, (PrintHeight - 25) / Rows
        .CellSize pritwidth, PrintWidth
        .NewDoc "考试成绩"
        .Caption = "考试成绩" & "打印预览"
        .Orientation = 0
        .ScaleTop = -13
        .ScaleLeft = -15
        .FontBold = True
        .FontSize = 22
        .ForeColor = vbBlack
        .FontName = "宋体"
'         For i = 1 To Len(dwmc)
            dwmc1 = dwmc '1 + " " + Mid(dwmc, i, 1)
'         Next i
        .TextC 90, 12, dwmc1
        .FontSize = 18
        .TextC 90, 23, "科 目 二 考 试 成 绩 单"
        .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 15, 120, 150
        .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 And numPL <> "F" Then
            .ForeColor = RGB(255, 0, 0)
            .DrawStyle = vbDash
            If InStr(numPL, "P") = 1 Then
                i = Mid(numPL, 3, 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
            Else
                i = Mid(numPL, 3, 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
            End If
            .ForeColor = vbBlack
            .DrawStyle = vbSolid
        ElseIf numLine < 20 Then
            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
        .FontSize = 12
        '.FontBold = True
       ' .TextC 120, 240, "结  论："
       ' .TextC 140, 240, ksJG
        '.LineU 130, 240, 20
        .TextC 120, 242, "被考人签字："
        '.LineU 130, 250, 20
        .TextC 20, 242, "考试员签字："
       ' .LineU 30, 250, 20
       ' .FontBold = False
        '.TextL 150, 250, "(签字)"
        '.TextL 80, 250, "(签字)"
        .EndDoc
        .Preview
    End With
End Sub