embarcode.frm

自定报表组件

VERSION 5.00
Object = "{E085E244-949A-11D1-A94A-000021E13178}#1.3#0"; "PREVIEW.OCX"
Begin VB.Form frmEMBarCode 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "电能表专用条形码制作系统(￡)"
   ClientHeight    =   4725
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7410
   Icon            =   "EMBarCode.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4725
   ScaleWidth      =   7410
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox txtLines 
      Height          =   270
      Left            =   6300
      TabIndex        =   3
      Top             =   180
      Width           =   855
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "退出系统(&X)"
      Height          =   1290
      Left            =   5865
      Picture         =   "EMBarCode.frx":0442
      Style           =   1  'Graphical
      TabIndex        =   14
      ToolTipText     =   "退出条形码制作系统"
      Top             =   3180
      Width           =   1290
   End
   Begin VB.CommandButton cmdPreview 
      Caption         =   "打印预览(&P)"
      Height          =   1290
      Left            =   3900
      Picture         =   "EMBarCode.frx":0CC4
      Style           =   1  'Graphical
      TabIndex        =   13
      ToolTipText     =   "条形码制作打印预览"
      Top             =   3180
      Width           =   1290
   End
   Begin VB.TextBox txtNoEMID 
      Height          =   3510
      Left            =   510
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   6
      ToolTipText     =   "输入时请用"",""或""回车""分隔各编号"
      Top             =   1020
      Width           =   2700
   End
   Begin VB.TextBox txtCount 
      BackColor       =   &H00FFFFFF&
      Height          =   270
      Left            =   5700
      TabIndex        =   12
      Top             =   1920
      Width           =   1500
   End
   Begin VB.TextBox txtEMID 
      BackColor       =   &H00FFFFFF&
      Height          =   270
      Left            =   5700
      TabIndex        =   10
      Top             =   1530
      Width           =   1500
   End
   Begin VB.TextBox txtNo 
      BackColor       =   &H00FFFFFF&
      Height          =   270
      Left            =   5685
      TabIndex        =   8
      Top             =   1140
      Width           =   1500
   End
   Begin VB.OptionButton optOrdered 
      Caption         =   "零散编号(&R)"
      Height          =   180
      Index           =   0
      Left            =   300
      TabIndex        =   4
      Top             =   810
      Width           =   1620
   End
   Begin VB.OptionButton optOrdered 
      Caption         =   "连续编号(&O)"
      Height          =   180
      Index           =   1
      Left            =   3900
      TabIndex        =   5
      Top             =   810
      Width           =   1560
   End
   Begin VB.CheckBox chkContent 
      Caption         =   "打印局编号(&E)"
      Height          =   225
      Index           =   1
      Left            =   2400
      TabIndex        =   1
      Top             =   210
      Width           =   1800
   End
   Begin VB.CheckBox chkContent 
      Caption         =   "打印出厂编号(&N)"
      Height          =   225
      Index           =   0
      Left            =   300
      TabIndex        =   0
      Top             =   210
      Width           =   1800
   End
   Begin vbpPreview.Preview Preview1 
      Left            =   3765
      Top             =   2550
      _ExtentX        =   741
      _ExtentY        =   741
      Caption         =   "打印预览"
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00FFFFFF&
      Index           =   1
      X1              =   75
      X2              =   7365
      Y1              =   630
      Y2              =   630
   End
   Begin VB.Line Line1 
      Index           =   0
      X1              =   60
      X2              =   7350
      Y1              =   615
      Y2              =   615
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "每页纸可打印行数(&L):"
      Height          =   180
      Left            =   4500
      TabIndex        =   2
      Top             =   240
      Width           =   1800
   End
   Begin VB.Label lblCount 
      AutoSize        =   -1  'True
      Caption         =   "打印数目(&C):"
      Height          =   180
      Left            =   4200
      TabIndex        =   11
      Top             =   1980
      Width           =   1080
   End
   Begin VB.Label lblEMIDStart 
      AutoSize        =   -1  'True
      Caption         =   "起始局编号(&M):"
      Height          =   180
      Left            =   4200
      TabIndex        =   9
      Top             =   1590
      Width           =   1260
   End
   Begin VB.Label lblNoStart 
      AutoSize        =   -1  'True
      Caption         =   "起始出厂编号(&S):"
      Height          =   180
      Left            =   4200
      TabIndex        =   7
      Top             =   1200
      Width           =   1440
   End
End
Attribute VB_Name = "frmEMBarcode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private arrBarCode() As String
Private BarCodeCount As Long
Private BarCodeItemsPerPage As Long

Private Sub chkContent_Click(Index As Integer)
  chkContent(Index).ForeColor = IIf(chkContent(Index).Value = vbChecked, &HFF0000, 0)
End Sub

Private Sub cmdExit_Click()
  Unload Me
End Sub

Private Sub cmdPreview_Click()
  Dim Msg As String
  Dim Str As String
  Dim CurrNo As String
  Dim CurrEMID As String
  Dim Item As String
  Dim NoEMIDCount As Long
  Dim N As Long
  
  Screen.MousePointer = 11
  
  With Printer
    .ScaleMode = 6
    If .ScaleWidth < 189 Then
      Msg = "打印纸的可打印宽度应不小于189毫米." & vbCrLf
    End If
    BarCodeItemsPerPage = Int(Val(txtLines.Text))
    If BarCodeItemsPerPage <= 0 Then
      Msg = Msg & "您所设置的每页打印行数无效." & vbCrLf
    ElseIf .ScaleHeight < 10 * BarCodeItemsPerPage Then
      Msg = Msg & "打印纸的可打印高度应不够您所设置的每页打印行数." & vbCrLf
    End If
    BarCodeItemsPerPage = 6 * BarCodeItemsPerPage
  End With
  
  If (chkContent(0).Value <> vbChecked) And (chkContent(1).Value <> vbChecked) Then
    Msg = Msg & "请选择您所需打印的条形码内容:出厂编号/局编号." & vbCrLf
  Else
    If optOrdered(0).Value Then
      Str = Trim(txtNoEMID.Text)
      If Len(Str) > 0 Then
        Str = Str & ","
        Do
          N = InStr(Str, vbCrLf)
          If N > 0 Then
            Str = Left(Str, N - 1) & "," & Mid(Str, N + 2)
          Else
            Exit Do
          End If
        Loop
        If (chkContent(0).Value = vbChecked) And (chkContent(1).Value = vbChecked) Then
          CurrNo = "No:"
          CurrEMID = "局号:"
        ElseIf chkContent(0).Value = vbChecked Then
          CurrNo = "No:"
          CurrEMID = CurrNo
        Else
          CurrEMID = "局号:"
          CurrNo = CurrEMID
        End If
        BarCodeCount = 0
        Do While Len(Str) > 0
          N = InStr(Str, ",")
          If N > 0 Then
            Item = Trim(Left(Str, N - 1))
            Str = Trim(Mid(Str, N + 1))
            If Len(Item) > 0 Then
              BarCodeCount = BarCodeCount + 1
              ReDim Preserve arrBarCode(1, BarCodeCount - 1)
              arrBarCode(0, BarCodeCount - 1) = Item
              arrBarCode(1, BarCodeCount - 1) = IIf((BarCodeCount Mod 2) = 1, CurrNo, CurrEMID) & Item
            End If
          Else
            Exit Do
          End If
        Loop
        If BarCodeCount = 0 Then Msg = Msg & "您未输入有效的编号." & vbCrLf
      End If
    Else
      CurrNo = Trim(txtNo.Text)
      CurrEMID = Trim(txtEMID.Text)
      If (chkContent(0).Value = vbChecked) And (Len(CurrNo) = 0) Then Msg = Msg & "未输入起始出厂编号." & vbCrLf
      If (chkContent(1).Value = vbChecked) And (Len(CurrEMID) = 0) Then Msg = Msg & "未输入起始局编号." & vbCrLf
      NoEMIDCount = Int(Val(txtCount.Text))
      If NoEMIDCount <= 0 Then Msg = Msg & "您所输入的打印数目无效." & vbCrLf
      If Len(Msg) = 0 Then
        If (chkContent(0).Value = vbChecked) And (chkContent(1).Value = vbChecked) Then
          BarCodeCount = NoEMIDCount * 2
          ReDim arrBarCode(1, BarCodeCount - 1)
          CreateBarCodes CurrNo, 0, 2, "No:"
          CreateBarCodes CurrEMID, 1, 2, "局号:"
        Else
          BarCodeCount = NoEMIDCount
          ReDim arrBarCode(1, BarCodeCount - 1)
          If chkContent(0).Value = vbChecked Then
            CreateBarCodes CurrNo, 0, 1, "No:"
          Else
            CreateBarCodes CurrEMID, 0, 1, "局号:"
          End If
        End If
      End If
    End If
  End If
  
  If Len(Msg) = 0 Then
    BarCodeOutput
  Else
    MsgBox Msg, vbInformation
  End If
  
  ReDim arrBarCode(1, 0)
  Screen.MousePointer = 0
End Sub

Private Sub Form_Load()
  On Error Resume Next
  chkContent(0).Value = Val(GetSetting("启东林洋", "条形码制作", "打印出厂编号", "1"))
  chkContent(1).Value = Val(GetSetting("启东林洋", "条形码制作", "打印局编号", "1"))
  txtLines.Text = GetSetting("启东林洋", "条形码制作", "每页可打印行数", "22")
  If GetSetting("启东林洋", "条形码制作", "零散编号", "True") = "True" Then
    optOrdered(0).Value = True
  Else
    optOrdered(1).Value = True
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  On Error Resume Next
  SaveSetting "启东林洋", "条形码制作", "打印出厂编号", chkContent(0).Value
  SaveSetting "启东林洋", "条形码制作", "打印局编号", chkContent(1).Value
  SaveSetting "启东林洋", "条形码制作", "每页可打印行数", txtLines.Text
  SaveSetting "启东林洋", "条形码制作", "零散编号", IIf(optOrdered(0).Value, "True", "False")
End Sub

Private Sub optOrdered_Click(Index As Integer)
  If optOrdered(0).Value Then
    optOrdered(0).ForeColor = &HFF0000
    optOrdered(1).ForeColor = 0
    txtNoEMID.Enabled = True
    txtNoEMID.BackColor = &HFFFFFF
    lblNoStart.Enabled = False
    lblEMIDStart.Enabled = False
    lblCount.Enabled = False
    txtNo.Enabled = False
    txtNo.BackColor = &HC0C0C0
    txtEMID.Enabled = False
    txtEMID.BackColor = &HC0C0C0
    txtCount.Enabled = False
    txtCount.BackColor = &HC0C0C0
  Else
    optOrdered(0).ForeColor = 0
    optOrdered(1).ForeColor = &HFF0000
    txtNoEMID.Enabled = False
    txtNoEMID.BackColor = &HC0C0C0
    lblNoStart.Enabled = True
    lblEMIDStart.Enabled = True
    lblCount.Enabled = True
    txtNo.Enabled = True
    txtNo.BackColor = &HFFFFFF
    txtEMID.Enabled = True
    txtEMID.BackColor = &HFFFFFF
    txtCount.Enabled = True
    txtCount.BackColor = &HFFFFFF
  End If
End Sub

Private Sub BarCodeOutput()
  Dim I As Long
  Dim Index As Integer
  
  With Preview1
    .Caption = "启东林洋电子表厂条形码制作系统(打印预览)"
    .NewDoc
    
    For I = 0 To BarCodeCount - 1
      Index = I Mod BarCodeItemsPerPage
      If Index = 0 Then
        If I <> 0 Then .NewPage
        .FontName = "楷体"
        .FontBold = True
        .FontSize = 10
      End If
      .ScaleLeft = -32 * (Index Mod 6)
      .ScaleTop = -10 * (Index \ 6)
      .OutputBarCodeOf39Ex 0, 0, 29, 6, arrBarCode(0, I)
      .TextE 0, 7.8, 31, arrBarCode(1, I)
    Next I
    
    .EndDoc
    .Preview
  End With
End Sub

Private Sub CreateBarCodes(ByVal StartMsg As String, ByVal StartIndex As Long, ByVal StepValue As Integer, ByVal PrevMsg As String)
  Dim I As Long
  Dim Value As Long
  Dim PrevSign As String
  Dim ValueFormat As String
  Dim ValueStr As String
  
  For I = 1 To Len(StartMsg)
    If InStr("0123456789", Left(StartMsg, 1)) > 0 Then
      Exit For
    Else
      PrevSign = PrevSign & Left(StartMsg, 1)
      StartMsg = Mid(StartMsg, 2)
    End If
  Next I
  Value = Val(StartMsg)
  ValueFormat = String(Len(StartMsg), "0")
  
  For I = StartIndex To BarCodeCount - 1 Step StepValue
    ValueStr = Format(Value, ValueFormat)
    arrBarCode(0, I) = PrevSign & ValueStr
    arrBarCode(1, I) = PrevMsg & arrBarCode(0, I)
    Value = Value + 1
  Next I
End Sub