........
........
{$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
Printer.PrinterIndex := Printer.PrinterIndex;
Printer.GetPrinter(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;
Printer.PrinterIndex := Printer.PrinterIndex;
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
Printer.PrinterIndex := Printer.PrinterIndex;
Printer.GetPrinter(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;
Printer.PrinterIndex := Printer.PrinterIndex;
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);
MyCanvas.Pen.Width:=IntLineWidth;
MyCanvas.Ellipse(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(Canvas.Font.Handle, SizeOf(LogRec), @LogRec);
LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;
LogRec.lfFaceName :='宋体';
LogRec.lfHeight:=round(FontSize*mm_V);
LogRec.lfWeight:=0;
NewFont := CreateFontIndirect(LogRec);
OldFont := SelectObject(Canvas.Handle,NewFont);
end;
x:=Round((x+PageLeft)*mm_H);
y:=Round((y+PageTop)*mm_V);
MyCanvas.TextOut(round(x),round(y),txt);
end; }
// 2:
begin
x:=Round((x+PageLeft)*mm_H);
y:=Round((y+PageTop)*mm_V);
MyCanvas.Font.Height:=round(FontSize*mm_V);
MyCanvas.Font.Name:=FontName;
MyCanvas.TextOut(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);
MyCanvas.MoveTo(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); //输出线宽
MyCanvas.Pen.Width:=IntLineWidth; //设置线宽
MyCanvas.LineTo(point2.X,point2.Y);
point1:=point2;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
TmpQry : TADOQuery;
begin
MyCanvas:=Image1.Canvas;
ADOCOnnection1.Connected := false;
ADOConnection1.ConnectionString :='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+GetCurrentDir()+'\data.mdb;Persist Security Info=False';
ADOCOn:=ADOConnection1;
ADOTable1.Active := true;
TmpQry := OpenDB('select * from report order by ID',ADOCon);
ComboBox1.Items.Clear;
SetLength(TabIds,TmpQry.RecordCount);
while not TmpQry.Eof do
begin
ComboBox1.Items.Add(VarToStr(TmpQry.FieldValues['Title']));
TabIds[TmpQry.RecNo-1]:=TmpQry.FieldValues['id'];
TmpQry.Next;
end;
if ComboBox1.Items.Count>0 then ComboBox1.ItemIndex :=0;
TmpQry.Free
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 TmpQry.Eof do
begin
x1 := TmpQry.FieldValues['x1'];
y1 := TmpQry.FieldValues['y1'];
w := TmpQry.FieldValues['width'];
if not TmpQry.FieldValues['relatively'] then recover; //若非相对坐村,恢复原点
ClassId := TmpQry.FieldValues['ClassId'];
case ClassId of
1 : begin //标签
txt := VarToStr(TmpQry.FieldValues['text']);
if not TmpQry.FieldByName('FontSize').IsNull then
FontSize := TmpQry.FieldValues['FontSize']
else FontSize := 2.5;
if not TmpQry.FieldByName('FontName').IsNull then
FontName:=TmpQry.FieldValues['FontName']
else FontName:='宋体';
MyCanvas.Font.Style:=[];
if TmpQry.FieldValues['FontBold'] then
MyCanvas.Font.Style:=[fsBold];
_outTxt(x1,y1,txt,FontSize,FontName);
end;
2 : begin //直线
x2 := TmpQry.FieldValues['x2'];
y2 := TmpQry.FieldValues['y2'];
_line(x1,y1,x2,y2,w);
end;
3 : begin //圆
r := TmpQry.FieldValues['r'];
_circle(x1,y1,r,w);
end;
4 : begin //字段
if not TmpQry.FieldByName('text').IsNull then
begin
if not TmpQry1.FieldByName(TmpQry.FieldValues['text']).IsNull then
begin
txt := VarToStr(TmpQry1.FieldValues[TmpQry.FieldValues['text']]);
if not TmpQry.FieldByName('FontSize').IsNull then
FontSize := TmpQry.FieldValues['FontSize']
else FontSize := 2.5;
if not TmpQry.FieldByName('FontName').IsNull then
FontName:=TmpQry.FieldValues['FontName']
else FontName:='宋体';
MyCanvas.Font.Style:=[];
if TmpQry.FieldValues['FontBold'] then
MyCanvas.Font.Style:=[fsBold];
TmpColor := MyCanvas.Font.Color;
MyCanvas.Font.Color := clBlack;
_outTxt(x1,y1,txt,FontSize,FontName);
MyCanvas.Font.Color := TmpColor;
end;
end;
end;
end;
TmpQry.Next;
end;
TmpQry.Free;
end;
procedure _init(PageSize:TPoint);
begin
case PrnMode of
1: begin
PhysicalWidth:=PageSize.x; //物理页宽
PhysicalHeight:=PageSize.Y; //物理页高
PageWidth:=printer.PageWidth; //逻辑页宽
PageHeight:=printer.PageHeight; //逻辑页高
end;
2: begin
PageWidth:=PhysicalHeight; //逻辑页宽
PageHeight:=PhysicalHeight; //逻辑页高
end;
end;
end;
//---------------------------------------------------------------------------------
procedure TForm1.OutPut(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 := ComboBox1.ItemIndex+1; //报表号
Sql := 'select * from report where id='+IntToStr(TabId);
TmpQry := OpenDb(Sql,ADOCon);
if not TmpQry.Eof then
begin
PaperW := TmpQry.FieldValues['PaperWidth'];
paperH := TmpQry.FieldValues['PaperHeight'];
Sql := VarToStr(TmpQry.FieldValues['Sql']);
if not ADOTable1.Eof then
sql := _replace(sql,'@id@',VarToStr(ADOTable1.FieldValues['id']))
else sql :='';
PrintDialog1:=TPrintDialog.Create(nil);
PageLeft := TmpQry.FieldValues['Left'];
PageTop := TmpQry.FieldValues['Top'];
case PrnMode of
1: begin
if PrintDialog1.Execute then
begin
SetPaperHeight(paperH);
SetPaperWidth(PaperW);
Escape(Printer.Handle, GETPHYSPAGESIZE, 0,nil,@PageSize); //取得物理页尺寸
PointX:=GetDeviceCaps(Printer.Handle,LOGPIXELSX);
PointY:=GetDeviceCaps(Printer.Handle,LOGPIXELSY);
mm_H:=PointX/25.4;
mm_V:=PointY/25.4;
_Init(PageSize);
Printer.Title:=VarToStr(TmpQry.FieldValues['title']);
MyCanvas := Printer.Canvas;
Printer.BeginDoc;
MyCanvas.Brush.Color:=clBlue;
MyCanvas.Brush.Style := bsclear;
MyCanvas.Pen.Color:=clGreen;
MyCanvas.Font.Color := clGreen;
Zoom:=TmpQry.FieldValues['Zoom'];
mm_H := mm_H*zoom;
mm_V := mm_V*zoom;
_Grid(TabId,Sql,Grid,data);
Printer.EndDoc;
end;
end;
2: begin
mm_H:=2;
mm_V:=2;
Zoom := ComboBox2.ItemIndex+2 ; //全局缩放比例
mm_H := mm_H*zoom;
mm_V := mm_V*zoom;
Image1.Picture.Graphic.Width := 1;
Image1.Picture.Graphic.Height := 1;
Image1.Width := Image1.Picture.Graphic.Width;
Image1.Height := Image1.Picture.Graphic.Height;
Image1.Picture.Graphic.Width := round(PaperW*mm_H);
Image1.Picture.Graphic.Height := round(PaperH*mm_V);
Image1.Width := Image1.Picture.Graphic.Width;
Image1.Height := Image1.Picture.Graphic.Height;
Image1.Top:=10-ScrollBox1.VertScrollBar.Position;
if Image1.Width+10>ScrollBox1.Width then
Image1.Left:=0-ScrollBox1.HorzScrollBar.Position+2
else
Image1.Left:=((ScrollBox1.Width-Image1.Width) div 2)-8
-ScrollBox1.HorzScrollBar.Position;
Image1.Canvas.Brush.Style := bsSolid;// ---------清除预览画布上的残像
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Rectangle(0,0,PageWidth,PageHeight);
Shape1.Top:=Image1.Top+10;
Shape1.Left:=Image1.Left+10;
Shape1.Width:=Image1.Width;
Shape1.Height:=Image1.Height;
Shape1.Visible:=True;
Image1.Visible := true;
MyCanvas.Brush.Color :=clWhite;
MyCanvas.FillRect(MyCanvas.ClipRect); //清除残留影像
MyCanvas:=Image1.Canvas;
MyCanvas.Brush.Color:=clBlue;
MyCanvas.Brush.Style := bsclear;
MyCanvas.Pen.Color:=clGreen;
MyCanvas.Font.Color := clGreen;
Zoom:=TmpQry.FieldValues['Zoom'];
mm_H := mm_H*zoom;
mm_V := mm_V*zoom;
_Grid(TabId,Sql,Grid,data);
end;
end;
end;
TmpQry.free;
end;
//-----------------------------------------------------------------------------------
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Start_Point.X:=x;
Start_Point.Y:=y;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ScrollBox1.HorzScrollBar.Position:= ScrollBox1.HorzScrollBar.Position+(Start_Point.X-x);
ScrollBox1.VertScrollBar.Position:= ScrollBox1.VertScrollBar.Position+(Start_Point.Y-y);
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
OutPut(1,checkBox1.Checked,checkBox2.Checked);
end;
procedure TForm1.ToolButton2Click(Sender: TObject);
begin
OutPut(2,checkBox1.Checked,checkBox2.Checked);
end;
procedure TForm1.DBEdit10Change(Sender: TObject);
begin
DBText1.caption := NumToChnStr(StrToFloat(DBEdit10.Text),false);
end;
procedure TForm1.DBEdit12Change(Sender: TObject);
begin
DBText2.caption := NumToChnStr(StrToFloat(DBEdit12.Text),false);
end;
procedure TForm1.ADOTable1BeforePost(DataSet: TDataSet);
begin
ADOTable1.FieldValues['cn_price'] := NumToChnStr(StrToFloat(DBEdit12.Text),false);
ADOTable1.FieldValues['cn_rate'] := NumToChnStr(StrToFloat(DBEdit12.Text),false);
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
if ADOTable1.State = dsEdit then ADOTable1.Post;
ToolButton2.Click;
end;
procedure TForm1.Shape1ContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
begin
end;
procedure TForm1.TabSheet2ContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
begin
end;
end.
111
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
