Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 158
  • Last Modified:

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

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
nk51
Asked:
nk51
  • 2
1 Solution
 
ZifNabCommented:
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
 
nk51Author Commented:
I use HP.

Your code is good. But doesn't exist a more simple code ?
0
 
ZifNabCommented:
I'm afraid not... (not that I know of) because this one helps with some different systems (color palette, etc)...
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now