frmm_label.frm

利用VB+ACCESS开发的专用布料管理系统

        ' 条码打印高度要减去下面的字符显示高度

        intHeight = intHeight - Printer.TextHeight(strBC)

    End If

   

    Const intWidthCU As Integer = 30 ' 粗线和宽间隙宽度

    Const intWidthXI As Integer = 10 ' 细线和窄间隙宽度

    Dim intIndex As Integer            ' 当前处理的字符串索引

    Dim i As Integer, j As Integer, k As Integer    ' 循环控制变量


    ' 添加起始字符

    If Left(strBC, 1) <> "*" Then

        strBC = "*" & strBC

    End If

    ' 添加结束字符

    If Right(strBC, 1) <> "*" Then

        strBC = strBC & "*"

    End If

   

    ' 循环处理每个要显示的条码字符

    For i = 1 To Len(strBC)

        ' 确定当前字符在 strBarTable 中的索引

        Select Case Mid(strBC, i, 1)

        Case "*"

            intIndex = 39

        Case "$"

            intIndex = 38

        Case "%"

            intIndex = 37

        Case "-"

            intIndex = 36

        Case "0" To "9"

            intIndex = CInt(Mid(strBC, i, 1))

        Case "A" To "Z"

            intIndex = Asc(Mid(strBC, i, 1)) - Asc("A") + 10

        Case Else

            MsgBox "要打印的条形码字符串中包含无效字符！当前版本只支持字符 '0'-'9','A'-'Z','-','%','$'和'*'"

        End Select

     

        ' 是否在条形码下方打印人工识别字符

        If bolPrintText = True Then

            Printer.CurrentX = x

            Printer.CurrentY = y + intHeight

            Printer.Print Mid(strBC, i, 1)

        End If


        For j = 1 To 5

            ' 画细线

            If Mid(strBarTable(intIndex), j, 1) = "0" Then

                For k = 0 To intWidthXI - 1

                    Printer.Line (x + k, y)-Step(0, intHeight)

                Next k

                x = x + intWidthXI

            ' 画宽线

            Else

                For k = 0 To intWidthCU - 1

                    Printer.Line (x + k, y)-Step(0, intHeight)

                Next k

                x = x + intWidthCU

            End If


            ' 每个字符条码之间为窄间隙

            If j = 5 Then

                x = x + intWidthXI * 3

                Exit For

            End If

       

            ' 窄间隙

            If Mid(strBarTable(intIndex), j + 5, 1) = "0" Then

                x = x + intWidthXI * 3

            ' 宽间隙

            Else

                x = x + intWidthCU * 2

            End If

        Next j

    Next i


    ' 恢复打印机 ScaleMode

    Printer.ScaleMode = intOldScaleMode

    ' 恢复打印机 DrawWidth

    Printer.DrawWidth = intOldDrawWidth

    ' 恢复打印机 Font

    Set Printer.Font = fntOldFont

End Sub

Private Sub PrintBarLabel()
    Dim PCn As New ADODB.Connection
    Dim PRec As New ADODB.Recordset
    
    PCn.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" & _
        SysDbPath & "\report97.mdb;jet oledb:database password=tony;"
    PCn.Open
    PRec.CursorLocation = adUseClient
    PRec.Open "select * from LabelDB", PCn, adOpenDynamic, adLockOptimistic
    If PRec.EOF And PRec.BOF Then
        PCn.Close: Set PCn = Nothing
        PRec.Close: Set PRec = Nothing
        MsgBox "输入的定单号没有可打印数据！", vbOKOnly + vbCritical, "打印出错"
        Exit Sub
    End If
    On Error GoTo Er
    Dim i As Integer
    
    Do While Not PRec.EOF
        Call PrintLabel(PRec, 1 * Cm, 0.6 * Cm, 1.8, 1.6)
        
'        PRec.MoveNext
'        If Not PRec.EOF Then
            Call PrintLabel(PRec, (1 + 10) * Cm, 0.6 * Cm, 1.8, 1.6)
'        Else
'            i = i + 1
'            Printer.EndDoc
'            GoTo NextRec
'        End If
        
        PRec.MoveNext
        If Not PRec.EOF Then
            Call PrintLabel(PRec, 1 * Cm, (0.6 + 13.7) * Cm, 1.8, 1.6)
'        Else
'            i = i + 1
'            Printer.EndDoc
'            GoTo NextRec
'        End If
'
'        PRec.MoveNext
'        If Not PRec.EOF Then
            Call PrintLabel(PRec, (1 + 10) * Cm, (0.6 + 13.7) * Cm, 1.8, 1.6)
        Else
            Printer.EndDoc
            i = i + 1
            GoTo NextRec
        End If
        i = i + 1
        Printer.EndDoc
NextRec:
        If Not PRec.EOF Then PRec.MoveNext
    Loop
    PRec.Close: Set PRec = Nothing
    PCn.Close: Set PCn = Nothing
    MsgBox "共打印了 " & i & " 张A4纸！", vbOKOnly + vbExclamation, "打印"
    Exit Sub
Er:
    If Err.Number = 20526 Then
        MsgBox "请检查打印机是否已正确连接！", vbOKOnly + vbCritical, "打印机输出错误"
    ElseIf Err.Number = 482 Then
        MsgBox "系统没有安装打印机，请安装打印机后再试试看！", vbOKOnly + vbCritical, "找不到打印机..."
    Else
        MsgBox Err.Number & " : " & Err.Description, vbOKOnly + vbCritical, "打印出错"
        Resume
    End If
    Printer.KillDoc
End Sub


Private Sub PrintLabel(PRec As ADODB.Recordset, TbLf As Double, TbTp As Double, a As Double, B As Double)
    Printer.Font = "宋体"
    Printer.FontSize = 17
    Printer.CurrentX = TbLf + 1 * Cm
    Printer.CurrentY = TbTp
    Printer.Print PRec.Fields("startid")
    
    Printer.Font.Name = "Arial"
    Printer.Font.SIZE = 11
    Printer.DrawWidth = 1
    
    Printer.CurrentX = TbLf
    Printer.CurrentY = TbTp + a * Cm
    Printer.Print "ORDER:   " & PRec.Fields("orderid")
    Printer.Line (TbLf + 1.7 * Cm, TbTp + 0.4 * Cm + a * Cm)- _
                 (TbLf + (1.7 + 2.9) * Cm, TbTp + 0.4 * Cm + a * Cm)
    Printer.CurrentX = TbLf + 4.8 * Cm
    Printer.CurrentY = TbTp + a * Cm
    Printer.Print "LOT#:  " & PRec.Fields("ph")
    Printer.Line (TbLf + (4.8 + 1.2) * Cm, TbTp + 0.4 * Cm + a * Cm)- _
                 (TbLf + (4.8 + 1.2 + 2.5) * Cm, TbTp + 0.4 * Cm + a * Cm)
    
    Printer.CurrentX = TbLf
    Printer.CurrentY = TbTp + (a + B) * Cm
    Printer.Print "ARTICLE:   " & PRec.Fields("XH")
    Printer.Line (TbLf + 1.9 * Cm, TbTp + 0.4 * Cm + (a + B) * Cm)- _
                 (TbLf + (1.9 + 2.7) * Cm, TbTp + 0.4 * Cm + (a + B) * Cm)
    Printer.CurrentX = TbLf + 4.8 * Cm
    Printer.CurrentY = TbTp + (a + B) * Cm
    Printer.Print "COLOR:  " & PRec.Fields("YS")
    Printer.Line (TbLf + (4.8 + 1.3) * Cm, TbTp + 0.4 * Cm + (a + B) * Cm)- _
                 (TbLf + (4.8 + 1.3 + 2.4) * Cm, TbTp + 0.4 * Cm + (a + B) * Cm)
    
    Printer.CurrentX = TbLf
    Printer.CurrentY = TbTp + (a + 2 * B) * Cm
    Printer.Print "ROLL#:   " & Val(PRec.Fields("pid"))
    Printer.Line (TbLf + 1.5 * Cm, TbTp + 0.4 * Cm + (a + 2 * B) * Cm)- _
                 (TbLf + (1.5 + 3.1) * Cm, TbTp + 0.4 * Cm + (a + 2 * B) * Cm)
    Printer.CurrentX = TbLf + 4.8 * Cm
    Printer.CurrentY = TbTp + (a + 2 * B) * Cm
    Printer.Print "YARDS:  " & PRec.Fields("shjm") & "(码)"
    Printer.Line (TbLf + (4.8 + 1.6) * Cm, TbTp + 0.4 * Cm + (a + 2 * B) * Cm)- _
                 (TbLf + (4.8 + 1.6 + 2.1) * Cm, TbTp + 0.4 * Cm + (a + 2 * B) * Cm)
    
    Printer.CurrentX = TbLf
    Printer.CurrentY = TbTp + (a + 3 * B) * Cm
    Printer.Print "POINTS/100YDS: " & PRec.Fields("zhm")
    Printer.Line (TbLf + 3.3 * Cm, TbTp + 0.4 * Cm + (a + 3 * B) * Cm)- _
                 (TbLf + (3.3 + 1.3) * Cm, TbTp + 0.4 * Cm + (a + 3 * B) * Cm)
    Printer.CurrentX = TbLf + 4.8 * Cm
    Printer.CurrentY = TbTp + (a + 3 * B) * Cm
    Printer.Print "METER:  " & PRec.Fields("shjf") & "(米)"
    Printer.Line (TbLf + (4.8 + 1.6) * Cm, TbTp + 0.4 * Cm + (a + 3 * B) * Cm)- _
                 (TbLf + (4.8 + 1.6 + 2.1) * Cm, TbTp + 0.4 * Cm + (a + 3 * B) * Cm)
    
    Printer.CurrentX = TbLf + 0.8 * Cm
    Printer.CurrentY = TbTp + (a + 3 * B + 1) * Cm
    Printer.Print "CONTENT:"
    Call PrintBarCode(Trim(Text5.Text), (TbLf / Cm + 1.2) * 10, _
        (TbTp / Cm + a + 3 * B + 1 + 0.8) * 10, 15, True)
    
    Printer.Font.Name = "Arial"
    Printer.Font.SIZE = 9
    
    Printer.CurrentX = TbLf + 2.2 * Cm
    Printer.CurrentY = TbTp + (a + 3 * B + 1 + 2.8) * Cm
    Printer.Print "Please Note:"
    Printer.CurrentX = TbLf + 2.2 * Cm
    Printer.CurrentY = TbTp + (a + 3 * B + 1 + 2.8 + 0.4) * Cm
    Printer.Print "* Inspect before cutting"
    Printer.CurrentX = TbLf + 2.2 * Cm
    Printer.CurrentY = TbTp + (a + 3 * B + 1 + 2.8 + 0.4 * 2) * Cm
    Printer.Print "* No claims acceptable after cutting"
    Printer.CurrentX = TbLf + 2.2 * Cm
    Printer.CurrentY = TbTp + (a + 3 * B + 1 + 2.8 + 0.4 * 3) * Cm
    Printer.Print "* Do not mix the different dye-lot on"
    Printer.CurrentX = TbLf + 2.2 * Cm
    Printer.CurrentY = TbTp + (a + 3 * B + 1 + 2.8 + 0.4 * 4) * Cm
    Printer.Print "the cutting table"
End Sub