机的方法，我试过很多方法，可是I/O错误总是比我的判断早出现，所以采用以下的烂招来检测打印机。首先在uses增加Printers，再准备一个列表框ComboBox1，其属性Visible设为FALSE，然后在打印之前执行下列语句，那么就可以检测到是否存在打印机了： procedure TForm1.ButtonClick(Sender: Tobject); begin ComboBox1.Clear; ComboBox1.Items.Assign(Printer.Printers); if ComboBox1.Items.CommaText=``then Messagedlg(`你需要安装打印机才能打印！`,mtError,[mbOk],0); else Form1.Print; end; 精确打印输出的程序实现 简介： 一、概述 在银行，税务，邮政等行业的实际工作中，经常涉及到在印刷好具有固定格式的汇款单，储蓄凭证，税票等单据上的确定位置打印输出相关的信息。在此类需求中，精确地定位单据并打印相关信息，是解决问题]的关键。一般情况下，开发者都是通过在打印机上通过重复的测试来达到实际需求。那么，有没有简单有效而又灵活的方法实现上述功能呢？ 二、基本思路 分析上述单据的特征，可以发现：此类打印输出的信息一般比较简短，不涉及到文字过长的折行处理，另外，其打印输出的位置相对固定。因此，我们可以通过用尺子以毫米为单位，测量好每个输出信息位置的横向和纵向坐标，作为信息输出的位置。但由于不同打印机在实际输出效果上，总是存在理论和实际位置的偏差，因此，要求程序具有一定的灵活性，供最终用户根据需要，进行必要的位置调整。因此，可设置一打印配置文件，用于存储横坐标和纵坐标的偏移量，用于用户进行位置校正，从而提供了一定的灵活性。 三、精确打印输出的程序实现 1． 在Delphi中新建一个名为mprint.pas的单元文件并编写如下程序，单元引用中加入Printers略： //取得字符的高度 function CharHeight: Word; var Metrics: TTextMetric; begin GetTextMetrics(Printer.Canvas.Handle, Metrics); Result := Metrics.tmHeight; end; file://取得字符的平均宽度 function AvgCharWidth: Word; var Metrics: TTextMetric; begin GetTextMetrics(Printer.Canvas.Handle, Metrics); Result := Metrics.tmAveCharWidth; end; file://取得纸张的物理尺寸---单位：点 function GetPhicalPaper: TPoint; var PageSize : TPoint; begin file://PageSize.X; 纸张物理宽度-单位:点 file://PageSize.Y; 纸张物理高度-单位:点 Escape(Printer.Handle, GETPHYSPAGESIZE, 0,nil,@PageSize); Result := PageSize; end; file://2.取得纸张的逻辑宽度--可打印区域 file://取得纸张的逻辑尺寸 function PaperLogicSize: TPoint;
21
var APoint: TPoint; begin APoint.X := Printer.PageWidth; APoint.Y := Printer.PageHeight; Result := APoint; end; file://纸张水平对垂直方向的纵横比例 function HVLogincRatio: Extended; var AP: TPoint; begin Ap := PaperLogicSize; Result := Ap.y/Ap.X; end; file://取得纸张的横向偏移量-单位：点 function GetOffSetX: Integer; begin Result := GetDeviceCaps(Printer.Handle, PhysicalOffSetX); end; file://取得纸张的纵向偏移量-单位：点 function GetOffSetY: Integer; begin Result := GetDeviceCaps(Printer.Handle, PhysicalOffSetY); end; file://毫米单位转换为英寸单位 function MmToInch(Length: Extended): Extended; begin Result := Length/25.4; end; file://英寸单位转换为毫米单位 function InchToMm(Length: Extended): Extended; begin Result := Length*25.4; end; file://取得水平方向每英寸打印机的点数 function HPointsPerInch: Integer; begin Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX); end; file://取得纵向方向每英寸打印机的光栅数 function VPointsPerInch: Integer; begin Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY) end; file://横向点单位转换为毫米单位 function XPointToMm(Pos: Integer): Extended; begin Result := Pos*25.4/HPointsPerInch; end; file://纵向点单位转换为毫米单位 function YPointToMm(Pos: Integer): Extended; begin Result := Pos*25.4/VPointsPerInch; end; file://设置纸张高度-单位：mm procedure SetPaperHeight(Value:integer); var Device : array[0..255] of char; Driver : array[0..255] of char; Port : array[0..255] of char;
22
hDMode : THandle; PDMode : PDEVMODE; begin file://自定义纸张最小高度127mm if Value < 127 then Value := 127; file://自定义纸张最大高度432mm if Value > 432 then Value := 432; 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.PrinterInde Delphi应用程序中中国式报表的制作 在众多可视化数据库开发工具中,Delphi以其真正的面向对象、高效率、支持多层结构应用开发、支持多层B/S结构开发等优良特性脱颖而出，成为广大编程人员的首选开发工具。 在数据库应用程序开发中，系统设计员、程序设计员需要考虑的一个重要问题是如何设计和输出报表，在Delphi中我们可以采用多种方案来解决这一问题，如运用OLE自动化技术将数据输出到MS-WORD、MS-EXCEL中等，但其中最直接、最本地化的还是使用Delphi3.0/40中的QuickReport报表组件，它是挪威QuSoft公司专门为Delphi 编写的，使用QuickReport可以迅速设计出符合西方人习惯的报表。 然而，在设计中国式报表时，笔者发现在QuickReport中设计列与列之间的竖线和斜线比较困难；虽然QuickReport提供了TQShape控件,使用该控件可以画出列与列之间的竖线，但如果用户不能正确调整TQShape实例的高度，输出报表中的竖线不是不连续就是超长，另外如果我们调整了某个Band的高度，我们将不得不调整该Band下的所有TQShape实例的高度；至于斜线，QuickReport报表组件根本就没有提供这一功能。 笔者认真查找了有关资料，成功地解决以上问题，并愿意将解决方法与大家共享，希望能对大家有所帮助。 １、 解决思路 以TQShape为父类，建立新的控件，新控件可以画竖线、斜线和反斜线。重载TQShape类的Paint方法，这样在设计阶段可以非常直观地画斜线、反斜线和竖线，用户可以在设计阶段选择线的类型，如果选择直线，控件自动将其高度调整为所属Band的高度，用户可以调整其横向位置但不能调整其高度；如果选择斜线，用户可以根据需要调整斜线的长度和倾角。重载TQShape类的Print方法，这样可以在运行阶段输出直线和斜线。 说明：该控件只能画直线和斜线，如果读者需要画矩形和园，可以使用TQShape控件来实现。 ２、控件设计步骤 步骤１、使用Delphi提供的控件向导，选择TQShape为父类，建立新类TMyQRShape，并选择适当的包(Package)，最后生成单元文件。 步骤２、在生成的单元文件中，增加枚举类型， Tlines = ( None,TopBottom,BottomTop ) ; None、TopBottom、BottomTop三种取值，分别代表直线、斜线 和反斜线 / 。 步骤３、在新类TMyQRShape 中增加private 成员 FLineType:Tlines ，增加published属性 LineType:Tlines Read FLineType Write SetFLineType 。 步骤４、建立过程SetFLineType 。 procedure TMyQRShape.SetFLineType(Value:Tlines); begin if Value<>FLineType then begin FLineType:=Value ; Invalidate ;
23
end ; end ; 步骤５、重载Paint方法 procedure TMyQRShape.Paint ; begin case LineType of BottomTop: begin Canvas.MoveTo(0,Height) ; Canvas.LineTo(width,0 ) ; end ; TopBottom: begin Canvas.MoveTo(0,0) ; Canvas.LineTo(width,Height ) ; end ; None: begin Height := Parent.Height ; Top:=0 ; Width:=4 ; Shape:=qrsVertLine ; Inherited Paint ; end ; end ; end ; 步骤６、重载Print方法 procedure TMyQRShape.Print(OfsX,OfsY : Integer); begin with QRPrinter do begin case LineType of BottomTop: begin Canvas.MoveTo(Xpos(OfsX + Size.Left), Ypos(OfsY + Size.Top)+Height) Canvas.LineTo(Xpos(OfsX + Size.Left)+width,Ypos(OfsY + Size.Top) ) ; end ; TopBottom: begin Canvas.MoveTo(Xpos(OfsX + Size.Left), Ypos(OfsY + Size.Top)) ; Canvas.LineTo(Xpos(OfsX + Size.Left)+Width,Ypos(OfsY + Size.Top)+Height ) ; end ; None: Inherited Print(OfsX,OfsY ) ; end ; end ; end; 步骤７、保存并安装TMyQRShape控件。 本控件在Delphi40下调试、安装，并成功应用于某数据库管理系统的开发。该控件的完整代码如下。 源程序： unit MyQRShape; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, QuickRpt, Qrctrls; type Tlines = ( None,TopBottom,BottomTop ) ; TMyQRShape = class(TQRShape) private FLineType:Tlines ; procedure SetFLineType(Value:Tlines) ; protected procedure Print(OfsX, OfsY : integer); override; procedure Paint ;Override ;
24
public published property LineType:Tlines Read FLineType Write SetFLineType ; end; procedure Register; implementation procedure TMyQRShape.SetFLineType(Value:Tlines); begin if Value<>FLineType then begin FLineType:=Value ; Invalidate ; end ; end ; procedure TMyQRShape.Paint ; begin case LineType of BottomTop: begin Canvas.MoveTo(0,Height) ; Canvas.LineTo(width,0 ) ; end ; TopBottom: begin Canvas.MoveTo(0,0) ; Canvas.LineTo(width,Height ) ; end ; None: begin Height := Parent.Height ; Top:=0 ; Width:=4 ; Shape:=qrsVertLine ; Inherited Paint ; end ; end ; end ; procedure TMyQRShape.Print(OfsX,OfsY : Integer); begin with QRPrinter do begin case LineType of BottomTop: begin Canvas.MoveTo(Xpos(OfsX + Size.Left), Ypos(OfsY + Size.Top)+Height) Canvas.LineTo(Xpos(OfsX + Size.Left)+width,Ypos(OfsY + Size.Top) ) ; end ; TopBottom: begin Canvas.MoveTo(Xpos(OfsX + Size.Left), Ypos(OfsY + Size.Top)) ; Canvas.LineTo(Xpos(OfsX + Size.Left)+Width,Ypos(OfsY + Size.Top)+Height ) ; end ; None: Inherited Print(OfsX,OfsY ) ; end ; end ; end; procedure Register; begin RegisterComponents(`Qreport`, [TMyQRShape]); end;
25