请教大家：对scrollbox 进行打印，打印出图像太小，如何调成与显示大小相同，且不失真 ( 积分: 100 )

  • 主题发起人 主题发起人 tl_lyq
  • 开始时间 开始时间
T

tl_lyq

Unregistered / Unconfirmed
GUEST, unregistred user!
var
BMP: TBitMap;
SR, DR: TRect;
P: TPoint;
printer:tprinter;
dlg: TPrinterSetupDialog;
begin
dlg := TPrinterSetupDialog.Create(nil);
if dlg.Execute then
begin
BMP := TBitMap.Create;
BMP.Width := ScrollBox1.Width;
BMP.Height := ScrollBox1.Height;
P := ScrollBox1.ClientToParent(Point(0, 0), Self);
SR := Rect(P.X, P.Y, BMP.Width, BMP.Height);
DR := Rect(0, 0, BMP.Width, BMP.Height);
BMP.Canvas.CopyRect(DR, Canvas, SR);
printer:=tprinter.Create;
Printer.begin
Doc;
self.PrintScale :=poProportional;
Bitblt(printer.Canvas.Handle, 0, 0, bmp.Width, bmp.Height,
bmp.Canvas.Handle, 0, 0, srcCopy);
Printer.EndDoc;
dlg.Free;
BMP.Free;
end;
打印出来很小。且scrollbox不显示部分无法打印
 
var
BMP: TBitMap;
SR, DR: TRect;
P: TPoint;
printer:tprinter;
dlg: TPrinterSetupDialog;
begin
dlg := TPrinterSetupDialog.Create(nil);
if dlg.Execute then
begin
BMP := TBitMap.Create;
BMP.Width := ScrollBox1.Width;
BMP.Height := ScrollBox1.Height;
P := ScrollBox1.ClientToParent(Point(0, 0), Self);
SR := Rect(P.X, P.Y, BMP.Width, BMP.Height);
DR := Rect(0, 0, BMP.Width, BMP.Height);
BMP.Canvas.CopyRect(DR, Canvas, SR);
printer:=tprinter.Create;
Printer.begin
Doc;
self.PrintScale :=poProportional;
Bitblt(printer.Canvas.Handle, 0, 0, bmp.Width, bmp.Height,
bmp.Canvas.Handle, 0, 0, srcCopy);
Printer.EndDoc;
dlg.Free;
BMP.Free;
end;
打印出来很小。且scrollbox不显示部分无法打印
 
你把BMP转换成EMF然后放大,再转换成BMP打印试一试!
 
好象要设置一下GDI Mapping Modes
共有以下几种
MM_TEXT 1 pixel
MM_LOMETRIC 0.1 mm
MM_HIMETRIC 0.01 mm
MM_LOENGLISH 0.01 in.
MM_HIENGLISH 0.001 in.
MM_TWIPS 1/1440 in. (0.0007 in.)
除了第一种以象素为单位外，其它的都是以实际尺寸为单位，都能得到所见即所得的效果，但默认的刚好是第一种。
dc.SetMapMode (MM_LOMETRIC);
dc.Ellipse (0, 0, 500, -300);

对了，tl_lyq,我想问你个问题,
你前不久发了一个问题:自定义控件：panel+memo=Tmypanel,请教memo如何继承panel的事件 ,这个问题是怎么解决的，我现在也遇到了这个问题，困惑了好久，能说一下你的解决办法吗？不胜期待。。。。
 
unit IDMYpanel;
interface
uses
Graphics,Windows,dialogs, Messages, SysUtils, StdCtrls, Classes, ComCtrls, CommCtrl,ExtCtrls , Controls ;
type
TMypanel = class(Tpanel)
private
Memo:tMemo;
statusbar:tstatusbar;
FOnMemoMouseMove: TMouseMoveEvent ;
Function ReadMemoText():string;
procedure SetMemoText(Const Value:string);
Function ReadMemocolor():Tcolor;
procedure SetMemocolor(Const Value:Tcolor);
Function ReadstatusbarColor():Tcolor;
procedure setstatusbarColor(Const Value:Tcolor);
Function ReadSt1():string;
procedure SetSt1(Const Value:string);
Function ReadSt2():string;
procedure SetSt2(Const Value:string);
Function ReadSt3():string;
procedure SetSt3(Const Value:string);
Function ReadSt4():string;
procedure SetSt4(Const Value:string);
Function ReadSt5():string;
procedure SetSt5(Const Value:string);
Function ReadSt6():string;
procedure SetSt6(Const Value:string);
Function ReadSt7():string;
procedure SetSt7(Const Value:string);
Function ReadSt8():string;
procedure SetSt8(Const Value:string);
Function ReadSt9():string;
procedure SetSt9(Const Value:string);
Function ReadSt10():string;
procedure SetSt10(Const Value:string);
Function ReadSt11():string;
procedure SetSt11(Const Value:string);
procedure SetOnDragDrog(Sender, Source: TObject;
X, Y: Integer);
procedure SetOnDragOver(Sender, Source: TObject;
X, Y: Integer;
State: TDragState;
var Accept: Boolean);
procedure PanelResize(Sender: TObject);
protected
procedure MouseMove(Shift1: TShiftState;
X1, Y1: Integer);
override;
proceduredo
MemoMouseMove(Sender1: TObject;Shift1: TShiftState;
X1, Y1: Integer);
procedure SetSpQuan(Sender: TObject;Const Fact_hwlength:integer;const Fact_hwheight:integer;const splength:integer;const spwidth:integer;const spheight:integer;const splayer:integer;const splquan:integer;const spwquan:integer) ;
public
constructor create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
property St1_sj:string read ReadSt1 write Setst1;
property St2_sj:string read ReadSt2 write Setst2;
property St3_sj:string read ReadSt3 write Setst3;
property St4_sj:string read ReadSt4 write Setst4;
property St1_ll:string read ReadSt5 write Setst5;
property St2_ll:string read ReadSt6 write Setst6;
property St3_ll:string read ReadSt7 write Setst7;
property St4_ll:string read ReadSt8 write Setst8;
property spcode:string read ReadSt9 write Setst9;
property spname:string read ReadSt10 write Setst10;
property hwheight:string read ReadSt11 write Setst11;
property MemoText:string read ReadMemoText write SetMemoText;
property MemoColor:Tcolor read ReadMemoColor write SetMemoColor;
property statusbarColor:Tcolor read ReadstatusbarColor write SetstatusbarColor;
property OnMemoMouseMove: TMouseMoveEvent read FOnMemoMouseMove write FOnMemoMouseMove;
end;

procedure Register;
implementation
uses unit1;
procedure TMypanel.mousemove(Shift1: TShiftState;
X1, Y1: Integer) ;
begin
inherited MouseMove(Shift1, X1, Y1);
end;

procedure TMyPanel.DoMemoMouseMove(Sender1: TObject;Shift1: TShiftState;
X1, Y1: Integer);
begin
if Assigned(FOnMemoMouseMove) then
FOnMemoMouseMove(sender1,shift1, X1, Y1);
inherited mousemove(Shift1, X1, Y1);
end;
procedure TMypanel.SetSpQuan(Sender: TObject;Const Fact_hwlength:integer;Const Fact_hwheight:integer;const splength:integer;const spwidth:integer;const spheight:integer;const splayer:integer;const splquan:integer;const spwquan:integer) ;
var lengthnum,widthnum,layernum:integer;
begin
layernum :=Fact_hwheight div (spheight * splayer);
lengthnum:=Fact_hwlength div (splength * splquan);
widthnum :=unit1.thehjWidth div (spwidth * spwquan);
if (layernum=0) then
begin
showmessage('当前货位尺寸无法摆放您选择的商品!高度不够，货位高度：'+inttostr(Fact_hwheight)+' ;商品高度：'+inttostr(spheight * splayer));
try(sender as tmypanel).height:=Fact_hwheight;except end;
abort;
end
else
if (lengthnum=0) then
begin
showmessage('当前货位尺寸无法摆放您选择的商品!横向宽度不够，货位横向宽度：'+inttostr(Fact_hwlength)+' ;商品长度：'+inttostr((splength * splquan)));
try(sender as tmypanel).Width :=(splength * splquan)* thebl div 100-13;except end;
abort;
end
else
if (widthnum=0) then
begin
showmessage('当前货位尺寸无法摆放您选择的商品!纵向宽度不够，货位纵向宽度：'+inttostr(unit1.thehjWidth)+' ;商品宽度：'+inttostr((spwidth * spwquan)));
abort;
end
else
begin
layernum :=Fact_hwheight div spheight ;
lengthnum:=Fact_hwlength div splength ;
widthnum :=unit1.thehjWidth div spwidth ;
self.St1_ll:=inttostr(layernum);
self.St2_ll:=inttostr(lengthnum);
self.St3_ll:=inttostr(widthnum);
end;
end;
procedure TMypanel.SetOnDragDrog(Sender, Source: TObject;
X, Y: Integer);
begin
if (Source is Tlistview) and (sender is Tmemo) then
if ((sender as tmemo).Text='空白') then
showmessage('此栏目不允许摆放商品，请点右键新建货位！')
else
begin
SetSpQuan(sender,((sender as tmemo).Width+13) * 100 div thebl,strtoint(Tmypanel((sender as tmemo).Parent).hwheight),strtoint(Tlistview(Source).Selected.SubItems[1]),strtoint(Tlistview(Source).Selected.SubItems[2]),strtoint(Tlistview(Source).Selected.SubItems[3]),1,1,1);
self.St1_sj:=self.St1_ll;
self.St2_sj:=self.St2_ll;
self.St3_sj:=self.St3_ll;
self.spcode := Tlistview(Source).Selected.Caption ;
memo.lines.clear;
Memo.Lines.Add(Tlistview(Source).Selected.SubItems[9]+'-');
Memo.Lines.Add(Tlistview(Source).Selected.SubItems[0]);
Memo.Lines.Add('['+format('%3s',[Tlistview(Source).Selected.SubItems[1]])+'X'+format('%3s',[Tlistview(Source).Selected.SubItems[2]])+'X'+format('%3s',[Tlistview(Source).Selected.SubItems[3]])+']' );
self.Tag :=strtoint(Tlistview(Source).Selected.Caption );
end;
end;

procedure TMypanel.PanelResize(Sender: TObject);
var splength,spwidth,spheight,splquan,spwquan,splayer:integer;
begin
if ((sender as tmypanel).MemoText <>'空白') and ((sender as tmypanel).MemoText <>'') then
begin
splength:=strtoint(copy((sender as tmypanel).Memo.Lines.text,pos('[',(sender as tmypanel).Memo.Lines.text)+1,3));
spwidth:=strtoint(copy((sender as tmypanel).Memo.Lines.text,pos('[',(sender as tmypanel).Memo.Lines.text)+5,3));
spheight:=strtoint(copy((sender as tmypanel).Memo.Lines.text,pos('[',(sender as tmypanel).Memo.Lines.text)+9,3));
splayer:=strtoint((sender as tmypanel).statusbar.Panels[0].text);
splquan:=strtoint((sender as tmypanel).statusbar.Panels[2].text);
spwquan:=strtoint((sender as tmypanel).statusbar.Panels[4].text);
if not unit1.ChangeBl then
SetSpQuan(sender,((sender as tmypanel).Width+13) * 100 div thebl,strtoint(((sender as tmypanel).hwheight)),splength ,spwidth ,spheight ,splayer, splquan,spwquan);
end;
if not unit1.ChangeBl then
begin
self.St4_ll:=inttostr(((sender as tmypanel).width+13) * 100 div thebl)+' mm';
self.St4_sj:=inttostr(((sender as tmypanel).width+13) * 100 div thebl)+' mm';
end;
end;

procedure TMypanel.SetOnDragOver(Sender, Source: TObject;
X, Y: Integer;
State: TDragState;
var Accept: Boolean);
begin
if (source is Tlistview) then
Accept :=true;
end;

Function TMypanel.ReadMemoColor():Tcolor;
begin
Result:=memo.color;
end;
procedure TMypanel.SetMemoColor(Const Value:Tcolor);
begin
Memo.color:=Value;
end;

Function TMypanel.ReadstatusbarColor():Tcolor;
begin
Result:=statusbar.color;
end;
procedure TMypanel.SetstatusbarColor(Const Value:Tcolor);
begin
statusbar.color:=Value;
end;
Function TMypanel.ReadMemoText():string;
begin
Result:=memo.Lines.text;
end;
procedure TMypanel.SetMemoText(Const Value:string);
begin
Memo.Lines.text:=Value;
end;

Function TMypanel.ReadSt1():string;
begin
Result:=statusbar.Panels[0].text;
end;
procedure TMypanel.SetSt1(Const Value:string);
begin
statusbar.Panels[0].text:=Value;
end;

Function TMypanel.ReadSt2():string;
begin
Result:=statusbar.Panels[2].text;
end;
procedure TMypanel.SetSt2(Const Value:string);
begin
statusbar.Panels[2].text:=Value;
end;

Function TMypanel.ReadSt3():string;
begin
Result:=statusbar.Panels[4].text;
end;
procedure TMypanel.SetSt3(Const Value:string);
begin
statusbar.Panels[4].text:=Value;
end;

Function TMypanel.ReadSt4():string;
begin
Result:=statusbar.Panels[5].text;
end;
procedure TMypanel.SetSt4(Const Value:string);
begin
statusbar.Panels[5].text:=value;
end;

Function TMypanel.ReadSt5():string;
begin
Result:=statusbar.Panels[6].text;
end;
procedure TMypanel.SetSt5(Const Value:string);
begin
statusbar.Panels[6].text:=value;
end;

Function TMypanel.ReadSt6():string;
begin
Result:=statusbar.Panels[7].text;
end;
procedure TMypanel.SetSt6(Const Value:string);
begin
statusbar.Panels[7].text:=value;
end;

Function TMypanel.ReadSt7():string;
begin
Result:=statusbar.Panels[8].text;
end;
procedure TMypanel.SetSt7(Const Value:string);
begin
statusbar.Panels[8].text:=value;
end;
Function TMypanel.ReadSt8():string;
begin
Result:=statusbar.Panels[9].text;
end;
procedure TMypanel.SetSt8(Const Value:string);
begin
statusbar.Panels[9].text:=value;
end;

Function TMypanel.ReadSt9():string;
begin
Result:=statusbar.Panels[10].text;
end;
procedure TMypanel.SetSt9(Const Value:string);
begin
statusbar.Panels[10].text:=value;
end;

Function TMypanel.ReadSt10():string;
begin
Result:=statusbar.Panels[11].text;
end;
procedure TMypanel.SetSt10(Const Value:string);
begin
statusbar.Panels[11].text:=value;
end;
Function TMypanel.ReadSt11():string;
begin
Result:=statusbar.Panels[12].text;
end;
procedure TMypanel.SetSt11(Const Value:string);
begin
statusbar.Panels[12].text:=value;
end;

constructor TMypanel.create(AOwner: TComponent);
begin
inherited Create(AOwner);
Memo:=TMemo.Create(Self);
self.bevelouter:=bvnone;
self.Font.Size :=9;
self.OnDragDrop :=self.SetOnDragDrog;
self.OnDragOver :=self.SetOnDragOver;
self.OnResize :=PanelResize;
Memo.OnDragDrop :=self.OnDragDrop;
Memo.OnDragOver :=self.OnDragOver;
Memo.OnMouseMove :=DoMemoMouseMove;
Memo.Alignment :=taCenter;
Memo.Font.Size :=self.Font.Size;
Memo.Font.color:=self.Font.color;
Memo.Parent:=self;
memo.Align :=Alclient;
Memo.ReadOnly :=true;
Memo.SetSubComponent(True);
Memo.ScrollBars :=ssnone;
statusbar:=tstatusbar.create(self);
statusbar.Parent :=self;
statusbar.Align :=alBottom;
with statusbar.Panels.Adddo
//层
begin
Alignment :=taCenter;
width:=25;
end;
with statusbar.Panels.Adddo
//X
begin
width:=15;
text:='X';
Alignment :=taCenter;
Bevel:=pbNone;
end;

with statusbar.Panels.Adddo
//长
begin
width:=25;
Alignment :=taCenter;
end;

with statusbar.Panels.Adddo
//X
begin
width:=15;
text:='X';
Alignment :=taCenter;
Bevel:=pbNone;
end;

with statusbar.Panels.Adddo
//宽
begin
width:=25;
Alignment :=taCenter;
end;

with statusbar.Panels.Adddo
//其他
begin
width:=500;
Alignment :=taCenter;
end;

with statusbar.Panels.Adddo
//理论层
begin
width:=0;
Alignment :=taCenter;
end;
with statusbar.Panels.Adddo
//理论长
begin
width:=0;
Alignment :=taCenter;
end;
with statusbar.Panels.Adddo
//理论宽
begin
width:=0;
Alignment :=taCenter;
end;
with statusbar.Panels.Adddo
//其他
begin
width:=0;
Alignment :=taCenter;
end;
with statusbar.Panels.Adddo
//商品编码
begin
width:=0;
Alignment :=taCenter;
end;
with statusbar.Panels.Adddo
//商品名称
begin
width:=0;
Alignment :=taCenter;
end;
with statusbar.Panels.Adddo
//货位高
begin
width:=0;
Alignment :=taCenter;
end;


end;

destructor TMypanel.Destroy;
begin
inherited;
end;

procedure Register;
begin
RegisterComponents('Standard', [TMypanel]);
end;


end.
 
To thjie
以上是我控件原代码，但一些事件无法写到调用窗体中，故直接写在了控件中。很不规范。
打印的我照你的代码试试吧。
 
您必须登录或注册才可回复。

Similar threads

S
如何在屏幕上显示出与实际纸张大小相同的图像，并打印出来(50分)
回复
8
查看
362
slunar
S
后退
顶部