Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.12.26;
Скачать: [xml.tar.bz2];

Вниз

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

 
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.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.12.26;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.58 MB
Время: 0.037 c
1-86024
svs-123456789
2002-12-16 14:39
2002.12.26
компоненты


1-85881
Pasha_
2002-12-15 04:37
2002.12.26
TMetaClass


3-85845
Suharew
2002-12-06 22:46
2002.12.26
Как заблокировать запись таблицы


1-85936
17.12.2002
2002-12-17 15:54
2002.12.26
HTML


14-86122
HiEx
2002-12-05 12:48
2002.12.26
Помогите найти FastNet для D7. (За мной если что не заржавеет)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский