Fórum Imprimir modo DOS e escolher a impressora pelo PrintDialog #263512

unit VDOPrinterControl;

interface

uses
  Windows, SysUtils, Classes, Graphics, Dialogs, Printers,
  WinSpool;

type
  EVDOPrinterControl = class(Exception);
  { **** }
  TVDOPrinterControl = class(TComponent)
  private
    { Internos }
    FPrinterHandle: DWord;
    { Propriedades Read Only }
    FIsPrinting: Boolean;
    FPrintersList: TStrings;
    { Read / Write }
    FPrinterName: String;
    FShowDialog: Boolean;
    { Eventos }
    FOnAbort: TNotifyEvent;
    FOnError: TNotifyEvent;
    FOnSend: TNotifyEvent;
    FOnStart: TNotifyEvent;
    FOnTerminate: TNotifyEvent;
    { Procedures e Functions internos }
    function CheckPrinter(APrinterName: String): Boolean;
    function GetPrintersList: TStrings;
    procedure RaiseError(Msg: String);
    procedure SetToPrinter;
    function ShowPrintDialog: Boolean;
    procedure WriteStr(const Buffer: String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Métodos }
    procedure Abort;
    procedure BeginControl;
    procedure EndControl;
    procedure Send(Command: String);
    { Propriedades Read Only }
    property IsPrinting: Boolean read FIsPrinting;
    property PrintersList: TStrings read FPrintersList;
  published
    { Propriedades Read / Write }
    property PrinterName: String read FPrinterName write FPrinterName;
    property ShowDialog: Boolean read FShowDialog write FShowDialog;
    { Eventos }
    property OnAbort: TNotifyEvent read FOnAbort write FOnAbort;
    property OnError: TNotifyEvent read FOnError write FOnError;
    property OnSend: TNotifyEvent read FOnSend write FOnSend;
    property OnStart: TNotifyEvent read FOnStart write FOnStart;
    property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
  end;

implementation

uses Controls, VDOPrintConsts;

{**** TVDOPrinterControl **** }

constructor TVDOPrinterControl.Create(AOwner: TComponent);
begin
  inherited;
  FIsPrinting:= False;
  FPrintersList:= GetPrintersList;
  FPrinterName:= ´´;
  FShowDialog:= True;
end;

destructor TVDOPrinterControl.Destroy;
begin
  if FIsPrinting then Abort;
  FPrintersList.Free;
  inherited;
end;

function TVDOPrinterControl.CheckPrinter(APrinterName: String): Boolean;
var i: integer;
begin
  Result:= False;
  for i:= 0 to (FPrintersList.Count - 1) do
  begin
    Result:= (FPrintersList.Strings[i] = APrinterName);
    if Result then Break;
  end;
end;

function TVDOPrinterControl.GetPrintersList: TStrings;
var ADevice, ADriver, APort: array[0..255] of char;
    HDevMode: THandle;
    DefaultIndex, i: Integer;
begin
  if FPrintersList = nil then
    FPrintersList:= TStringList.Create;
  DefaultIndex:= Printer.PrinterIndex;
  FPrintersList.Clear;
  for i:= 0 to (Printer.Printers.Count - 1) do
  begin
    Printer.PrinterIndex:= i;
    Printer.GetPrinter(ADevice, ADriver, APort, HDevMode);
    FPrintersList.Add(ADevice);
  end;
  Printer.PrinterIndex:= DefaultIndex;
  Result:= FPrintersList;
end;

procedure TVDOPrinterControl.RaiseError(Msg: String);
begin
  if Assigned(FOnError) then FOnError(Self);
  raise EVDOPrinterControl.Create(Msg);
end;

procedure TVDOPrinterControl.SetToPrinter;
var ADevice, ADriver, APort: array[0..255] of char;
    HDevMode: THandle;
begin
  Printer.GetPrinter(ADevice, ADriver, APort, HDevMode);
  FPrinterName:= ADevice;
end;

function TVDOPrinterControl.ShowPrintDialog: Boolean;
var PrintDlg: TPrintDialog;
begin
  FPrinterName:= ´´;
  PrintDlg:= TPrintDialog.Create(nil);
  Result:= PrintDlg.Execute;
  PrintDlg.Free;
end;

procedure TVDOPrinterControl.WriteStr(const Buffer: String);
var Len, Count: DWord;
begin
  if not FIsPrinting then RaiseError(Format(SNotPrinting, [FPrinterName]));
  Len:= Length(Buffer);
  WritePrinter(FPrinterHandle, Pointer(Buffer), Len , Count);
  if not Count = Len then RaiseError(Format(SWriteError, [FPrinterName]));
end;

{ **** Public **** }

procedure TVDOPrinterControl.Abort;
begin
  if not FIsPrinting then Exit;
  if AbortPrinter(FPrinterHandle) then
  begin
    if ClosePrinter(FPrinterHandle) then
    begin
      if Assigned(FOnAbort) then FOnAbort(Self);
    end
    else RaiseError(Format(SClosePrinterError, [FPrinterName]));
  end
  else RaiseError(Format(SAbortPrinterError, [FPrinterName]));
end;

procedure TVDOPrinterControl.BeginControl;
var DocInfo: TDocInfo1;
begin
  if FIsPrinting then RaiseError(Format(SPrinting, [FPrinterName]));
  if FPrinterName <> ´´ then
    if CheckPrinter(FPrinterName) then
      Printer.PrinterIndex:= Printer.Printers.IndexOf(FPrinterName)
    else
    begin
      MessageDlg(Format(SInvalidPrinter, [FPrinterName]), mtError, [mbOK], 0);
      FShowDialog:= True;
    end;
  if FShowDialog then
    if not ShowPrintDialog then Exit;
  SetToPrinter;
  if FPrinterName = ´´ then RaiseError(SNoDefaultPrinter);
  if OpenPrinter(PChar(FPrinterName), FPrinterHandle, nil) then
  begin
    with DocInfo do
    begin
      pDatatype:= ´RAW´;
      pDocName:= PChar(´´);
      pOutputFile:= nil;
    end;
    if StartDocPrinter(FPrinterHandle, 1, @DocInfo) <> 0 then
    begin
      if StartPagePrinter(FPrinterHandle) then
      begin
        if Assigned(FOnStart) then FOnStart(Self);
        FIsPrinting:= True;
      end
      else RaiseError(Format(SStartPageError, [FPrinterName]));
    end
    else RaiseError(Format(SStartDocError, [´´, FPrinterName]));
  end
  else RaiseError(Format(SOpenPrinterError, [FPrinterName]));
end;

procedure TVDOPrinterControl.EndControl;
begin
  if not FIsPrinting then Exit;
  if EndPagePrinter(FPrinterHandle) then
  begin
    if EndDocPrinter(FPrinterHandle) then
    begin
      if ClosePrinter(FPrinterHandle) then
      begin
        if Assigned(FOnTerminate) then FOnTerminate(Self);
        FIsPrinting:= False;
      end
      else RaiseError(Format(SClosePrinterError, [FPrinterName]));
    end
    else RaiseError(Format(SEndDocError, [´´, FPrinterName]));
  end
  else RaiseError(Format(SEndPageError, [FPrinterName]));
end;

procedure TVDOPrinterControl.Send(Command: String);
begin
  if not FIsPrinting then Exit;
  WriteStr(Command);
  if Assigned(FOnSend) then FOnSend(Self);
end;

end.

procedure TForm1.Button1Click(Sender: TObject);
var VDOPrinterControl1: TVDOPrinterControl;
begin
  VDOPrinterControl1 := TVDOPrinterControl.Create(Self);
  with VDOPrinterControl1 do
  begin
    BeginControl;
    Send(#15);
    EndControl;
  end;
  VDOPrinterControl1.Free;
end;