D
Dlwxn
Unregistered / Unconfirmed
GUEST, unregistred user!
我现在做图形打印,设置如下:在ScrollBox上放一PaintBox,当PaintBox的Align属性设置为alClient时,在PaintBox上的图形能全部打印出来。但把PanitBox的属性Align设置为alNone时,同时把PaintBox的大小调整比ScrollBox大,打印的结果是只是Scrollbox所能显示的图形,还带有边框。如何打印整个PaintBox上的图形?因为有很多图形,一个屏幕肯定是放不下的。以下是输出图形的代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TMainForm = class(TForm)
Button1: TButton;
Image1: TImage;
ScrollBox1: TScrollBox;
PaintBox1: TPaintBox;
procedure PaintBox1Paint(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
const
CStep = 40;
CStartColor = clBlue;
CEndColor = clBlack;
procedure TMainForm.PaintBox1Paint(Sender: TObject);
var
I: Integer;
iRedInc: BYTE;
iGreenInc: Byte;
iBlueInc: Byte;
R: TRect;
cl: TColor;
iIncrement: Integer;
begin
iRedInc := (GetRvalue(CEndColor) - GetRvalue(CStartColor)) div CStep;
iGreenInc := (GetGvalue(CEndColor) - GetGvalue(CStartColor)) div CStep;
iBlueInc := (GetBvalue(CEndColor) - GetBvalue(CStartColor)) div CStep;
iIncrement := PaintBox1.ClientHeight div CStep;
I := 0;
cl := CStartColor;
while I <= PaintBox1.ClientHeight do
begin
R := Rect(0, I, PaintBox1.Width, I + iIncrement);
PaintBox1.Canvas.Brush.Color := cl;
PaintBox1.Canvas.FillRect(R);
Inc(I, iIncrement);
cl := RGB(GetRvalue(cl) + iRedInc, GetGvalue(cl) + iGreenInc, GetBvalue(cl) + iBlueInc);
end;
end;
procedure TMainForm.Button1Click(Sender: TObject);
var
bmp: TBitmap;
begin
bmp :=tbitmap.create;
bmp.width :=paintbox1.width;
bmp.height :=paintbox1.height;
bitblt(bmp.canvas.handle,0,0,bmp.width,bmp.height,paintbox1.canvas.handle,0,0,srccopy);
image1.autosize :=true;
image1.picture.bitmap.assign(bmp);
image1.picture.savetofile('c:/a.bmp');
bmp.free;
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TMainForm = class(TForm)
Button1: TButton;
Image1: TImage;
ScrollBox1: TScrollBox;
PaintBox1: TPaintBox;
procedure PaintBox1Paint(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
const
CStep = 40;
CStartColor = clBlue;
CEndColor = clBlack;
procedure TMainForm.PaintBox1Paint(Sender: TObject);
var
I: Integer;
iRedInc: BYTE;
iGreenInc: Byte;
iBlueInc: Byte;
R: TRect;
cl: TColor;
iIncrement: Integer;
begin
iRedInc := (GetRvalue(CEndColor) - GetRvalue(CStartColor)) div CStep;
iGreenInc := (GetGvalue(CEndColor) - GetGvalue(CStartColor)) div CStep;
iBlueInc := (GetBvalue(CEndColor) - GetBvalue(CStartColor)) div CStep;
iIncrement := PaintBox1.ClientHeight div CStep;
I := 0;
cl := CStartColor;
while I <= PaintBox1.ClientHeight do
begin
R := Rect(0, I, PaintBox1.Width, I + iIncrement);
PaintBox1.Canvas.Brush.Color := cl;
PaintBox1.Canvas.FillRect(R);
Inc(I, iIncrement);
cl := RGB(GetRvalue(cl) + iRedInc, GetGvalue(cl) + iGreenInc, GetBvalue(cl) + iBlueInc);
end;
end;
procedure TMainForm.Button1Click(Sender: TObject);
var
bmp: TBitmap;
begin
bmp :=tbitmap.create;
bmp.width :=paintbox1.width;
bmp.height :=paintbox1.height;
bitblt(bmp.canvas.handle,0,0,bmp.width,bmp.height,paintbox1.canvas.handle,0,0,srccopy);
image1.autosize :=true;
image1.picture.bitmap.assign(bmp);
image1.picture.savetofile('c:/a.bmp');
bmp.free;
end;
end.