原来的做法是:窗体上有picture 控件: picBarCode在类模块中函数:Public Function Barcode(CodeType As String, strCode As String, pic As Object, barscale As Integer, barHeight As Single, StartX As Single, startY As Single) Dim barWidth As Single, i0 As Integer, barStart As Single Select Case CodeType Case "39": strCode = UCase(strCode): Code39 strCode Case "128": Code128 strCode Case "2/5": strCode = IIf(Len(strCode) Mod 2 > 0, strCode & "0", strCode): Code25 strCode Case "Codabar": strCode = UCase(strCode): Codabar strCode End Select barStart = StartX For i0 = 1 To Len(sBar) barWidth = Mid(sBar, i0, 1) * barscale If i0 Mod 2 > 0 Then pic.Line (barStart, startY)-Step(barWidth, barHeight), vbBlack, BF barStart = barStart + IIf(i0 Mod 2 > 0, barWidth, barWidth * 1.3) Next pic.FontSize = 16: pic.CurrentX = StartX: pic.CurrentY = (startY * 1.2) + barHeight: pic.Print strCode End Function在窗体中的调用是 Barcode CodeType, txtData, picBarCode, 2, 60, 20, 20想改为:
Option ExplicitPublic Const LR_LOADFROMFILE = &H10 Public Const IMAGE_BITMAP = 0 Public Const IMAGE_ICON = 1 Public Const IMAGE_CURSOR = 2 Public Const IMAGE_ENHMETAFILE = 3Public Const SRCCOPY As Long = &HCC0020 Public Const BI_RGB = 0& Public Const DIB_RGB_COLORS = 0 '结构BITMAPINFO中包含了RGB值的数组RGBQUAD Public Const STRETCH_HALFTONE As Long = &H4&Public Type BITMAPINFOHEADER '40 字节位图文件头 biSize As Long '结构所需字节数 biWidth As Long '图像宽度 biHeight As Long '图像高度 biPlanes As Integer '必须为1,不用考虑 biBitCount As Integer '颜色位数 biCompression As Long '指定是否压缩,一般取BI_RGB biSizeImage As Long '实际的位图占据的字节数,=biWidth'(必须是4的整数〕*biHeight biXPelsPerMeter As Long '水平分辨率 biYPelsPerMeter As Long '垂直分辨率 biClrUsed As Long '本图像用到的实际实际颜色数 biClrImportant As Long '本图像中重要的颜色数,为0,则认为所有的图像都是重要的 End TypePublic Type RGBQUAD rgbBlue As Byte '该颜色的蓝色分量 rgbGreen As Byte '该颜色的绿色分量 rgbRed As Byte '该颜色的红色分量 rgbReserved As Byte '保留值 End TypePublic Type Bitmap bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End TypePublic Type BitmapInfo bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUAD End TypePublic Type BITMAPFILEHEADER bfType(1 To 2) As Byte bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Public Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BitmapInfo, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BitmapInfo, ByVal wUsage As Long) As Long Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BitmapInfo, ByVal wUsage As Long) As Long Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Public 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 Public Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Option Explicit'以下是GDI+的声明 Public Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End TypePublic Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End TypePublic Type EncoderParameter GUID As GUID NumberOfValues As Long type As Long Value As Long End TypePublic Type EncoderParameters Count As Long Parameter As EncoderParameter End TypePublic Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long Public Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long Public Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long Public Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long Public Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long Public Declare Function GdipSaveImageToStream Lib "GDIPlus" (ByVal Image As Long, ByVal stream As Long, clsidEncoder As GUID, encoderParams As Any) As Long Public Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
那就要定义BMP结构了,比较烦的,写不清除,找找资料吧,CSDN上有的
Dim barWidth As Single, i0 As Integer, barStart As Single
Select Case CodeType
Case "39": strCode = UCase(strCode): Code39 strCode
Case "128": Code128 strCode
Case "2/5": strCode = IIf(Len(strCode) Mod 2 > 0, strCode & "0", strCode): Code25 strCode
Case "Codabar": strCode = UCase(strCode): Codabar strCode
End Select
barStart = StartX
For i0 = 1 To Len(sBar)
barWidth = Mid(sBar, i0, 1) * barscale
If i0 Mod 2 > 0 Then pic.Line (barStart, startY)-Step(barWidth, barHeight), vbBlack, BF
barStart = barStart + IIf(i0 Mod 2 > 0, barWidth, barWidth * 1.3)
Next
pic.FontSize = 16: pic.CurrentX = StartX: pic.CurrentY = (startY * 1.2) + barHeight: pic.Print strCode
End Function在窗体中的调用是 Barcode CodeType, txtData, picBarCode, 2, 60, 20, 20想改为:
不使用窗体上的picture 直接生成图片,然后存储在指定的目录下
这种问题并不难,前提是你对GDI中的API相对熟悉。
picture在你这里,可简单的看做是一个自动维护的hDC,不用它,当然你要自己维护。实现步骤:
1、建立内存中的hDC,并选入一个新建的BMP对象;
2、在hDC中输出文本;
3、建立BitMapInfoHeader结构(真彩位图无需调色板)与BITMAPFILEHEADER结构,取得位图数据,写入文件;
这些操作中要用到大量API函数,你若很了解,我不说,你也会用,若不了解,说了,一时也很难学会。
补充一下:图片文件格式有很多种,我前说的只是指BMP,若需其它格式,这个问题就复杂了。
将位图句柄与内存场景dc关联,就可以操作了如果有格式转化,很麻烦
你可以参考一下gdi+的函数,格式的转化很方便
Public Const IMAGE_BITMAP = 0
Public Const IMAGE_ICON = 1
Public Const IMAGE_CURSOR = 2
Public Const IMAGE_ENHMETAFILE = 3Public Const SRCCOPY As Long = &HCC0020
Public Const BI_RGB = 0&
Public Const DIB_RGB_COLORS = 0 '结构BITMAPINFO中包含了RGB值的数组RGBQUAD
Public Const STRETCH_HALFTONE As Long = &H4&Public Type BITMAPINFOHEADER '40 字节位图文件头
biSize As Long '结构所需字节数
biWidth As Long '图像宽度
biHeight As Long '图像高度
biPlanes As Integer '必须为1,不用考虑
biBitCount As Integer '颜色位数
biCompression As Long '指定是否压缩,一般取BI_RGB
biSizeImage As Long '实际的位图占据的字节数,=biWidth'(必须是4的整数〕*biHeight
biXPelsPerMeter As Long '水平分辨率
biYPelsPerMeter As Long '垂直分辨率
biClrUsed As Long '本图像用到的实际实际颜色数
biClrImportant As Long '本图像中重要的颜色数,为0,则认为所有的图像都是重要的
End TypePublic Type RGBQUAD
rgbBlue As Byte '该颜色的蓝色分量
rgbGreen As Byte '该颜色的绿色分量
rgbRed As Byte '该颜色的红色分量
rgbReserved As Byte '保留值
End TypePublic Type Bitmap
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End TypePublic Type BitmapInfo
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End TypePublic Type BITMAPFILEHEADER
bfType(1 To 2) As Byte
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BitmapInfo, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BitmapInfo, ByVal wUsage As Long) As Long
Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BitmapInfo, ByVal wUsage As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public 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
Public Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End TypePublic Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End TypePublic Type EncoderParameter
GUID As GUID
NumberOfValues As Long
type As Long
Value As Long
End TypePublic Type EncoderParameters
Count As Long
Parameter As EncoderParameter
End TypePublic Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Public Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Public Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long
Public Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Public Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Public Declare Function GdipSaveImageToStream Lib "GDIPlus" (ByVal Image As Long, ByVal stream As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Public Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
online(龙卷风V3.0--笑傲江湖):代码测试中