Technical Information Database<\/p>\n
TI1412D.txt A Better Way To Print a Form
\nCategory :General Programming
\nPlatform :All
\nProduct :Delphi All
\nDescription:<\/p>\n
The following TI details a better way to print the contents of
\na form, by getting the device independent bits in 256 colors
\nfrom the form, and using those bits to print the form to the
\nprinter.
\n
\nIn addition, a check is made to see if the screen or printer
\nis a palette device, and if so, palette handling for the device
\nis enabled. If the screen device is a palette device, an additional
\nstep is taken to fill the bitmap’s palette from the system palette,
\novercoming some buggy video drivers who don’t fill the palette in.<\/p>\n
Note: Since this code does a screen shot of the form, the form must
\nbe the topmost window and the whole from must be viewable when the
\nform shot is made.<\/p>\n
[code lang=”delphi”]unit Prntit;<\/p>\n
interface<\/p>\n
uses
\n SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
\n Controls, Forms, Dialogs, StdCtrls, ExtCtrls;<\/p>\n
type
\n TForm1 = class(TForm)
\n Button1: TButton;
\n Image1: TImage;
\n procedure Button1Click(Sender: TObject);
\n private
\n { Private declarations }
\n public
\n { Public declarations }
\n end;<\/p>\n
var
\n Form1: TForm1;<\/p>\n
implementation<\/p>\n
{$R *.DFM}<\/p>\n
uses Printers;<\/p>\n
procedure TForm1.Button1Click(Sender: TObject);
\nvar
\n dc: HDC;
\n isDcPalDevice : BOOL;
\n MemDc :hdc;
\n MemBitmap : hBitmap;
\n OldMemBitmap : hBitmap;
\n hDibHeader : Thandle;
\n pDibHeader : pointer;
\n hBits : Thandle;
\n pBits : pointer;
\n ScaleX : Double;
\n ScaleY : Double;
\n ppal : PLOGPALETTE;
\n pal : hPalette;
\n Oldpal : hPalette;
\n i : integer;
\nbegin
\n {Get the screen dc}
\n dc := GetDc(0);
\n {Create a compatible dc}
\n MemDc := CreateCompatibleDc(dc);
\n {create a bitmap}
\n MemBitmap := CreateCompatibleBitmap(Dc,
\n form1.width,
\n form1.height);
\n {select the bitmap into the dc}
\n OldMemBitmap := SelectObject(MemDc, MemBitmap);<\/p>\n
{Lets prepare to try a fixup for broken video drivers}
\n isDcPalDevice := false;
\n if GetDeviceCaps(dc, RASTERCAPS) and
\n RC_PALETTE = RC_PALETTE then begin
\n GetMem(pPal, sizeof(TLOGPALETTE) +
\n (255 * sizeof(TPALETTEENTRY)));
\n FillChar(pPal^, sizeof(TLOGPALETTE) +
\n (255 * sizeof(TPALETTEENTRY)), #0);
\n pPal^.palVersion := $300;
\n pPal^.palNumEntries :=
\n GetSystemPaletteEntries(dc,
\n 0,
\n 256,
\n pPal^.palPalEntry);
\n if pPal^.PalNumEntries <> 0 then begin
\n pal := CreatePalette(pPal^);
\n oldPal := SelectPalette(MemDc, Pal, false);
\n isDcPalDevice := true
\n end else
\n FreeMem(pPal, sizeof(TLOGPALETTE) +
\n (255 * sizeof(TPALETTEENTRY)));
\n end;<\/p>\n
{copy from the screen to the memdc\/bitmap}
\n BitBlt(MemDc,
\n 0, 0,
\n form1.width, form1.height,<\/p>\n
Dc,
\n form1.left, form1.top,
\n SrcCopy);<\/p>\n
if isDcPalDevice = true then begin
\n SelectPalette(MemDc, OldPal, false);
\n DeleteObject(Pal);
\n end;<\/p>\n
{unselect the bitmap}
\n SelectObject(MemDc, OldMemBitmap);
\n {delete the memory dc}
\n DeleteDc(MemDc);
\n {Allocate memory for a DIB structure}
\n hDibHeader := GlobalAlloc(GHND,
\n sizeof(TBITMAPINFO) +
\n (sizeof(TRGBQUAD) * 256));
\n {get a pointer to the alloced memory}
\n pDibHeader := GlobalLock(hDibHeader);<\/p>\n
{fill in the dib structure with info on the way we want the DIB}
\n FillChar(pDibHeader^,
\n sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256),
\n #0);
\n PBITMAPINFOHEADER(pDibHeader)^.biSize :=
\n sizeof(TBITMAPINFOHEADER);
\n PBITMAPINFOHEADER(pDibHeader)^.biPlanes := 1;
\n PBITMAPINFOHEADER(pDibHeader)^.biBitCount := 8;
\n PBITMAPINFOHEADER(pDibHeader)^.biWidth := form1.width;
\n PBITMAPINFOHEADER(pDibHeader)^.biHeight := form1.height;
\n PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;<\/p>\n
{find out how much memory for the bits}<\/p>\n
GetDIBits(dc,
\n MemBitmap,
\n 0,
\n form1.height,
\n nil,
\n TBitmapInfo(pDibHeader^),
\n DIB_RGB_COLORS);<\/p>\n
{Alloc memory for the bits}
\n hBits := GlobalAlloc(GHND,
\n PBitmapInfoHeader(pDibHeader)^.BiSizeImage);
\n {Get a pointer to the bits}
\n pBits := GlobalLock(hBits);<\/p>\n
{Call fn again, but this time give us the bits!}
\n GetDIBits(dc,
\n MemBitmap,
\n 0,
\n form1.height,
\n pBits,
\n PBitmapInfo(pDibHeader)^,
\n DIB_RGB_COLORS);<\/p>\n
{Lets try a fixup for broken video drivers}
\n if isDcPalDevice = true then begin
\n for i := 0 to (pPal^.PalNumEntries – 1) do begin
\n PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed :=
\n pPal^.palPalEntry[i].peRed;
\n PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen :=
\n pPal^.palPalEntry[i].peGreen;
\n PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue :=
\n pPal^.palPalEntry[i].peBlue;
\n end;
\n FreeMem(pPal, sizeof(TLOGPALETTE) +
\n (255 * sizeof(TPALETTEENTRY)));
\n end;<\/p>\n
{Release the screen dc}
\n ReleaseDc(0, dc);
\n {Delete the bitmap}
\n DeleteObject(MemBitmap);<\/p>\n
{Start print job}
\n Printer.BeginDoc;<\/p>\n
{Scale print size}
\n if Printer.PageWidth < Printer.PageHeight then begin\n ScaleX := Printer.PageWidth;\n ScaleY := Form1.Height * (Printer.PageWidth \/ Form1.Width);\n end else begin\n ScaleX := Form1.Width * (Printer.PageHeight \/ Form1.Height);\n ScaleY := Printer.PageHeight;\n end;\n\n\n {Just incase the printer drver is a palette device}\n isDcPalDevice := false;\n if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and\n RC_PALETTE = RC_PALETTE then begin\n {Create palette from dib}\n GetMem(pPal, sizeof(TLOGPALETTE) +\n (255 * sizeof(TPALETTEENTRY)));\n FillChar(pPal^, sizeof(TLOGPALETTE) + \n (255 * sizeof(TPALETTEENTRY)), #0);\n pPal^.palVersion := $300;\n pPal^.palNumEntries := 256;\n for i := 0 to (pPal^.PalNumEntries - 1) do begin\n pPal^.palPalEntry[i].peRed := \n PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;\n pPal^.palPalEntry[i].peGreen := \n PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;\n pPal^.palPalEntry[i].peBlue := \n PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;\n end;\n pal := CreatePalette(pPal^);\n FreeMem(pPal, sizeof(TLOGPALETTE) + \n (255 * sizeof(TPALETTEENTRY)));\n oldPal := SelectPalette(Printer.Canvas.Handle, Pal, false);\n isDcPalDevice := true\n end;\n\n {send the bits to the printer}\n StretchDiBits(Printer.Canvas.Handle,\n 0, 0,\n Round(scaleX), Round(scaleY),\n 0, 0,\n Form1.Width, Form1.Height,\n pBits,\n PBitmapInfo(pDibHeader)^,\n DIB_RGB_COLORS,\n SRCCOPY);\n\n {Just incase you printer drver is a palette device}\n if isDcPalDevice = true then begin\n SelectPalette(Printer.Canvas.Handle, oldPal, false);\n DeleteObject(Pal);\n end;\n\n {Clean up allocated memory}\n GlobalUnlock(hBits);\n GlobalFree(hBits);\n GlobalUnlock(hDibHeader);\n GlobalFree(hDibHeader);\n\n\n {End the print job}\n Printer.EndDoc;\nend;\n[\/code]\n\n[tags]Delphi, Printing, Forms[\/tags]\n<\/p>\n","protected":false},"excerpt":{"rendered":"
Technical Information Database TI1412D.txt A Better Way To Print a Form Category :General Programming Platform :All Product :Delphi All Description: The following TI…<\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"spay_email":""},"categories":[11],"tags":[75,100,119],"jetpack_featured_media_url":"","jetpack_shortlink":"https:\/\/wp.me\/p71Tml-3n","_links":{"self":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/posts\/209"}],"collection":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/comments?post=209"}],"version-history":[{"count":0,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/posts\/209\/revisions"}],"wp:attachment":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/media?parent=209"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/categories?post=209"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/tags?post=209"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}