我的应用程序是在 Delphi 6 中开发的。由于后台处理和大量数据(消耗大约 60MB - 120MB 物理内存),这是一个资源密集型应用程序。该应用程序的功能之一是创建条形码图像并打印它们。如果用户继续生成条形码,那么至少十分之一的条形码会出现缺失行。
我能够使用 TExcellenImagePrinter 组件解决此问题。但是,它大大降低了性能。该解决方案被我的客户拒绝,因此,现在我尝试用 GDI+ 替换 WinAPI StretchDIBits 调用。
原始源码如下:
procedure PrintBitmap(ARect:TRect; Bitmap:TBitmap);
var
Info: PBitmapInfo;
InfoSize: dword{Integer};
Image: Pointer;
ImageSize: dword{ integer};
iWidth,iHeight :integer;
iReturn : integer ;
begin
GetDIBSizes(Bitmap.handle,InfoSize,ImageSize);
if (LoadDIBFromTBitmap(Bitmap,Pointer(Info),Image,iWidth,iHeight)) then
begin
SetStretchBltMode(Printer.Canvas.handle,STRETCH_HALFTONE);
SetBrushOrgEx(Printer.Canvas.handle, 0, 0, NIL);
iReturn := StretchDIBits(Printer.Canvas.Handle, ARect.Left, ARect.Top,
ARect.Right - ARect.Left, ARect.Bottom - ARect.Top,
0, 0, Info^.bmiHeader.biWidth,
Info^.bmiHeader.biHeight, Image, Info^,DIB_RGB_COLORS, SRCCOPY);
end;
FreeMemEx(Info);
FreeMemEx(Image);
end;
按照 Joe 在 embarcadero 论坛 ( http://www.progdigy.com/?page_id=7 ) 中的建议,我从 ( https://forums.embarcadero.com/thread.jspa?messageID=471501#471501 ) 获取了 GDI+ header 。
我修改了我的源代码如下:
创建 TGPGraphics 类的对象并为其分配打印机句柄。
gp := TGPGraphics.Create(Printer.Canvas.Handle);
创建 TGPBitmap 类的对象并将条形码图像分配给它。
bmp := TGPBitmap.Create(Info^,Image);
Info 是 TBitmapInfo,Image 是一个指针。
- 将打印机尺寸分配给 TGPRect 记录的实例矩形
调用了 DrawImage 函数:
gp.DrawImage(bmp,矩形);
但是,进行这些更改后,打印机的输出中会显示空图像。 您能否指出我是否遗漏了某些内容或者我的实现是错误的。 您能就此提供任何指示吗?
最佳答案
我发现以下代码演示了从 dib 创建兼容位图 (DBB)。 那应该对你有用。也许它可以写得更好,但总而言之,它只是有效......至少对我来说......
procedure PRPrintBitmapOnCanvas(Canvas: TMetafileCanvas; Bitmap: TBitmap; posLeft, posTop: Integer);
var
lpbmih: TBitmapInfoHeader;
lpbmi: TBitmapInfo;
aBitmap: HBITMAP;
aDC: LongWord;
begin
Fillchar(lpbmih, SizeOf(lpbmih), 0);
lpbmih.biSize := SizeOf(lpbmih);
lpbmih.biWidth := bitmap.width;
lpbmih.biHeight := bitmap.height;
lpbmih.biPlanes := 1;
lpbmih.biBitCount := 32;
lpbmih.biCompression := BI_RGB;
Fillchar(lpbmi, SizeOf(lpbmi), 0);
lpbmi.bmiHeader.biSize := SizeOf(lpbmi.bmiHeader);
lpbmi.bmiHeader.biPlanes := 1;
lpbmi.bmiHeader.biBitCount := 32;
lpbmi.bmiHeader.biCompression := BI_RGB;
aBitmap := CreateDIBitmap(Canvas.Handle, lpbmih, 0, nil, lpbmi, DIB_RGB_COLORS);
if aBitmap = 0 then RaiseLastOSError;
try
aDC := CreateCompatibleDC(Canvas.Handle);
SelectObject(aDC, aBitmap);
BitBlt(aDC, 0, 0, bitmap.Width, bitmap.Height, bitmap.Canvas.Handle, 0, 0, SRCCOPY);
BitBlt(canvas.handle, posLeft, posTop, bitmap.Width, bitmap.Height, aDC, 0, 0, SRCCOPY);
DeleteDC(aDC);
finally
DeleteObject(aBitmap)
end;
end;
关于delphi - 用 GDI+ 替换 StretchDIBits(在将图像绘制到打印机 Canvas 时),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/11344504/