直接控制串口打印单元

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.