Barcode Image Processing with Delphi 6 using StretchDIBits - Missing Dashed Outlines

Question

My application was developed in Delphi 6. This is a resource-intensive application due to background processing and a large amount of data (it consumes about 60 MB - 120 MB of physical memory). One of the functions of this application is the creation of barcode images after performing a certain process. If the user continues to generate barcodes, then at least one out of ten barcodes has missing lines. We have the following steps to generate the output:

• Create a barcode image (TImage) in memory. Image height - 10 pixels. We use the pf24bit pixel format.
• Resize the image in memory according to the canvas of the printer and transfer it to the canvas of the printer. The code for step # 2 is as follows:

---

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; 

We checked that the problem is in step # 2, since the barcode image is generated without any problems. (We commented on Step # 2 and concluded in the form of BMP files to confirm this).

In addition, we tried the following workarounds:

• We used the TExcellentImagePrinter component to perform the resize operation. But the problem has not been resolved.
• We included the WinAPI call SETPROCESSWORKINGSETSIZE to reduce / update the current memory used by the application.
• We included Sleep (3000) in the code so that Windows could allocate memory for the image. Enabling Sleep, however, reduced the frequency of this error.

Can you provide any suggestions?

Answer 1

I use this function to print barcodes with great success. He suggests that the bitmap is a 100% scaled barcode (each x-pixel represents a barcode bar), the height does not matter, it can only be 1px.

The hint is to print the barcode using the correct line, and not as a bitmap: The function simply "reads" the barcode and draws it using overlay on any canvas. If the resulting scale (width xFactor = aToRect to the width of the barcode) is either an integer or a sufficiently large real number (no problem for printers), the printed barcode can be read without any problems. It also works great with PDF printers.

You just need to create a 100% scaled barcode for the bitmap (as you already did, the height can be 1px, the color of the barcode must be clBlack) and pass it in the aFromBMP parameter. Then aToCanvas will be your printer canvas. aToRect is the destination address in the printer canvas. aColor is the color of the target barcode (can be anything).

 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

Finally, I was able to solve the problem using TExcellentImagePrinter .

I replaced GETDIB with the LoadDIBFromTBitmap and StretchDIBits with PrintDIBitmapXY in the code snippet above (my post).

Thanks to Joe for providing the right advice.