печать на принтере заштрихованного полигона

← →
vladnt (2002-12-13 15:34) [0]

Уважаемые мастера. Подскажите , как напечатать на принтере белый полигон с черной штриховкой.Стандартными процедурами печатается либо черный полигон( если Brush.Color:=clBlack), либо черный полигон с белой штриховкой (если Brush.Color:=clWhite).

← →
Игорь Шевченко (2002-12-13 16:19) [1]

Brush.style := bsDiagonal ? Но я сомневаюсь, что на принтере смасштабируется штриховка...

← →
LongIsland (2002-12-13 16:21) [2]

procedure TForm1.Button1Click(Sender: TObject); var p: array of TPoint; begin if not PrintDialog1.Execute then Exit; SetLength(p, 3); p[0].X:=0; p[0].Y:=0; p[1].X:=100; p[1].Y:=100; p[2].X:=100; p[2].Y:=200; Printer.BeginDoc; Printer.Canvas.Brush.Style:=bsFDiagonal; Printer.Canvas.Brush.Color:=clBlack; Printer.Canvas.Pen.Color:=clBlack; Printer.Canvas.Polygon(p); Printer.EndDoc; end;

А проблема только в том, что надо установить цвет кисти черный. И все... :-)

← →
vladnt (2002-12-13 16:49) [3]

LongIsland
Проблема и заключается в том, что программа в вашем случае рисует на принтере черный треугольник, а если поставить Printer.Canvas.Brush.Color:=clWhite
нарисует черный треугольник с белой штриховкой.

← →
LongIsland (2002-12-13 17:14) [4]

Brush.Color - это цвет ШТРИХОВКИ!!!

← →
vladnt (2002-12-14 08:40) [5]

LongIsland
Если я поставлю Brush.Color:=clBlack нарисует черную штриховку,но ее не видно,потому что заливка полигона тоже черная.
По-моему здесь надо изменить свойства принтера, типа TDeviceMode. ,но как?

← →
vladnt (2002-12-16 09:14) [6]

Вопрос не решен. Image.Canvas рисует правильно,а Printer.canvas отказывается.

← →
MBo (2002-12-16 15:50) [7]

procedure TForm1.Button1Click(Sender: TObject);
var b:tbitmap;
w,h:integer;
begin
b:=tbitmap.create;
w:=printer.PageWidth;
h:=printer.Pageheight;
b.width:=w div 32;
b.height:=h div 32;
b.Canvas.brush.Style:=bsDiagCross;
b.Canvas.brush.color:=clblack;
b.Canvas.Rectangle(0,0,w div 20,h div 20);
Canvas.draw(0,0,b);
printer.BeginDoc;
printer.Canvas.stretchdraw(rect(0,0,w div 4,h div 4),b);
printer.EndDoc;
end;

← →
vladnt (2002-12-16 16:10) [8]

MBo
Принцип знаком и понятен,но StretchDraw у меня на принтере не работает,так же как и CopyRect (причину не ведаю). На выходе белый лист.

← →
MBo (2002-12-17 10:16) [9]

procedure PrintHatchPolygon(Canvas: TCanvas; Pts: array of TPoint; FillStep:
Integer);
var
ClipRgn: HRGN;
r: TRect;
i, MaxSize, OldPenColor, HatchStyle: integer;

procedure Line(X1, Y1, X2, Y2: Integer);
begin
Canvas.MoveTo(X1, Y1);
Canvas.LineTo(X2, Y2);
end;

begin
case Canvas.Brush.Style of
bsVertical: HatchStyle := 1;
bsHorizontal: HatchStyle := 2;
bsFDiagonal: HatchStyle := 4;
bsBDiagonal: HatchStyle := 8;
bsCross: HatchStyle := 3;
bsDiagCross: HatchStyle := 12;
else
HatchStyle := 0;
end;
OldPenColor := Canvas.Pen.Color;
Canvas.Pen.Color := Canvas.Brush.Color;
ClipRgn := CreatePolygonRgn(Pts, High(Pts) + 1, ALTERNATE);
GetRgnBox(ClipRgn, r);
MaxSize := R.Bottom - R.Top;
if MaxSize < (R.Right - R.Left) then
MaxSize := R.Right - R.Left;
SelectClipRgn(Canvas.Handle, ClipRgn);
with R do
begin
if (HatchStyle and 1) > 0 then
for i := 1 to (R.Right - R.Left) div FillStep do
Line(Left + i * FillStep, Top, Left + i * FillStep, Bottom);
if (HatchStyle and 2) > 0 then
for i := 1 to (R.Bottom - R.Top) div FillStep do
Line(Left, Top + i * FillStep, Right, Top + i * FillStep);
// FillStep := Round(1.414 * FillStep);
if (HatchStyle and 4) > 0 then
for i := 1 to 2 * MaxSize div FillStep do
Line(Left, Bottom - i * FillStep, Left + i * FillStep, Bottom);
if (HatchStyle and 8) > 0 then
for i := 1 to 2 * MaxSize div FillStep do
Line(Left, Top + i * FillStep, Left + i * FillStep, Top);
end;
SelectClipRgn(Canvas.Handle, 0);
DeleteObject(ClipRgn);
Canvas.Pen.Color := OldPenColor;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
p: array[0..2] of TPoint;
begin
//контроль на форме
p[0] := Point(10, 10);
p[1] := Point(100, 10);
p[2] := Point(10, 200);
Canvas.Brush.Style := bsDiagCross;
Canvas.Brush.Color := clRed;
PrintHatchPolygon(Canvas, P, 8);
Canvas.Brush.Style := bsClear;
Canvas.Polygon(p);

//масштабирование здесь от фонаря
p[0] := Point(1100, 100);
p[1] := Point(2000, 100);
p[2] := Point(1100, 2000);
printer.BeginDoc;
Printer.Canvas.Pen.Width := 5;
Printer.Canvas.Brush.Style := bsDiagCross;
Printer.Canvas.Brush.Color := clBlack;
PrintHatchPolygon(Printer.Canvas, P, 80);
Printer.Canvas.Brush.Style := bsClear;
Printer.Canvas.Polygon(p);
printer.EndDoc;
end;

← →
vladnt (2002-12-17 11:19) [10]

MBo
Большое спасибо!!! Работает отлично. Буду разбираться. Интересно только, со всеми принтерами такая беда?

← →
MBo (2002-12-17 12:47) [11]

>со всеми принтерами такая беда?
Не знаю, опыта нет, первый раз из Дельфи печатал.
Надо проверять (виноват не принтер, а его драйвер)
GetDeviceCaps с RASTERCAPS на RC_STRETCHBLT.

печать на принтере заштрихованного полигона Найти похожие ветки