Преамбула: Для формирования некоего документа, состоящего из текстов и картинок (например этикетки на посылке) используются объекты VCL — TLabel и TImage. Написан специальный конструктор, в котором в стиле Delphi IDE можно нарисовать шаблон любой конфигурации для печати различных этикеток, и затем сохранить его в БД в виде XML (содержимое картинки переводится в строку). При печати этикетки все объекты шаблона рисуют себя на холсте (Canvas) принтера. Все работает отлично, за исключением одной маленькой проблемы — рандомно (зависимость отследить не удалось) TImage вместо картинки рисует черный прямоугольник. Причем не обязательно это должен быть канвас принтера, на форме тоже иногда бывает. Есть какие-нибудь идеи, как это побороть? Для отрисовки используются функции Canvas.CopyRect, Canvas.StretchDraw — результат один и тот же. Хелп!

Здравствуйте, KaBoom, Вы писали:

KB> рандомно (зависимость отследить не удалось) TImage вместо картинки рисует черный прямоугольник

Сделайте функцию, которая сразу после отрисовки проверяет канвас на "чёрный прямоугольник". Там брейкпоинт на положительное срабатывание, или отладочную печать... в общем, ловите ситуацию.

Здравствуйте, KaBoom, Вы писали:

KB>При печати этикетки все объекты шаблона рисуют себя на холсте (Canvas) принтера.

Как это реализовано?

Здравствуйте, Aniskin, Вы писали:

A>Здравствуйте, KaBoom, Вы писали:

KB>>При печати этикетки все объекты шаблона рисуют себя на холсте (Canvas) принтера.

A>Как это реализовано?

procedure TfmTemplate.PrintObjects(ACanvas: TCanvas);
var
   i: Integer;
begin    
   for i := 0 to Pred(ComponentCount) do
   begin
      if Components[i].ClassType = TTicketRotateImage   then TTicketRotateImage(Components[i]).DrawOnCanvas(ACanvas);
      if Components[i].ClassType = TTicketStaticImage   then TTicketStaticImage(Components[i]).DrawOnCanvas(ACanvas);
      if Components[i].ClassType = TTicketLabel         then TTicketLabel(Components[i]).DrawOnCanvas(ACanvas);
      if Components[i].ClassType = TTicketBarcode       then TTicketBarcode(Components[i]).DrawOnCanvas(ACanvas);
   end;
end;


procedure TfmTemplate.Print;
begin
   Printer.BeginDoc;
   PrintObjects(Printer.Canvas);
   Printer.EndDoc;
end;

З.ы.: С интерфейсами не стал заморачиваться, поскольку объектов всего 4 типа и новых не предвидится

Здравствуйте, KaBoom, Вы писали:

A>>Как это реализовано?

KB>

KB>procedure TfmTemplate.PrintObjects(ACanvas: TCanvas);
KB>var
KB>   i: Integer;
KB>begin    
KB>   for i := 0 to Pred(ComponentCount) do
KB>   begin
KB>      if Components[i].ClassType = TTicketRotateImage   then TTicketRotateImage(Components[i]).DrawOnCanvas(ACanvas);
KB>      if Components[i].ClassType = TTicketStaticImage   then TTicketStaticImage(Components[i]).DrawOnCanvas(ACanvas);
KB>      if Components[i].ClassType = TTicketLabel         then TTicketLabel(Components[i]).DrawOnCanvas(ACanvas);
KB>      if Components[i].ClassType = TTicketBarcode       then TTicketBarcode(Components[i]).DrawOnCanvas(ACanvas);
KB>   end;
KB>end;


KB>procedure TfmTemplate.Print;
KB>begin
KB>   Printer.BeginDoc;
KB>   PrintObjects(Printer.Canvas);
KB>   Printer.EndDoc;
KB>end;
KB>

Вставляйте запись в лог после каждой строки и смотрите что произошло. За несколько итераций отловите.

Здравствуйте, KaBoom, Вы писали:

KB> if Components[i].ClassType = TTicketRotateImage then TTicketRotateImage(Components[i]).DrawOnCanvas(ACanvas);
KB> if Components[i].ClassType = TTicketStaticImage then TTicketStaticImage(Components[i]).DrawOnCanvas(ACanvas);
KB> if Components[i].ClassType = TTicketLabel then TTicketLabel(Components[i]).DrawOnCanvas(ACanvas);
KB> if Components[i].ClassType = TTicketBarcode then TTicketBarcode(Components[i]).DrawOnCanvas(ACanvas);

Еще бы глянуть код той процедуры DrawOnCanvas, в которой периодически рисуется черный прямоугольник.

Здравствуйте, Aniskin, Вы писали:

A>Еще бы глянуть код той процедуры DrawOnCanvas, в которой периодически рисуется черный прямоугольник.

procedure TTicketStaticImage.DrawOnCanvas(ACanvas: TCanvas);
var
  RLeft, RTop, RRight, RBottom: Integer;
begin
   RLeft   := Left;
   RTop    := Top;
   RRight  := RLeft+Width;
   RBottom := RTop+Height;


   RLeft   := Floor(RLeft   * HorizontalScale);
   RTop    := Floor(RTop    * VerticalScale);
   RRight  := Floor(RRight  * HorizontalScale);
   RBottom := Floor(RBottom * VerticalScale);
   ACanvas.CopyRect(Rect(RLeft, RTop, RRight, RBottom), Picture.Bitmap.Canvas, Rect(0,0,Picture.Bitmap.Width, Picture.Bitmap.Height));

   //ACanvas.StretchDraw(Rect(RLeft, RTop, RRight, RBottom), Picture.Bitmap);
end;

HorizontalScale и VerticalScale это множители для пересчета экранных координат в координаты принтера, определяются один раз в начале работы:

procedure InitScales;
begin
   HorizontalScale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) / GetDeviceCaps(GetDC(0), LOGPIXELSX);
   VerticalScale   := GetDeviceCaps(Printer.Handle, LOGPIXELSY) / GetDeviceCaps(GetDC(0), LOGPIXELSY);
end;

Здравствуйте, KaBoom, Вы писали:

Версия Delphi? Печать в основном потоке? Во время печати нет дополнительных работающих потоков, работающих с TCanvas?

Здравствуйте, Aniskin, Вы писали:

A>Здравствуйте, KaBoom, Вы писали:

A>Версия Delphi? Печать в основном потоке? Во время печати нет дополнительных работающих потоков, работающих с TCanvas?

Delphi 7, печать в основном потоке, больше никто с Canvas не работает

Здравствуйте, KaBoom, Вы писали:

KB>Преамбула: Для формирования некоего документа, состоящего из текстов и картинок (например этикетки на посылке) используются объекты VCL — TLabel и TImage. Написан специальный конструктор, в котором в стиле Delphi IDE можно нарисовать шаблон любой конфигурации для печати различных этикеток, и затем сохранить его в БД в виде XML (содержимое картинки переводится в строку). При печати этикетки все объекты шаблона рисуют себя на холсте (Canvas) принтера. Все работает отлично, за исключением одной маленькой проблемы — рандомно (зависимость отследить не удалось) TImage вместо картинки рисует черный прямоугольник. Причем не обязательно это должен быть канвас принтера, на форме тоже иногда бывает. Есть какие-нибудь идеи, как это побороть? Для отрисовки используются функции Canvas.CopyRect, Canvas.StretchDraw — результат один и тот же. Хелп!

Появилась мысль что где-то у вас есть утечка графических ресурсов, и в какой-то момент это приводит к неработоспособности системы.
Например попробуйте эту тулзу http://www.nirsoft.net/utils/gdi_handles.html (нашел первое попавшееся)

Здравствуйте, Danchik, Вы писали:

D>Появилась мысль что где-то у вас есть утечка графических ресурсов, и в какой-то момент это приводит к неработоспособности системы.
D>Например попробуйте эту тулзу http://www.nirsoft.net/utils/gdi_handles.html (нашел первое попавшееся)

Боюсь это не поможет, потому что при следующей (после черного прямоугольника) печати все печатается нормально

KB>TImage вместо картинки рисует черный прямоугольник. Причем не обязательно это должен быть канвас принтера, на форме тоже иногда бывает. Есть какие-нибудь идеи, как это побороть?

как-то напарывался на такое с одной картинкой в QRImage, выкрутился тупой заменой битмэпа на такой же с другой битностью цвета (ЕМНИП, битность уменьшал)
так что глубже не разбирался

KB>

KB>   ACanvas.CopyRect(Rect(RLeft, RTop, RRight, RBottom), Picture.Bitmap.Canvas, Rect(0,0,Picture.Bitmap.Width, Picture.Bitmap.Height));
KB>

После этой процедуры попробовал проверить значения ACanvas.Pixels в той области, куда копировался битмап, а они все равны -1. Хотя картинка печатается нормально. Есть идеи почему так?

Здравствуйте, KaBoom, Вы писали:

KB>>

KB>>   ACanvas.CopyRect(Rect(RLeft, RTop, RRight, RBottom), Picture.Bitmap.Canvas, Rect(0,0,Picture.Bitmap.Width, Picture.Bitmap.Height));
KB>>

KB>После этой процедуры попробовал проверить значения ACanvas.Pixels в той области, куда копировался битмап, а они все равны -1. Хотя картинка печатается нормально. Есть идеи почему так?

Может это и гадание на кофейной гуще. Но мне кажется что канва принтера, это что-то из разряда метафайла, не уверен что коректно у векторного представления просить пиксели.

Здравствуйте, Danchik, Вы писали:

D>Здравствуйте, KaBoom, Вы писали:

KB>>>

KB>>>   ACanvas.CopyRect(Rect(RLeft, RTop, RRight, RBottom), Picture.Bitmap.Canvas, Rect(0,0,Picture.Bitmap.Width, Picture.Bitmap.Height));
KB>>>

KB>>После этой процедуры попробовал проверить значения ACanvas.Pixels в той области, куда копировался битмап, а они все равны -1. Хотя картинка печатается нормально. Есть идеи почему так?

D>Может это и гадание на кофейной гуще. Но мне кажется что канва принтера, это что-то из разряда метафайла, не уверен что коректно у векторного представления просить пиксели.


Удалось выяснить, что дело таки не в принтере и его канвас. Дело в загрузке TImage из TStream. Закономерность пока отловить не удалось, иногда 10000 загрузок подряд проходят нормально, а иногда подобные объекты начинают показывать черные квадраты через раз. Данные перепроверены тысячу раз, ошибок нигде никаких нет, но пофиксить это мне не удается. Изза этой долбаной проблемы я могу вылететь с работы, но идей никаких нету. Выручайте, братья.

Здравствуйте, KaBoom, Вы писали:

KB> Дело в загрузке TImage из TStream. ... могу вылететь с работы,

Блин, ну несерьёзно.

1. Зачем грузить image 10000 раз? Грузите один раз и кэшируйте. Не верю я, что у вас на этикетках десятки тысяч картинок.

2. Если не удаётся найти причину, то блин уже писал — после загрузки проверяйте этот image, что в нём. Загрузился ли чёрный квадрат или нормальный рисунок. И тупо перегружайте, пока не загрузится, в конце-то концов.

Здравствуйте, Softwarer, Вы писали:

S>Здравствуйте, KaBoom, Вы писали:

KB>> Дело в загрузке TImage из TStream. ... могу вылететь с работы,

S>Блин, ну несерьёзно.

S>1. Зачем грузить image 10000 раз? Грузите один раз и кэшируйте. Не верю я, что у вас на этикетках десятки тысяч картинок.

S>2. Если не удаётся найти причину, то блин уже писал — после загрузки проверяйте этот image, что в нём. Загрузился ли чёрный квадрат или нормальный рисунок. И тупо перегружайте, пока не загрузится, в конце-то концов.

Грузил я 10000 раз в качестве стресс-теста. Обычно на билете от одной до 5 картинок, редко больше. Кэшировать не выход — за день печати может случиться, что две одинаковые картинки не будут печататься, а печать идет тысячами. Картинка после загрузки, если произошел сбой, не полностью черная, а внизу битмапа несколько рядов разноцветных пикселей. Плюс я еще тормознул, и перепутал строки со столбцами пикселей, при проверке на одноцветность. В результате, в качестве костыля, решение сделано по Вашему варианту — проверяется верхняя половина картинки, если у всех пикселей цвет одинаковый — перезагрузка. Клиента это решение устраивает, но меня не очень. Лог показывает, что картинка может перегружаться до 5ти раз подряд, прежде чем загрузится нормально. Что за

Canvas.Changed ?