?
Solved

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

Posted on 1999-01-25
3
Medium Priority
?
152 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
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…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …
In this video, Percona Director of Solution Engineering Jon Tobin discusses the function and features of Percona Server for MongoDB. How Percona can help Percona can help you determine if Percona Server for MongoDB is the right solution for …
Suggested Courses

770 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