Here's the code I wrote last week for the "rough-cut", so it may need some
optimization. I just haven't had time to get back to it yet. I believe
just looking at it again now, that I should be able to do without the 2nd
bmp, but it does work fine as it is in any case! <g> Also note that it is
hardcoded for a res of 1024 x 768! Multiplying the size by 3 gave me the
print coverage I needed.
////////////// CODE START //////////////////////////////////////////////
procedure TMainF1.ScreenShot(x : integer; y : integer; Width : integer;
Height : integer; bm : TBitMap);
var
dc: HDC;
lpPal : PLOGPALETTE;
begin
{test width and height}
if ((Width = 0) OR (Height = 0)) then exit;
bm.Width := Width;
bm.Height := Height;
{get the screen dc}
dc := GetDc(0);
if (dc = 0) then exit;
{do we have a palette device?}
if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then begin
{allocate memory for a logical palette}
GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
{zero it out to be neat}
FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)),
#0);
{fill in the palette version}
lpPal^.palVersion := $300;
{grab the system palette entries}
lpPal^.palNumEntries := GetSystemPaletteEntries(dc, 0, 256,
lpPal^.palPalEntry);
if (lpPal^.PalNumEntries <> 0) then begin
{create the palette}
bm.Palette := CreatePalette(lpPal^);
end;
FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
end;
{copy from the screen to the bitmap}
BitBlt(bm.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, Dc, x, y,
SRCCOPY);
{release the screen dc}
ReleaseDc(0, dc);
end;
procedure TMainF1.PrintBtClick(Sender: TObject);
Var
MyRect : TRect;
begin
//MyPrint := TPrinter.Create;
MyBitmap := TBitmap.Create;
MyBitmap.Height := Screen.Height;
MyBitmap.Width := Screen.Width;
MyPrint := TPrinter.Create;
MyRect.Left := 0;
MyRect.Top := 0;
MyRect.Right := 3072;
MyRect.Bottom := 2304;
try
ScreenShot(0, 0, Screen.Width, Screen.Height, MyBitmap);
if Printer1.Execute then
begin
MyPrint.Orientation := poLandscape;
if Printer1.PrintToFile = True then
begin
MyPrint.BeginDoc;
MyPrint.Canvas.StretchDraw(MyRect, MyBitmap);
MyPrint.EndDoc;
MyBitmap.SaveToFile(AppCommonDir + 'Week ' + IntToStr(WeekNo) +
' EmpWorkSchedule.bmp')
end
Else
begin
MyPrint.BeginDoc;
MyPrint.Canvas.StretchDraw(MyRect, MyBitmap);
MyPrint.EndDoc;
end;
end;
finally
FreeAndNil(MyBitmap);
FreeAndNil(MyPrint);
end;//finally
end;
////////////// CODE END //////////////////////////////////////////////
>From "Robert Meek"
Personal e-mail: [EMAIL PROTECTED]
dba / "Tangentals Design"
Visit us at: www.TangentalsDesign.com
Home of "The Keep"!
Member of: "Association of Shareware Professionals"
Moderator for: "The Delphi", "Delphi-DB", and "Delphi-Talk"
programming lists at elists.org, and "DelphiTalk.net"
at www.DelphiTalk.net
-----Original Message-----
From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] On Behalf
Of Chuck Belanger
Sent: Tuesday, April 05, 2005 1:23 PM
To: Borland's Delphi Discussion List
Subject: Re: StringGrids D2005
Hi, Robert:
> What I ended up
> doing for my current problem was to snap a screenshot of the grid, load it
> to a bmp I created, and then sent that to the printer's canvas.
Actually, this sounds better than the TGridView print component. Could you
send
a little code to help out with the screenshot to bmp to printer?
Thanks,
Chuck Belanger
_______________________________________________
Delphi mailing list -> [email protected]
http://www.elists.org/mailman/listinfo/delphi
_______________________________________________
Delphi mailing list -> [email protected]
http://www.elists.org/mailman/listinfo/delphi
