2023年12月27日发(作者：)

delphi打印实现(节选)

........

........

{$R *.dfm}

procedure SetPaperHeight(Value:integer); //设置纸张高度-单位：mm

var

Device : array[0..255] of char;

Driver : array[0..255] of char;

Port : array[0..255] of char;

hDMode : THandle;

PDMode : PDEVMODE;

begin

if Value < 127 then Value := 127; //自定义纸张最小高度127mm

if Value > 432 then Value := 432; //自定义纸张最大高度432mm

rIndex := rIndex;

nter(Device, Driver, Port, hDMode);

if hDMode <> 0 then

begin

pDMode := GlobalLock(hDMode);

if pDMode <> nil then

begin

pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE or

DM_PAPERLENGTH;

pDMode^.dmPaperSize := DMPAPER_USER;

pDMode^.dmPaperLength := Value * 10;

pDMode^.dmFields := pDMode^.dmFields or DMBIN_MANUAL;

pDMode^.dmDefaultSource := DMBIN_MANUAL;

GlobalUnlock(hDMode);

end;

end;

rIndex := rIndex;

end;

procedure SetPaperWidth(Value:integer); //设置纸张宽度：单位--mm

var

Device : array[0..255] of char;

Driver : array[0..255] of char;

Port : array[0..255] of char;

hDMode : THandle;

PDMode : PDEVMODE;

begin

if Value < 76 then Value := 76; //自定义纸张最小宽度76mm

if Value > 216 then Value := 216; //自定义纸张最大宽度216mm

rIndex := rIndex;

nter(Device, Driver, Port, hDMode);

if hDMode <> 0 then

begin

pDMode := GlobalLock(hDMode);

if pDMode <> nil then

begin

pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE or

DM_PAPERWIDTH;

pDMode^.dmPaperSize := DMPAPER_USER;

pDMode^.dmPaperWidth := Value * 10; //将毫米单位转换为0.1mm单位

pDMode^.dmFields := pDMode^.dmFields or DMBIN_MANUAL;

pDMode^.dmDefaultSource := DMBIN_MANUAL;

GlobalUnlock(hDMode);

end;

end;

rIndex := rIndex;

end;

//======================================绘基础几何图型函======================

//--------------------圆--------------------------------------------------------

procedure _Circle(x,y,r,N:real);

var

IntLineWidth:Integer;

begin

x:=x*mm_H;

y:=y*mm_V;

r:=r*mm_H;

IntLineWidth:=Round(N*mm_H);

:=IntLineWidth;

e(round(x-r),round(y-r),round(x+r),round(y+r));

end;

function _outTxt(x,y:Real;Txt:String;FontSize:Real;FontName:String):Boolean;

var

LogRec: TLOGFONT;

OldFont, NewFont: HFONT;

i: LongInt;

begin

数

// case PrnMode of

{ 1: begin

with printer do

begin

GetObject(, SizeOf(LogRec), @LogRec);

recision := OUT_TT_ONLY_PRECIS;

Name :='宋体';

ht:=round(FontSize*mm_V);

ht:=0;

NewFont := CreateFontIndirect(LogRec);

OldFont := SelectObject(,NewFont);

end;

x:=Round((x+PageLeft)*mm_H);

y:=Round((y+PageTop)*mm_V);

t(round(x),round(y),txt);

end; }

// 2:

begin

x:=Round((x+PageLeft)*mm_H);

y:=Round((y+PageTop)*mm_V);

:=round(FontSize*mm_V);

:=FontName;

t(round(x),round(y),txt);

end;

// end;

end;

//移动坐标点

procedure _Move(x,y:Real);

begin

Point1.X:=point1.X+round(x*mm_H);

point1.Y:=Point1.Y+round(y*mm_V);

(point1.X,point1.Y);

end;

procedure _line(x1,y1,x2,y2,LineWidth:Real);

var

point2:TPoint;

IntLineWidth:Integer;

begin

// if x1+y1<>0 then

_move(x1,y1); //移动到起点坐标

point2.X:=Point1.X+round(x2*mm_H);

point2.Y:=Point1.Y+round(y2*mm_V);

IntLineWidth:=Round(LineWidth*mm_H); //输出线宽

:=IntLineWidth; //设置线宽

(point2.X,point2.Y);

point1:=point2;

end;

procedure eate(Sender: TObject);

var

TmpQry : TADOQuery;

begin

MyCanvas:=;

ted := false;

tionString :='Provider=.4.0;Data

Source='+GetCurrentDir()+';Persist Security Info=False';

ADOCOn:=ADOConnection1;

:= true;

TmpQry := OpenDB('select * from report order by ID',ADOCon);

;

SetLength(TabIds,Count);

while not do

begin

(VarToStr(alues['Title']));

TabIds[-1]:=alues['id'];

;

end;

if >0 then dex :=0;

end;

procedure recover;

begin

point1.X := round(PageLeft*mm_H);

point1.Y := round(PageTop*mm_V);

end;

procedure _Grid(Id:Integer;Sql:String;Grid,Data:Boolean);

var

TmpQry,TmpQry1 : TADOQuery;

x1,y1,x2,y2,r,w,FontSize:real;

txt : String;

classId : Integer;

FontName : TFontName ; //显示使用的字体

TmpColor:TColor;

begin

if Sql<>'' then TmpQry1 := OpenDB(sql,ADOCon);

Sql := 'select * from TableLib where hidden=0 and tabId='+IntToStr(Id);

if (not Grid) and (data) then sql:=sql+' and classId=4';

if (grid) and (not data) then sql:=sql+' and classId<>4';

TmpQry := OpenDB(Sql,ADOCon);

while not do

begin

x1 := alues['x1'];

y1 := alues['y1'];

w := alues['width'];

if not alues['relatively'] then recover; //若非相对坐村,恢复原点

ClassId := alues['ClassId'];

case ClassId of

1 : begin //标签

txt := VarToStr(alues['text']);

if not yName('FontSize').IsNull then

FontSize := alues['FontSize']

else FontSize := 2.5;

if not yName('FontName').IsNull then

FontName:=alues['FontName']

else FontName:='宋体';

:=[];

if alues['FontBold'] then

:=[fsBold];

_outTxt(x1,y1,txt,FontSize,FontName);

end;

2 : begin //直线

x2 := alues['x2'];

y2 := alues['y2'];

_line(x1,y1,x2,y2,w);

end;

3 : begin //圆

r := alues['r'];

_circle(x1,y1,r,w);

end;

4 : begin //字段

if not yName('text').IsNull then

begin

if not yName(alues['text']).IsNull then

begin

txt := VarToStr(alues[alues['text']]);

if not yName('FontSize').IsNull then

FontSize := alues['FontSize']

else FontSize := 2.5;

if not yName('FontName').IsNull then

FontName:=alues['FontName']

else FontName:='宋体';

:=[];

if alues['FontBold'] then

:=[fsBold];

TmpColor := ;

:= clBlack;

_outTxt(x1,y1,txt,FontSize,FontName);

:= TmpColor;

end;

end;

end;

end;

;

end;

;

end;

procedure _init(PageSize:TPoint);

begin

case PrnMode of

1: begin

PhysicalWidth:=PageSize.x;

PhysicalHeight:=PageSize.Y;

PageWidth:=dth;

PageHeight:=ight;

end;

2: begin

PageWidth:=PhysicalHeight;

PageHeight:=PhysicalHeight;

end;

end;

end;

//---------------------------------------------------------------------------------

procedure (PrnMode:Integer;Grid,data:Boolean);

var

PaperW,PaperH:integer;

PrintDialog1:TPrintDialog;

LogRec: TLOGFONT;

OldFont, NewFont: HFONT;

//物理页宽

//物理页高

//逻辑页宽

//逻辑页高

//逻辑页宽 //逻辑页高

PageSize:Tpoint;

pw,ph,PointX,PointY:Integer; //纸张设置

TabId : Integer;

TmpQry :TADOQuery;

Sql:String;

begin

TabId := dex+1; //报表号

Sql := 'select * from report where id='+IntToStr(TabId);

TmpQry := OpenDb(Sql,ADOCon);

if not then

begin

PaperW := alues['PaperWidth'];

paperH := alues['PaperHeight'];

Sql := VarToStr(alues['Sql']);

if not then

sql := _replace(sql,'@id@',VarToStr(alues['id']))

else sql :='';

PrintDialog1:=(nil);

PageLeft := alues['Left'];

PageTop := alues['Top'];

case PrnMode of

1: begin

if e then

begin

SetPaperHeight(paperH);

SetPaperWidth(PaperW);

Escape(, GETPHYSPAGESIZE, 0,nil,@PageSize);

理页尺寸

PointX:=GetDeviceCaps(,LOGPIXELSX);

PointY:=GetDeviceCaps(,LOGPIXELSY);

mm_H:=PointX/25.4;

mm_V:=PointY/25.4;

_Init(PageSize);

:=VarToStr(alues['title']);

MyCanvas := ;

oc;

:=clBlue;

:= bsclear;

:=clGreen;

:= clGreen;

Zoom:=alues['Zoom'];

//取得物

mm_H := mm_H*zoom;

mm_V := mm_V*zoom;

_Grid(TabId,Sql,Grid,data);

;

end;

end;

2: begin

mm_H:=2;

mm_V:=2;

Zoom := dex+2 ; //全局缩放比例

mm_H := mm_H*zoom;

mm_V := mm_V*zoom;

:= 1;

:= 1;

:= ;

:= ;

:= round(PaperW*mm_H);

:= round(PaperH*mm_V);

:= ;

:= ;

:=on;

if +10> then

:=on+2

else

:=(() div 2)-8

-on;

:= bsSolid;// ---------清除预览画布上的残像

:=clWhite;

:=clWhite;

gle(0,0,PageWidth,PageHeight);

:=+10;

:=+10;

:=;

:=;

e:=True;

e := true;

:=clWhite;

ct(ct); //清除残留影像

MyCanvas:=;

:=clBlue;

:= bsclear;

:=clGreen;

:= clGreen;

Zoom:=alues['Zoom'];

mm_H := mm_H*zoom;

mm_V := mm_V*zoom;

_Grid(TabId,Sql,Grid,data);

end;

end;

end;

;

end;

//-----------------------------------------------------------------------------------

procedure 1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

Start_Point.X:=x;

Start_Point.Y:=y;

end;

procedure 1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

on:= on+(Start_Point.X-x);

on:= on+(Start_Point.Y-y);

end;

procedure tton1Click(Sender: TObject);

begin

OutPut(1,d,d);

end;

procedure tton2Click(Sender: TObject);

begin

OutPut(2,d,d);

end;

procedure 10Change(Sender: TObject);

begin

n := NumToChnStr(StrToFloat(),false);

end;

procedure 12Change(Sender: TObject);

begin

n := NumToChnStr(StrToFloat(),false);

end;

procedure le1BeforePost(DataSet: TDataSet);

begin

alues['cn_price'] := NumToChnStr(StrToFloat(),false);

alues['cn_rate'] := NumToChnStr(StrToFloat(),false);

end;

procedure ntrol1Change(Sender: TObject);

begin

if = dsEdit then ;

;

end;

procedure 1ContextPopup(Sender: TObject; MousePos: TPoint;

var Handled: Boolean);

begin

end;

procedure et2ContextPopup(Sender: TObject; MousePos: TPoint;

var Handled: Boolean);

begin

end;

end.

procedure PrintDbGrid(DataSet:TDataSet;DbGrid:TDbGrid;Title:String);

var

PointX,PointY:integer;

ScreenX:integer;

i,lx,ly:integer;

px1,py1,px2,py2:integer;

RowPerPage,RowPrinted:integer;

ScaleX:Real;

THeight:integer;

TitleWidth:integer;

SumWidth:integer;

PageCount:integer;

SpaceX,SpaceY:integer;

RowCount:integer;

begin

PointX:=Round(GetDeviceCaps(,LOGPIXELSX)/2.54);

PointY:=Round(GetDeviceCaps(,LOGPIXELSY)/2.54);

ScreenX:=Round(PerInch/2.54);

ScaleX:=PointX/ScreenX;

RowPrinted:=0;

SumWidth:=0;

oc;

With do

begin

eControls;

;

THeight:=Round(TextHeight('我')*2.5);//设定每行高度为字符高的1.5倍

SpaceY:= Round(TextHeight('我')/4);

SpaceX:=Round(TextWidth('我')/4);

RowPerpage:=Round((ight-5*PointY)/THeight); //上下边缘各2厘米

ly:=2*PointY;

PageCount:=0;

while not do

begin

if (RowPrinted=RowPerPage) or (RowPrinted=0) then

begin

if RowPrinted<>0 then

e;

RowPrinted:=0;

PageCount:=PageCount+1;

:='宋体';

:=16;

:=+[fsBold];

lx:=Round((dth-TextWidth(Title))/2);

ly:=2*PointY;

TextOut(lx,ly,Title);

:=11;

:=-[fsBold];

lx:=dth-5*PointX;

ly:=Round(2*PointY+0.2*PointY);

if RowPerPage*PageCount>Count then

RowCount:=Count

else

RowCount:=RowPerPage*PageCount;

TextOut(lx,ly,''+IntToStr(RowPerPage*(PageCount-1)+1)+'-'+IntToStr(RowCount)+'(Count)+'条');

lx:=2*PointX;

ly:=ly+THeight*2;

py1:=ly-SpaceY;

if RowCount=Count then

py2:=py1+THeight*(RowCount-RowPerPage*(PageCount

条，共第'+IntToStr