Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

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

Posted on 1999-01-25
3
Medium Priority
?
154 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 150 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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
This video shows how to quickly and easily deploy an email signature for all users in Office 365 and prevent it from being added to replies and forwards. (the resulting signature is applied on the server level in Exchange Online) The email signat…
Want to learn how to record your desktop screen without having to use an outside camera. Click on this video and learn how to use the cool google extension called "Screencastify"! Step 1: Open a new google tab Step 2: Go to the left hand upper corn…
Suggested Courses

963 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