frmmain.frm

生成条形码的DLL文件及其使用例子

VERSION 5.00
Begin VB.Form frmMain 
   AutoRedraw      =   -1  'True
   Caption         =   "条码生成函数演示"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
   Begin VB.Menu mnuPrint 
      Caption         =   "打印"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 一些 API 函数和数据类型声明

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type

Private Sub Form_Load()
    Dim hMemDC As Long
    Dim hBitmap As Long
    Dim Bm As BITMAP
    
    hMemDC = CreateCompatibleDC(hdc)  ' 生成 DC

'   生成三九码
    hBitmap = MakeBarCode(1, "123456", 3, 7, 100, 0)  ' 生成条码位图
    
    If hBitmap = 0 Then
        MsgBox "条码生成错误!"
        Exit Sub
    End If
    
    SelectObject hMemDC, hBitmap  ' 将位图选入 DC
    
    GetObject hBitmap, Len(Bm), Bm  ' 取得位图的大小信息
    
    ' 将位图复制到显示设备
    StretchBlt hdc, 100, 50, _
               Bm.bmWidth, Bm.bmHeight, _
               hMemDC, 0, 0, Bm.bmWidth, Bm.bmHeight, vbSrcAnd

'  生成CODE128码
    hBitmap = MakeBarCode(3, "123456", 3, 7, 100, 0)  ' 生成条码位图
    
    If hBitmap = 0 Then
        MsgBox "条码生成错误!"
        Exit Sub
    End If
    
    SelectObject hMemDC, hBitmap  ' 将位图选入 DC
    
    GetObject hBitmap, Len(Bm), Bm  ' 取得位图的大小信息
    
    ' 将位图复制到显示设备
    StretchBlt hdc, 100, 200, _
               Bm.bmWidth, Bm.bmHeight, _
               hMemDC, 0, 0, Bm.bmWidth, Bm.bmHeight, vbSrcAnd

    DeleteDC hMemDC
    DeleteObject hBitmap
    
End Sub

Private Sub mnuPrint_Click()
    Dim hMemDC As Long
    Dim hBitmap As Long
    Dim Bm As BITMAP

    Printer.Print "条码打印"
    hMemDC = CreateCompatibleDC(Printer.hdc)
    
    hBitmap = MakeBarCode(1, "01234567", 8, 20, 300, 0)  ' 三九码
    
    If hBitmap = 0 Then
        MsgBox "条码生成错误!"
        Exit Sub
    End If
    
    SelectObject hMemDC, hBitmap
    
    GetObject hBitmap, Len(Bm), Bm
    
    n = StretchBlt(Printer.hdc, 300, 1000, _
               Bm.bmWidth, Bm.bmHeight, _
               hMemDC, 0, 0, Bm.bmWidth, Bm.bmHeight, vbSrcAnd)
    
    hBitmap = MakeBarCode(3, "01234567", 8, 20, 300, 0)   '  CODE 128码
    
    If hBitmap = 0 Then
        MsgBox "条码生成错误!"
        Exit Sub
    End If
    
    SelectObject hMemDC, hBitmap
    
    GetObject hBitmap, Len(Bm), Bm

    
    n = StretchBlt(Printer.hdc, 300, 3100, _
               Bm.bmWidth, Bm.bmHeight, _
               hMemDC, 0, 0, Bm.bmWidth, Bm.bmHeight, vbSrcAnd)
    
    Printer.EndDoc
    
    DeleteDC hMemDC
    DeleteObject hBitmap

End Sub