bardemo.frm

PDF417/QR条码制作源程序

            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   240
         TabIndex        =   1
         Top             =   240
         Width           =   975
      End
   End
   Begin VB.Image Image_Bar 
      Height          =   3255
      Left            =   3000
      Top             =   3840
      Width           =   5535
   End
End
Attribute VB_Name = "Frm_BarCode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'动态链接库引用
Private Declare Function InitRead Lib "EnCodePdf.dll" (ByVal hcallwnd As Long, ByVal pathname As String) As Long
Private Declare Function CloseRead Lib "EnCodePdf.dll" () As Long
Private Declare Function EnCodePdf Lib "EnCodePdf.dll" (ByVal txtFile As String) As String
Private Declare Function MakePdf417 Lib "EnCodePdf.dll" (ByVal txtFile As String, ByVal pictfile As String, ByVal otherfile As String) As String
Private Declare Function SetConFile Lib "EnCodePdf.dll" (ByVal Profile As String) As Long
Private Declare Function MakeQrCode Lib "EnCodeQr.dll" (ByVal txtFile As String, ByVal pictfile As String, ByVal otherfile As String) As String
Private Declare Function SetQrConFile Lib "EnCodeQr.dll" (ByVal Profile As String) As Long
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

'exports from nlcomp.dll    图像压缩函数
Private Declare Function SizeDIB Lib "Wcomp.dll" (ByVal oldmap As String, ByVal BmpHeight As Integer, ByVal BmpWidth As Integer) As Long
Private Declare Function Wcompress Lib "Wcomp.dll" (ByVal infile As String, ByVal outfile As String, ByVal budget As Long) As Long
Private Declare Function Wdecompress Lib "Wcomp.dll" (ByVal infile As String, ByVal outfile As String) As Long

'变量定义
Dim m_bWorkMode As Boolean      'TRUE_PDF417    FALSE_QRCODE

'初始化
Private Sub Form_Load()
 If Dir(App.Path & "\MakeBarCode.ini") <> "" Then
    Edit_ConFileName.Text = App.Path & "\MakeBarCode.ini"
 End If
 Cmd_Print.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call Cmd_Exit_Click
End Sub

'选择PDF417操作
Private Sub Op_Pdf_Click()
    m_bWorkMode = True
End Sub
'选择Qr_Code操作
Private Sub Op_Qr_Click()
    m_bWorkMode = False
End Sub
'选择文本文件
Private Sub Cmd_TxtFileName_Click()
    Dim I As Integer
    Dim strTmp As String
    Dim FileNo As Integer
    CDlg_FileName.Filter = "Text Files (*.txt)|*.txt"
    CDlg_FileName.ShowOpen
    Edit_TxtFileName.Text = CDlg_FileName.FileName
    If (Edit_TxtFileName.Text <> "") Then
        I = 0
        FileNo = FreeFile()
        Open Edit_TxtFileName.Text For Input As #FileNo
        Do While Not EOF(FileNo)
            Input #FileNo, strTmp
            Edit_Source.Text = Edit_Source.Text & strTmp & Chr(13) & Chr(10)
        Loop
        Close #FileNo
    End If
End Sub
'选择位图文件
Private Sub Cmd_ImgFileName_Click()
    CDlg_FileName.Filter = "Bitmap Files (*.bmp,*.jpg,*jpe)|*.JPG;*.JPE;*.BMP"
    CDlg_FileName.ShowOpen
    
    Edit_ImgFileName.Text = CDlg_FileName.FileName
    If (Edit_ImgFileName.Text <> "") Then
        Image_Bar.Stretch = False
        Image_Bar.Picture = LoadPicture(Edit_ImgFileName.Text)
    End If
    Cmd_Print.Enabled = False
End Sub
'选择参数文件
Private Sub Cmd_ConFileName_Click()
    CDlg_FileName.Filter = "配置文件(*.ini)|*.ini"
    CDlg_FileName.ShowOpen
    Edit_ConFileName.Text = CDlg_FileName.FileName
End Sub
'生成条形码
Private Sub Cmd_Create_Click()
   Dim FileNo As Integer
    Dim txtFile As String
    Dim strBmpFile As String
    Dim binBmpFile As String
    Dim xScale As Integer
    Dim yScale As Integer
    On Error GoTo ErrNote
    
    '将文本写入文本文件
    xScale = 1
    yScale = 1
    txtFile = ""
    If (Edit_Source.Text <> "") Then
        FileNo = FreeFile()
        txtFile = App.Path + "\TxtTemp.txt"
        Open txtFile For Output As #FileNo
        Print #FileNo, Edit_Source.Text
        Close #FileNo
    End If
    
    '进行图形压缩
    binBmpFile = ""
    If (Edit_ImgFileName.Text <> "") Then
        Image_Bar.Picture = LoadPicture(Edit_ImgFileName.Text)
        strBmpFile = App.Path + "\strbmpfile.bmp"
        binBmpFile = App.Path + "\binBmpFile.img"
        SavePicture Image_Bar.Picture, strBmpFile
        Call SizeDIB(binBmpFile, 100, 100)
        Call Wcompress(strBmpFile, binBmpFile, 800)
        Kill (strBmpFile)
    End If
    
    '设置制码参数
    If (Edit_ConFileName.Text <> "") Then
      If (m_bWorkMode) Then
        SetConFile (Edit_ConFileName.Text)
      Else
        SetQrConFile (Edit_ConFileName.Text)
      End If
    End If
    '进行条形码制作
    If (txtFile <> "" Or binBmpFile <> "") Then
        If (m_bWorkMode) Then
            strBmpFile = MakePdf417(txtFile, binBmpFile, "")
            xScale = GetPrivateProfileInt("PDF", "XScale", 1, Edit_ConFileName)
            yScale = GetPrivateProfileInt("PDF", "YScale", 1, Edit_ConFileName)
        Else
            strBmpFile = MakeQrCode(txtFile, binBmpFile, "")
            xScale = GetPrivateProfileInt("QR", "XScale", 1, Edit_ConFileName)
            yScale = xScale
        End If
        If (strBmpFile <> "") Then      '显示条码
            Image_Bar.Stretch = False
            Image_Bar.Picture = LoadPicture(strBmpFile)
            Image_Bar.Height = yScale * Image_Bar.Height
            Image_Bar.Width = xScale * Image_Bar.Width
            Image_Bar.Stretch = True
            Kill (strBmpFile)
            Cmd_Print.Enabled = True
            Cmd_Copy.Enabled = True
        Else
            MsgBox "编码失败!"
            Image_Bar.Stretch = False
            Image_Bar.Picture = LoadPicture("")
            Clipboard.Clear
            Cmd_Print.Enabled = False
            Cmd_Copy.Enabled = False
        End If
    End If
    Exit Sub
    
ErrNote:
    MsgBox Err.Description
End Sub
'设置条码参数
Private Sub Cmd_SetConfig_Click()
 If (Edit_ConFileName.Text <> "") Then
    If (m_bWorkMode) Then
        frmpdf.m_strProfile = Edit_ConFileName.Text
        frmpdf.Show vbModal, Me
    Else
        frmQr.m_strProfile = Edit_ConFileName.Text
        frmQr.Show vbModal, Me
    End If
 Else
    MsgBox "未设置参数文件名"
 End If
End Sub
'设置串口参数
Private Sub Cmd_SetComm_Click()
If (Edit_ConFileName.Text <> "") Then
    frmComm.m_strProfile = Edit_ConFileName.Text
    frmComm.Show vbModal, Me
Else
    MsgBox "未设置参数文件名"
 End If
End Sub
'打开/关闭串口
Private Sub Cmd_OpenComm_Click()
If Cmd_OpenComm.Caption = "连接串口" Then
    Call SetConFile(Edit_ConFileName.Text)
    If InitRead(Me.hwnd, App.Path + "\") = 0 Then
        Cmd_OpenComm.Caption = "断开串口"
    End If
Else    '关闭串口
    If CloseRead() = 0 Then
        Cmd_OpenComm.Caption = "连接串口"
    End If
End If
End Sub
'打印条码
Private Sub Cmd_Print_Click()
    frmPrint.Width = Image_Bar.Width
    frmPrint.Height = Image_Bar.Height
    frmPrint.Refresh
    frmPrint.Image_Print.Stretch = False
    frmPrint.Image_Print.Picture = Image_Bar.Picture
    frmPrint.Image_Print.Width = Image_Bar.Width
    frmPrint.Image_Print.Height = Image_Bar.Height
    frmPrint.Image_Print.Stretch = True
    frmPrint.PrintForm
End Sub
'拷贝
Private Sub Cmd_Copy_Click()
    Clipboard.Clear
    Clipboard.SetData Image_Bar.Picture, vbCFBitmap
    Cmd_Copy.Enabled = False
End Sub

'退出系统
Private Sub Cmd_Exit_Click()
    If Cmd_OpenComm.Caption = "断开串口" Then
        Call Cmd_OpenComm_Click
    End If
    Unload frmPrint
    Unload Me
End Sub
'接收串口信息
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim FileNo As Integer
Dim strTmp As String
Dim strBmpFile As String

strBmpFile = App.Path & "\temp.bmp"
If KeyCode = 255 Then
    FileNo = FreeFile()
    Open App.Path & "\temp.txt" For Input As #FileNo
    Edit_Source.Text = ""
    Do While Not EOF(FileNo)
       strTmp = ""
       Input #FileNo, strTmp
       Edit_Source.Text = Edit_Source.Text & strTmp & Chr(13) & Chr(10)
    Loop
    Close #FileNo
    If Dir(strBmpFile) <> "" Then
        Kill (strBmpFile)
    End If
    If Dir(App.Path & "\temp.img") <> "" Then
        If FileLen(App.Path & "\temp.img") > 10 Then
            Call Wdecompress(App.Path & "\temp.img", strBmpFile)
        End If
    End If
    If Dir(strBmpFile) <> "" Then
        Image_Bar.Picture = LoadPicture(strBmpFile)
    Else
        Image_Bar.Picture = LoadPicture("")
    End If
    Cmd_Print.Enabled = False
End If
End Sub