Reported by Bill Ruele
問題のコード：
procedure TForm1.btnPrinterClick(Sender: TObject);
const SQ_SIZE = 300;
var i: Integer;
begin
if PrintDialog.Execute then
begin
Printer.BeginDoc;
for i := Integer(Low(TBrushStyle)) to Integer(High(TBrushStyle)) do
begin
Printer.Canvas.Brush.Color := clBlack;
Printer.Canvas.Brush.Style := TBrushStyle(i);
Printer.Canvas.Rectangle(SQ_SIZE, SQ_SIZE * i, SQ_SIZE * 2, SQ_SIZE * i + SQ_SIZE);
end;
Printer.EndDoc;
end;
end;
このコードは、さまざまな標準の塗りつぶしパターンを使って箱型の列を印刷するはずです。これは Win98 では正しく動作します。しかし NT では、プリンタ/ドライバによって異なる結果になります。ただし、一般的には全ての四角形が空、または黒の塗りつぶしになります。ブラシの色をセットするタイミングを、style をセットする前や後にしてみましたが、それでも駄目でした。
純粋な API を使用した場合には期待した結果が得られるので、これはプリンタドライバの問題ではないと思います。
PrintDlg(...);
StartDoc(...);
CreateHatchBrush(...); ( or CreateBrushIndirect();)
SelectObject(...);
Windows.rectangle(...);
DeleteObject(...);
EndDoc(...);
また、Delphi/API のハイブリッドなアプローチを使用した場合にも、正しい結果を得ることが出来ました。
procedure TForm1.btnHybrid2Click(Sender: TObject);
const SQ_SIZE = 300;
var
i: Integer;
OrigBrush,
Brush: HBRUSH;
begin
if PrintDialog.Execute then
begin
Printer.BeginDoc;
for i := 1 to 6 do
begin
Brush := CreateHatchBrush(i-1, RGB(0,0,0));
OrigBrush := SelectObject(Printer.Canvas.Handle, Brush);
Printer.Canvas.rectangle(SQ_SIZE, i * SQ_SIZE, 2 * SQ_SIZE, (i+1) * SQ_SIZE);
SelectObject(Printer.Canvas.Handle, OrigBrush);
DeleteObject(Brush);
end;
Printer.EndDoc;
end;
end;
少し変形したバージョンでも同じように正しい結果を得ることが出来ます。
procedure TForm1.btnHybrid3Click(Sender: TObject);
const SQ_SIZE = 300;
var
i: Integer;
OrigBrush,
Brush: HBRUSH;
begin
if PrintDialog.Execute then
begin
Printer.BeginDoc;
for i := 1 to 6 do
begin
Brush := CreateHatchBrush(i-1, RGB(0,0,0));
OrigBrush := Printer.Canvas.Brush.Handle;
Printer.Canvas.Brush.Handle := Brush;
Printer.Canvas.rectangle(SQ_SIZE, i * SQ_SIZE, 2 * SQ_SIZE, (i+1) * SQ_SIZE);
Printer.Canvas.Brush.Handle := OrigBrush;
DeleteObject(Brush);
end;
Printer.EndDoc;
end;
end;
CreateHatchBrush() のところで CreateBrushIndirect() を使用したり、Windows.Rectangle() のところで Windows.FillRect() を使用した場合にも、同じ結果を得ることが出来ます。
理想的には、純粋な Delphi のコードで正しく動作してほしいです。回避方法のどれかを採用する場合、潜在的なメモリリークや、TPrinter オブジェクト内部の何かを壊すことを心配します。
|