Solved

How to print a form with code (Delphi 3)?

Posted on 1999-01-25
3
145 Views
Last Modified: 2010-04-06
I want to print the main form by clicking on a button.
I use the Print method of the form and I only get a white paper.
What's the matter ???
Thanx.
0
Comment
Question by:nk51
  • 2
3 Comments
 
LVL 8

Accepted Solution

by:
ZifNab earned 50 total points
ID: 1363311
Hi nk51,

This can be your printer... do you use HP? Epson?

Try this method (from Inprise):



                          Technical Information Database

                          TI1412D.txt   A Better Way To Print a Form
                          Category   :General Programming
                          Platform    :All
                          Product    :Delphi  All

                          Description:


                          The following TI details a better way to print the contents of

                          a form, by getting the device independent bits in 256 colors

                          from the form, and using those bits to print the form to the

                          printer.



                          In addition, a check is made to see if the screen or printer

                          is a palette device, and if so, palette handling for the device

                          is enabled. If the screen device is a palette device, an additional

                          step is taken to fill the bitmap's palette from the system palette,

                          overcoming some buggy video drivers who don't fill the palette in.



                          Note: Since this code does a screen shot of the form, the form must

                          be the topmost window and the whole from must be viewable when the

                          form shot is made.









                          unit Prntit;



                          interface



                          uses

                            SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,

                            Controls, Forms, Dialogs, StdCtrls, ExtCtrls;



                          type

                            TForm1 = class(TForm)

                              Button1: TButton;

                              Image1: TImage;

                              procedure Button1Click(Sender: TObject);

                            private

                              { Private declarations }

                            public

                              { Public declarations }

                            end;



                          var

                            Form1: TForm1;



                          implementation



                          {$R *.DFM}





                          uses Printers;





                          procedure TForm1.Button1Click(Sender: TObject);

                          var

                            dc: HDC;

                            isDcPalDevice : BOOL;

                            MemDc :hdc;

                            MemBitmap : hBitmap;

                            OldMemBitmap : hBitmap;

                            hDibHeader : Thandle;

                            pDibHeader : pointer;

                            hBits : Thandle;

                            pBits : pointer;

                            ScaleX : Double;

                            ScaleY : Double;

                            ppal : PLOGPALETTE;

                            pal : hPalette;

                            Oldpal : hPalette;

                            i : integer;

                          begin

                           {Get the screen dc}

                            dc := GetDc(0);

                           {Create a compatible dc}

                            MemDc := CreateCompatibleDc(dc);

                           {create a bitmap}

                            MemBitmap := CreateCompatibleBitmap(Dc,

                                                                form1.width,

                                                                form1.height);

                           {select the bitmap into the dc}

                            OldMemBitmap := SelectObject(MemDc, MemBitmap);



                           {Lets prepare to try a fixup for broken video drivers}

                            isDcPalDevice := false;

                            if GetDeviceCaps(dc, RASTERCAPS) and

                               RC_PALETTE = RC_PALETTE then begin

                              GetMem(pPal, sizeof(TLOGPALETTE) +

                                (255 * sizeof(TPALETTEENTRY)));

                              FillChar(pPal^, sizeof(TLOGPALETTE) +

                                (255 * sizeof(TPALETTEENTRY)), #0);

                              pPal^.palVersion := $300;

                              pPal^.palNumEntries :=

                                GetSystemPaletteEntries(dc,

                                                        0,

                                                        256,

                                                        pPal^.palPalEntry);

                              if pPal^.PalNumEntries <> 0 then begin

                                pal := CreatePalette(pPal^);

                                oldPal := SelectPalette(MemDc, Pal, false);

                                isDcPalDevice := true

                              end else

                              FreeMem(pPal, sizeof(TLOGPALETTE) +

                                     (255 * sizeof(TPALETTEENTRY)));

                            end;



                           {copy from the screen to the memdc/bitmap}

                            BitBlt(MemDc,

                                   0, 0,

                                   form1.width, form1.height,

                                   Dc,

                                   form1.left, form1.top,

                                   SrcCopy);



                            if isDcPalDevice = true then begin

                              SelectPalette(MemDc, OldPal, false);

                              DeleteObject(Pal);

                            end;



                           {unselect the bitmap}

                            SelectObject(MemDc, OldMemBitmap);

                           {delete the memory dc}

                            DeleteDc(MemDc);

                           {Allocate memory for a DIB structure}

                            hDibHeader := GlobalAlloc(GHND,

                                                      sizeof(TBITMAPINFO) +

                                                      (sizeof(TRGBQUAD) * 256));

                           {get a pointer to the alloced memory}

                            pDibHeader := GlobalLock(hDibHeader);



                           {fill in the dib structure with info on the way we want the DIB}

                            FillChar(pDibHeader^,

                                     sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256),

                                     #0);

                            PBITMAPINFOHEADER(pDibHeader)^.biSize :=

                              sizeof(TBITMAPINFOHEADER);

                            PBITMAPINFOHEADER(pDibHeader)^.biPlanes := 1;

                            PBITMAPINFOHEADER(pDibHeader)^.biBitCount := 8;

                            PBITMAPINFOHEADER(pDibHeader)^.biWidth := form1.width;

                            PBITMAPINFOHEADER(pDibHeader)^.biHeight := form1.height;

                            PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;



                           {find out how much memory for the bits}

                            GetDIBits(dc,

                                      MemBitmap,

                                      0,

                                      form1.height,

                                      nil,

                                      TBitmapInfo(pDibHeader^),

                                      DIB_RGB_COLORS);



                           {Alloc memory for the bits}

                            hBits := GlobalAlloc(GHND,

                                                 PBitmapInfoHeader(pDibHeader)^.BiSizeImage);

                           {Get a pointer to the bits}

                            pBits := GlobalLock(hBits);



                           {Call fn again, but this time give us the bits!}

                            GetDIBits(dc,

                                      MemBitmap,

                                      0,

                                      form1.height,

                                      pBits,

                                      PBitmapInfo(pDibHeader)^,

                                      DIB_RGB_COLORS);



                           {Lets try a fixup for broken video drivers}

                            if isDcPalDevice = true then begin

                              for i := 0 to (pPal^.PalNumEntries - 1) do begin

                                PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed :=

                                  pPal^.palPalEntry[i].peRed;

                                PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen :=

                                  pPal^.palPalEntry[i].peGreen;

                                PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue :=

                                  pPal^.palPalEntry[i].peBlue;

                              end;

                              FreeMem(pPal, sizeof(TLOGPALETTE) +

                                     (255 * sizeof(TPALETTEENTRY)));

                            end;



                           {Release the screen dc}

                            ReleaseDc(0, dc);

                           {Delete the bitmap}

                            DeleteObject(MemBitmap);



                           {Start print job}

                            Printer.BeginDoc;



                           {Scale print size}

                            if Printer.PageWidth < Printer.PageHeight then begin

                             ScaleX := Printer.PageWidth;

                             ScaleY := Form1.Height * (Printer.PageWidth / Form1.Width);

                            end else begin

                             ScaleX := Form1.Width * (Printer.PageHeight / Form1.Height);

                             ScaleY := Printer.PageHeight;

                            end;





                           {Just incase the printer drver is a palette device}

                            isDcPalDevice := false;

                            if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and

                                RC_PALETTE = RC_PALETTE then begin

                             {Create palette from dib}

                              GetMem(pPal, sizeof(TLOGPALETTE) +

                                    (255 * sizeof(TPALETTEENTRY)));

                              FillChar(pPal^, sizeof(TLOGPALETTE) +

                                    (255 * sizeof(TPALETTEENTRY)), #0);

                              pPal^.palVersion := $300;

                              pPal^.palNumEntries := 256;

                              for i := 0 to (pPal^.PalNumEntries - 1) do begin

                                pPal^.palPalEntry[i].peRed :=

                                  PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;

                                pPal^.palPalEntry[i].peGreen :=

                                  PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;

                                pPal^.palPalEntry[i].peBlue :=

                                  PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;

                              end;

                              pal := CreatePalette(pPal^);

                              FreeMem(pPal, sizeof(TLOGPALETTE) +

                                      (255 * sizeof(TPALETTEENTRY)));

                              oldPal := SelectPalette(Printer.Canvas.Handle, Pal, false);

                              isDcPalDevice := true

                            end;



                           {send the bits to the printer}

                            StretchDiBits(Printer.Canvas.Handle,

                                          0, 0,

                                          Round(scaleX), Round(scaleY),

                                          0, 0,

                                          Form1.Width, Form1.Height,

                                          pBits,

                                          PBitmapInfo(pDibHeader)^,

                                          DIB_RGB_COLORS,

                                          SRCCOPY);



                           {Just incase you printer drver is a palette device}

                            if isDcPalDevice = true then begin

                              SelectPalette(Printer.Canvas.Handle, oldPal, false);

                              DeleteObject(Pal);

                            end;





                           {Clean up allocated memory}

                            GlobalUnlock(hBits);

                            GlobalFree(hBits);

                            GlobalUnlock(hDibHeader);

                            GlobalFree(hDibHeader);





                           {End the print job}

                            Printer.EndDoc;





                          end;



                          Reference:


                          7/16/98 4:34:11 PM
0
 

Author Comment

by:nk51
ID: 1363312
I use HP.

Your code is good. But doesn't exist a more simple code ?
0
 
LVL 8

Expert Comment

by:ZifNab
ID: 1363313
I'm afraid not... (not that I know of) because this one helps with some different systems (color palette, etc)...
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
This video discusses moving either the default database or any database to a new volume.
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now