Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to Print a TForm Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
23-Aug-02
Category
Reporting /Printing
Language
Delphi 2.x
Views
19
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas

Printing a TForm

Answer:

If you try to print a Delphi form with the Print() method, it will print but the 
page is blank.
Instead use the following method.

1      
2   procedure TForm1.PrintForm;
3   var
4     DC: HDC;
5     isDcPalDevice: Bool;
6     MemDC: HDC;
7     MemBitmap: HBITMAP;
8     OldMemBitmap: HBITMAP;
9     hDibHeader: THandle;
10    pDibHeader: Pointer;
11    hBits: THandle;
12    pBits: Pointer;
13    ScaleX: Double;
14    ScaleY: Double;
15    pPal: PLOGPALETTE;
16    pal: HPALETTE;
17    OldPal: HPALETTE;
18    i: Integer;
19  begin
20    {Get the screen dc}
21    DC := GetDC(0);
22    {Create a compatible dc}
23    MemDC := CreateCompatibleDC(DC);
24    {create a bitmap}
25    MemBitmap := CreateCompatibleBitmap(DC, Self.Width, Self.Height);
26    {select the bitmap into the dc}
27    OldMemBitmap := SelectObject(MemDC, MemBitmap);
28  
29    {Lets prepare to try a fixup for broken video drivers}
30    isDcPalDevice := False;
31    if GetDeviceCaps(DC, RASTERCAPS) and RC_PALETTE = RC_PALETTE then
32    begin
33      GetMem(pPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
34      FillChar(pPal^, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)),
35        #0);
36      pPal^.palVersion := $300;
37      pPal^.palNumEntries := GetSystemPaletteEntries(DC, 0, 256, pPal^.palPalEntry);
38      if pPal^.palNumEntries <> 0 then
39      begin
40        pal := CreatePalette(pPal^);
41        OldPal := SelectPalette(MemDC, pal, False);
42        isDcPalDevice := True
43      end
44      else
45        FreeMem(pPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
46    end;
47    {copy from the screen to the memdc/bitmap}
48    BitBlt(MemDC, 0, 0, Self.Width, Self.Height, DC, Self.Left, Self.Top, SRCCOPY);
49  
50    if isDcPalDevice = True then
51    begin
52      SelectPalette(MemDC, OldPal, False);
53      DeleteObject(pal);
54    end;
55    {unselect the bitmap}
56    SelectObject(MemDC, OldMemBitmap);
57    {delete the memory dc}
58    DeleteDC(MemDC);
59    {Allocate memory for a DIB structure}
60    hDibHeader := GlobalAlloc(GHND, SizeOf(TBITMAPINFO) + (SizeOf(TRGBQUAD) *
61      256));
62    {get a pointer to the alloced memory}
63    pDibHeader := GlobalLock(hDibHeader);
64  
65    {fill in the dib structure with info on the way we want the DIB}
66    FillChar(pDibHeader^, SizeOf(TBITMAPINFO) + (SizeOf(TRGBQUAD) *
67      256), #0);
68    PBITMAPINFOHEADER(pDibHeader)^.biSize := SizeOf(TBITMAPINFOHEADER);
69    PBITMAPINFOHEADER(pDibHeader)^.biPlanes := 1;
70    PBITMAPINFOHEADER(pDibHeader)^.biBitCount := 8;
71    PBITMAPINFOHEADER(pDibHeader)^.biWidth := Self.Width;
72    PBITMAPINFOHEADER(pDibHeader)^.biHeight := Self.Height;
73    PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;
74  
75    {find out how much memory for the bits}
76    GetDIBits(DC, MemBitmap, 0, Self.Height, nil, TBITMAPINFO(pDibHeader^),
77      DIB_RGB_COLORS);
78  
79    {Alloc memory for the bits}
80    hBits := GlobalAlloc(GHND, PBITMAPINFOHEADER(pDibHeader)^.BiSizeImage);
81  
82    {Get a pointer to the bits}
83    pBits := GlobalLock(hBits);
84  
85    {Call fn again, but this time give us the bits!}
86    GetDIBits(DC, MemBitmap, 0, Self.Height, pBits, PBitmapInfo(pDibHeader)^,
87      DIB_RGB_COLORS);
88  
89    {Lets try a fixup for broken video drivers}
90    if isDcPalDevice = True then
91    begin
92      for i := 0 to (pPal^.palNumEntries - 1) do
93      begin
94        PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed := pPal^.palPalEntry[i].peRed;
95        PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen := 
96  pPal^.palPalEntry[i].peGreen;
97        PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue := pPal^.palPalEntry[i].peBlue;
98      end;
99      FreeMem(pPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
100   end;
101   {Release the screen dc}
102   ReleaseDC(0, DC);
103   {Delete the bitmap}
104   DeleteObject(MemBitmap);
105 
106   {Start print job}
107   Printer.BeginDoc;
108 
109   {Scale print size }
110   ScaleX := Self.Width * 3;
111   ScaleY := Self.Height * 3;
112 
113   {
114   if Printer.PageWidth < Printer.PageHeight then
115   begin
116     ScaleX := Printer.PageWidth;
117     ScaleY := Self.Height*(Printer.PageWidth/Self.Width);
118   end
119   else
120   begin
121     ScaleX := Self.Width*(Printer.PageHeight/Self.Height);
122     ScaleY := Printer.PageHeight;
123   end;
124   }
125 
126   {Just incase the printer drver is a palette device}
127   isDcPalDevice := False;
128   if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and RC_PALETTE = RC_PALETTE 
129 then
130   begin
131     {Create palette from dib}
132     GetMem(pPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
133     FillChar(pPal^, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)),
134       #0);
135     pPal^.palVersion := $300;
136     pPal^.palNumEntries := 256;
137     for i := 0 to (pPal^.palNumEntries - 1) do
138     begin
139       pPal^.palPalEntry[i].peRed := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;
140       pPal^.palPalEntry[i].peGreen := 
141 PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;
142       pPal^.palPalEntry[i].peBlue := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;
143     end;
144     pal := CreatePalette(pPal^);
145     FreeMem(pPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
146     OldPal := SelectPalette(Printer.Canvas.Handle, pal, False);
147     isDcPalDevice := True
148   end;
149   {send the bits to the printer}
150   StretchDiBits(Printer.Canvas.Handle, 0, 0, Round(ScaleX), Round(ScaleY),
151     0, 0, Self.Width, Self.Height, pBits, PBitmapInfo(pDibHeader)^,
152     DIB_RGB_COLORS, SRCCOPY);
153 
154   {Just incase you printer drver is a palette device}
155   if isDcPalDevice = True then
156   begin
157     SelectPalette(Printer.Canvas.Handle, OldPal, False);
158     DeleteObject(pal);
159   end;
160   {Clean up allocated memory}
161   GlobalUnlock(hBits);
162   GlobalFree(hBits);
163   GlobalUnlock(hDibHeader);
164   GlobalFree(hDibHeader);
165 
166   {end the print job}
167   Printer.EndDoc;
168 end;


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC