Obsługa wydruków dokumentów

1.   Druk tekstu


var F: TextFile;

begin AssignFile(F, 'LPT1');   Rewrite(F);   Writeln(F, 'Serwus');   Writeln(F, 'Druga linia!');   Writeln(F, #12);   CloseFile(F);
end;

2.   Druk tekst z pomocą okienka TPrintDialog


unit Unit1;   interface uses {...,}ComCtrls;

type TForm1 = class(TForm)
Button1: TButton; PrintDialog1: TPrintDialog; RichEdit1: TRichEdit;
procedure Button1Click(Sender: TObject);
{...}
end;

var Form1: TForm1;

implementation     {$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
if PrintDialog1.Execute then
Richedit1.Print('Ltp1');   {Ltp1, Lpt2 port drukarki}
end;

end.

3.   Druk obszaru


uses Printers;

procedure PrintText(Text: string);
begin
with Printer do begin
BeginDoc;   Canvas.TextOut(5, 50, Text);   EndDoc;
end;   end;

4. Druk - skalowanie w milimetrach


uses   printers;

procedure TForm1.Button1Click(Sender: TObject);
begin
printer.BeginDoc;     //Each logical unit is mapped to 0.1 millimeter.
//Positive x is to the right; positive y is up.
SetMapMode(printer.Canvas.Handle, MM_LOMETRIC);
with printer.Canvas do begin     //font 5 mm height
Font.Height := 50;   Font.Name := 'Verdana';
TextOut(250, - 110, 'SwissDelphiCenter');
TextOut(250, - 180, 'http://www.swissdelphicenter.ch');
MoveTo(250, - 240);   //Draw a line of 7,5 cm
LineTo(1000, - 240);
end;   printer.EndDoc;
end;

5. Druk o
azu - TImage


uses Printers;

{1.wersja }
procedure TForm1.Button1Click(Sender: TObject);
var ScaleX, ScaleY: Integer; RR: TRect;
begin
with Printer do begin
BeginDoc;     // / The StartDoc function starts a print job.
try
ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
// Retrieves information about the Pixels per Inch of the Printer.
RR := Rect(0, 0, Image1.picture.Width * scaleX, Image1.Picture.Height * ScaleY);
Canvas.StretchDraw(RR, Image1.Picture.Graphic);     // Stretch to fit
finally     EndDoc;     // Textdatei-Variable.
end; end; end;

{2.wersja }
procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
var BitmapHeader: pBitmapInfo; BitmapImage: Pointer; HeaderSize: DWORD; ImageSize: DWORD;
begin
GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
GetMem(BitmapHeader, HeaderSize);     GetMem(BitmapImage, ImageSize);
try
GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
StretchDIBits(Canvas.Handle,
DestRect.Left, DestRect.Top,     // Destination Origin
DestRect.Right - DestRect.Left,     // Destination Width
DestRect.Bottom - DestRect.Top,     // Destination Height
0, 0,     // Source Origin
Bitmap.Width, Bitmap.Height,     // Source Width   Height
BitmapImage, TBitmapInfo(BitmapHeader^), DIB_RGB_COLORS, SRCCOPY)
finally     FreeMem(BitmapHeader);     FreeMem(BitmapImage) end
end     {PrintBitmap};

{3. wersja }
procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
var Header, Bits: Pointer; HeaderSize: DWORD; BitsSize: DWORD;
begin
GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
Header := AllocMem(HeaderSize);     Bits := AllocMem(BitsSize);
try
GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
DestRect.Right, DestRect.Bottom,
0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^),
DIB_RGB_COLORS, SRCCOPY);
finally     FreeMem(Header, HeaderSize);     FreeMem(Bits, BitsSize);
end; end;

procedure PrintImage(Image: TImage; ZoomPercent: Integer);
// if ZoomPercent=100, Image will be printed across the whole page
var relHeight, relWidth: integer;
begin
Screen.Cursor := crHourglass;     Printer.BeginDoc;
with Image.Picture.Bitmap do begin
if ((Width / Height) > (Printer.PageWidth / Printer.PageHeight)) then begin
// Stretch Bitmap to width of PrinterPage
relWidth := Printer.PageWidth;     relHeight := MulDiv(Height, Printer.PageWidth, Width);
end else begin     // Stretch Bitmap to height of PrinterPage
relWidth := MulDiv(Width, Printer.PageHeight, Height);
relHeight := Printer.PageHeight;
end;
relWidth := Round(relWidth * ZoomPercent / 100);
relHeight := Round(relHeight * ZoomPercent / 100);
DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), Image.Picture.Bitmap);
end;
Printer.EndDoc;     Screen.cursor := crDefault;
end;

// przykład:
procedure TForm1.Button1Click(Sender: TObject);
begin     // Druk image w skali 40% zoom:
PrintImage(Image1, 40);
end;

6.  Zapis ustawienia drukarki do pliku


procedure TForm1.Button1Click(Sender: TObject);
var PrinterSetup: TPrinterSetup
begin
PrinterSetup := TPrinterSetup.Create;     PrinterSetup.SaveSetup(FileName);
//where file name is a string to the location of the File ex.'c:\print.cfg'
PrinterSetup.Free;
end

{odrębny plik*****}
unit PrinterSetup;

interface

uses printers, windows, SysUtils, Classes, WinSpool;

type TPrinterSetup = class

private
Device, Driver, Port: array[0..CCHDEVICENAME] of char;
DeviceMode: THandle;
procedure Refresh;
protected
public
procedure SaveSetup(FileName: TFilename);
procedure LoadSetup(FileName: TFilename);
end;
TPrinterConfig = record
ADevice, ADriver, APort: array[0..CCHDEVICENAME] of char;
SizeOfDeviceMode: DWORD;
end;

implementation

procedure TPrinterSetup.Refresh;
begin
Printer.GetPrinter(Device, Driver, Port, DeviceMode);
end;

procedure TPrinterSetup.SaveSetup(FileName: TFilename);
var StubDevMode: TDeviceMode; SetupPrinter: TPrinterConfig; FPrinterHandle: THandle;
fFileConfig: file of TPrinterConfig; fFileDevMode: file of Char; pDevMode: PChar; Contador: Integer;
begin
Refresh; with SetupPrinter do begin
StrLCopy(ADevice, Device, SizeOf(ADevice));     StrLCopy(ADriver, Driver, SizeOf(ADriver));
StrLCopy(APort, Port, SizeOf(APort));     OpenPrinter(Device, FPrinterHandle, nil);
SizeOfDeviceMode := DocumentProperties(0, FPrinterHandle, Device,
StubDevMode, StubDevMode, 0);
end;
AssignFile(fFileConfig, FileName);     ReWrite(fFileConfig);
Write(fFileConfig, SetupPrinter);     CloseFile(fFileConfig);
AssignFile(fFileDevMode, FileName);     Reset(fFileDevMode);
Seek(fFileDevMode, FileSize(fFileDevMode));     pDevMode := GlobalLock(DeviceMode);
for Contador := 0 to SetupPrinter.SizeOfDeviceMode - 1 do begin
Write(fFileDevMode, pDevMode[Contador]);
end;
CloseFile(fFileDevMode);     GlobalUnLock(DeviceMode);
end;

procedure TPrinterSetup.LoadSetup(FileName: TFilename);
var SetupPrinter: TPrinterConfig; fFileConfig: file of TPrinterConfig; fFileDevMode: file of Char;
ADeviceMode: THandle; pDevMode: PChar; Contador: Integer;
begin
if FileExists(FileName) then begin
AssignFile(fFileConfig, FileName);     Reset(fFileConfig);
read(fFileConfig, SetupPrinter);     CloseFile(fFileConfig);
AssignFile(fFileDevMode, FileName);     Reset(fFileDevMode);
Seek(fFileDevMode, SizeOf(SetupPrinter));
ADeviceMode := GlobalAlloc(GHND,     SetupPrinter.SizeOfDeviceMode);
pDevMode := GlobalLock(ADeviceMode);
for Contador := 0 to SetupPrinter.SizeOfDeviceMode - 1 do begin
read(fFileDevMode, char(pDevMode[Contador]));
end;
CloseFile(fFileDevMode);     GlobalUnLock(ADeviceMode);
Printer.SetPrinter(SetupPrinter.ADevice, SetupPrinter.ADriver,
SetupPrinter.APort, ADeviceMode);
end; end;

end.

7.   Ustawienie minimalnego marginesu drukarki


type TMargins = record
Left, Top, Right, Bottom: Double
end;

procedure GetPrinterMargins(var Margins: TMargins);
var PixelsPerInch: TPoint; PhysPageSize: TPoint; OffsetStart: TPoint; PageRes: TPoint;
begin
PixelsPerInch.y := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
PixelsPerInch.x := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
Escape(Printer.Handle, GETPHYSPAGESIZE, 0, nil, @PhysPageSize);
Escape(Printer.Handle, GETPRINTINGOFFSET, 0, nil, @OffsetStart);
PageRes.y := GetDeviceCaps(Printer.Handle, VERTRES);
PageRes.x := GetDeviceCaps(Printer.Handle, HORZRES);
Margins.Top := OffsetStart.y / PixelsPerInch.y;     // margines górny
Margins.Left := OffsetStart.x / PixelsPerInch.x;     // margines lewy
Margins.Bottom := ((PhysPageSize.y - PageRes.y) / PixelsPerInch.y) - (OffsetStart.y / PixelsPerInch.y);     // margines dolny
Margins.Right := ((PhysPageSize.x - PageRes.x) / PixelsPerInch.x) - (OffsetStart.x / PixelsPerInch.x);     // margines prawy
end;

function InchToCm(Pixel: Single): Single;     // Convert inch to Centimeter
begin
Result := Pixel * 2.54
end;

procedure TForm1.Button1Click(Sender: TObject);
var Margins: TMargins;
begin
GetPrinterMargins(Margins);
ShowMessage(Format('Margins: (Left: %1.3f, Top: %1.3f, Right: %1.3f, Bottom: %1.3f)',
[InchToCm(Margins.Left),     InchToCm(Margins.Top),
InchToCm(Margins.Right),     InchToCm(Margins.Bottom)]));
end;

8.   Sprawdzenie czy drukarka drukuje w kolorze


uses Printers, WinSpool;

procedure TForm1.Button1Click(Sender: TObject);
var Dev, Drv, Prt: array[0..255] of Char;
DM1: PDeviceMode; DM2: PDeviceMode; Sz: Integer; DevM: THandle;
begin
Printer.PrinterIndex := -1;     Printer.GetPrinter(Dev, Drv, Prt, DevM);
DM1 := nil;     DM2 := nil;
Sz := DocumentProperties(0, 0, Dev, DM1^, DM2^, 0); GetMem(DM1, Sz);
DocumentProperties(0, 0, Dev, DM1^, DM2^, DM_OUT_BUFFER);
if DM1^.dmColor > 1 then     label1.Caption := Dev + ': Można w kolorze'
else     label1.Caption := Dev + ': Czarno - biała';
if DM1^.dmFields and DM_Color < > 0 then
Label2.Caption := 'Drukarka może drukować w kolorze'
else     Label2.Caption := 'Przykro mi ale jestem monochromatyczna';
FreeMem(DM1);
end;

9.   Wykaz rozmiarów drukowanych stron w drukarce


Uses Printers, WinSpool;

procedure GetPapernames(sl: TStrings);
type
TPaperName = array [0..63] of Char;
TPaperNameArray = array [1..High(Word) div SizeOf(TPaperName)] of TPaperName;
PPapernameArray = ^TPaperNameArray;
var Device, Driver, Port: array [0..255] of Char;
hDevMode: THandle; i, numPaperformats: Integer; pPaperFormats: PPapernameArray;
begin
Printer.PrinterIndex := -1;     // Standard printer
Printer.GetPrinter(Device, Driver, Port, hDevmode);
numPaperformats := WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, nil, nil);
if numPaperformats 0 then begin
GetMem(pPaperformats, numPaperformats * SizeOf(TPapername));
try     WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES,
PChar(pPaperFormats), nil);     sl.Clear;
for i := 1 to numPaperformats do sl.Add(pPaperformats^[i]);
finally     FreeMem(pPaperformats);     end;
end;     end;

procedure TForm1.Button1Click(Sender: TObject);
begin
GetPapernames(memo1.Lines);
end;

10.   Drukowanie TStringgrida wariant I


uses printers;

//StringGrid Inhalt ausdrucken
procedure PrintStringGrid(Grid: TStringGrid; Title: string; Orientation: TPrinterOrientation);
var P, I, J, YPos, XPos, HorzSize, VertSize: Integer; AnzSeiten, Seite, Zeilen, HeaderSize, FooterSize, ZeilenSize, FontHeight: Integer; mmx, mmy: Extended; Footer: string;
begin
//Kopfzeile, Fußzeile, Zeilenabstand, Schriftgröße festlegen
HeaderSize := 100; FooterSize := 200; ZeilenSize := 36; FontHeight := 36;   //Printer initializieren
Printer.Orientation := Orientation;   Printer.Title := Title;   Printer.BeginDoc;
//Druck auf mm einstellen
mmx := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALWIDTH) /
GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX) * 25.4;
mmy := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALHEIGHT) /
GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY) * 25.4;

VertSize := Trunc(mmy) * 10; HorzSize := Trunc(mmx) * 10;
SetMapMode(Printer.Canvas.Handle, MM_LOMETRIC);

//Zeilenanzahl festlegen
Zeilen := (VertSize - HeaderSize - FooterSize) div ZeilenSize; //Seitenanzahl ermitteln
if Grid.RowCount mod Zeilen < > 0 then   AnzSeiten := Grid.RowCount div Zeilen + 1
else AnzSeiten := Grid.RowCount div Zeilen;
Seite := 1; //Grid Drucken
for P := 1 to AnzSeiten do begin   //Kopfzeile
Printer.Canvas.Font.Height := 48;
Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth(Title) div 2)), - 20,Title);
Printer.Canvas.Pen.Width := 5; Printer.Canvas.MoveTo(0, - HeaderSize);
Printer.Canvas.LineTo(HorzSize, - HeaderSize);   //Fußzeile
Printer.Canvas.MoveTo(0, - VertSize + FooterSize);
Printer.Canvas.LineTo(HorzSize, - VertSize + FooterSize);
Printer.Canvas.Font.Height := 36;
Footer := 'Seite: ' + IntToStr(Seite) + ' von ' + IntToStr(AnzSeiten);
Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth(Footer) div 2)), - VertSize + 150,Footer); //Zeilen drucken
Printer.Canvas.Font.Height := FontHeight;   YPos := HeaderSize + 10;
for I := 1 to Zeilen do begin
if Grid.RowCount > = I + (Seite - 1) * Zeilen then begin   XPos := 0;
for J := 0 to Grid.ColCount - 1 do begin
Printer.Canvas.TextOut(XPos, - YPos, Grid.Cells[J, I + (Seite - 1) * Zeilen - 1]); XPos := XPos + Grid.ColWidths[J] * 3; end;
YPos := YPos + ZeilenSize;   end; end;   //Seite hinzufügen
Inc(Seite);   if Seite < = AnzSeiten then Printer.NewPage; end;   Printer.EndDoc;
end;

//Przykład:
procedure TForm1.Button1Click(Sender: TObject);
begin //Drucken im Querformat
PrintStringGrid(Grid, 'StringGrid Print Landscape', poLandscape);   //Drucken im Hochformat
PrintStringGrid(Grid, 'StringGrid Print Portrait', poPortrait);
end;

11.   Drukowanie StringGrida - wariant II


procedure PrintGrid(sGrid: TStringGrid; sTitle: string);
var X1, X2: Integer; Y1, Y2: Integer; TmpI: Integer; F: Integer; TR: TRect;
begin
Printer.Title := sTitle;     Printer.BeginDoc;
Printer.Canvas.Pen.Color := 0;
Printer.Canvas.Font.Name := 'Times New Roman';
Printer.Canvas.Font.Size := 12;
Printer.Canvas.Font.Style := [fsBold, fsUnderline];
Printer.Canvas.TextOut(0, 100, Printer.Title);
for F := 1 to sGrid.ColCount - 1 do begin
X1 := 0;     for TmpI := 1 to (F - 1) do
X1 := X1 + 5 * (sGrid.ColWidths[TmpI]);     Y1 := 300;     X2 := 0;
for TmpI := 1 to F do
X2 := X2 + 5 * (sGrid.ColWidths[TmpI]);     Y2 := 450;     TR := Rect(X1, Y1, X2 - 30, Y2);
Printer.Canvas.Font.Style := [fsBold];
Printer.Canvas.Font.Size := 7;
Printer.Canvas.TextRect(TR, X1 + 50, 350, sGrid.Cells[F, 0]);
Printer.Canvas.Font.Style := [];     for TmpI := 1 to sGrid.RowCount - 1 do begin
Y1 := 150 * TmpI + 300;     Y2 := 150 * (TmpI + 1) + 300;     TR := Rect(X1, Y1, X2 - 30, Y2);
Printer.Canvas.TextRect(TR, X1 + 50, Y1 + 50, sGrid.Cells[F, TmpI]);
end;     end;     Printer.EndDoc;
end;

//przykład:
procedure TForm1.Button1Click(Sender: TObject);
begin
PrintGrid(StringGrid1, 'Drukowanie Stringgrida');
end;

12. Wykaz sterowników drukarki


{1. wersja }
uses Printers, Winspool;

procedure TForm1.FormCreate(Sender: TObject);
begin
ComboBox1.Items.Assign(Printer.Printers);
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var hPrinter: THandle; PrtName: string; DriverInfo: PDriverInfo2; dwNeeded: DWORD;
begin
Memo1.Clear; PrtName := Combobox1.Text;
OpenPrinter(PChar(PrtName), hPrinter, nil);
GetPrinterDriver(hPrinter, nil, 2, DriverInfo, 0, dwNeeded);
GetMem(DriverInfo, dwNeeded);
if GetPrinterDriver(hPrinter, nil, 2, DriverInfo, dwNeeded, dwNeeded) then begin     // dodaje info do Memo1
Memo1.Lines.Add('Version: ' + IntToStr(DriverInfo.cVersion));
Memo1.Lines.Add(StrPas(DriverInfo.pName));
Memo1.Lines.Add(StrPas(DriverInfo.pEnvironment));
Memo1.Lines.Add(StrPas(DriverInfo.pDriverPath));
Memo1.Lines.Add(StrPas(DriverInfo.pDataFile));
Memo1.Lines.Add(StrPas(DriverInfo.pConfigFile));
end else Memo1.Lines.Add('No Info needed = ' + IntToStr(dwNeeded));
ClosePrinter(hPrinter);     FreeMem(DriverInfo);
end;

{2. wersja******}
unit Unit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, WinSpool;

type TForm1 = class(TForm)
Button1: TButton; ListBox1: TListBox;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
private { Private-Deklarationen }
pEnumDriversData: PDriverInfo2;
public { Public-Deklarationen }
end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ListBox1Click(Sender: TObject);
var pTemp: PDriverInfo2;
begin
with Sender as TListbox do begin
if ItemIndex >= 0 then begin
memo1.Clear;     pTemp := PDriverInfo2(Items.Objects[ItemIndex]);
with memo1.Lines, pTemp^ do begin
Add(Format('cVersion:'#9#9'%d', [cVersion]));
Add(Format('pName:'#9#9'%s', [pName]));
Add(Format('pEnvironment:'#9'%s', [pEnvironment]));
Add(Format('pDriverPath:'#9'%s', [pDriverPath]));
Add(Format('pDataFile:'#9#9'%s', [pDataFile]));
Add(Format('pConfigFile:'#9'%s', [pConfigFile]));
end; end; end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i, bytesNeeded: DWORD; pTemp: PDriverInfo2; NumDrivers: DWORD;
begin
listbox1.Clear; if Assigned(pEnumDriversData) then     FreeMem(pEnumDriversData);
// get number of installed drivers
Numdrivers := 0; bytesNeeded := 0;
EnumPrinterDrivers(nil, nil, 2, nil, 0, bytesNeeded, NumDrivers);
if bytesNeeded = 0 then begin
ShowMessage('No printer drivers installed!');     Exit;
end;

GetMem(pEnumDriversData, bytesNeeded);     // allocate memory for the driver data
if EnumPrinterDrivers(nil, nil, 2, pEnumDriversData, bytesNeeded,
bytesNeeded, NumDrivers) then begin     // fetch driver data
pTemp := pEnumDriversData;     // add drivers to listbox1
for i := 1 to Numdrivers do begin
listbox1.Items.AddObject(pTemp^.pName, TObject(pTemp));     Inc(pTemp);
// Note: Inc increments a pointer by the size of its base type!
end;
listbox1.ItemIndex := 0;     listbox1Click(listbox1);
end     else     RaiseLastWin32Error;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(pEnumDriversData) then     FreeMem(pEnumDriversData);
end;

end.

13.   Ustawienie drukarki domyślnej


uses Printers, Messages;

function GetDefaultPrinter: string;
var ResStr: array[0..255] of Char;
begin
GetProfileString('Windows', 'device', '', ResStr, 255);     Result := StrPas(ResStr);
end;

procedure SetDefaultPrinter1(NewDefPrinter: string);
var ResStr: array[0..255] of Char;
begin
StrPCopy(ResStr, NewdefPrinter);     WriteProfileString('windows', 'device', ResStr);
StrCopy(ResStr, 'windows'); SendMessage(HWND_
OADCAST, WM_WININICHANGE, 0, Longint(@ResStr));
end;

procedure SetDefaultPrinter2(PrinterName: string);
var I: Integer; Device: PChar; Driver: PChar; Port: PChar; HdeviceMode: THandle; aPrinter: TPrinter;
begin
Printer.PrinterIndex := -1;     GetMem(Device, 255);     GetMem(Driver, 255);     GetMem(Port, 255);
aPrinter := TPrinter.Create;
try for I := 0 to Printer.Printers.Count - 1 do begin
if Printer.Printers = PrinterName then begin
aprinter.PrinterIndex := i;     aPrinter.getprinter(device, driver, port, HdeviceMode);
StrCat(Device, ',');     StrCat(Device, Driver);     StrCat(Device, Port);
WriteProfileString('windows', 'device', Device);     StrCopy(Device, 'windows');
SendMessage(HWND_
OADCAST, WM_WININICHANGE, 0, Longint(@Device));
end; end; finally     aPrinter.Free;     end;
FreeMem(Device, 255);    FreeMem(Driver, 255);     FreeMem(Port, 255);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := GetDefaultPrinter2;
end;

//Fill the combobox with all available printers
procedure TForm1.FormCreate(Sender: TObject);
begin
Combobox1.Items.Clear;     Combobox1.Items.AddStrings(Printer.Printers);
end;

//Set the selected printer in the combobox as default printer
procedure TForm1.Button2Click(Sender: TObject);
begin
SetDefaultPrinter(Combobox1.Text);
end;

14.   Odczyt rozmiaru papieru (strony) w milimetrach


procedure TForm1.Button1Click(Sender: TObject);
var papermmx,    papermmy: Extended;
begin
Printer.BeginDoc;
// PHYSICALWIDTH = szer. papieru
// LOGPIXELSX = DPI (rozdzielczość piksele na cal) 25.4 = przelicznik z cali na MM
papermmx := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALWIDTH) /
GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX) * 25.4;
papermmy := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALHEIGHT) /
GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY) * 25.4;

with Printer.Canvas do begin
TextOut(200, 100, floattostr(papermmx) + ' mm x ' + floattostr(papermmy) + ' mm');
end; Printer.EndDoc;
end;

15.   Domyślna rozdzielczość drukarki


uses Printers;

function GetPixelsPerInchX: Integer;
begin
Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
end;

function GetPixelsPerInchY: Integer;
begin
Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := Format('x: %d y: %d DPI (dots per inch)', [GetPixelsPerInchX, GetPixelsPerInchY]);
end;

16.   Port i nazwa podłączonej drukarki


type TPrinterDevice = class   {type definition NOT interfaced by Printers.pas}
Driver, Device, Port: string;
end; { .... }

uses Printers; { .... }

function GetCurrentPrinterPort: string;
begin
Result := TPrinterDevice(Printer.Printers.Objects[Printer.PrinterIndex]).Port;
end;

{The exact printer's name known to Windows for use in API calls can be obtained by:}
function GetCurrentPrinterName: string;
begin
Result := TPrinterDevice(Printer.Printers.Objects[Printer.PrinterIndex]).Device;
end;

//przykład:
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := GetCurrentPrinterPort;   Label2.Caption := GetCurrentPrinterName;
end;

17. Wydruk obiektu typu TStrings.


Funkcja poniżej przyjmuje jako parametr obiekt typu TStrings i drukowanie każdej linii w drukarkę domyślną. Jako parametr typu obiektu jest TStrings, funkcja ta działa z wszelkiego rodzaju składników, które pochodzą od TStrings właściwości (np. TDBMemo, TListBox, TMemo, TOutline, itp.).

uses Printers;

procedure PrintStrings(Strings: TStrings);
var Prn: TextFile; i: word;
begin
AssignPrn(Prn); try Rewrite(Prn); try for i := 0 to Strings.Count - 1 do
writeln(Prn, Strings.Strings[i]); finally CloseFile(Prn);
end; except
on EInOutError do
MessageDlg(' Błąd drukowania tekstu.', mtError, [mbOk], 0);
end; end;

Aby wydrukować zawartość TStringList, należy użyć następującej składni: PrintStrings(Listbox1.Items);

18. Jak określić liczbę zadań drukowania


komenda Windowsa wm_spoolerstatus zawsze wysyła dodaje lub usuwa zadania drukowania. W przykładzie poniżej przechwytujemy tę wiadomość.

typetform1 = 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;

19. Jak znaleźć wszystkie rozmiary papieru obsługiwane przez drukarkę?


uses printers, winspool;

procedure getpapernames(sl: tstrings);
type
tpapername = array [0..63] of char;
tpapernamearray = array [1..high(word) div sizeof(tpapername)] of tpapername;
ppapernamearray = ^tpapernamearray;
var
device, driver, port: array [0..255] of char; hdevmode: thandle;
i, numpaperformats: integer; ppaperformats: ppapernamearray;
begin
printer.printerindex := -1; // standard printer
printer.getprinter(device, driver, port, hdevmode);
numpaperformats := winspool.devicecapabilities(device, port, dc_papernames, nil, nil);
if numpaperformats 0 then
begin
getmem(ppaperformats, numpaperformats * sizeof(tpapername));
try
winspool.devicecapabilities(device, port, dc_papernames, pchar(ppaperformats), nil);
sl.clear;
for i := 1 to numpaperformats do sl.add(ppaperformats^[i]);
finally freemem(ppaperformats); end; end;
end;

procedure tform1.button1click(sender: tobject);
begin
getpapernames(memo1.lines);
end;

20. Jak zmienić domyślną drukarkę?


Opcja 1. Jeśli jest win.ini:

uses inifiles;

procedure tform1.button1click(sender: tobject);
var winini: tinifile; wininifilename: array [0..max_path] of char; s: array [0..64] of char;
begin
getwindowsdirectory(wininifilename, sizeof(wininifilename));
strcat(wininifilename, 'win.ini'); winini := tinifile.create(wininifilename);
try winini.writestring('windows','device', 'hp laserjet series ii,hppcl,lpt1:');
finally winini.free; end;
strcopy(s, 'windows');
sendmessage(hwnd_
oadcast, wm_wininichange, 0, longint(@s));
end;

opcja 2 Jak odczytać / ustawić drukarkę domyślną?

uses printers, messages;

function getdefaultprinter: string;
var resstr: array[0..255] of char;
begin
getprofilestring('windows', 'device', '', resstr, 255); result := strpas(resstr);
end;

procedure setdefaultprinter1(newdefprinter: string);
var resstr: array[0..255] of char;
begin
strpcopy(resstr, newdefprinter); writeprofilestring('windows', 'device', resstr);
strcopy(resstr, 'windows');
sendmessage( hwnd _
oadcast , wm_wininichange, 0, longint(@resstr));
end;

procedure setdefaultprinter2(printername: string);
var i: integer; device: pchar; driver: pchar; port: pchar;
hdevicemode: thandle; printer: tprinter;
begin
printer.printerindex := -1; getmem(device, 255);
getmem(driver, 255); getmem(port, 255);
aprinter := tprinter.create;
try for i := 0 to printer.printers.count - 1 do
begin
if printer.printers = printername then
begin
aprinter.printerindex := i; aprinter.getprinter(device, driver, port, hdevicemode);
strcat(device, ','); strcat(device, driver); strcat(device, port);
writeprofilestring('windows', 'device', device); strcopy(device, 'windows');
sendmessage( hwnd _
oadcast , wm_wininichange, 0, longint(@device));
end; end;
finally aprinter.free; end; freemem(device, 255); freemem(driver, 255);
freemem(port, 255);
end;

procedure tform1.button1click(sender: tobject);
begin
label1.caption := getdefaultprinter2;
end;

//wypełnia combobox wszystkimi dostępnymi drukarkami
procedure tform1.formcreate(sender: tobject);
begin
combobox1.items.clear;
combobox1.items.addstrings(printer.printers);
end;

//ustaw wy
aną drukarkę w combobox jako drukarkę domyślną
procedure tform1.button2click(sender: tobject);
begin
setdefaultprinter(combobox1.text);
end;

21. Wydruk komponentu TStringGrid z tabelami - kolejna wersja.


uses printers;

procedure printgrid(sgrid: tstringgrid; stitle: string);
var x1, x2: integer; y1, y2: integer; tmpi: integer; f: integer; tr: trect;
begin
printer.title := stitle; printer.begindoc;
//Te ustawienia mogą być zmieniane
printer.canvas.pen.color := 0; printer.canvas.font.name := 'times new roman';
printer.canvas.font.size := 12; printer.canvas.font.style := [fsbold, fsunderline];
printer.canvas.textout(0, 100, printer.title);
for f := 1 to sgrid.colcount - 1 do
begin
x1 := 0; for tmpi := 1 to (f - 1) do
x1 := x1 + 5 * (sgrid.colwidths[tmpi]); y1 := 300; x2 := 0;
for tmpi := 1 to f do
x2 := x2 + 5 * (sgrid.colwidths[tmpi]); y2 := 450; tr := rect(x1, y1, x2 - 30, y2);
printer.canvas.font.style := [fsbold]; printer.canvas.font.size := 7;
printer.canvas.textrect(tr, x1 + 50, 350, sgrid.cells[f, 0]);
printer.canvas.font.style := []; for tmpi := 1 to sgrid.rowcount - 1 do
begin
y1 := 150 * tmpi + 300; y2 := 150 * (tmpi + 1) + 300;
tr := rect(x1, y1, x2 - 30, y2);
printer.canvas.textrect(tr, x1 + 50, y1 + 50, sgrid.cells[f, tmpi]);
end; end; printer.enddoc;
end;

22. Druk tekstu spod Delphi z tworzeniem kopii na TMemo.


procedure teditform.printed;
var line: integer; printtext: system.text;
begin
assignprn(printtext); rewrite(printtext);
printer.canvas.font := memo1.font;
for line := 0 to memo2.lines.count - 1 do
writeln(printtext, memo2.lines[line]); system.close(printtext);
end;

W ramach innej opcji można taki tekst zapisać do pliku tekstowego i wysłać go do np, portu LPT1.

23. Jak programowo zmienić obecny port drukarki?


Użyj klasy SetPrinter TPrinter. przykład:

uses Printers;
{$IFNDEF WIN32} const MAX_PATH = 144; {$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);
var pDevice : pChar; pDriver : pChar; pPort : pChar;
hDMode : THandle; PDMode : PDEVMODE;
begin
if PrintDialog1.Execute then
begin
GetMem(pDevice, cchDeviceName); GetMem(pDriver, MAX_PATH);
GetMem(pPort, MAX_PATH);
Printer.GetPrinter(pDevice, pDriver, pPort, hDMode);
Printer.SetPrinter(pDevice, PDriver, 'FILE:', hDMode);
FreeMem(pDevice, cchDeviceName); FreeMem(pDriver, MAX_PATH);
FreeMem(pPort, MAX_PATH); Printer.BeginDoc;
Printer.Canvas.TextOut(100, 100, 'Delphi jest fajna!'); Printer.EndDoc; end;
end;

24. Jak określić rozmiar strony bez TPrintSetupDialog


var Device : array[0..cchDeviceName-1] of Char;
Driver : array[0..(MAX_PATH-1)] of Char; Port : array[0..32] of Char;
hDMode : THandle; pDMode : PDevMode; sDev : array[0..32] of Char;
begin
Printer.GetPrinter(Device,Driver,Port,hDMode);
if hDMode < > 0 then
begin
pDMode :=GlobalLock(hDMode); if pDMode < > nil then
begin
pdMode^.dmOrientation :=2; //landscape - pozioma
pdMode^.dmPaperSize := DMPAPER_A3; GlobalUnlock(hDMode);
end; end; . . .

25. Drukowanie do pliku - wariant.


uses printers;
{$R *.DFM}

procedure StartPrintToFile(filename: string);
var CTitle: array[0..31] of Char; DocInfo: TDocInfo;
begin
with Printer do
begin
BeginDoc; EndPage(Canvas.handle); Windows.AbortDoc(Canvas.handle);
StrPLCopy(CTitle, Title, SizeOf(CTitle) - 1); { Restart i druk do pliku jako miejsce docelowe. }
FillChar(DocInfo, SizeOf(DocInfo), 0); with DocInfo do
begin
cbSize := SizeOf(DocInfo); lpszDocName := CTitle; lpszOutput := PChar(filename);
end;
StartDoc(Canvas.handle, DocInfo); StartPage(Canvas.handle); end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
StartPrintToFile('C:\temp\temp.prn');
try Printer.Canvas.TextOut(100, 100, 'Hello World.');
finally Printer.endDoc; end;
end;

26. Druk do pliku - wersja od Delphi 2010


procedure TForm1.BitBtn1Click(Sender: TObject);
begin
with PrintDialog1 do
begin
Options := [poPrintToFile]; PrintToFile := True; if Execute then
begin
if PrintToFile then
begin
SaveDialog1.Title := 'Druk do pliku: '; { zapis w formacie UTF8. }
if SaveDialog1.Execute then
RichEdit1.Lines.SaveToFile(SaveDialog1.FileName, TEncoding.UTF8);
end else RichEdit1.Print(''); end; end;
end;

procedure TForm1.FormCreate(Sender: TObject);
const Path = 'OverView.RTF';// być może trzeba zmienić ścieżkę.
begin
RichEdit1.PlainText := False; { odczyt w formacie UTF8 }
RichEdit1.Lines.LoadFromFile(Path, TEncoding.UTF8);
RichEdit1.ScrollBars := ssVertical;
end;

27. Podgląd tekstu RichEdita przed drukowaniem.


Aby wyświetlić sformatowany tekst na każdym płótnie należy użyć standardowego zdarzenia EM_FORMATRANGE.

function PrintRTFToBitmap(ARichEdit : TRichEdit; ABitmap : TBitmap) : Longint;
var range : TFormatRange;
begin
FillChar(Range, SizeOf(TFormatRange), 0);
// Rendering to the same DC we are measuring.
Range.hdc := ABitmap.Canvas.handle;
Range.hdcTarget := ABitmap.Canvas.Handle;// ustaw stronę.
Range.rc.left := 0; Range.rc.top := 0;
Range.rc.right := ABitmap.Width * 1440 div Screen.PixelsPerInch;
Range.rc.Bottom := ABitmap.Height * 1440 div Screen.PixelsPerInch;
// Domyślnie druk tekstu całego dokumentu.
Range.chrg.cpMax := -1; Range.chrg.cpMin := 0;
// format tekstu - sformatowany
Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
// zwolnienie bufora dla tej informacji
SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0);
end;

Wariant 2 - pokazuje w jaki sposób wyświetlać i drukować tylko określony fragment tekstu ...

function PrintToCanvas(ACanvas : TCanvas; FromChar, ToChar : integer;
ARichEdit : TRichEdit; AWidth, AHeight : integer) : Longint;
var Range : TFormatRange;
begin
FillChar(Range, SizeOf(TFormatRange), 0); Range.hdc := ACanvas.handle;
Range.hdcTarget := ACanvas.Handle;
Range.rc.left := 0; Range.rc.top := 0;
Range.rc.right := AWidth * 1440 div Screen.PixelsPerInch;
Range.rc.Bottom := AHeight * 1440 div Screen.PixelsPerInch;
Range.chrg.cpMax := ToChar; Range.chrg.cpMin := FromChar;
Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0);
end;

Wariant 3 - podgląd i druk tekstu RichEdita z o
azem w tle.

Należy narysować na płótnie o
az i RichEdita a następnie połączyć to:

procedure TForm1.Button2Click(Sender: TObject);
var Bmp : TBitmap;
begin
Bmp := TBitmap.Create; bmp.Width := 300; bmp.Height := 300;
PrintToCanvas(bmp.Canvas,2,5,RichEdit1,300,300);
BitBlt(Image1.Picture.Bitmap.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height,
bmp.Canvas.Handle, 0, 0, srcAND); Image1.Repaint;
bmp.Free;
end;

28. Wydruk pliku Excela z użyciem OLE.


uses ComObj;

procedure TForm1.Button1Click(Sender: TObject);
var ExcelApp: OLEVariant;
begin
// tworzenie objektu dla wystąpienia pliku Excela
ExcelApp := CreateOleObject('Excel.Application');
try
ExcelApp.Workbooks.Open('C:\test\xyz.xls');
//można tu zmodyfikować ustawienia z PageSetup
ExcelApp.ActiveSheet.PageSetup.Orientation := xlLandscape;
ExcelApp.Worksheets.PrintOut; //wydrukuj
finally if not VarIsEmpty(ExcelApp) then // zamknij Excel
begin
ExcelApp.Quit; ExcelApp := Unassigned; end; end;
end;

29. Tworzenie podglądu RichEdita przed drukowaniem - wariant.


unit RichEditPreview;

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Printers, RichEdit, Menus, ComCtrls, ToolWin;

type TPageOffset = record
mStart, mEnd: Integer;
rendRect: TRect;
end;
TPreviewForm = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
private { Private-Deklarationen }
public { Public-Deklarationen }
PreviewPanel: TPanel;
procedure DrawRichEdit;
end;

TPreviewPanel = class(TPanel)
private
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
property Canvas;
end;

var PreviewForm: TPreviewForm;

implementation
uses Unit1, RxRichEd;
{$R *.dfm}

procedure TPreviewForm.FormCreate(Sender: TObject);
begin
PreviewPanel := TPreviewPanel.Create(Self);
PreviewPanel.Parent := Self; PreviewPanel.Color := clWhite;
end;

procedure TPreviewForm.FormDestroy(Sender: TObject);
begin
if PreviewPanel < > nil then PreviewPanel.Free
end;

procedure TPreviewForm.FormResize(Sender: TObject);
var wPage, hPage, wClient, hClient: integer;
begin // get the printer dimensions
wPage := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
hPage := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
// get the client window dimensions.
hClient := Panel2.ClientHeight; // initially adjust width to match height
wClient := MulDiv(Panel2.ClientHeight, wPage, hPage);
// if that doesn't fit, then do it the other way
if wClient > Panel2.ClientWidth then
begin
wCLient := Panel2.ClientWidth; hClient := MulDiv(Panel2.ClientWidth, hPage, wPage);
// center the page in the window
PreviewPanel.Top := ((Panel2.ClientHeight - hClient) div 2) - Panel1.Height;
end else begin // center the page in the window
PreviewPanel.Left := (Panel2.ClientWidth - wClient) div 2;
PreviewPanel.Top := Panel1.Height;
end; // now set size of panel
PreviewPanel.Width := wClient; PreviewPanel.Height := hClient
end;

procedure TPreviewForm.DrawRichEdit;
var wPage, hPage, xPPI, yPPI, wTwips, hTwips, currPage: integer;
pageRect, rendRect, frameRect: TRect; po: TPageOffset;
fr: TFormatRange; lastOffset, xOffset, yOffset, xPrinterOffset, yPrinterOffset: integer;
FPageOffsets: array of TPageOffset; TextLenEx: TGetTextLengthEx;
hdcDesktop, hdcCanvas, hdcPrinter, xDesktopPPI, yDesktopPPI,
xFactor, yFactor: integer;
begin
wPage := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
hPage := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
xPPI := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
yPPI := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
wTwips := MulDiv(wPage, 1440, xPPI);
hTwips := MulDiv(hPage, 1440, yPPI);
with pageRect do
begin
Left := 0; Top := 0; Right := wTwips; Bottom := hTwips end;
with rendRect do
begin
Left := 0; Top := 0; Right := pageRect.Right - (1440 * 4);
Bottom := pageRect.Bottom - (1440 * 4) end;
po.mStart := 0;
hdcDesktop := GetWindowDC(GetDesktopWindow);
hdcCanvas := TPreviewPanel(PreviewPanel).Canvas.Handle;
hdcPrinter := Printer.Handle;
// Next, define and initialize a FORMATRANGE structure.
fr.hdc := hdcDesktop; fr.hdcTarget := hdcPrinter;
fr.chrg.cpMin := po.mStart; fr.chrg.cpMax := -1;
// We will need the size of the text in the control.
if RichEditVersion >= 2 then
begin
with TextLenEx do
begin
flags := GTL_DEFAULT; codepage := CP_ACP end;
lastOffset := SendMessage(Form1.Editor.Handle, EM_GETTEXTLENGTHEX,
wParam(@TextLenEx), 0)
end else
lastOffset := SendMessage(Form1.Editor.Handle, WM_GETTEXTLENGTH, 0, 0);
// Clear the control's formatting buffer before rendering.
SendMessage(Form1.Editor.Handle, EM_FORMATRANGE, 0, 0);
SaveDC(hdcCanvas);
SetMapMode(hdcCanvas, MM_TEXT);
SetMapMode(hdcCanvas, MM_ANISOTROPIC);
SetMapMode(hdcPrinter, MM_TEXT);
SetWindowExtEx(hdcCanvas, pageRect.Right, pageRect.Bottom, nil);
xDesktopPPI := GetDeviceCaps(hdcDesktop, LOGPIXELSX);
yDesktopPPI := GetDeviceCaps(hdcDesktop, LOGPIXELSY);
ScaleWindowExtEx(hdcCanvas, xDesktopPPI, 1440, yDesktopPPI, 1440, nil);
SetViewportExtEx(hdcCanvas, PreviewPanel.ClientWidth, PreviewPanel.ClientHeight, nil);

xPrinterOffset := MulDiv(GetDeviceCaps(hdcPrinter, PHYSICALOFFSETX), 1440, xPPI);
yPrinterOffset := MulDiv(GetDeviceCaps(hdcPrinter, PHYSICALOFFSETY), 1440, yPPI);
rendRect.Left := rendRect.Left + (xPrinterOffset shr 1);
rendRect.Right := rendRect.Right - xPrinterOffset - (xPrinterOFfset shr 1);
rendRect.Top := rendRect.Top + (yPrinterOffset shr 1);
rendRect.Bottom := rendRect.Bottom - yPrinterOffset - (yPrinterOFfset shr 1);
// Remember that we are hardcoding two-inch margins.
xOffset := MulDiv(PreviewPanel.ClientWidth shl 1, 1440, pageRect.Right);
yOffset := MulDiv(PreviewPanel.ClientHeight shl 1, 1440, pageRect.Bottom);
SetViewportOrgEx(hdcCanvas, xOffset, yOffset, nil);

while ((fr.chrg.cpMin < > -1) and (fr.chrg.cpMin < lastOffset)) do
begin
fr.rc := rendRect; fr.rcPage := pageRect; po.mStart := fr.chrg.cpMin;
fr.chrg.cpMin := SendMessage(Form1.Editor.Handle, EM_FORMATRANGE, 0, Longint(@fr));
po.mEnd := fr.chrg.cpMin - 1; po.rendRect := fr.rc;
if High(FPageOffsets) = -1 then SetLength(FPageOffsets, 1)
else
SetLength(FPageOffsets, Length(FPageOffsets) + 1);
FPageOffsets[High(FPageOffsets)] := po
end;

fr.hdc := hdcCanvas; fr.hdcTarget := 0;
fr.rc := FPageOffsets[currPage].rendRect; fr.rcPage := pageRect;
fr.chrg.cpMin := FPageOffsets[currPage].mStart;
fr.chrg.cpMax := FPageOffsets[currPage].mEnd;
fr.chrg.cpMin := SendMessage(Form1.Editor.Handle, EM_FORMATRANGE, 1, Longint(@fr));
SetMapMode(hdcCanvas, MM_TEXT);
SetViewportOrgEx(hdcCanvas, 0, 0, nil); frameRect := rendRect;
OffsetRect(frameRect, 1440 + 1440, 1440 + 1440);
xFactor := MulDiv(PreviewPanel.ClientWidth,
(pageRect.Right - rendRect.Right) shr 1, pageRect.Right);
yFactor := MulDiv(PreviewPanel.ClientHeight,
(pageRect.Bottom - rendRect.Bottom) shr 1, pageRect.Bottom);

frameRect.Left := xFactor; frameRect.Right := PreviewPanel.ClientWidth - xFactor;
frameRect.Top := yFactor;
frameRect.Bottom := PreviewPanel.ClientHeight - yFactor;
Windows.FrameRect(hdcCanvas, frameRect, GetStockObject(BLACK_
USH));
and Close the DrawRichEdit() method.RestoreDC(hdcCanvas, - 1);
ReleaseDC(GetDesktopWindow, hdcDesktop);
SendMessage(Form1.Editor.Handle, EM_FORMATRANGE, 0, 0);
Finalize(FPageOffsets);
end;

(* A to dla uruchomienia TPanel *)
constructor TPreviewPanel.Create(Owner: TComponent);
begin
inherited Create(Owner);
end;

destructor TPreviewPanel.Destroy;
begin
inherited Destroy
end;

procedure TPreviewPanel.Paint;
begin
inherited Paint; PreviewForm.DrawRichEdit;
end;

end.

30. Wydruk TImage - kolejne warianty


Wariant 1:
uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
var ScaleX, ScaleY: Integer; RR: TRect;
begin
with Printer do
begin
BeginDoc; // The StartDoc function starts a print job.
try ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
// Retrieves information about the Pixels per Inch of the Printer.
RR := Rect(0, 0, Image1.picture.Width * scaleX, Image1.Picture.Height * ScaleY);
Canvas.StretchDraw(RR, Image1.Picture.Graphic); // Stretch to fit
finally EndDoc; end; end;
end;

Wariant 2:
procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
var BitmapHeader: pBitmapInfo; BitmapImage: Pointer; HeaderSize: DWORD;
ImageSize: DWORD;
begin
GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
GetMem(BitmapHeader, HeaderSize);
GetMem(BitmapImage, ImageSize);
try
GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top, // Destination Origin
DestRect.Right - DestRect.Left, // Destination Width
DestRect.Bottom - DestRect.Top, // Destination Height
0, 0, // Source Origin
Bitmap.Width, Bitmap.Height, // Source Width   Height
BitmapImage, TBitmapInfo(BitmapHeader^),
DIB_RGB_COLORS, SRCCOPY)
finally FreeMem(BitmapHeader); FreeMem(BitmapImage) end
end {PrintBitmap};

Wariant 3: // od www.experts-exchange.com
uses printers;

procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
var Header, Bits: Pointer; HeaderSize: DWORD; BitsSize: DWORD;
begin
GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
Header := AllocMem(HeaderSize); Bits := AllocMem(BitsSize);
try
GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
DestRect.Right, DestRect.Bottom,
0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^),
DIB_RGB_COLORS, SRCCOPY);
finally FreeMem(Header, HeaderSize); FreeMem(Bits, BitsSize); end;
end;

//jeżeli ZoomPercent=100 to o
az będzie wydrukowany na całej stronie
procedure PrintImage(Image: TImage; ZoomPercent: Integer);
var relHeight, relWidth: integer;
begin
Screen.Cursor := crHourglass; Printer.BeginDoc;
with Image.Picture.Bitmap do
begin
if ((Width / Height) > (Printer.PageWidth / Printer.PageHeight)) then
begin // Stretch Bitmap to width of PrinterPage
relWidth := Printer.PageWidth; relHeight := MulDiv(Height, Printer.PageWidth, Width);
end else begin
// Stretch Bitmap to height of PrinterPage
relWidth := MulDiv(Width, Printer.PageHeight, Height);
relHeight := Printer.PageHeight;
end;
relWidth := Round(relWidth * ZoomPercent / 100);
relHeight := Round(relHeight * ZoomPercent / 100);
DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), Image.Picture.Bitmap);
end;
Printer.EndDoc; Screen.cursor := crDefault;
end;

// przykład wywołania - o
az na 40% strony
procedure TForm1.Button1Click(Sender: TObject);
begin
PrintImage(Image1, 40);
end;

31. Drukowanie różnych rodzajów grafiki - autor Alexey Torgashin.


Przykład powinien działać ze wszystkimi rodzajami grafiki: bitmapami, metaplikiami i ikonami.
Parametry:
- AImage: obiekt TImage.
- ACopies: liczba kopii (0 dla jednej kopii).
- AFitToPage: o
az na całą stronę. Jeśli o
az jest mniejsz to będzie rozciągnięty.
- AFitOnlyLarger: pozwala pomieścić tylko o
azy większe od rozmiaru strony.
- Acenter: o
az na środku strony.
- APixelsPerInch: ilość pikseli na cal ekranu - daj PixelsPerInch twojej formy lub rozdzielczość ekranu.
- ACaption: tytuł drukowania

function ImagePrint(AImage: TImage;ACopies: word;AFitToPage,AFitOnlyLarger,
ACenter: boolean; APixelsPerInch: integer;const ACaption: string): boolean;
var bmp: TBitmap;
begin
bmp:= TBitmap.Create;
try bmp.PixelFormat:= pf24bit; {$ifdef ADV_IMAGE_CONV}
if not CorrectImageToBitmap(AImage, bmp, clWhite) then
begin
Result:= false; Exit end; {$else} with AImage.Picture do
begin
bmp.Width:= Graphic.Width; bmp.Height:= Graphic.Height;
bmp.Canvas.Draw(0, 0, Graphic); end; {$endif}
Result:= BitmapPrint( bmp, ACopies, AFitToPage, AFitOnlyLarger,
ACenter, APixelsPerInch, ACaption);
finally bmp.Free; end;
end;

function BitmapPrint(ABitmap: TBitmap;ACopies: word;AFitToPage,AFitOnlyLarger,
ACenter: boolean;APixelsPerInch: integer;const ACaption: string): boolean;
varScale, ScalePX, ScalePY, ScaleX, ScaleY: Double;
SizeX, SizeY,RectSizeX, RectSizeY, RectOffsetX, RectOffsetY: integer; i: integer;
Begin
Result:= true;
Assert( Assigned(ABitmap) and (ABitmap.Width > 0) and (ABitmap.Height > 0),
'BitmapPrint: bitmap is empty.');
if ACopies = 0 then Inc(ACopies);
with Printer do
begin
SizeX:= PageWidth; SizeY:= PageHeight;
ScalePX:= GetDeviceCaps(Handle, LOGPIXELSX) / APixelsPerInch;
ScalePY:= GetDeviceCaps(Handle, LOGPIXELSY) / APixelsPerInch;
ScaleX:= SizeX / ABitmap.Width / ScalePX;
ScaleY:= SizeY / ABitmap.Height / ScalePY;
if ScaleX < ScaleY then Scale:= ScaleX
else Scale:= ScaleY;
if (not AFitToPage) or (AFitOnlyLarger and (Scale > 1.0)) then
Scale:= 1.0;
RectSizeX:= Trunc(ABitmap.Width * Scale * ScalePX);
RectSizeY:= Trunc(ABitmap.Height * Scale * ScalePY);
if ACenter then
begin
RectOffsetX:= (SizeX - RectSizeX) div 2; RectOffsetY:= (SizeY - RectSizeY) div 2;
end else begin
RectOffsetX:= 0; RectOffsetY:= 0; end; Title:= ACaption;
try BeginDoc;
try for i:= 1 to ACopies do
begin
Canvas.StretchDraw( Rect( RectOffsetX, RectOffsetY, RectOffsetX + RectSizeX,
RectOffsetY + RectSizeY), ABitmap );
if i < ACopies then NewPage; end;
finally EndDoc; end;
except Result:= false; end; end;
end;

32. PRINTPREVIEW - podgląd drukowania - kolejna wersja.


unit printpreview;
interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls;

typeTForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
PreviewPaintbox: TPaintBox;
Label1: TLabel;
Label2: TLabel;
LeftMarginEdit: TEdit;
TopMarginEdit: TEdit;
Label3: TLabel;
Label4: TLabel;
RightMarginEdit: TEdit;
Label5: TLabel;
BottomMarginEdit: TEdit;
ApplyMarginsButton: TButton;
OrientationRGroup: TRadioGroup;
Label6: TLabel;
ZoomEdit: TEdit;
ZoomUpDown: TUpDown;
procedure LeftMarginEditKeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure PreviewPaintboxPaint(Sender: TObject);
procedure ApplyMarginsButtonClick(Sender: TObject);
private { Private declarations }
PreviewText: String;
public { Public declarations }
end;

var Form1: TForm1;
implementation
uses printers;
{$R *.DFM}

procedure TForm1.LeftMarginEditKeyPress(Sender: TObject; var Key: Char);
begin
If not (Key in ['0'..'9',#9,DecimalSeparator]) Then Key := #0;
end;

procedure TForm1.FormCreate(Sender: TObject);
var S: String;
procedure loadpreviewtext;
var sl: TStringlist;
begin
sl:= Tstringlist.Create;
try sl.Loadfromfile( Extractfilepath( application.exename )+'printpreview.pas');
PreviewText := sl.Text;
finally sl.free end; end;
begin
// Inicjowanie z marginesem 0.75 cala
S:= FormatFloat('0.00',0.75); LeftMarginEdit.Text := S; TopMarginEdit.Text := S;
RightMarginEdit.Text := S; BottomMarginEdit.Text := S;
// Inicjowanie przełączników Radiogroup -orientacja pionowa
If Printer.Orientation = poPortrait Then OrientationRGroup.ItemIndex := 0
Else OrientationRGroup.ItemIndex := 1;
//wyświetl tekst
LoadPreviewtext;
end;

procedure TForm1.PreviewPaintboxPaint(Sender: TObject);
var
pagewidth, pageheight: Double; // rozmiar drukowanej strony w calach
printerResX, printerResY: Integer; //rozdzielczość druku piksele/ cal
minmarginX, minmarginY: Double; // niedrukowalny margines w calach
outputarea: TRect; // obszar wydruku w 1/1000 cala
scale: Double; // współczynnik przeliczenia piksele na 1/1000 cala

procedure InitPrintSettings;

function GetMargin( S: String; inX: Boolean ):Double;
begin
Result := StrToFloat(S); if InX then begin
if Result < minmarginX then Result := minmarginX;
end else begin
if Result < minmarginY then Result := minmarginY; end; end;
begin
printerResX := GetDeviceCaps( printer.handle, LOGPIXELSX );
printerResY := GetDeviceCaps( printer.handle, LOGPIXELSY );
pagewidth := GetDeviceCaps( printer.handle, PHYSICALWIDTH ) / printerResX;
pageheight := GetDeviceCaps( printer.handle, PHYSICALHEIGHT) / printerResY;
minmarginX := GetDeviceCaps( printer.handle, PHYSICALOFFSETX)/ printerResX;
minmarginY := GetDeviceCaps( printer.handle, PHYSICALOFFSETY)/ printerResY;
outputarea.Left := Round( GetMargin( LeftMarginEdit.Text, true ) * 1000);
outputarea.Top := Round( GetMargin( TopMarginEdit.Text, false ) * 1000);
outputarea.Right := Round(( pagewidth -
GetMargin( RightMarginEdit.Text, true )) * 1000);
outputarea.Bottom := Round(( pageheight -
GetMargin( BottomMarginEdit.Text, false )) * 1000);
end; { InitPrintSettings }

33. Przerwanie drukowania - wersja od Delphi 2010


Po naciśnięciu klawisza ESC drukowanie zostaje przerwane i wyświetla się okno komunikatu. Pamiętaj by ustawić na True KeyPreview aby zapewnić obsługę zdarzeń onKeyDown.

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
var I, X, Y: Integer; Memo1 : TMemo; r: TRect;
begin
Memo1 := TMemo.Create(Form1); Memo1.Parent := Form1;
Memo1.Visible := True; Memo1.Width := 700;
if (OpenDialog1.Execute) then
begin
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
Printer.BeginDoc; X := 200; Y := 200;
for I := 0 to 140 do
if (not Printer.Aborted) then
begin
Printer.Canvas.TextOut(X, Y, Memo1.Lines[I]); Y := Y + 80;
if (Y > (Printer.PageHeight - 300)) then
begin
Y := 200; Printer.NewPage; Sleep(1000); // to czas na przerwanie!
end; end;
if (not Printer.Aborted) then Printer.EndDoc; end;
if Printer.Aborted then
MessageDlg('Drukowanie zostało przerwane.', mtInformation, [mbOK], 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
KeyPreview := True;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Key=VK_ESCAPE) and Printer.Printing then
begin
Printer.Abort;
// MessageDlg('Druk przerwany', mtInformation, [mbOK],0);
end; end;

34. Orientacja drukowanej strony - wersja Delphi 2010.


Ten przykład wymaga dwóch Radiobuttonów na formularzu o nazwie Landscape i Portrait. Formularz zawiera także przycisk. Po wy
aniu orientacji, klikając na przycisk drukarka drukuje jedną linię tekstu na kartce o wy
anej orientacji.

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
begin
Printer.BeginDoc;
Printer.Canvas.TextOut(100,100,'Drukuję sobie BBB');
Printer.EndDoc;
end;

procedure TForm1.LandscapeClick(Sender: TObject);
begin
Printer.Orientation := poLandscape;
end;

procedure TForm1.PortraitClick(Sender: TObject);
begin
Printer.Orientation := poPortrait;
end;

35. Numeracja drukowanych stron i podpowiedzi na pasku StatusBar


Ten przykład wymaga przycisku (button1) i paska stanu (StatusBar1) na formularzu. Po kliknięciu na przycisk, jedna linia tekstu jest drukowana na sześćiu odrębnych stronach. Na pasku StatusBar pojawia się komunikat informujący o numerze drukowanej strony. Właściwość SimplePanel StatusBara = True.

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
var I: Integer;
begin
StatusBar1.SimplePanel := True; { panel z jedną tylko celą. }
Printer.BeginDoc;
for I := 1 to 6 do
begin
Printer.Canvas.TextOut(100, 100, 'Object Pascal to fajna rzecz');
StatusBar1.SimpleText := 'Teraz druk strony ' + IntToStr(Printer.PageNumber);
Printer.NewPage;
end; Printer.EndDoc;
end;

36. Rozmiar drukowanej strony - wersja Delphi 2010.


Po kliknięciu na przycisk zawartość memo jest drukowana z 200-pikselowym o
amowaniem strony.

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
var X, Y, I, margin: Integer;
begin
with Printer do
begin
BeginDoc; margin := 1000; X := margin; Y := margin; I := 0;
while(Y < PageHeight) do
begin
Canvas.TextRect(Rect(X, Y, PageWidth-margin, PageHeight-margin), X, Y, Memo1.Lines[I]);
Y := Y + 100; I := I + 1; end; EndDoc; end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Width := 1000; Memo1.Lines.LoadFromFile('readme.txt');
end;

37. Lista zadań wydruku (kolejka wydruku) dla drukarki.


uses Winspool, Printers;

function GetCurrentPrinterHandle: THandle;
var Device, Driver, Port: array[0..255] of Char; hDeviceMode: THandle;
begin
Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
if not OpenPrinter(@Device, Result, nil) then
RaiseLastWin32Error;
end;

function SavePChar(p: PChar): PChar;
const error: PChar = 'Nil';
begin
if not Assigned(p) then Result := error else Result := p;
end;

procedure TForm1.Button1Click(Sender: TObject);
type
TJobs = array [0..1000] of JOB_INFO_1; PJobs = ^TJobs;
var
hPrinter: THandle; bytesNeeded, numJobs, i: Cardinal; pJ: PJobs;
begin
hPrinter := GetCurrentPrinterHandle;
try EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded, numJobs);
pJ := AllocMem(bytesNeeded);
if not EnumJobs(hPrinter, 0, 1000, 1, pJ, bytesNeeded, bytesNeeded, numJobs) then
RaiseLastWin32Error; memo1.Clear;
if numJobs = 0 then
memo1.Lines.Add('Nie ma dokumentów oczekujących w kolejce')
else
for i := 0 to Pred(numJobs) do
memo1.Lines.Add(Format('Printer %s, Job %s, Status (%d): %s',
[SavePChar(pJ^[i].pPrinterName), SavePChar(pJ^[i].pDocument),
pJ^[i].Status, SavePChar(pJ^[i].pStatus)]));
finally ClosePrinter(hPrinter); end;
end;

38. Drukowanie bezpośrednio w milimetrach - autor Simon Grossenbacher


uses printers;

procedure TForm1.Button1Click(Sender: TObject);
begin
printer.BeginDoc;
//MM_LOMETRIC - mapowanie strony według skali 0.1 millimetra.
SetMapMode(printer.Canvas.Handle, MM_LOMETRIC);
with printer.Canvas do
begin
Font.Height := 50; // fonty mają 5 mm wysokości
Font.Name := 'Verdana';
TextOut(250, - 110, 'SwissDelphiCenter');
TextOut(250, - 180, 'http://www.swissdelphicenter.ch');
MoveTo(250, - 240); LineTo(1000, - 240); //rysuje linię 7,5 cm
end; printer.EndDoc;
end;

39. Zapis i odczyt ustawień globalnych drukarki - autor Rob Schoenaker


Każdorazowe ustawianie właściwości drukarki to żmudne zadanie.Poniższy kod pozwala na zapisanie bieżących ustawień zainstalowanej drukarki do streamu przy użyciu procedury SavePrinterInfo. Za pomocą LoadPrinterInfo można zawsze po
ać zapisane ustawienia i zastosować je do drukarki.

unit PrinterIO;

interface

uses Classes;

procedure SavePrinterInfo(APrinterName: PChar; ADestStream: TStream);
procedure LoadPrinterInfo(APrinterName: PChar; ASourceStream: TStream);

implementation

uses Windows, SysUtils, WinSpool;

procedure SavePrinterInfo(APrinterName: PChar; ADestStream: TStream);
var HPrinter : THandle; InfoSize, BytesNeeded: Cardinal; PI2: PPrinterInfo2;
PrinterDefaults: TPrinterDefaults;
begin
with PrinterDefaults do
begin
DesiredAccess := PRINTER_ACCESS_USE; pDatatype := nil; pDevMode := nil;
end;
if OpenPrinter(APrinterName, HPrinter, @PrinterDefaults) then
try SetLastError(0);
//określa liczbę bajtów do tworzenia PRINTER_INFO_2 ...
if not GetPrinter(HPrinter, 2, nil, 0, @BytesNeeded) then
begin
//Allokacja pamięci dla wskaźnika PRINTER_INFO_2 pointer (PrinterInfo2)...
PI2 := AllocMem(BytesNeeded);
try InfoSize := SizeOf(TPrinterInfo2);
if GetPrinter(HPrinter, 2, PI2, BytesNeeded, @BytesNeeded) then
ADestStream.Write(PChar(PI2)[InfoSize], BytesNeeded - InfoSize);
finally FreeMem(PI2, BytesNeeded); end; end;
finally ClosePrinter(HPrinter); end;
end;

procedure LoadPrinterInfo(APrinterName: PChar; ASourceStream: TStream);
var HPrinter : THandle; InfoSize, BytesNeeded: Cardinal; PI2: PPrinterInfo2;
PrinterDefaults: TPrinterDefaults;
begin
with PrinterDefaults do
begin
DesiredAccess := PRINTER_ACCESS_USE; pDatatype := nil; pDevMode := nil;
end;
if OpenPrinter(APrinterName, HPrinter, @PrinterDefaults) then
try SetLastError(0);
//określa liczbę bajtów do tworzenia PRINTER_INFO_2 ...
if not GetPrinter(HPrinter, 2, nil, 0, @BytesNeeded) then
begin
//alokacja pamieci dla wskaźnika PRINTER_INFO_2 ......
PI2 := AllocMem(BytesNeeded);
try InfoSize := SizeOf(TPrinterInfo2);
if GetPrinter(HPrinter, 2, PI2, BytesNeeded, @BytesNeeded) then
begin
PI2.pSecurityDescriptor := nil;
ASourceStream.ReadBuffer(PChar(PI2)[InfoSize], BytesNeeded - InfoSize);
// Dołącz to ustawienie do drukarki
if DocumentProperties(0, hPrinter, APrinterName, PI2.pDevMode^,
PI2.pDevMode^, DM_IN_BUFFER or DM_OUT_BUFFER) = IDOK then
begin
SetPrinter(HPrinter, 2, PI2, 0); // Ignoruj wynik tego połączenia...
end; end;
finally FreeMem(PI2, BytesNeeded); end; end;
finally ClosePrinter(HPrinter); end;
end;

end.