其他分享
首页 > 其他分享> > delphi打印实现(节选)

delphi打印实现(节选)

作者:互联网

原文链接:http://www.cnblogs.com/tran/archive/2006/08/15/477943.html

........

........

{$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.

转载于:https://www.cnblogs.com/tran/archive/2006/08/15/477943.html

标签:begin,end,mm,delphi,打印,节选,TmpQry,FieldValues,MyCanvas
来源: https://blog.csdn.net/weixin_30340617/article/details/97495286