Печать на принтер и превью в Win98 - какие-то странные глюки.

← →
romeo (2003-11-30 17:38) [0]

В своей программе организовал печать и превью векторной графики. Пока занимался ею только на работе (под Win2000) - все было нормально. Решил на выходных дома ударно потрудиться. Дома - Win98SE. И тут началося...

Объясню подробнее что именно делаю:

W := GetDeviceCaps(Printer.Handle, HORZRES);
H := GetDeviceCaps(Printer.Handle, VERTRES);
CompDC := CreateCompatibleDC(Printer.Handle);
B_Handle := CreateCompatibleBitmap(Printer.Handle, W, H);
SelectObject(CompDC, B_Handle);

for Loop := 0 to Objects.Count - 1 do begin
if Objects[Loop].VisibleInRect(PrintableArea) and Objects[Loop].Layer.Visible and Objects[Loop].Layer.Printable
then Objects[Loop].Print(CompDC)
end;

Сами объекты рисуются вот таким макаром:

procedure TPolyLine.Print(hCanvas: hDC; Margins: TPoint; Scale: Real);
var
Loop: Integer;
Pen: hPen;
begin
Pen := CreatePen(PS_SOLID, 1, Color);
SelectObject(hCanvas, Pen);
MoveToEx(hCanvas, Margins.x + Round((Points[0].x - PrintableArea.Left)/Scale), Margins.y + Round((Points[0].y - PrintableArea.Top)/Scale), nil);
for Loop := 0 to FPoints.Count - 1 do begin
LineTo(hCanvas, Margins.x + Trunc((Points[Loop].x - PrintableArea.Left)/Scale), Margins.y + Trunc((Points[Loop].y - PrintableArea.Top)/Scale));
end;
DeleteObject(Pen);
end;

А затем этот CompDC рисую BitBlt-ом на Printer.Canvas.Handle или, если превью - то на PaintBox.Canvas.Handle.

Так вот, если объектов не очень много (сотни две -три) - все работает нормально, превью виден как надо. Если их количество переваливает за какое-то (так и не выяснил какое) значение - в превью рисуется девственно чистый листочек бумажки. А при fmPreview.Close выскакивает занятное сообщение на РУССКОМ языке: "Параметр задан неверно". Шрифт сообщения может изменяться от раза к разу. Если после этого не закрывать программу - то отмечаются странности в перерисовке компонентов на главной форме. Да, если программа была запущена из-под Delphi, то до сообщения дело не доходит - система просто зависает, спасает только кнопочка "Reset" ...

Стал копаться. Выяснил, что если всю уйму объектов рисовать одним и тем же Pen-ом, то все работает нормально, т.е.:

procedure TPolyLine.Print(hCanvas: hDC; Margins: TPoint; Scale: Real);
var
Loop: Integer;
Pen: hPen;
begin
//Pen := CreatePen(PS_SOLID, 1, Color);
//SelectObject(hCanvas, Pen);
MoveToEx(hCanvas, Margins.x + Round((Points[0].x - PrintableArea.Left)/Scale), Margins.y + Round((Points[0].y - PrintableArea.Top)/Scale), nil);
for Loop := 0 to FPoints.Count - 1 do begin
LineTo(hCanvas, Margins.x + Trunc((Points[Loop].x - PrintableArea.Left)/Scale), Margins.y + Trunc((Points[Loop].y - PrintableArea.Top)/Scale));
end;
// DeleteObject(Pen);
end;

Что за полтергейст, блин?!
Если кто знает в чем дело - помогите, а? Заранее спасиба...

← →
nikkie (2003-11-30 17:44) [1]

ресурсов не хватило :)
pen у тебя не удаляется.

DeleteObject
If the function succeeds, the return value is nonzero.
If the specified handle is not valid or is currently selected into a DC, the return value is zero.

надо делать так:
Pen := CreatePen(...);
OldPen := SelectObject(hCanvas, Pen);
...
SelectObject(hCanvas, OldPen);
DeleteObject(Pen);

← →
romeo (2003-11-30 17:59) [2]

Печать на принтер и превью в Win98 - какие-то странные глюки. Найти похожие ветки