用Delphi6使用StretchDIBits处理条形码图像-输出中缺少条线

Question

我的应用程序是在Delphi 6中开发的。由于后台处理和大量数据（它消耗大约60MB-120MB的物理内存），这是一个资源密集型应用程序。该应用程序的功能之一是在完成某些过程后创建条形码图像。如果用户继续生成条形码，则至少十分之一的条形码中缺少行。我们在生成输出时有以下步骤：

1. 在内存中创建条形码图像（TImage）。图像的高度为10个像素。我们使用pf24bit像素格式
2. 根据打印机的画布调整内存中的图像大小，并将其传递到打印机的画布。步骤#2的代码如下：

---

procedure PrintBitmap(ARect:TRect; Bitmap:TBitmap);
var
  Info: PBitmapInfo;
  InfoSize: dword{Integer};
  Image: Pointer;
  ImageSize: dword{ integer};
  iReturn : integer ;
  iWidth,iHeight :integer;
begin
try
  with Bitmap do
  begin
     iReturn := 1;
     GetDIBSizes( Handle, InfoSize, ImageSize );
     GetMem( Info, InfoSize );
     try
        getMem( Image, ImageSize );
        try
           GetDIB(Handle, Palette, Info^, Image^);
           try
             with Info^.bmiHeader do
             begin
                SetStretchBltMode(Printer.Canvas.handle,HALFTONE);
                iReturn := **StretchDIBits**(Printer.Canvas.Handle, ARect.Left, ARect.Top,
                ARect.Right - ARect.Left, ARect.Bottom - ARect.Top,
                0, 0, biWidth, biHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
             end;
           except on E:Exception do
           begin
              gobjLog.pWritetoLog(0,'RptWrks2','PrintBitmap','Exception in StretchDIBits with message '+e.Message);
           end;
           end
        finally
           FreeMem(Image, ImageSize);
        end;
     finally
        FreeMem(Info, InfoSize);
     end;
end
except on E:Exception do
begin
    gobjLog.pWritetoLog(0,'RptWrks2','PrintBitmap','Exception in PrintBitMap with message '+e.Message);
end;
end;

我们检查了问题在于步骤#2，因为条形码图像是在没有任何问题的情况下生成的。（我们注释掉了步骤#2，并将输出作为BMP文件来确认这一点）。

此外，我们尝试了以下解决方案：

1. 我们使用TExcellentImagePrinter组件来执行调整大小操作。但，这个问题并没有得到解决
2. 我们包含了SETPROCESSWORKINGSETSIZE WinAPI调用，以减少/刷新应用程序使用的当前内存
3. 我们在代码中包含了Sleep（3000），这样Windows就可以为图像分配内存。但是，包括睡眠降低了此错误的发生频率

你能提供一些建议吗？

Answer 1

我使用此功能打印条形码，非常成功。它假设位图是100%缩放的条形码（每个x像素都是条形码条纹），高度无关紧要，可能只有1px。

线索是用fillrect而不是位图打印条形码：该函数只是"读取"条形码，并将其填充到某个画布上。如果得到的比例（xFactor=aToRect宽度与条形码宽度之比）是一个整数或足够大的实数（对于打印机来说没有问题），则可以毫无问题地读取打印的条形码。它也适用于PDF打印机。

您只需要生成一个100%缩放的条形码到位图（正如您已经做的那样；高度可能是1px；条形码的颜色必须是clBlack），并将其传递到aFromBMP参数中。aToCanvas将成为您的打印机画布。aToRect是打印机画布中的目标矩形。aColor是目标条形码的颜色（可能是所有颜色）。

procedure PrintBarCodeFromBitmap(const aFromBMP: TBitmap;
  const aToCanvas: TCanvas; const aToRect: TRect;
  const aColor: TColor = clBlack);
var I, xStartRect: Integer;
  xFactor: Double;
  xColor: TColor;
  xLastBrush: TBrush;
begin
  xLastBrush := TBrush.Create;
  try
    xLastBrush.Assign(aToCanvas.Brush);
    aToCanvas.Brush.Color := aColor;
    aToCanvas.Brush.Style := bsSolid;
    xFactor := (aToRect.Right-aToRect.Left)/aFromBMP.Width;
    xStartRect := -1;
    for I := 0 to aFromBMP.Width do begin
      if I < aFromBMP.Width then
        xColor := aFromBMP.Canvas.Pixels[I, 0]
      else
        xColor := clWhite;
      if (xStartRect < 0) and (xColor = clBlack) then begin
        xStartRect := I;
      end else if (xStartRect >= 0) and (xColor <> clBlack) then begin
        aToCanvas.FillRect(
          Rect(
            Round(aToRect.Left+xStartRect*xFactor),
            aToRect.Top,
            Round(aToRect.Left+I*xFactor),
            aToRect.Bottom));
        xStartRect := -1;
      end;
    end;
  finally
    aToCanvas.Brush.Assign(xLastBrush);
    xLastBrush.Free;
  end;
end;

Answer 2

最后我使用TExcellentImagePrinter解决了这个问题。

在上面的代码片段（我的帖子）中，我用LoadDIBFromTBitmap函数替换了GETDIB，用PrintDIBitmapXY替换了StretchDIBits。

感谢Joe提供了正确的指导方针。