module1.bas

检定证书的管理打印程序VB6+ace

Attribute VB_Name = "Module1"
Global conn As ADODB.Connection
Global conns As String
Global grs As ADODB.Recordset
Global flag As Integer
Global bm(16) As String
Global bmm(4) As String
Type jlqj
   mc As String
   gg As String
   dqd As String
   jdzsh As String
End Type
Global jdjga(20) As String  '检定结果数组
Global jlqla(10) As jlqj  '检定器具数组
Global gzsbh As String    '证书编号
Global gi As Integer      '检定器具数组i
Global gi2 As Integer
Global jlqjk As Integer '标志计量器具表是否为空
Global prizj   '增加打印机标志
Global xgjg As Integer
Global xgjlqjfla As Integer
Global cxtj As String  '查询条件
Global btt(4) As Integer
Global jdzsnra(14) As String
Global jdtja(2) As Single
Type pritype
    X As Single
    Y As Single
    l As Single
    h As Single
End Type
Global pril(16) As pritype
Global pjlqj(4) As pritype
Global pjdjg As pritype
Global caxiun As Integer '查询标记
Global caxunbj As Integer
'****************************************
Global btzsbh As String
Global btwtdw As String
Global btyqmc As String
Global btxhgg As String
Global btzzc As String
Global btccbh As String
Global btjdjl As String
Global btszr As String
Global btjyy As String
Global btjdy As String
Global btjdri As String
Global btyxqz As String
Global btjdyj As String
Public Sub fillcombo(ByVal cb As ComboBox, ByVal rs As ADODB.Recordset)
If rs.RecordCount > 0 Then
For i = 0 To rs.RecordCount - 1
  If Len(rs.Fields(1)) <> 0 Then
   cb.AddItem rs.Fields(1)
  End If
  rs.MoveNext
Next i
End If
End Sub
Public Sub fillmgz(ByVal grid As MSHFlexGrid, ByRef bm() As String, ByRef btl1() As Integer, ByVal rs1 As ADODB.Recordset)
'On Error GoTo err1:
'Debug.Print grid.Rows
'grid.RowHeight() = 0
For i = 2 To grid.Rows - 1
  grid.RemoveItem 2
Next i
grid.Cols = rs1.Fields.Count

For i = 0 To rs1.Fields.Count - 1
    grid.ColAlignment(i) = 1
    grid.ColAlignmentFixed(i) = 1
   If i = 13 Then
    grid.ColWidth(i) = btl1(i) * 100
   Else
    grid.ColWidth(i) = btl1(i) * 200
   End If
 
    grid.TextMatrix(0, i) = bm(i)
Next i
For i = 0 To rs1.RecordCount - 1
    strsql = ""
    For j = 0 To rs1.Fields.Count - 1
         strsql = strsql & rs1.Fields(j) & Chr(9)
    Next j
    rs1.MoveNext
    grid.AddItem strsql
    
Next i
grid.RowHeight(1) = 0
err1:
rs1.Close
End Sub
Public Sub priint()
rx = 3000
rx1 = 4900

'1111111111111111111111
pril(0).X = 3700
pril(0).Y = 3500
pril(0).l = 0
pril(0).h = 0
'22222222222222222222222
pril(1).X = rx
pril(1).Y = 4200
pril(1).l = 0
pril(1).h = 0
'333333333333333333333333
pril(2).X = rx
pril(2).Y = 4650
pril(2).l = 0
pril(2).h = 0
'444444444444444444444444444
pril(3).X = rx
pril(3).Y = 5150
pril(3).l = 0
pril(3).h = 0
'55555555555555
pril(4).X = rx
pril(4).Y = 5600
pril(4).l = 0
pril(4).h = 0
'6
pril(5).X = rx
pril(5).Y = 6100
pril(5).l = 0
pril(5).h = 0
'7
pril(6).X = rx
pril(6).Y = 6550
pril(6).l = 0
pril(6).h = 0
'8
pril(7).X = rx1
pril(7).Y = 7900
pril(7).l = 0
pril(7).h = 0
'9
pril(8).X = rx1
pril(8).Y = 8300
pril(8).l = 0
pril(8).h = 0
'10
pril(9).X = rx1
pril(9).Y = 8800
pril(9).l = 0
pril(9).h = 0
'11
pril(10).X = rx
pril(10).Y = 9500
pril(10).l = 0
pril(10).h = 0
'12
pril(11).X = rx
pril(11).Y = 10000
pril(11).l = 0
pril(11).h = 0

End Sub
Public Sub prijdzs() '打印检定证书正面
On Error GoTo err1
Printer.FontSize = 11
Printer.CurrentX = pril(i).X
Printer.CurrentY = pril(i).Y
Printer.Print jdzsnra(i)

For i = 1 To 9
  If Len(jdzsnra(i)) > 15 Then
     Printer.CurrentX = pril(i).X
     Printer.CurrentY = pril(i).Y - Printer.TextHeight(jdzsnra(i))
     Printer.Print Mid(jdzsnra(i), 1, 15)
     Printer.CurrentY = pril(i).Y
     Printer.CurrentX = pril(i).X
     Printer.Print Mid(jdzsnra(i), 16, Len(jdzsnra(i)) - 15)
   Else
   
     Printer.CurrentX = pril(i).X
     Printer.CurrentY = pril(i).Y
     Printer.Print jdzsnra(i)
  End If
Next i
Printer.CurrentX = pril(10).X + 400
Printer.CurrentY = pril(10).Y
dat = jdzsnra(10)
'dat = Format(dat, "yyyymmdd")
daty = Mid(dat, 1, 4)
Printer.Print daty
Printer.CurrentY = pril(10).Y
Printer.CurrentX = pril(10).X + 1850
datm = Mid(dat, 5, 2)
Printer.Print datm
Printer.CurrentY = pril(10).Y
Printer.CurrentX = pril(10).X + 3050
datd = Mid(dat, 7, 2)
Printer.Print datd
dat = jdzsnra(11)
'dat = Format(dat, "yyyymmdd")
Printer.CurrentX = pril(11).X + 400
Printer.CurrentY = pril(11).Y
Printer.Print Mid(dat, 1, 4)
Printer.CurrentY = pril(11).Y
Printer.CurrentX = pril(11).X + 1850
Printer.Print Mid(dat, 5, 2)
Debug.Print Mid(dat, 5, 2)
Printer.CurrentY = pril(11).Y
Printer.CurrentX = pril(11).X + 3050
Printer.Print Mid(dat, 7, 2)
Debug.Print Mid(dat, 7, 2)
Printer.EndDoc
err1:
   If err.Number <> 0 Then
       
       MsgBox err.Description, 4144, " 提示"
   End If
End Sub
Public Sub intb()

pril(12).X = 1100
pril(12).Y = 2300
pril(12).l = 0
pril(12).h = 0

pril(13).X = 2700
pril(13).Y = 6330
pril(13).l = 0
pril(13).h = 0

pril(14).X = 5400
pril(14).Y = 6330
pril(14).l = 0
pril(14).h = 0

'Global pjlqj(4) As pritype
jlqjy = 3950
jlqjh = 1600
pjlqj(0).X = 750
pjlqj(0).Y = jlqjy
pjlqj(0).l = 1850
pjlqj(0).h = jlqjh

pjlqj(1).X = 2630
pjlqj(1).Y = jlqjy
pjlqj(1).l = 1500
pjlqj(1).h = jlqjh

pjlqj(2).X = 4200
pjlqj(2).Y = jlqjy
pjlqj(2).l = 1500
pjlqj(2).h = jlqjh

pjlqj(3).X = 5800
pjlqj(3).Y = jlqjy
pjlqj(3).l = 1600
pjlqj(3).h = jlqjh


'Global pjdjg As pritype
pjdjg.X = 1100
pjdjg.Y = 7500
pjdjg.h = 3000
pjdjg.l = 6800
End Sub
Public Sub pjdzsb() '打印检定证书北面
'打印依据,温度,湿度
On Error GoTo err1

Printer.FontSize = 11
Printer.CurrentX = pril(12).X
Printer.CurrentY = pril(12).Y
Printer.Print jdzsnra(12)
Printer.CurrentX = pril(13).X
Printer.CurrentY = pril(13).Y
Printer.Print jdzsnra(13)
Printer.CurrentX = pril(14).X
Printer.CurrentY = pril(14).Y
Printer.Print jdzsnra(14)
'打印器具表
i = 0
yy = pjlqj(0).Y
Do While Len(jlqla(i).mc) <> 0
    For j = 0 To 3
        If (yy < pjlqj(j).Y) Then
          yy = pjlqj(j).Y
        End If
    Next j
    For j = 0 To 3
      pjlqj(j).Y = yy
    Next j
    pjlb pjlqj(0).X, pjlqj(0).Y, jlqla(i).mc, pjlqj(0).l, pjlqj(0).h
    pjlb pjlqj(1).X, pjlqj(1).Y, jlqla(i).gg, pjlqj(1).l, pjlqj(1).h
    pjlb pjlqj(2).X, pjlqj(2).Y, jlqla(i).dqd, pjlqj(2).l, pjlqj(2).h
    pjlb pjlqj(3).X, pjlqj(3).Y, jlqla(i).jdzsh, pjlqj(3).l, pjlqj(3).h
    i = i + 1
     'an = MsgBox("名称超过20个字", vbYes, "提示!!!!!!!")
Loop

'打印检定结果
i = 0
ll = 0
Do While Len(jdjga(i)) <> 0
 ll = ll + Printer.TextHeight(jdjga(i)) + 100
 i = i + 1
Loop
If ll > pjdjg.h Then
  an = MsgBox("内容太多", vbYesNo, "提示!!!!!!!")
End If
i = 0
Do While Len(jdjga(i)) <> 0
 pjdj pjdjg.X, pjdjg.Y, pjdjg.l, pjdjg.h, jdjga(i)
 pjdjg.Y = pjdjg.Y + Printer.TextHeight(jdjga(i)) + 100
 i = i + 1
Loop
Printer.EndDoc
err1:
  If err.Number <> 0 Then
      MsgBox err.Description, 4144, " 提示"
  End If
End Sub

Public Sub pjdj(x1 As Single, y1 As Single, ll As Single, hh As Single, str As String)
Dim ww As Single
Dim wh As Single
 Printer.CurrentX = x1
 Printer.CurrentY = y1
 Printer.Print str
End Sub

Public Sub pjlb(ByVal X As Single, ByRef cy As Single, ByVal str As String, ByVal lw As Single, ByVal lh As Single)
Dim ww, wh As Single
Dim str1, str2 As String
Dim i, j, slen, ptr As Integer
ww = Printer.TextWidth(Trim(str))
wh = Printer.TextHeight(str)
If ww <= lw Then
      Printer.CurrentX = X
      Printer.CurrentY = cy
      cy = cy + wh
      Printer.Print str
      Exit Sub
End If
slen = Len(Trim(str))
ptr = 1
j = 1
For i = 1 To slen
 str1 = Mid(str, 1, j)
 str2 = Mid(str, 1, j + 1)
 If (Printer.TextWidth(str1)) <= lw And (Printer.TextWidth(str2) > lw) Or (j >= (slen - ptr + 1)) Then
         Printer.CurrentX = X
         Printer.CurrentY = cy
         Printer.Print str1
         ptr = ptr + Len(str1)
         str = right(str, slen - ptr + 1)
         j = 0
         cy = cy + wh
 End If
 j = j + 1
Next i
End Sub