⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 print_lens.pas

📁 精确套打与机械图纸生成, 包含了所有源码, 可供朋友们打印方面的参考
💻 PAS
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
begin
  begin
    SetPaperHeight(297);
    SetPaperWidth(210);
    Printer.Canvas.Brush.Style := bsclear;
    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);
    with Printer do
    begin
      Printer.Title:=ID;
      BeginDoc;
     _DrawingLens(r1,r2,t,d,s,D1,Nd,Vd,Newton_r1,Newton_R2,E,C,Mat_Cn,Mat_Hoya,Id,Mc,Date,Film_R1,Film_R2);
     EndDoc;
    end;
  end;
end;//--------------------------------输出透镜图结束----------------------------

procedure TForm1.Button1Click(Sender: TObject);
var
  r1,r2,t,d,S,D1,Nd,Vd,Newton_r1,Newton_r2,E,C:Real;
  Mat_Cn,Mat_Hoya,Id,Mc,Date,Film_R1,Film_R2:String;
  KK:Integer;
begin
  if PrintDialog1.Execute then
  begin
    Printer.Title:=ID;
    ADOQuery1.First;
    while Not ADOQuery1.Eof do
    begin

      r1:=ADOQuery1.FieldValues['R1'];
      r2:=ADOQuery1.FieldValues['R2'];
      d:=ADOQuery1.FieldValues['D'];
      t:=ADOQuery1.FieldValues['t'];
      Vd:=ADOQuery1.FieldValues['Vd_China'];
      Nd:=ADOQuery1.FieldValues['Nd_China'];

      ID:=VarToStr(ADOQuery1.FieldValues['ID']);
      MC:=VarToStr(ADOQuery1.FieldValues['MC']);
      Mat_CN:=VarToStr(ADOQuery1.FieldValues['Type_China']);
      Mat_HOYA:=VarToStr(ADOQuery1.FieldValues['Type_Hoya']);
      D1:=27;
      Newton_r1:=5;
      Newton_r2:=5;
      E:=5;
      C:=0.2;
      Date:='20021024';
      Film_R1:='多层膜';
      Film_R2:='S53';
      Nd:=1.516797;
      Vd:=64.2;
       s:=2;

      ADOQuery1.Next;
          r1:=-420.7;
      r2:=80;
      t:=2;
      d:=30;
      s:=2;
      D1:=27;
      Nd:=1.516797;
      Vd:=64.2;
      Newton_r1:=5;
      Newton_r2:=5;
      E:=5;
      C:=0.2;
      Mat_Cn:='K9L';
      Mat_Hoya:='BSC7';
      Id:='AF01-0503-13';
      Mc:='物镜第四透镜';
      Date:='20021024';
      Film_R1:='多层膜';
      Film_R2:='S53';

      _LENS(r1,r2,t,d,s,D1,Nd,Vd,Newton_r1,Newton_R2,E,C,Mat_Cn,Mat_Hoya,Id,Mc,Date,Film_R1,Film_R2);
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  r1,r2,t,d,S,D1,Nd,Vd,Newton_r1,Newton_r2,E,C:Real;
  Mat_Cn,Mat_Hoya,Id,Mc,Date,Film_R1,Film_R2:String;
  LogRec: TLOGFONT;
  OldFont, NewFont: HFONT;
  k,i: LongInt;
  PageSize:Tpoint;
  PointX,PointY:Integer;   //英寸
  DateStr,st:String;
  Date1:TDate;
begin
  if PrintDialog1.Execute then
  begin
    SetPaperHeight(297);
    SetPaperWidth(210);
    Printer.Canvas.Brush.Style := bsclear;
    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);
    with Printer do
    begin
      Printer.Title:='LensDrawings';
      BeginDoc;
      ADOQuery1.First;
      while Not ADOQuery1.Eof do
      begin
        r1:=ADOQuery1.FieldValues['R1'];
        r2:=ADOQuery1.FieldValues['R2'];
        d:=ADOQuery1.FieldValues['D'];
        t:=ADOQuery1.FieldValues['t'];
        d1:=ADOQuery1.FieldValues['D1']*2;

        ID:=VarToStr(ADOQuery1.FieldValues['ID']);
        MC:=VarToStr(ADOQuery1.FieldValues['MC']);
        Mat_CN:=VarToStr(ADOQuery1.FieldValues['Type_China']);
        Mat_HOYA:=VarToStr(ADOQuery1.FieldValues['Type_Hoya']);
        Newton_r1:=ADOQuery1.FieldValues['Newton_R1'];
        Newton_r2:=ADOQuery1.FieldValues['Newton_R2'];
        E:=ADOQuery1.FieldValues['E'];
        C:=ADOQuery1.FieldValues['C'];
        Film_R1:=VarToStr(ADOQuery1.FieldValues['Film_R1']);
        Film_R2:=VarToStr(ADOQuery1.FieldValues['Film_R2']);
        S:=ADOQuery1.FieldValues['S'];

        Date1:=ADOQuery1.FieldValues['Date'];
        Date:=IntToStr(yearOf(Date1))+Copy(IntToStr(100+MonthOf(Date1)),2,2)+Copy(IntToStr(100+DayOf(Date1)),2,2);

        if length(VarToStr(ADOQuery1.FieldValues['Vd_China']))<>0 then
           Vd:=ADOQuery1.FieldValues['Vd_China']
        else Vd:=0;


        if length(VarToStr(ADOQuery1.FieldValues['Nd_China']))<>0 then
           Nd:=ADOQuery1.FieldValues['Nd_China']
        else Nd:=0;

        If ADOQuery1.RecNo>1 then Printer.NewPage;
        _DrawingLens(r1,r2,t,d,s,D1,Nd,Vd,Newton_r1,Newton_R2,E,C,Mat_Cn,Mat_Hoya,Id,Mc,Date,Film_R1,Film_R2);
        if Not ADOQuery1.Eof then ADOQuery1.Next;


     end;
     EndDoc;
    end;
  end;
end;//--------------------------------输出透镜图结束----------------------------


procedure _mxz();
var
 i,j,k:integer;
begin
 Printer.Canvas.Pen.Color:=clGreen;     //-------设置色彩

 point1.X:=0;   //------------输出表头横线 (左边)
 point1.Y:=0;
 move(67,11);
 line(30,0,0.09);
 move(-30,4);
 line(30,0,0.09);
 move(-30,4);
 line(30,0,0.09);
 move(7,1);    //----------------表头下画线(中间)
 line(85,0,0.09);
 move(-85,0.5);
 line(85,0,0.09);

 point1.X:=0;   //------------输出表头横线(右边)
 point1.Y:=0;
 move(206,13);
 line(10,0,0.09);
 move(-10,4);
 line(10,0,0.09);
 move(-10,4);
 line(30,0,0.09);
 move(10,0);
 line(10,0,0.09);

 move(-32,-8);
 line(10,0,0.09);
 move(-10,4);
 line(32,0,0.09);


 point1.X:=0;   //------------输出横线
 point1.Y:=0;
 move(28,23);
 line(233,0,0.09);
 move(-233,0.5);
 line(233,0,0.09);

 move(-168,6.5);
 line(168,0,0.09);

 move(-233,5);
 line(12,0,0.09);
 move(53,1);
 for i:=0 to 2 do
 begin
   move(22,0);
   line(34,0,0.09);
 end;

 for i:=0 to 20 do
 begin
   move(-233,7);
   if (i mod 5)=0 then
     line(233,0,0.3)
   else
     line(233,0,0.09);
 end;

 point1.X:=0;   //------------输出竖线
 point1.Y:=0;
 move(28,23);
 k:=163;  //竖线高度
 line(0,k,0.09);
 move(0.5,-k);
 line(0,k,0.09);

 move(11.5,-k);
 line(0,k,0.09);

 move(10.5,-k);
 line(0,k,0.09);
 move(0.5,-k);
 line(0,k,0.09);

 move(41.5,-k);
 line(0,k,0.09);
 move(0.5,-k);
 line(0,k,0.09);

 for i:=0 to 1 do
 begin
   move(55.5,-k);
   line(0,k,0.09);
    move(0.5,-k);
   line(0,k,0.09);
 end;


 point1.X:=0;   //------------输出竖线
 point1.Y:=0;
 move(28,23);
 move(6,12);
 k:=k-12;
 line(0,k,0.09);
 move(58,0);
 k:=k+5;

 for i:=0 to 2 do
 begin
   move(12,-k);
   line(0,k,0.09);
   move(10.5,-k);
   line(0,k,0.09);
   move(0.5,-k);
   line(0,k,0.09);
   k:=k-6;
   for j:=1 to 10 do
   begin
     move(3,-k);
     if (j mod 3)=0 then
      line(0,k,0.3)
     else line(0,k,0.09);
   end;
   k:=k+6;
   move(3,0);
 end;

 Printer.Canvas.Pen.Color:=clBlack;     //-------恢复色彩
end;

procedure _mxzTxt();
var
  FontName:String;
  i,j:Integer;
  k:real;
begin
   Printer.Canvas.Font.Color:=clGreen;     //-------设置色彩

   _OutTxt(145,11,  '明 细 账',8,'黑体');
   FontName:='宋体';
   _OutTxt(52, 8,  '最高存量',3,FontName);
   _OutTxt(52,12,  '最低存量',3,FontName);
   _OutTxt(52,16,  '存放地点',3,FontName);

   _OutTxt(198,10,  '帐号',3,FontName);
   _OutTxt(198,14,  '种类',3,FontName);
   _OutTxt(198,18,  '规格',3,FontName);
   _OutTxt(217,10,  '页数',3,FontName);
   _OutTxt(217,14,  '品名',3,FontName);
   _OutTxt(235,10,  '总页数',3,FontName);
   _OutTxt(238,18,  '单位',3,FontName);

   _OutTxt(36,28,  '年',3,FontName);
   _OutTxt(42.5,26,  '凭单',3,FontName);

   _OutTxt(108,26,  '收',3,FontName);
   _OutTxt(130,26,  '入',3,FontName);
   _OutTxt(164,26,  '发',3,FontName);
   _OutTxt(181,26,  '出',3,FontName);
   _OutTxt(219,26,  '结',3,FontName);
   _OutTxt(242,26,  '存',3,FontName);

   _OutTxt(30,37,  '月',3,FontName);
   _OutTxt(35.5,37,  '日',3,FontName);
   _OutTxt(42.5,37,  '号数',3,FontName);

   _OutTxt(60,31,  '摘',3,FontName);
   _OutTxt(82,31,  '要',3,FontName);

   for i:=0 to 2 do
   begin
     k:=92+56*i;
     _OutTxt(K+2,35,  '数  量',3,FontName);
     _OutTxt(K+13,35,  '单 价',3,FontName);
     _OutTxt(K+33,31,  '金    额',3,FontName);
     _OutTxt(K+23,38,  '亿千百十万千百十元角分',3,FontName);
   end;
   Printer.Canvas.Font.Color:=clBlack;     //-------恢复色彩
end;


procedure _mxzFillTxt(fill:Integer);
begin
    if fill=2 then
    begin
      _OutTxt(110,7,  VarToStr(Form1.ADOQuery2.FieldValues['FZMC']),8,'黑体');
      _OutTxt(225,6,  VarToStr(Form1.ADOQuery2.FieldValues['序号']),3,'Times New Roman');
      _OutTxt(200,11,  VarToStr(Form1.ADOQuery2.FieldValues['类别']),3,'黑体');
      _OutTxt(225,11,  VarToStr(Form1.ADOQuery2.FieldValues['名称']),3,'黑体');
      _OutTxt(200,17,  VarToStr(Form1.ADOQuery2.FieldValues['规格']),3,'黑体');
      _OutTxt(245,17,  VarToStr(Form1.ADOQuery2.FieldValues['单位']),3,'黑体');
      _OutTxt(27,28,  '2003',3,'Times New Roman');
      _OutTxt(28,46,  '10',3,'Times New Roman');
      _OutTxt(33.5,46,  '21',3,'Times New Roman');
      _OutTxt(211,46,  VarToStr(Form1.ADOQuery2.FieldValues['数量']),3,'Times New Roman');
    end
    else
    begin
      _OutTxt(110,11,  VarToStr(Form1.ADOQuery2.FieldValues['FZMC']),8,'黑体');
      _OutTxt(225,10,  VarToStr(Form1.ADOQuery2.FieldValues['序号']),3,'Times New Roman');
      _OutTxt(205,14,  VarToStr(Form1.ADOQuery2.FieldValues['类别']),3,'黑体');
      _OutTxt(225,14,  VarToStr(Form1.ADOQuery2.FieldValues['名称']),3,'黑体');
      _OutTxt(205,18,  VarToStr(Form1.ADOQuery2.FieldValues['规格']),3,'黑体');
      _OutTxt(245,18,  VarToStr(Form1.ADOQuery2.FieldValues['单位']),3,'黑体');
      if fill=0 then
        _OutTxt(30,28,  '2003',3,'Times New Roman')
      else
        _OutTxt(30,26.5,  '2003',3,'Times New Roman');
      _OutTxt(30,45,  '10',3,'Times New Roman');
      _OutTxt(35,45,  '21',3,'Times New Roman');
      _OutTxt(210,45,  VarToStr(Form1.ADOQuery2.FieldValues['数量']),3,'Times New Roman');
    end;
end;

procedure _FormActivate();
var
  FirstTickCount : real;
begin
  FirstTickCount := GetTickCount;
  Repeat
    Application.ProcessMessages;
  Until ((GetTickCount - FirstTickCount) >= LongInt (1000)); //显示启动封面 3秒钟的时间
end;

procedure _OutMxz(Part,PCount,Fill:Integer);
var
  LogRec: TLOGFONT;
  OldFont, NewFont: HFONT;
  k,i: LongInt;
  PageSize:Tpoint;
  PointX,PointY:Integer;   //英寸
  st:String;
  m:Integer;
begin
  if form1.PrintDialog1.Execute then
  begin
    Printer.Title:='d';
    SetPaperHeight(267);
    SetPaperWidth(189);
    if Fill=1 then
    begin
      SetPaperHeight(267+30);
      SetPaperWidth(189+21);
    end;


    Printer.Orientation:=  poLandscape;   //设置横向打印
    Printer.Canvas.Brush.Style := bsclear;
    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);

    if Fill<>0 then
    begin
      PageTop:=PageTop-round(StrToFloat(Form1.Edit3.Text)*mm_V);
      PageLeft:=PageLeft-round(StrToFloat(Form1.Edit4.Text)*mm_H);
    end;

    if Form1.ADOQuery2.RecordCount>((Part-1)*PCount)then
     Form1.ADOQuery2.MoveBy((Part-1)*PCount);
    m:=0;
    with Printer do
    begin
      BeginDoc;
       while not Form1.ADOQuery2.Eof do
       begin
         m:=m+1;
         if m>1 then Printer.NewPage;
           if Fill=0 then
           begin
             _mxz();
             _mxzTxt();
             _Logo(40,13,15,clGreen);
             //_OutCircle();
           end;
           _mxzFillTxt(fill);
           Form1.ADOQuery2.Next;
           if m>Pcount-1 then break;
       end;
     EndDoc;
    end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  _OutMxz(StrToInt(Edit1.text),StrToInt(Edit2.Text),0);
end;//--------------------------------输出透镜图结束----------------------------


procedure TForm1.Button4Click(Sender: TObject);
begin
  _OutMxz(StrToInt(Edit1.text),StrToInt(Edit2.Text),1);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  _OutMxz(StrToInt(Edit1.text),StrToInt(Edit2.Text),2);
end;

end.
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -