📄 print_lens.pas
字号:
unit Print_Lens;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Printers, Grids, DBGrids, DB, ADODB,DateUtils, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
PrintDialog1: TPrintDialog;
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button3: TButton;
ADOConnection2: TADOConnection;
ADOQuery2: TADOQuery;
Edit1: TEdit;
Edit2: TEdit;
Button4: TButton;
Edit3: TEdit;
Edit4: TEdit;
Button5: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Bevel1: TBevel;
Label6: TLabel;
Bevel2: TBevel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
mm_H,mm_V:real; //毫米
point1:TPoint;
PhysicalWidth,PhysicalHeight,PageWidth,PageHeight,PageLeft,PageRight,PageTop,PageBottom:Integer;
implementation
{$R *.dfm}
function _FocalLength(r1,r2,n,t,Opt_N:real):real;
{函数名称:FocalLength(N1,N2,N3,N4,N5:real):real
函数功能:求厚透镜焦距公式(单片)
参数说明: N1 ---- r1
N2 ---- r2
N3 ---- 折射率
N4 ---- 透镜中心厚度
N5 ---- 计算时采用的公式
=1:采用没有经过化简的公式 (计算经果误差大)
=0:采用经过化简的公式 (计算经果较精确)
返回值：实型
-----------------------------------------------------------
编写日期:2002.11.25 18:00
作 者:杨振华
编写地点：昆明欧海科技开发有限公司 (开发部)
}
var
f:real;
begin
if (n>0) and (n<>1) then
begin
if r2=0 then // r2无穷大
f:=r1/(n-1)
else if r1=0 then // r1无穷大
f:=-r2/(n-1)
else if Opt_N=0 then
f:=1/((n-1)*(1/r1-1/r2+t*(n-1)/(n*r1*r2))) //Opt_N=0---采用焦距原公式(误差大)----Nikon较常用 例:S1,S3等产品(默认值)
else
f:=-(n*r1*r2) / ((n*(r2-r1)-t)*(1-n)); //Opt_N=1---采用化简过的公式(精度高)
//-------- 结束 <if r2=0>--------
result :=f;
end
else
result :=0;
end; // FocalLength()函数结束 -------------------
function _BasePoint(r1,r2,n,t,Opt_N:real):real;
{函数名称:BasePoint(N1,N2,N3,N4,N5:real):real
函数功能:求厚透镜物、象方基点公式(单片)
参数说明: N1 ---- r1
N2 ---- r2
N3 ---- 折射率(n)
N4 ---- 透镜中心厚度(t)
N5 ---- =0:返回物点值
=1:返回象点值
变量说明: p1 ---- 物点
p2 ---- 像点
f ---- 厚透镜焦镜
f1 ---- 物方溥透镜焦距
f2 ---- 像方溥透镜焦距
返回值：实型
-----------------------------------------------------------
编写日期:2002.11.25 19:00
作 者:杨振华
编写地点：昆明欧海科技开发有限公司 (开发部)
}
var
p1,p2:real; //p1----物点;p2----像点
f: real; //厚透镜焦距
f1,f2:real; //f1 ---物方溥透镜焦距，f2---象方溥透镜焦距
begin
if r1=0 then //r1=0 即r1为无穷大，此时p1=(2/3)t,p2=0
begin
p1:=2/3*t;
p2:=0;
end
else if r2=0 then //r2=0 即r2为无穷大，此时p1=0,p2=(2/3)t
begin
p1:=0;
p2:=-(2/3)*t;
end
else if (n<>0)then
begin
f1:=r1/(n-1);
f2:=r2/(n-1);
f:=_FocalLength(r1,r2,n,t,0);
P1:=-(t*f)/(n*f2);
p2:=-(t*f)/(n*f1);
end
else
begin
p1:=0; //Opt_N=0
p2:=0; //Opt_N=1
end;
//--结束 <if r1=0>--------
if Opt_N=0 then result:=p1 else result := p2;
end; // ------结束BasePoint()物像基点函数-------
Function _LensVerge(r1,r2,t,d:real):real;
{函数名称:Lens(r1,r2,t,d:real):real;
函数功能:求厚透镜物、象方基点公式(单片)
参数说明: r1 ---- 左球面半径
r2 ---- 右球面半径
t ---- 透镜中心厚度
d ---- 透镜口径
变量说明: Ox_r1 -- r1圆心x轴坐标
Ox_r2 -- r2圆心x轴坐标
x1 -- r1弧线边缘x轴坐标
x2 -- r2弧线边缘x轴坐标
xA -- r1弧线象限点
xB -- r2弧线象限点
返回值：厚透镜边缘厚度
-----------------------------------------------------------
编写日期:2002.11.25 20:00
作 者:杨振华
编写地点：昆明欧海科技开发有限公司 (开发部)
}
var
xA,xB,Ox_r1,Ox_r2:Real;
begin
Ox_r1:=(-t)/2 +r1; //R1圆心x坐标
Ox_r2:=(+t)/2 +r2; //R2圆心x坐标
if r1<>0 then
xA:=Ox_r1-(r1/abs(r1))*Sqrt(abs(r1*r1-(d/2)*(d/2)))
else
xA:=-t/2;
if r2<>0 then
xB:=Ox_r2-(r2/abs(r2))*Sqrt(abs(r2*r2-(d/2)*(d/2)))
else
xB:=t/2;
Result:=xB-xA;
end;
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);
begin
x:=x*mm_H;
y:=y*mm_V;
r:=r*mm_H;
Printer.Canvas.Pen.Width:=Round(N*mm_H);
Printer.Canvas.Ellipse(round(x-r),round(y-r),round(x+r),round(y+r));
end;
function _OutCircle():Boolean;
var
a,x,y,r:Real;
begin
a:=66;
x:=13;
y:=PhysicalHeight/2/mm_H;
r:=3;
_Circle(x,y,r,0.09);
_Circle(x,y-a,r,0.09);
_Circle(x,y+a,r,0.09);
end;
function _init(PageSize:TPoint):Boolean;
begin
PhysicalWidth:=PageSize.x; //物理页宽
PhysicalHeight:=PageSize.Y; //物理页高
PageWidth:=printer.PageWidth; //逻辑页宽
PageHeight:=printer.PageHeight; //逻辑页高
PageLeft:=GetDeviceCaps(Printer.Handle,PHYSICALOFFSETX); //左边距
PageTop:=GetDeviceCaps(Printer.Handle,PHYSICALOFFSETY); //上边距
PageRight:=PhysicalWidth-PageLeft-PageWidth; //右边距
PageBottom:=PhysicalHeight-PageTop-PageHeight; //下边距
end;
function _outTxt(x,y:Real;Txt:String;FontSize:Real;FontName:String):Boolean;
var
LogRec: TLOGFONT;
OldFont, NewFont: HFONT;
i: LongInt;
begin
with printer do
begin
GetObject(Canvas.Font.Handle, SizeOf(LogRec), @LogRec);
LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;
if FontName='宋体' then LogRec.lfFaceName :='宋体'
else
if FontName='黑体' then LogRec.lfFaceName :='黑体'
else
if FontName='经典仿宋繁' then LogRec.lfFaceName :='经典仿宋繁'
else
if FontName='经典黑体繁' then LogRec.lfFaceName :='经典黑体繁'
else
if FontName='经典楷体繁' then LogRec.lfFaceName :='经典楷体繁'
else
if FontName='经典宋体繁' then LogRec.lfFaceName :='经典宋体繁'
else
if FontName='经典行楷繁' then LogRec.lfFaceName :='经典行楷繁'
else
if FontName='经典隶书繁' then LogRec.lfFaceName :='经典隶书繁'
else
if FontName='Txt' then LogRec.lfFaceName :='Txt'
else
if FontName='Times New Roman' then LogRec.lfFaceName :='Times New Roman';
LogRec.lfHeight:=round(FontSize*mm_V);
LogRec.lfWeight:=0;
NewFont := CreateFontIndirect(LogRec);
OldFont := SelectObject(Canvas.Handle,NewFont);
end;
x:=Round(x*mm_H)-PageLeft;
y:=Round(y*mm_V)-PageTop;
Printer.Canvas.TextOut(round(x),round(y),txt);
end;
{ //-----------------------输出页面设置信息-------------------------------------
function _OutInit():Boolean;
begin
with Form1.Memo1 do
begin
Clear;
Text:=Text+'物理页高：'+VarToStr(PhysicalHeight/mm_V)+'(mm)';
Text:=Text+#13#10+'物理页宽：'+VarToStr(PhysicalWidth/mm_H)+'(mm)';
Text:=Text+#13#10+'逻辑页高：'+VarToStr(PageHeight/mm_V)+'(mm)';
Text:=Text+#13#10+'逻辑页宽：'+VarToStr(PageWidth/mm_H)+'(mm)';
Text:=Text+#13#10+'左边距： '+VarToStr(PageLeft/mm_H)+'(mm)';
Text:=Text+#13#10+'右边距： '+VarToStr(PageRight/mm_H)+'(mm)';
Text:=Text+#13#10+'上边距： '+VarToStr(PageTop/mm_V)+'(mm)';
Text:=Text+#13#10+'下边距： '+VarToStr(PageBottom/mm_V)+'(mm)';
end;
end;
}
function line(x,y,LineWidth:Real):Boolean;
var
point2:TPoint;
begin
point2.X:=Point1.X+round(x*mm_H);
point2.Y:=Point1.Y+round(y*mm_V);
Printer.Canvas.Pen.Width:=Round(LineWidth*mm_H); //设置线宽
printer.Canvas.LineTo(point2.X,point2.Y);
point1:=point2;
result:=true;
end;
function Move(x,y:Real):Boolean;
begin
Point1.X:=point1.X+round(x*mm_H);
point1.Y:=Point1.Y+round(y*mm_V);
Printer.Canvas.MoveTo(point1.X,point1.Y);
result:=true;
end;
procedure _arrow(O_tmp:TPoint;K:Integer;M:Real);
var
O:Array[1..4] of TPoint;
begin
O[1].X:=O_Tmp.X;
O[1].Y:=O_Tmp.Y;
if abs(k)=1 then // 上下箭头 ↑↓
begin
O[2].X:=O[1].X;
O[2].Y:=O[1].Y+round(3*k*mm_V*M);
O[3].X:=O[1].X-round(0.4*K*mm_V);
O[3].Y:=O[1].Y+round(1.5*K*mm_V*M);
O[4].X:=O[1].X+round(0.4*k*mm_V);
O[4].Y:=O[3].Y;
end;
if abs(k)=2 then //左右箭头 ←→
begin
K:=round(K/abs(K));
M:=1; //设定箭头的类型为外箭头,(若不设定，则为随放置的相对位置变化 +1:--外 -1:--内)
O[2].X:=O[1].X+round(3*k*mm_H*M);
O[2].Y:=O[1].Y;
O[3].X:=O[1].X+round(1.5*K*mm_H*M);
O[3].Y:=O[1].Y-round(0.4*K*mm_H);
O[4].X:=O[3].X;
O[4].Y:=O[1].Y+round(0.4*k*mm_H);
end;
With Printer do
begin
Canvas.MoveTo(O[1].X,O[1].Y);
Canvas.LineTo(O[2].x,O[2].Y);
Canvas.MoveTo(O[3].X,O[3].Y);
Canvas.LineTo(O[1].x,O[1].Y);
Canvas.LineTo(O[4].x,O[4].Y);
end;
end;
function _Symbol(O_Tmp:TPoint;C:String;N:Integer):Tpoint;
var
LogRec: TLOGFONT;
OldFont, NewFont: HFONT;
k:integer;
begin
if N=1 then
begin
with printer do
begin
GetObject(Canvas.Font.Handle, SizeOf(LogRec), @LogRec);
LogRec.lfEscapement:=0;
LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;
LogRec.lfFaceName :='Txt';
// LogRec.lfWeight:=900;
LogRec.lfHeight:=round(4*mm_V);
NewFont := CreateFontIndirect(LogRec);
OldFont := SelectObject(Canvas.Handle,NewFont);
if (C='C') or (C='c') then //输出直径符号
begin
Canvas.TextOut(O_Tmp.X,round(O_Tmp.Y-0.5*mm_V),'o');
Canvas.TextOut(O_Tmp.X,O_Tmp.Y,'/');
end;
if (copy(C,1,1)='@') then //输出正负号
begin
Canvas.TextOut(O_Tmp.X,round(O_Tmp.Y-1*mm_H),'+');
Canvas.TextOut(O_Tmp.X,round(O_Tmp.Y-1*mm_H),'_');
O_Tmp.X:=Printer.Canvas.PenPos.X;
Canvas.TextOut(O_Tmp.X,O_Tmp.Y,copy(C,2,length(c)-1));
end;
if copy(C,1,1)='$' then //输出主尺寸
begin
Canvas.TextOut(O_Tmp.X,O_Tmp.Y,copy(C,2,length(c)-1));
end;
if (copy(C,1,1)='&') then //输出上下公差之---上公差
begin
for k:=1 to length(c)-1 do
begin
if copy(c,k,1)='^' then break;
end;
GetObject(Canvas.Font.Handle, SizeOf(LogRec), @LogRec);
LogRec.lfEscapement:=0;
LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;
LogRec.lfFaceName :='Txt';
LogRec.lfWeight:=900;
LogRec.lfHeight:=round(2.5*mm_V);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -