La web de Seoane

Para que la impresora emita un pitido
\x1B@\x0A\x0D\x1B\x07\x0A\x0D
 
Para que corte el papel
\x1B@\x0A\x0D\x1Bi\x0A\x0D
 
Para abrir el cajon de monedas
\x1B@\x0A\x0D\027\112\000\100\250\x0A\x0D
 
Para que escriba "Hola mundo"  
\x1B@\x0A\x0DHola mundo\x0A\x0D

unit ufrmMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus;
 
type
  TfrmMain = class(TForm)
    txtSecuencia: TEdit;
    cmbPrinters: TComboBox;
    Label1: TLabel;
    Enviar: TButton;
    Label2: TLabel;
    mnuMain: TPopupMenu;
    mnuCortar: TMenuItem;
    mnuCopiar: TMenuItem;
    mnuPegar: TMenuItem;
    mnuEliminar: TMenuItem;
    N1: TMenuItem;
    mnuSeleccionar: TMenuItem;
    N2: TMenuItem;
    mnuDeshacer: TMenuItem;
    N3: TMenuItem;
    mnuWindows: TMenuItem;
    N4: TMenuItem;
    chkOnTop: TCheckBox;
    btnMenu: TButton;
    mnuEnviar: TMenuItem;
    mnuBucle: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure EnviarClick(Sender: TObject);
    procedure mnuDeshacerClick(Sender: TObject);
    procedure mnuCortarClick(Sender: TObject);
    procedure mnuCopiarClick(Sender: TObject);
    procedure mnuPegarClick(Sender: TObject);
    procedure mnuEliminarClick(Sender: TObject);
    procedure mnuSeleccionarClick(Sender: TObject);
    procedure mnuWindowsClick(Sender: TObject);
    procedure chkOnTopClick(Sender: TObject);
    procedure btnMenuClick(Sender: TObject);
    procedure mnuBucleClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  frmMain: TfrmMain;
 
implementation
 
{$R *.dfm}
 
uses Printers, WinSpool, Clipbrd, ufrmBucle;
 
function RawToWindows(Str: String): String;
var
  i: Integer;
begin
  Result:= '<';
  while Length(Str) > 0 do
  begin
    if Copy(Str, 1, 1) = '\' then
    begin
      if Uppercase(Copy(Str, 2, 1)) = 'X' then
        Str[2]:= '$';
      if not TryStrToInt(Copy(Str, 2, 3),i) then
        Continue;
      Delete(Str, 1, 3);
    end else i:= Byte(Str[1]);
    Delete(Str,1,1);
    Result:= Result + IntToHex(i,2);
  end;
  Result:= Result + '>';
end;  
 
function WriteRawDataToPrinter(PrinterName: String; Str: String): Boolean;
var
  PrinterHandle: THandle;
  DocInfo: TDocInfo1;
  i: Integer;
  B: Byte;
  Escritos: DWORD;
begin
  Result:= FALSE;
  if OpenPrinter(PChar(PrinterName), PrinterHandle, nil) then
  try
    FillChar(DocInfo,Sizeof(DocInfo),#0);
    with DocInfo do
    begin
      pDocName:= PChar('Printer Test');
      pOutputFile:= nil;
      pDataType:= 'RAW';
    end;
    if StartDocPrinter(PrinterHandle, 1, @DocInfo) <> 0 then
    try
      if StartPagePrinter(PrinterHandle) then
      try
        while Length(Str) > 0 do
        begin
          if Copy(Str, 1, 1) = '\' then
          begin
            if Uppercase(Copy(Str, 2, 1)) = 'X' then
              Str[2]:= '$';
            if not TryStrToInt(Copy(Str, 2, 3),i) then
              Exit;
            B:= Byte(i);
            Delete(Str, 1, 3);
          end else B:= Byte(Str[1]);
          Delete(Str,1,1);
          WritePrinter(PrinterHandle, @B, 1, Escritos);
        end;
        Result:= TRUE;
      finally
        EndPagePrinter(PrinterHandle);
      end;
    finally
      EndDocPrinter(PrinterHandle);
    end;
  finally
    ClosePrinter(PrinterHandle);
  end;
end;
 
procedure TfrmMain.btnMenuClick(Sender: TObject);
var
  P: TPoint;
begin
  GetCursorPos(P);
  mnuMain.Popup(P.X, P.Y);
end;
 
procedure TfrmMain.chkOnTopClick(Sender: TObject);
begin
  if chkOnTop.Checked then
    FormStyle:= fsStayOnTop
  else
    FormStyle:= fsNormal;
end;
 
procedure TfrmMain.EnviarClick(Sender: TObject);
begin
  if cmbPrinters.ItemIndex >= 0 then
  begin
    WriteRawDataToPrinter(cmbPrinters.Items[cmbPrinters.ItemIndex],
      txtSecuencia.Text);
  end;
end;
 
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  cmbPrinters.Items.Assign(Printer.Printers);
end;
 
procedure TfrmMain.mnuCopiarClick(Sender: TObject);
begin
  txtSecuencia.CopyToClipboard;
end;
 
procedure TfrmMain.mnuCortarClick(Sender: TObject);
begin
  txtSecuencia.CutToClipboard;
end;
 
procedure TfrmMain.mnuDeshacerClick(Sender: TObject);
begin
  txtSecuencia.Undo;
end;
 
procedure TfrmMain.mnuEliminarClick(Sender: TObject);
begin
  txtSecuencia.ClearSelection;
end;
 
procedure TfrmMain.mnuPegarClick(Sender: TObject);
begin
  txtSecuencia.PasteFromClipboard;
end;
 
procedure TfrmMain.mnuBucleClick(Sender: TObject);
begin
  with TfrmBucle.Create(Self) do
  try
    ShowModal;
  finally
    Free;
  end;
end;
 
procedure TfrmMain.mnuSeleccionarClick(Sender: TObject);
begin
  txtSecuencia.SelectAll;
end;
 
procedure TfrmMain.mnuWindowsClick(Sender: TObject);
begin
  ClipBoard.AsText:= RawToWindows(txtSecuencia.SelText);
end;
 
end.