Обработка изображения штрих-кода в Delphi 6 с использованием StretchDIBits - недостающие строки в выводе

Question

Мое приложение разработано в Delphi 6. Это ресурсоемкое приложение из-за фоновой обработки и большого объема данных (оно потребляет около 60-120 МБ физической памяти). Одной из функций этого приложения является создание изображений штрих-кода после выполнения определенной обработки. Если пользователь продолжает генерировать штрих-коды, то по крайней мере один из десяти штрих-кодов содержит пропущенные строки. У нас есть следующие шаги в генерации вывода:

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. Мы включили вызов SETAPROCESSWORKINGSETSIZE WinAPI, чтобы уменьшить / обновить текущую память, используемую приложением.
3. Мы включили Sleep (3000) в код, чтобы Windows могла выделить память для изображения. Однако включение Sleep уменьшило частоту появления этой ошибки.

Можете ли вы дать какие-либо предложения?

Answer 1

Наконец я смог решить проблему, используя TExcellentImagePrinter.

Я заменил GETDIB с LoadDIBFromTBitmap функцией и StretchDIBits с PrintDIBitmapXY в приведенном выше фрагменте кода (мой пост).

Спасибо Джо за правильные указания.

Answer 2

Я использую эту функцию для печати штрих-кодов с большим успехом.Предполагается, что растровое изображение имеет 100% масштабированный штрих-код (каждый x-пиксель является полосой штрих-кода), высота не имеет значения, она может быть только 1px.

Ключом является печать штрих-кода с помощью fillrect, а некак растровое изображение: функция просто «читает» штрих-код и рисует его с помощью fillrect на некотором холсте.Если получающийся в результате масштаб (xFactor = aToRect width to width barcode) представляет собой целое число или достаточно большое действительное число (для принтеров нет проблем), напечатанный штрих-код можно прочитать без каких-либо проблем.Он также прекрасно работает с 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;