From: John Reynolds <jreynolds@net-gate.com>
Subject: Form printing
Date: 12 May 1999 00:00:00 GMT
Message-ID: <3739D13A.9F965903@net-gate.com>
Content-Transfer-Encoding: 7bit
X-Accept-Language: en
Content-Type: text/plain; charset=us-ascii
Organization: Another Netscape Collabra Server User
Mime-Version: 1.0
Reply-To: jreynolds@net-gate.com
Newsgroups: borland.public.delphi.vcl.components.using

    Here is the final version of the code to print a bitmap snapshot of
a virtual form that can be larger than the client area.
There is an option to cram everything on one page or break it into
multiple pages, and  to use either color or mono,
depending on the printer. This was required when using the standard
delphi StrechDraw function. The new PrintBitmap function does not need
this.

    Thanks to Peter Below, Earl Glyn and Joe Hecht for their feedback.

    John Reynolds


procedure TfrmMain.miPrintClick(Sender: TObject);
var
 dlgPrint:   TPrintDialog;
 bm1,bm2:   TBitMap;
 i:  integer;
  iPW,iPH: integer;
// acTempDir: array[0..255] of char;
 iBms: integer;
  iHbms,iVbms: integer;
 aBm1Rects: array of TRect;

 ///////////////////////////////////////
 // Helper functions
 ///////////////////////////////////////

 procedure GetNextImage(iBm: integer);
 begin
  if not bPrintMultiPage then
   bm2.Assign(bm1) // Printing the virtual screen on one page, just copy
the whole thing
  else
   with bm2 do   // Printing seperate pages, copy each Rect

Canvas.CopyRect(Rect(0,0,Width,Height),bm1.Canvas,aBm1Rects[iBm]);
 end;

 function CalcBms: integer;
 var
  i: integer;
  iCw,iCh: integer;   // Client
  iVw,iVh: integer;   // Virtual
  iL,iT,iR,iB: integer;  // Rect
 begin
  // Calc the number of bitmaps required to print the virtual screen.
  // Fill aBm1Rect with the Rect values to be printed for each page
  if not bPrintMultiPage then
   Result:=1 // Just one page
  else
  begin
   with TfrmLadderProgram(ActiveMDIChild) do
   begin
    iCw:=ClientWidth;     // Displayed screen
    iCh:=ClientHeight;
    iVw:=HorzScrollBar.Range; // Virtual screen
    iVh:=VertScrollBar.Range;
   end;
   // If iVx=iCx then no scroll bars are needed. The following (iCx+1)
   // ensures that the page will not be split
   iHbms:=(iVw div (iCw+1)) + 1;  // Horz pages
    iVbms:=(iVh div (iCh+1)) + 1;   // Vert pages
   Result:=iHbms*iVbms; // Number of pages

      // Fill aBm1Rects with the Rect sections of bm1 to print
   iL:=0;
   iT:=0;
   iR:=iVw div iHbms;
   iB:=iVh div iVbms;
   SetLength(aBm1Rects,Result);
   for i:=0 to Result-1 do
   begin
        aBm1Rects[i]:=Rect(iL,iT,iR,iB);
    iL:=iR+1;
    Inc(iR,iVw div iHbms);
    if iR>iVw then
    begin // wrap to next row
     iL:=0;
     iR:=iVw div iHbms;
     iT:=iB+1;
       Inc(iB,iVh div iVbms);
    end
   end; // for i

   // Size the bitmap
   with bm2 do
   begin
    Width:=iVw div iHbms;
    Height:=iVh div iVbms;
    if bPrintColor then
     PixelFormat:=pf8bit
    else
     PixelFormat:=pf1bit;
    MonoChrome:=not bPrintCOlor;
   end;
  end;
 end;

begin
 try
  with TfrmLadderProgram(ActiveMDIChild) do
  begin
   HorzScrollBar.Position:=0; // Home the form
   VertScrollBar.Position:=0;
   DrawProgram(False,False,nil,bPrintColor); // Strip colors if MONO
   // Create the main bitmap
   bm1:=TBitMap.Create;
   // Size the bitmap to the virtual screen size
   with bm1 do
   begin
    Width:=HorzScrollBar.Range;
    Height:=VertScrollBar.Range;
    if bPrintColor then
     PixelFormat:=pf8bit
    else
     PixelFormat:=pf1bit;
    MonoChrome:=not bPrintColor;
   end;
   for i:=0 to ControlCount-1   do
   begin // Draw the controls on the bitmap
    if Controls[i] is TWinControl then
     with TWinControl(Controls[i]) do
      PaintTo(bm1.Canvas.Handle,Left,Top);
   end;

   {$IFOPT D+}
   // Save to a file in the Windows Temp dir
//   GetTempPath(SizeOf(acTempDir),acTempDir);
//   bm1.SaveToFile(string(acTempDir)+sFileName+'.bmp');
   {$ENDIF}

    DrawProgram(False,False,nil,True); // Restore colors
  end;


  dlgPrint:=TPrintDialog.Create(nil);
  with dlgPrint do
  begin
    if Execute then
   begin
    StatusMsg(0,'Printing ...');
    try
     // Create the secondary bitmap
     bm2:=TBitMap.Create;
     iBms:=CalcBms;

     // Print the bitmap
     with Printer,Canvas do
     begin
      Title:='Ladder program -
'+TfrmLadderProgram(ActiveMDIChild).sFileName;
      iPW:=PageWidth; // Printer page sizes
      iPH:=PageHeight;
      Begindoc;
      NewPage;

      // Print pages
      for i:=0 to iBms-1  do
      begin
       GetNextImage(i);
//       {$IFOPT D+}
//
bm2.SaveToFile(string(acTempDir)+TfrmLadderProgram(ActiveMDIChild).sFileName+'_'+IntToStr(i)+'.bmp');

//       {$ENDIF}
////       StretchDraw(Rect(0,0,iPw,iPh),bm2);
       PrintBitmap(Printer.Canvas,Rect(0,0,iPw,iPh),bm2);
       if iBms>1 then
        NewPage;
       end; // for
       end; // with
     StatusMsg(0,'');
    finally
     bm2.Free;
      Printer.Enddoc;
     dlgPrint.Free;
     end;
   end; // if
  end; // with
 finally
  bm1.Free;
 end;
end;