print_lens.pas

精确套打与机械图纸生成, 包含了所有源码, 可供朋友们打印方面的参考

//-------------------输出图纸外框---------------
  point1.X:=0;
  point1.Y:=0;
  Point1.X:=point1.X-PageLeft;
  Point1.y:=point1.y-PageTop;
  Move(25,10);
  Line(175,0,0.5);
  Line(0,277,0.5);
  Line(-175,0,0.5);
  Line(0,-277,0.5);
//-------------------Over---------------

//-------------------输出图纸变更框---------------
  point1.X:=0;
  point1.Y:=0;
  Point1.X:=point1.X-PageLeft;
  Point1.y:=point1.y-PageTop;
  Move(25,10);

  Move(0,6);
  for i:=1 to 4 do
  begin
    Line(105,0,0.2);
    Move(-105,6);
  end;
  Line(105,0,0.5);

  Move(-95,-6*i);
  Line(0,6*i,0.2);
  Move(15,-6*i);
  Line(0,6*i,0.2);
  Move(30,-6*i);
  Line(0,6*i,0.2);
  Move(40,-6*i);
  Line(0,6*i,0.2);
  Move(10,-6*i);
  Line(0,6*i,0.5);
//-------------------Voer---------------

//-------------------输出图框打孔装订参照线---------------
  point1.X:=0;
  point1.Y:=0;
  Point1.X:=point1.X-PageLeft;
  Point1.y:=point1.y-PageTop;
  Move(25,10);
  Move(-8,138.5);
  Line(8,0,0.5);
//-------------------Voer---------------

//-------------------输出图纸基本信息框---------------
  point1.X:=0;
  point1.Y:=0;
  Point1.X:=point1.X-PageLeft;
  Point1.y:=point1.y-PageTop;
  Move(25,10);

  Move(30,247);  //---------输出横线
  Line(145,0,0.5);
  Move(-93,6);
  Line(93,0,0.2);
  Move(-145,6);
  Line(78,0,0.2);
  Move(-78,6);
  Line(145,0,0.2);

  Move(-145,-18);  //---------输出竖线
  Line(0,30,0.5);
  for i:=1 to 3 do
  begin
    Move(13,-18);
    Line(0,18,0.2);
  end;
  Move(13,-30);
  Line(0,30,0.2);
  Move(13,-30);
  Line(0,12,0.2);
  Move(13,-12);
  Line(0,30,0.2);
  Move(10,-24);
  Line(0,24,0.2);
  Move(15,-30);
  Line(0,6,0.2);
//-------------------Voer-------------------------------


//-------------------输出透镜参数表框---------------
  point1.X:=0;
  point1.Y:=0;
  Point1.X:=point1.X-PageLeft;
  Point1.y:=point1.y-PageTop;
  Move(25,10);    //---------输出横线
  Move(30,247);
  Move(-30,-18);
  Line(175,0,0.5);
  Move(-175,6);
  Line(175,0,0.2);
  Move(-175,6);
  Line(117,0,0.2);

  Move(-117,6);
  Line(30,0,0.5);
  Move(-30,12);
  Line(30,0,0.2);
  Move(-30,6);
  Line(30,0,0.2);
  Move(-30,6);
  Line(30,0,0.2);
  Move(-20,-24);  //---------输出竖线
  Line(0,30,0.2);
  Move(20,-48);
  for i:=1 to 5 do
  begin
    Line(0,18,0.2);
    Move(29,-18);
  end;
//-------------------Voer-------------------------------

//-------------------输出透镜材料要求参数表框---------------
  point1.X:=0;
  point1.Y:=0;
  Point1.X:=point1.X-PageLeft;
  Point1.y:=point1.y-PageTop;
  Move(25,10);    //---------输出横线
  Move(0,35);
  Line(40,0,0.5);
  Line(0,40,0.5);
  Line(-40,0,0.5);
  Move(20,0);
  Line(0,-35,0.2);
  Move(-20,0);
  for i:=1 to 7 do
  begin
    Line(40,0,0.2);
    Move(-40,5);
  end;
  _SJ(6.88,-32.79);
  _SJ(0,5);
//-------------------Voer-------------------------------

//-------------------输出图纸变更框----三角符---------------
  point1.X:=0;
  point1.Y:=0;
  Point1.X:=point1.X-PageLeft;
  Point1.y:=point1.y-PageTop;
  Move(25,10);    //---------输出横线
  Move(5,1);
  for i:=1 to 5 do
  begin
    Line(-2.5,3.46,0.2);
    Line(5,0,0.2);
    Line(-2.5,-3.46,0.2);
    Move(9.5,2);
    Line(1,0,0.2);
    Move(4,0);
    Line(1,0,0.2);
    Move(-15.5,4);
  end;
//-------------------Voer-------------------------------
end; //-----------------------------输出图框线完成------------------------------

procedure _Logo(x,y,w:Real;Color:Tcolor); //------------生成公司标志----------------------
var
  t,s:real;
  O1,O2:Tpoint;
  O:Array[2..20] of TPoint;
  i,k:Integer;
  PenColor,BrushColor:TColor;
begin
  PenColor:=Printer.Canvas.Pen.Color;   //存储色彩
  BrushColor:=Printer.Canvas.Brush.Color;

  s:=w/30;  //缩放比例;
  t:=8.31902;  //纵横比;
  x:=x*mm_H-PageLeft;
  y:=y*mm_V-PageTop;
  O1.X:=round(x-12.5*s*mm_H);
  O1.Y:=round(y-t*s*mm_V);
  O2.X:=round(x+12.5*s*mm_H);
  O2.Y:=round(y+t*s*mm_V);


  Printer.Canvas.Pen.Width:=round(0.05*mm_H);
  Printer.Canvas.Pen.Color:=Color;

  Printer.Canvas.Brush.Style := bsSolid;//   ---------打开填充模式

  Printer.Canvas.Brush.Color:=Color;

  Printer.Canvas.Ellipse(O1.X,O1.Y,O2.X,O2.Y);

  O1.X:=round(x-t*s*mm_H);
  O1.Y:=round(y-t*s*mm_V);
  O2.X:=round(x+t*s*mm_H);
  O2.Y:=round(y+t*s*mm_V);
  Printer.Canvas.Brush.Color:=clWhite;
  Printer.Canvas.Ellipse(O1.X,O1.Y,O2.X,O2.Y);
  Printer.Canvas.Brush.Color:=Color;

  for i:=1 to 2 do
  begin
    if i=1 then K:=1 else K:=-1;  //左右镜像
    O[2].X:=round(x-k*s*15*mm_H);
    O[2].Y:=round(y+s*11.7112558*mm_V);
    O[3].X:=O[2].X+round(k*s*10*mm_H);
    O[3].Y:=O[2].Y;
    O[4].X:=O[3].X;
    O[4].Y:=O[3].Y-round(s*1*mm_V);
    O[5].X:=O[4].X-round(k*s*4.5*mm_V);
    O[5].Y:=O[4].Y;

    O[6].X:=O[5].X+round(k*s*3.0989501*mm_H);
    O[6].Y:=O[5].Y-round(s*5.3675391*mm_V);
    O[7].X:=O[6].X+round(k*s*4.8757968*mm_H);
    O[7].Y:=O[6].Y;
    O[8].X:=O[7].X;
    O[8].Y:=O[7].Y+round(s*5.3675391*mm_V);
    O[9].X:=O[8].X-round(k*s*2.25*mm_H);
    O[9].Y:=O[8].Y;
    O[10].X:=O[9].X;
    O[10].Y:=O[9].Y+round(s*1*mm_V);
    O[11].X:=round(x);
    O[11].Y:=O[10].Y;

    O[12].X:=O[11].X;
    O[12].Y:=O[11].Y-round(s*8.7942286*mm_V);
    O[13].X:=O[12].X-round(k*s*5*mm_H);
    O[13].Y:=O[12].Y;

    O[14].X:=round(x);
    O[14].Y:=O[13].Y-round(s*8.660254*mm_V);
    O[15].X:=O[14].X;
    O[15].Y:=O[14].Y-round(s*2.5757932*mm_V);

    O[16].X:=O[15].X-round(k*s*0.80521055*mm_H);
    O[16].Y:=O[15].Y+round(s*0.03906048*mm_V);

    O[17].X:=O[16].X-round(k*s*0.7976491*mm_H);
    O[17].Y:=O[16].Y+round(s*0.1089553*mm_V);

    O[18].X:=O[17].X-round(k*s*10.8971404*mm_H);
    O[18].Y:=O[17].Y+round(s*18.8744008*mm_V);
    O[19].X:=O[18].X-round(k*s*2.5*mm_H);
    O[19].Y:=O[18].Y;
    O[20].X:=O[19].X;
    O[20].Y:=O[19].Y+round(s*1*mm_V);
    Printer.Canvas.Polygon(O);
  end;
//  Printer.Canvas.Brush.Style :=
  Printer.Canvas.Pen.Color:=PenColor;      //--------恢复色彩
  Printer.Canvas.Brush.Color:=BrushColor;
  Printer.Canvas.Brush.Style := bsClear;

end;

procedure _Stamp();
begin
  _Circle(100.5-PageLeft/mm_H,281-PageTop/mm_V,5,0.3);
  _OutTxt(98,275.3, '杨',5,'经典隶书繁');
  _OutTxt(96,280, '振',5,'经典隶书繁');
  _OutTxt(100.5,280, '华',5,'经典隶书繁');
end;


procedure _FillDrawingTxt(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);
var
  LogRec: TLOGFONT;
  OldFont, NewFont: HFONT;
  Txt_Tmp,FontName:String;
  C1,C2:String;
  K,i,j:Integer;
begin
  //-----------透镜参数---------------------------------
    FontName:='Times New Roman';

    if copy(Id,6,1)='0' then        //---------------------物镜技术要求
      begin
      C1:='2B2B2 2 2 1C1B';
      C2:='1.  B=V不充许有粗麻点，粗擦痕宽度0.02～0.04；';
      C2:=c2+'#13#10'+'2.  对材料的要求按GB903-65，对零件表面疵病';
      C2:=c2+'#13#10'+'   的要求按GB1185-74。';
      end
    else                            //---------------------目镜技术要求
      begin
      C1:='3B3B2 2 2 1C2B';
      C2:='1.  B=V不充许有粗麻点，粗擦痕宽度0.02~0.04；';
      C2:=C2+'#13#10'+'2.  对材料的要求按GB903-65，对零件表面疵病';
      C2:=C2+'#13#10'+'的要求按GB1185-74。';
      end;

    for j:=1 to 7 do
    begin
      _OutTxt(52,51+(j-1)*5, copy(C1,(j-1)*2+1,2),3.5,FontName);
    end;

    _OutTxt(43,210,  '技术要求:',5,'经典仿宋繁');
    i:=1;
    c2:=c2+' '; //在尾部添加1空格，以便循环进行控制;
    for j:=1 to length(c2) do
    begin
      if (copy(c2,j,6)='#13#10') or (j=length(c2)) then
      begin
        _OutTxt(46,219+K*5,copy(c2,i,j-i),4,'经典仿宋繁');
        i:=j+6;
        K:=K+1;
      end;
    end;

    _OutTxt(31,246.5,  'R1='+FloatToStr(r1),3,FontName);
    _OutTxt(31,252.5,  'R2='+FloatToStr(r2),3,FontName);
    _OutTxt(66,246.5,  'N≤'+FloatToStr(Newton_r1),3,'宋体');
    _OutTxt(66,252.5,  'N≤'+FloatToStr(Newton_r2),3,'宋体');

    if Nd<>0 then
         _OutTxt(176,247,  'Nd='+FloatToStr(Nd),3,FontName)
    else
         _OutTxt(176,247,  'Nd= *',3,FontName);

    if Vd<>0 then
         _OutTxt(176,251,  'Vd='+FloatToStr(Vd),3,FontName)
    else _OutTxt(176,251,  'Vd= *',3,FontName);

    _OutTxt(40,261.5,  '(C=0.03)',3,FontName);
    _OutTxt(44,270,  FloatToStr(E)+'''',3,FontName);

    Txt_Tmp:=FloatToStr(round(_FocalLength(r1,r2,nD,t,0)*100)/100);
    if Txt_Tmp='0' then Txt_Tmp:='*';

    _OutTxt(45-length(Txt_Tmp)*1.8/2,276,Txt_Tmp,3,FontName);

    _OutTxt(43,282,  FloatToStr(C),3,FontName);

    _OutTxt(111,264,  FloatToStr(S)+' : '+'1',4,FontName);

    Txt_Tmp:=  Mat_Cn+'(China)';
    _OutTxt(120-Length(Txt_Tmp)*1.4/2,277,Txt_Tmp,3,FontName);

    Txt_Tmp:=  Mat_Hoya+'(HOYA)';
    _OutTxt(120-Length(Txt_Tmp)*1.5/2,281,Txt_Tmp,3,FontName);

    _OutTxt(165,258.6, copy(Date,1,4)+'年'+copy(Date,5,2)+'月'+copy(Date,7,2)+'日',4,'经典仿宋繁');
    _OutTxt(171.5-length(mc)*3/2,266,  MC,6,'经典楷体繁');
    _OutTxt(171.5-length(ID)*3/2,278,  ID,6,'宋体');


    Point1.X:=0;
    Point1.Y:=0;
    _SJ(90.5,247.5);
    _SJ(0,6);
    _SJ(10,0);
    _SJ(0,-6);
    _OutTxt(92,246.5,'N≤1',3,'宋体');
    _OutTxt(92,252.5,'N≤1',3,'宋体');
    _OutTxt(102,246.5,'R=B',3,'宋体');
    _OutTxt(102,252.5,'R=B',3,'宋体');

    _OutTxt(127.5-length(Film_R1)*1.5/2,246,Film_R1,3,'经典楷体繁');
    _OutTxt(127.5-length(Film_R2)*1.5/2,252,Film_R2,3,'经典楷体繁');

end;

procedure _OutBlockTxt();
var
  LogRec: TLOGFONT;
  OldFont, NewFont: HFONT;
  i: LongInt;
  FontName:String;
begin


    FontName:='经典仿宋繁';
  //-----------对材料的要求-----------------------------
    _OutTxt(33.2,51,  'Vd',4,'Txt');
    _OutTxt(33.2,56,  'Nd',4,'Txt');
    _OutTxt(36.4,46,  '对材料的要求',3.5,FontName);
    _OutTxt(26.5,61,  '光学均匀性',3.5,FontName);
    _OutTxt(26.5,66,  '双  折  射',3.5,FontName);
    _OutTxt(26.5,71,  '光吸收系数',3.5,FontName);
    _OutTxt(26.5,76,  '条  纹  度',3.5,FontName);
    _OutTxt(26.5,81,  '气  泡  度',3.5,FontName);
  //-----------透镜参数---------------------------------
    FontName:='Times New Roman';

    _OutTxt(38.8,240,  'R',5,FontName);
    _OutTxt(62.7,240,  'Newton',5,FontName);
    Point1.X:=0-PageTop;
    Point1.Y:=0-PageLeft;
    _SJ(92,242.1);
    Point1.X:=0-PageTop;
    Point1.Y:=0-PageLeft;
    _SJ(100,242.1);
    _OutTxt(93,240,  'N,',5,FontName);
    _OutTxt(101,240, 'R' ,5,FontName);

    _Circle(123-PageTop/mm_H,242.2-PageLeft/mm_V,1,0.09);
    FontName:='经典宋体繁';
    _OutTxt(130,240, '印',4,FontName);
    _OutTxt(150.5,240, '※',4,FontName);
    _OutTxt(159,240, '印',4,FontName);
    _OutTxt(177.7,240, 'Nd ,',4,'Times New Roman');
    _OutTxt(188.3,240, 'Vd',4,'Times New Roman');

    _OutTxt(28.3,258, '接',4,FontName);
    _OutTxt(28.3,264, '合',4,FontName);
    _OutTxt(28.3,270, 'ε',4,FontName);
    _OutTxt(29.5,276, 'f ',4,'Times New Roman');
    _OutTxt(26.5,282, '面取',4,FontName);

  //-----------透镜参数---------------------------------

    _OutTxt(62,259.2, '昆明欧海科技开发有限公司',3.7,'经典行楷繁');
    _OutTxt(56,264, 'KUNMING AO TECHNOLOGY CO., LTD',3.3,'宋体');
    _OutTxt(109,258, '尺 度',4,FontName);
    _OutTxt(122,258, '重 量',4,FontName);
    _OutTxt(135,258,   '第',4,FontName);
    _OutTxt(140.5,258, '三',4,FontName);
    _OutTxt(146,258,   '角',4,FontName);
    _OutTxt(151.6,258, '法',4,FontName);

    _OutTxt(57,270, '承 认',4,FontName);
    _OutTxt(70,270, '审 查',4,FontName);
    _OutTxt(83,270, '设 计',4,FontName);
    _OutTxt(96,270, '制 图',4,FontName);
    _OutTxt(114.5,270, '材 质',4,FontName);

    _OutTxt(136,264,   '名',4,FontName);
    _OutTxt(136,269.6, '称',4,FontName);
    _OutTxt(136,276,   '图',4,FontName);
    _OutTxt(136,281.6, '番',4,FontName);
    _Stamp();
    _Logo(59,260,6,clBlack);
end;

procedure _DrawingLens(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);
var
  K:Integer;
begin

   if length(film_R1)>0 then K:=1;
   if length(Film_R2)>0 then K:=K+2;

   _OutLens(r1,r2,t,d,D1,s,1,K);
   _OutBlock();
   _OutBlockTxt();
  _FillDrawingTxt(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;


//--------------------------------输出透镜图--------------------------------------------------------------
procedure _LENS(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);
var
  LogRec: TLOGFONT;
  OldFont, NewFont: HFONT;
  k,i: LongInt;
  PageSize:Tpoint;
  PointX,PointY:Integer;   //英寸
  st:String;