var F: TextFile;
begin
AssignFile(F, 'LPT1');
Rewrite(F); Writeln(F, 'Serwus'); Writeln(F, 'Druga linia!'); Writeln(F, #12); CloseFile(F);
end;
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.
uses Printers;
procedure PrintText(Text: string);
begin
with Printer do begin
BeginDoc; Canvas.TextOut(5, 50, Text); EndDoc;
end; end;
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;
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;
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.
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;
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;
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;
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;
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;
{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.
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;
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;
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;
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;
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);
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;
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;
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;
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;
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.
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;
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; . . .
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;
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;
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;
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;
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.
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;
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;
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 }
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;
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;
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;
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;
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;
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;
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.