直接控制串口打印单元

来源：互联网发布：renatus z网络班编辑：程序博客网时间：2024/04/28 03:59

unit uPrinter;

interface

uses Printers, types, Windows, Classes, SysUtils, Forms;

function CharHeight: Word;
function AvgCharWidth: Word;
function GetPhicalPaper: TPoint;
function PaperLogicSize: TPoint;
function HVLogincRatio: Extended;
function GetOffSetX: Integer;
function GetOffSetY: Integer;
function MmToInch(Length: Extended): Extended;
function InchToMm(Length: Extended): Extended;
function HPointsPerInch: Integer;
function VPointsPerInch: Integer;
function XPointToMm(Pos: Integer): Extended;
function YPointToMm(Pos: Integer): Extended;
procedure SetPaperHeight(Value: integer);
procedure SetPaperWidth(Value: integer);
procedure PrintText(X, Y: Extended; Txt: string; ConfigFileName: string; FontSize: Integer = 9);
function GetDefaultPrinterName(): PChar; //得到默认的打印机名称

implementation

//取得字符的高度
function CharHeight: Word;
var
Metrics: TTextMetric;
begin
GetTextMetrics(Printer.Canvas.Handle, Metrics);
Result := Metrics.tmHeight;
end;

//取得字符的平均宽度
function AvgCharWidth: Word;
var
Metrics: TTextMetric;
begin
GetTextMetrics(Printer.Canvas.Handle, Metrics);
Result := Metrics.tmAveCharWidth;
end;

//取得纸张的物理尺寸---单位：点
function GetPhicalPaper: TPoint;
var
PageSize: TPoint;
begin
//PageSize.X; 纸张物理宽度-单位:点
//PageSize.Y; 纸张物理高度-单位:点
Escape(Printer.Handle, GETPHYSPAGESIZE, 0, nil, @PageSize);
Result := PageSize;
end;

//取得纸张的逻辑宽度--可打印区域
//取得纸张的逻辑尺寸
function PaperLogicSize: TPoint;
var
APoint: TPoint;
begin
APoint.X := Printer.PageWidth;
APoint.Y := Printer.PageHeight;
Result := APoint;
end;

//纸张水平对垂直方向的纵横比例
function HVLogincRatio: Extended;
var
AP: TPoint;
begin
Ap := PaperLogicSize;
Result := Ap.y / Ap.X;
end;

//取得纸张的横向偏移量-单位：点
function GetOffSetX: Integer;
begin
Result := GetDeviceCaps(Printer.Handle, PhysicalOffSetX);
end;

//取得纸张的纵向偏移量-单位：点
function GetOffSetY: Integer;
begin
Result := GetDeviceCaps(Printer.Handle, PhysicalOffSetY);
end;

//毫米单位转换为英寸单位
function MmToInch(Length: Extended): Extended;
begin
Result := Length / 25.4;
end;

//英寸单位转换为毫米单位
function InchToMm(Length: Extended): Extended;
begin
Result := Length * 25.4;
end;

//取得水平方向每英寸打印机的点数
function HPointsPerInch: Integer;
begin
Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
end;

//取得纵向方向每英寸打印机的光栅数
function VPointsPerInch: Integer;
begin
Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
end;

//横向点单位转换为毫米单位
function XPointToMm(Pos: Integer): Extended;
begin
Result := Pos * 25.4 / HPointsPerInch;
end;

//纵向点单位转换为毫米单位
function YPointToMm(Pos: Integer): Extended;
begin
Result := Pos * 25.4 / VPointsPerInch;
end;

//设置纸张高度-单位：mm
procedure SetPaperHeight(Value: integer);
var
Device: array[0..255] of char;
Driver: array[0..255] of char;
Port: array[0..255] of char;
hDMode: THandle;
PDMode: PDEVMODE;
begin
//自定义纸张最小高度127mm
if Value < 127 then Value := 127;
//自定义纸张最大高度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.PrinterIndex := Printer.PrinterIndex;
end;

//设置纸张宽度：单位--mm
procedure SetPaperWidth(Value: integer);
var
Device: array[0..255] of char;
Driver: array[0..255] of char;
Port: array[0..255] of char;
hDMode: THandle;
PDMode: PDEVMODE;
begin
//自定义纸张最小宽度76mm
if Value < 76 then Value := 76;
//自定义纸张最大宽度216mm
if Value > 216 then Value := 216;
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;
      //将毫米单位转换为0.1mm单位
      pDMode^.dmPaperWidth := Value * 10;
      pDMode^.dmFields := pDMode^.dmFields or DMBIN_MANUAL;
      pDMode^.dmDefaultSource := DMBIN_MANUAL;
      GlobalUnlock(hDMode);
    end;
end;
Printer.PrinterIndex := Printer.PrinterIndex;
end;

//在 (Xmm, Ymm)处按指定配置文件信息和字体输出字符串
procedure PrintText(X, Y: Extended; Txt: string; ConfigFileName: string; FontSize: Integer = 9);
var
OrX, OrY: Extended;
Px, Py: Integer;
AP: TPoint;
Fn: TStrings;
FileName: string;
OffSetX, OffSetY: Integer;
begin
//打开配置文件，读出横向和纵向偏移量
try
    Fn := TStringList.Create;
    FileName := ExtractFilePath(Application.ExeName) + ConfigFileName;
    if FileExists(FileName) then
    begin
      Fn.LoadFromFile(FileName);
      //横向偏移量
      OffSetX := StrToInt(Fn.Values['X']);
      //纵向偏移量
      OffSetY := StrToInt(Fn.Values['Y']);
    end
    else
    begin
      //如果没有配置文件，则生成
      Fn.Values['X'] := '0';
      Fn.Values['Y'] := '0';
      Fn.SaveToFile(FileName);
    end;
finally
    Fn.Free;
end;
X := X + OffSetX;
Y := Y + OffSetY;
Px := Round(Round(X * HPointsPerInch * 10000 / 25.4) / 10000);
Py := Round(Round(Y * VPointsPerInch * 10000 / 25.4) / 10000);
Py := Py - GetOffSetY; //因为是绝对坐标, 因此, 不用换算成相对于Y轴坐标
Px := Px + 2 * AvgCharWidth;
Printer.Canvas.Font.Name := '宋体';
Printer.Canvas.Font.Size := FontSize;
//Printer.Canvas.Font.Color := clGreen;
Printer.Canvas.TextOut(Px, Py, Txt);
end;

function GetDefaultPrinterName(): PChar; //得到默认的打印机名称
var
sIniFile, sSection, sKeyName, p, q: PChar;
begin
sIniFile := 'win.ini';
sSection := 'windows';
sKeyName := 'device';
p := StrAlloc(80);
q := StrAlloc(80);
GetPrivateProfileString(sSection, sKeyName, nil, p, 80, sIniFile);
StrLCopy(q, p, (strscan(p, ',') - p));
Result := q;
end;

end.

//使用

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Printers,uPrinter;

type
TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
private
    //printer:TPrinter;
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
SetPaperHeight(80);
SetPaperWidth(150);
Printer.BeginDoc;
PrintText(15, 8, FormatDateTime('yyyy-mm-dd',Date), 'config.txt');
PrintText(35, 16, '门诊外科', 'config.txt');
PrintText(55, 16, '0000000098', 'config.txt');
PrintText(16, 26, '挂号类别：', 'config.txt');
PrintText(36, 26, '普通挂号', 'config.txt');
PrintText(56, 26, '诊查类别：', 'config.txt');
PrintText(76, 26, '急诊', 'config.txt');
PrintText(16, 34, '挂号费', 'config.txt');
PrintText(26, 34, '￥:0.80', 'config.txt');
PrintText(46, 34, '诊查费', 'config.txt');
PrintText(66, 34, '￥:1.00', 'config.txt');
PrintText(16, 42, '挂号费', 'config.txt');
PrintText(26, 42, '￥:0.00', 'config.txt');
PrintText(46, 42, '诊查费', 'config.txt');
PrintText(66, 42, '￥:0.00', 'config.txt');
PrintText(26, 56, '费用合计：', 'config.txt');
PrintText(46, 56, '壹元捌角整', 'config.txt');
PrintText(66, 56, '￥:1.80', 'config.txt');
Printer.EndDoc;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage(StrPas(GetDefaultPrinterName));
end;

end.