[Раздел] Печать

Определение количества заданий в спулере печати

Spooler печати Windows посылает WM_SPOOLERSTATUS каждый раз при добавлении и удалении заданий в очереди печати. В следующем примере показано как перехватить это сообщение:
type
TForm1 = class(TForm)
    Label1: TLabel;
private
    { Private declarations }
    procedure WM_SpoolerStatus(var Msg : TWMSPOOLERSTATUS);
    message WM_SPOOLERSTATUS;
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WM_SpoolerStatus(var Msg : TWMSPOOLERSTATUS);
begin
Lable1.Caption := IntToStr(msg.JobsLeft) +
            ' Jobs currenly in spooler';
msg.Result := 0;
end;


Источник: Дельфи. Вокруг да около.

Печать с масштабированием

Нижеприведённый пример показывает как вывести на печать изображение, помещённое в Image1 с масштабированием.

procedure TForm1.Button1Click(Sender: TObject);
// © Song
Var ScaleX, ScaleY: Integer;
Begin
 Printer.BeginDoc;
 With Printer Do
  try
   ScaleX:=GetDeviceCaps(Handle,LogPixelsX) div PixelsPerInch;
   ScaleY:=GetDeviceCaps(Handle,LogPixelsY) div PixelsPerInch;
   Canvas.StretchDraw(Rect(0,0,Image1.Picture.Width*ScaleX,Image1.Picture.Height*ScaleY),Image1.Picture.Graphic);
  finally
   EndDoc;
  end;
End;

Тема - элемент ЧАВО. Подготовлена by © Song

Вместо печати графики я хочу использовать резидентный шрифт принтера. Как?

--------------------------------------------------------------------------------

Используте функцию Windows API - GetStockObject() чтобы получить дескриптор (handle) шрифта по умолчанию устройства (DEVICE_DEFAULT_FONT) и передайте его Printer.Font.Handle.
Пример:

 
uses Printers;
procedure TForm1.Button1Click(Sender: TObject);
var tm : TTextMetric;    
    i : integer;
begin    
 if PrintDialog1.Execute then    
  begin        
   Printer.BeginDoc;        
   Printer.Canvas.Font.Handle := GetStockObject(DEVICE_DEFAULT_FONT);        
   GetTextMetrics(Printer.Canvas.Handle, tm);        
   for i := 1 to 10 do Printer.Canvas.TextOut(100,i * tm.tmHeight + tm.tmExternalLeading,'Test');       Printer.EndDoc;    
  end;
end;

2-ой пример:

unit Esc1;
 
interface
 
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{ add the printers unit }
uses
   Printers;
 
{$R *.DFM}
 
{ declare the "PASSTHROUGH" structure }
type TPrnBuffRec = record
  BuffLength : word;
  Buffer : array [0..255] of char;
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
var
  Buff : TPrnBuffRec;
  TestInt : integer;
  s : string;
begin
 
{ Test to see if the "PASSTHROUGH" escape is supported }
  TestInt := PASSTHROUGH;
  if Escape(Printer.Handle,
            QUERYESCSUPPORT,
            sizeof(TestInt),
            @TestInt,
            nil) > 0 then begin
 
  { Start the printout }
    Printer.BeginDoc;
 
  { Make a string to passthrough }
    s := ' A Test String ';
 
  { Copy the string to the buffer }
    StrPCopy(Buff.Buffer, s);
 
  { Set the buffer length }
    Buff.BuffLength := StrLen(Buff.Buffer);
 
  { Make the escape}
    Escape(Printer.Canvas.Handle,
           PASSTHROUGH,
           0,
           @Buff,
           nil);
 
  { End the printout }
    Printer.EndDoc;
  end;
end;
 
end.