PaintBox上图形打印问题。(100分)

  • 主题发起人 主题发起人 Dlwxn
  • 开始时间 开始时间
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.
 
你直接用bitblt拷貝PaintBox是拷貝不到沒有顯示部分的圖像的.
我給你一個方法,先創建一個TBitmap,然后直接在里面畫,當然畫的代碼與TPaintBox一樣:
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
iRedInc: BYTE;
iGreenInc: Byte;
iBlueInc: Byte;
R: TRect;
cl: TColor;
iIncrement: Integer;
BMP:TBitmap;
begin
BMP:=TBitmap.Create;
try
BMP.Width:=PaintBox1.ClientWidth;
BMP.Height:=PaintBox1.ClientHeight;
iRedInc := (GetRvalue(CEndColor) - GetRvalue(CStartColor)) div CStep;
iGreenInc := (GetGvalue(CEndColor) - GetGvalue(CStartColor)) div CStep;
iBlueInc := (GetBvalue(CEndColor) - GetBvalue(CStartColor)) div CStep;
iIncrement := BMP.Width div CStep;
I := 0;
cl := CStartColor;
while I <= BMP.Height do
begin
R := Rect(0, I, BMP.Width, I + iIncrement);
BMP.Canvas.Brush.Color := cl;
BMP.Canvas.FillRect(R);
Inc(I, iIncrement);
cl := RGB(GetRvalue(cl) + iRedInc, GetGvalue(cl) + iGreenInc, GetBvalue (cl) + iBlueInc);
end;
Image1.AutoSize :=True;
Image1.Picture.Assign(BMP);
finally
BMP.Free;
end;
end;
 
to:smokingroom 多谢!
我先看看,因为PaintBox的onPaint图形远比这复杂,需要修改比较多的东西。

还有没有其它方法?
 
问题解决,立即揭贴,多谢,效率高吧!
 
接受答案了.
 
后退
顶部