ff1.frm

用于机动车辆玻璃防盗码打印。已经在多家汽修店应用了三年多了

      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   0
      Left            =   960
      TabIndex        =   14
      Top             =   4995
      Width           =   615
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   975
      Index           =   0
      Left            =   240
      Top             =   4800
      Width           =   3015
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "打印数量"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   3
      Left            =   240
      TabIndex        =   9
      Top             =   2520
      Width           =   1215
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "车 架 号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   2
      Left            =   120
      TabIndex        =   5
      Top             =   1560
      Width           =   1335
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "发动机号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   1
      Left            =   120
      TabIndex        =   3
      Top             =   960
      Width           =   1335
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "车 牌 号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   0
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim kuanzhi As Single, zhaizhi As Single
Dim BmpName As String

Private Sub Form_Paint()
    If BmpName = "" Then BmpName = App.Path & "\b1.jpg"
    If Dir(BmpName) <> "" Then Tile Me, BmpName
End Sub


Private Sub Check1_Click()
  If Check1.Value = 1 Then Check1.Caption = "窄" Else Check1.Caption = "宽"
End Sub

Private Sub Command2_Click()
  PD
End Sub


Private Sub Command3_Click(Index As Integer)
  If Index = 0 Then
    CDlog.ShowPrinter
  ElseIf Index = 1 Then
    
  End If
End Sub

Private Sub Form_Load()
  Option1(0).Value = True
 ' Me.ScaleMode = 3
'  CDlog.PrinterDefault = False

  'Text1(0).Text = "陕A-435223"
  'Text1(1).Text = "123456"
  'Text1(2).Text = "987654"
  
  For n = 1 To 30
    Combo2(0).AddItem n
    Combo2(1).AddItem n
    Combo2(2).AddItem n
  Next
  
  For mm = 0 To 2
  Combo1(mm).AddItem "宋体"
  Combo1(mm).AddItem "楷体_GB2312"
  Combo1(mm).AddItem "黑体"
  Combo1(mm).AddItem "仿宋_GB2312"
  Next
  
  
  
  Combo1(0).Text = "宋体"
  Combo2(0).Text = 15
  Combo1(1).Text = "宋体"
  Combo2(1).Text = 15
  Combo1(2).Text = "宋体"
  Combo2(2).Text = 15
  Text1(3) = "1"
  
  
  If Dir(App.Path & "\pring.ini") <> "" Then
  Open "pring.ini" For Input As #1
    Do While Not EOF(1)
      Line Input #1, a$
      If Left(a$, 4) = "#字体1" Then
        Combo1(0).Text = Mid(a$, 6)
      End If
      If Left(a$, 4) = "#字体2" Then
        Combo1(1).Text = Mid(a$, 6)
      End If
      If Left(a$, 4) = "#字体3" Then
        Combo1(2).Text = Mid(a$, 6)
      End If
      If Left(a$, 4) = "#字号1" Then
        Combo2(0).Text = Mid(a$, 6)
      End If
      If Left(a$, 4) = "#字号2" Then
        Combo2(1).Text = Mid(a$, 6)
      End If
      If Left(a$, 4) = "#字号3" Then
        Combo2(2).Text = Mid(a$, 6)
      End If
      If Left(a$, 4) = "#上边距" Then
        Text2.Text = Mid(a$, 6)
      End If
      If Left(a$, 4) = "#行间距" Then
        Text3.Text = Mid(a$, 6)
      End If
      If Left(a$, 2) = "#宽" Then
        kuanzhi = Val(Mid(a$, 4))
      End If
      If Left(a$, 2) = "#窄" Then
        zhaizhi = Val(Mid(a$, 4))
      End If
    
      If Left(a$, 4) = "#背景图" Then
        BmpName = App.Path & "\" & Mid(a$, 6)
      End If
    Loop
  Close #1
  End If
  
  If kuanzhi = 0 Then kuanzhi = 3.8
  If zhaizhi = 0 Then zhaizhi = 3.2
  
End Sub

'打印(可预览的)
Sub PrintNew(nm1 As Integer)
'  1cm=566.928  Twips
 '大约1cm=560
  Dim bl As Long
  Dim L As Integer, L1 As Integer
  bl = 567
  
  
'标题
  
  PrintColor RGB(255, 255, 255)

'写表格固定文字
  lentxt0 = LenB(StrConv((Text1(0)), vbFromUnicode))
  lentxt1 = LenB(StrConv((Text1(1)), vbFromUnicode))
  lentxt2 = LenB(StrConv((Text1(2)), vbFromUnicode))
  For kk = 1 To nm1
    If Check1.Caption = "宽" Then
      page1 = kuanzhi * (kk - 1)
    Else
      page1 = zhaizhi * (kk - 1)
    End If
    
    If Combo2(0).Text = "" Then
      PrintFontSize 20
      fs = 20
    Else
      PrintFontSize Combo2(0).Text
      fs = Val(Combo2(0).Text)
    End If
    PrintFontName Combo1(0).Text
    PrintText_New Text1(0), (7.8 - fs / 55 * lentxt0) / 2, Val(Text2) + page1
    
    If Combo2(1).Text = "" Then
      PrintFontSize 20
      fs = 20
    Else
      PrintFontSize Combo2(1).Text
      fs = Val(Combo2(1).Text)
    End If
    PrintFontName Combo1(1).Text
    PrintText_New Text1(1), (7.8 - fs / 55 * lentxt1) / 2, Val(Text2) + page1 + Val(Combo2(0).Text) / 52 + Val(Text3)
  
    If Combo2(2).Text = "" Then
      PrintFontSize 20
      fs = 20
    Else
      PrintFontSize Combo2(2).Text
      fs = Val(Combo2(2).Text)
    End If
    PrintFontName Combo1(2).Text
    PrintText_New Text1(2), (7.8 - fs / 55 * lentxt2) / 2, Val(Text2) + page1 + (Val(Combo2(1).Text) / 52) + (Val(Combo2(0).Text) / 52) + Val(Text3) * 2
    
    If PrinterFlag = False Then
      PrintLine 0.1, page1, 7.8, page1, vbWhite
    End If
  Next
  
  PrintEndDoc
   
  

End Sub

Sub PD()
  

  If Option1(0).Value = True Then           '屏幕打印
     Picture1.Visible = True
     PrinterFlag = False
     PrintStartDoc Picture1, PrinterFlag, 7.8, 8.56, 1.011
     PrintNew Val(Text1(3))

  ElseIf Option1(1).Value = True Then      '打印机输出
     PrinterFlag = True
     
     If Check1.Value = 1 Then
       Printer.Height = zhaizhi * 567 * (Val(Text1(3)))
     Else
       Printer.Height = kuanzhi * 567 * (Val(Text1(3)))
     End If
'     MsgBox Printer.Height
     PrintStartDoc Picture1, PrinterFlag, 7.8, 4, 1
     PrintNew Val(Text1(3))
'     PrintNew 1
  End If

End Sub


'求与所需字符串长度最相似的长度
Function MidStr(InString As String, lenStr As Integer) As Integer
  Dim L1 As Integer, L As Integer
  Dim ST As String
  Dim ss(2) As Boolean, ls(2) As Integer
  ss(0) = False: ss(1) = False
  L = Len(InString)
  For m = 1 To L
    ST = Left(InString, m)
    L1 = LenB(StrConv(ST, vbFromUnicode))
    If L1 - lenStr = -1 Then
      ss(0) = True
      ls(0) = m
    End If
    If L1 - lenStr = 0 Then
      ss(1) = True
      ls(1) = m
    End If
  Next m
  
  If ss(1) Then
    MidStr = ls(1)
  Else
    MidStr = ls(0)
  End If

End Function

Sub PrintText_New(TextString As String, X As Single, Y As Single)
  PrintCurrentX X
  PrintCurrentY Y
  PrintPrint TextString
End Sub

Private Sub Form_Unload(Cancel As Integer)
  yn = MsgBox("确实要退出系统吗？", vbYesNo)
  If yn = vbYes Then End
End Sub

'平铺背景图片
Sub Tile(obj As Form, BmpName As String)
  Dim w As Integer, h As Integer
  Dim I As Integer, j As Integer
  If Dir(BmpName) = "" Then Exit Sub
  Set p = LoadPicture(BmpName)
  w = obj.ScaleX(p.Width, vbHimetric, vbTwips)
  h = obj.ScaleX(p.Height, vbHimetric, vbTwips)
  For I = 0 To obj.ScaleWidth Step w
    For j = 0 To obj.ScaleHeight Step h
      obj.PaintPicture p, I, j
    Next j
  Next I
End Sub