printp.pas

Canvas打印内容

constructor TPreview.Create(AOwner : TComponent);
begin
     inherited Create(AOwner);
     fPrintPreview := nil;
     PCanvas       := nil;
end;

destructor TPreview.Destroy;
begin
     if fPrintPreview <> nil then
        fPrintPreview.Release;

     if PCanvas <> nil then
        PCanvas.Free;

     inherited Destroy;
end;



function TPreview.BeginDoc : Boolean;
var
   pixelsperinchx  : longint;
   pixelsperinchy  : longint;
   pixperinch      : longint;
   physsize        : TPOINT;
   PrintDialog1    : TPrintDialog;
begin
    result := True;

      (*
      ** we have to do this BEFORE we get any info about the printer as
      ** they may change something in this dialog
      *)
    if not preview then
      begin
      PrintDialog1 := TPrintDialog.Create(Application);
      PrintDialog1.Options := [poPageNums, poWarning, poHelp];
      PrintDialog1.MinPage := 1;
      PrintDialog1.MaxPage := FPageCount;
      PrintDialog1.FromPage := 1;
      PrintDialog1.ToPage := FPageCount;
      if PrintDialog1.Execute then
        begin
        if PrintDialog1.PrintRange in [prAllPages] then
           begin
           minpage := 1;
           maxpage := FPageCount;
           end
        else
           begin
           if PrintDialog1.FromPage < 1 then
             minpage := 1
           else
             minpage := PrintDialog1.FromPage;
           if PrintDialog1.ToPage > FPageCount then
              maxpage := FPageCount
           else
              maxpage := PrintDialog1.ToPage;
           end;
        end
      else (* they chose 'OK' *)
        result := False;

      PrintDialog1.Free;
      end; (* initial not 'preview *)

    Escape( printer.handle, GETPHYSPAGESIZE, 0, nil, @physsize );

    pixelsperinchx := GetDeviceCaps( printer.handle, LOGPIXELSX );
    pixelsperinchy := GetDeviceCaps( printer.handle, LOGPIXELSY );

    if preview then
        begin
        (*
        ** We only create the form if the start a BeginDoc. This
        ** makes it a wee bit slower, but means we don't allocate
        ** unnecessary memory, esp. if we have this component on
        ** multiple forms...
        *)
        if fPrintPreview = nil then
          begin
          if Self.Owner.ClassType = tForm then
             fPrintPreview := TPrintPreview.Create(Self.Owner)
          else
             fPrintPreview := TPrintPreview.Create(Self);

          fPrintPreview.Left := 0;
          fPrintPreview.Top := 0;
          fPrintPreview.Preview := True;
          end;

        fPrintPreview.PreCanvas.PageNumber := 1;
        fPrintPreview.PreCanvas.PixelsPerInchPrinter := pixelsperinchx;
        fPrintPreview.Preview := preview;
        fPrintPreview.PreCanvas.Preview := preview;
        fPrintPreview.FPaintEvent := FSavePaintEvent;
        fPrintPreview.Scroll.Max := FPageCount;
        fPrintPreview.Scroll.Position := 1;
        fPrintPreview.lPageCount.Caption := inttostr(FPageCount);
        fPrintPreview.Width := Screen.Width - 3;
        fPrintPreview.Height := Screen.Height - 3;
        fPrintPreview.cbZoom.ItemIndex := 2;
        fPrintPreview.DrawMargins := FDrawMargins;

        bitmap := TBitmap.Create;
        bitmap.MonoChrome := True;

        pixperinch := fPrintPreview.pixelsperinch;

        (*
        ** We want to position the bitmap in the middle of the page
        *)

          (* this will ignore any scaling that has been done *)
        {fPrintPreview.PreCanvas.twipX := GetDeviceCaps( bitmap.Canvas.handle, LOGPIXELSX ) / 1440;
        fPrintPreview.PreCanvas.twipY := GetDeviceCaps( bitmap.Canvas.Handle, LOGPIXELSY ) / 1440;}

        fPrintPreview.Image1.Picture.Bitmap := bitmap;

        fPrintPreview.PreCanvas.SetCanvas( fPrintPreview.Image1.canvas );

        fPrintPreview.SetBitmapSize( PreviewSizeHalf );

        fPrintPreview.PreCanvas.SetFont( fPrintPreview.Canvas.Font );
        end
     else if result then (* as long as they said 'yes!' *)
        begin
        PCanvas := TPreviewCanvas.Create;

        PCanvas.SetCanvas( Printer.Canvas );
        PCanvas.PixelsPerInchPrinter := pixelsperinchx;
        (*
        ** the offset in pixels is ZERO for the printer as the
        ** printer object offsets it for us when we print
        *)
        PCanvas.OffsetX := 0;
        PCanvas.OffSetY := 0;

        PCanvas.twipX := pixelsperinchx / 1440;
        PCanvas.twipY := pixelsperinchy / 1440;
        PCanvas.twipMaxX := (Longint(printer.pagewidth) * 1440) div pixelsperinchx;
        pCanvas.twipMaxY := (Longint(printer.pageheight) * 1440) div pixelsperinchy;

        PCanvas.pixelsperinchdevice := pixelsperinchx; (* arbitrary choice! *)

        PageNumber := 1;

        Printer.BeginDoc;
        end;

        (*
        ** set the output canvas's font to the same font as
        ** the PrintPreview TFORM (should be a True Type font
        ** and therefore scalable)
        *)

     printmode := printing;
end;

procedure TPreview.UserWantedCancel(Sender : TObject);
begin
     UserCancelledPrinting := True;
end;

function TPreview.Print : Boolean;
var
   pageNumber   : longint;
   prt          : TfPrintingQuery;
begin
   result := False;

   if printmode = notprinting then
     Application.MessageBox( 'You have not used BeginDoc to set up printing', 'Error', MB_OK )
   else
     begin
     if preview then
        begin
        if fPrintPreview.ShowModal = mrOk then
           result := True;
        end
     else
        begin
        UserCancelledPrinting := False;

        if Assigned(FSavePaintEvent) then
          begin
          prt := TfPrintingQuery.Create(Application);
          prt.FOnCancel := UserWantedCancel;
          prt.SetMax( maxpage );
          prt.Show;
          Application.ProcessMessages;
          (* now print it! *)
          PageNumber := minpage;
          while ( PageNumber <= maxpage ) and ( not UserCancelledPrinting ) do
            begin
            prt.SetProgress( PageNumber );

            if PageNumber <> 1 then
               PCanvas.ClearCanvas;

            PCanvas.PageNumber := PageNumber;

            FSavePaintEvent(PCanvas,PageNumber);

            inc( PageNumber );
            end;
          end; (* there is a way to print! *)
          prt.Hide;
          prt.Release;
        end;
     end; (* in printing mode *)
end;

procedure TPreview.EndDoc;
begin
     if printmode = printing then
       begin
       if not preview then
          begin
          printer.canvas.font.pixelsperinch := pcanvas.pixelsperinchprinter;
          if UserCancelledPrinting then
            printer.Abort
          else
            printer.EndDoc;
          PCanvas.Free;
          pCanvas := nil;
          end
       else if fPrintPreview <> nil then
          begin
          printer.canvas.font.pixelsperinch := fprintpreview.precanvas.pixelsperinchprinter;
          fPrintPreview.Release;
          fPrintPreview := nil;
          end;

       printmode := notprinting;
       end;
end;


procedure TPreview.SetPreview( IsPreview : Boolean );
begin
     preview := IsPreview;

     if fPrintPreview <> nil then
       begin
       fPrintPreview.Preview := preview;
       fPrintPreview.PreCanvas.Preview := preview;
       end;
end;

function TPreview.GetPreview : Boolean;
begin
     result := preview;
end;

procedure TPreview.SetPaintEvent( pe : TDrawPPEvent );
begin
     fSavePaintEvent := pe;

     if fPrintPreview <> nil then
          fPrintPreview.FPaintEvent := pe;
end;

function TPreview.GetPaintEvent : TDrawPPEvent;
begin
     result := fSavePaintEvent;
end;

procedure TPreview.SetLeft( val : longint );
begin
     if fPrintPreview <> nil then
       fPrintPreview.left := val;
end;

function TPreview.GetLeft : Longint;
begin
     if fPrintPreview <> nil then
      result := fPrintPreview.left
     else
      result := 0;
end;

procedure TPreview.SetWidth( val : longint );
begin
     if fPrintPreview <> nil then
        fPrintPreview.width := val;
end;

function TPreview.GetWidth : Longint;
begin
     if fPrintPreview <> nil then
       result := fPrintPreview.width
     else
      result := 0;
end;

procedure TPreview.SetTop( val : longint );
begin
     if fPrintPreview <> nil then
       fPrintPreview.top := val;
end;

function TPreview.GetTop : Longint;
begin
     if fPrintPreview <> nil then
       result := fPrintPreview.top
     else
      result := 0;
end;

procedure TPreview.SetHeight( val : longint );
begin
     if fPrintPreview <> nil then
       fPrintPreview.height := val;
end;

function TPreview.GetHeight : Longint;
begin
     if fPrintPreview <> nil then
        result := fPrintPreview.height
     else
      result := 0;
end;

procedure TPreview.SetPageCount( pagecount : longint );
begin
     FPageCount := PageCount;

     if fPrintPreview <> nil then
        begin
        fPrintPreview.Scroll.Max := FPageCount;
        fPrintPreview.lPageCount.Caption := inttostr(FPageCount);
        end;
end;

function TPreview.GetDrawMargins : Boolean;
begin
     result := FDrawMargins;
end;

procedure TPreview.SetDrawMargins( margins : boolean );
begin
     FDrawMargins := margins;
     if fPrintPreview <> nil then
        fPrintPreview.DrawMargins := FDrawMargins;
end;




(*
*********************************************************************
***************** TPrintPreview - the form **************************
*********************************************************************
*)


procedure TPrintPreview.FormCreate(Sender: TObject);
begin
     preview   := True;
     PreCanvas := TPreviewCanvas.Create;
     PreCanvas.SetFont( Font );
end;

procedure TPrintPreview.FormDestroy(Sender: TObject);
begin
     PreCanvas.Free;
end;

procedure TPrintPreview.FormPaint(Sender: TObject);
var
   col  : tColor;
   rect : TRect;
begin
     PreCanvas.ClearCanvas;

     if DrawMargins then
       begin
       PreCanvas.DrawMargins;
       end;

     if Assigned(FPaintEvent) then
        FPaintEvent(PreCanvas, PreCanvas.PageNumber);
end;

procedure TPrintPreview.FormResize(Sender: TObject);
begin
     if Image1.Width < ScrollBox1.Width then
       Image1.Left := (ScrollBox1.Width - Image1.Width) div 2;
end;

procedure TPrintPreview.ScrollScroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
     (* change page numbers *)
     PreCanvas.PageNumber := Scroll.Position;
     Invalidate;
end;

procedure TPrintPreview.cbZoomChange(Sender: TObject);
begin
     case cbZoom.ItemIndex of
       0:
         SetBitmapSize( PreviewSizeFull );
       1:
         SetBitmapSize( PreviewSizeThreeQuarters );
       2:
         SetBitmapSize( PreviewSizeHalf );
       3:
         SetBitmapSize( PreviewSizeQuarter );
     end;

     Invalidate;
end;

procedure TPrintPreview.SetBitmapSize( pixelsperinch : longint );
var
   pixelsperinchx  : longint;
   pixelsperinchy  : longint;
   fullHeight,
   fullWidth       : longint;
   physsize        : TPOINT;
begin
   Escape( printer.handle, GETPHYSPAGESIZE, 0, nil, @physsize );

   pixelsperinchx := GetDeviceCaps( printer.handle, LOGPIXELSX );
   pixelsperinchy := GetDeviceCaps( printer.handle, LOGPIXELSY );

   (*
   ** offset in pixels, convert to twips (two steps as probs with integers)
   ** We have to do it ourselves, but when printing to the printer, these
   ** are ZERO as the PRINTER object offsets it for us.
   *)
   PreCanvas.OffsetX := ((physsize.x - printer.pagewidth) div 2);
   preCanvas.OffSetX := (PreCanvas.OffsetX * 1440) div pixelsperinchx;
   PreCanvas.OffSetY := ((physsize.y - printer.pageheight) div 2);
   PreCanvas.OffSetY := (PreCanvas.OffsetY * 1440) div pixelsperinchy;

   (*fPrintPreview.PreCanvas.PixelsPerInchDevice := pixelsperinchx;*)

   fullHeight := Round((physsize.y  * pixelsperinch ) / pixelsperinchy );
   fullWidth  := Round((physsize.x * pixelsperinch ) / pixelsperinchx);

   PreCanvas.twipMaxX := (Longint(printer.pagewidth) * 1440) div pixelsperinchx;
   PreCanvas.twipMaxY := (Longint(printer.pageheight) * 1440) div pixelsperinchy;

       (*
       ** have to figure out how much we are scaling the
       ** screen down in relation to the actual printer
       *)
   PreCanvas.screenScaleX := ( fullWidth / physsize.x );
   PreCanvas.screenScaleY := ( fullHeight / physsize.y );

   PreCanvas.twipX := pixelsperinch / 1440;
   PreCanvas.twipY := pixelsperinch / 1440;
   PreCanvas.maxX  := fullWidth;
   PreCanvas.maxY  := fullHeight;

   PreCanvas.PixelsPerInchDevice := pixelsperinch;

   Image1.Picture.bitmap.Height := fullHeight;
   Image1.Picture.bitmap.Width  := fullWidth;

   if fullWidth < ScrollBox1.Width then
     begin
     Image1.Left := (ScrollBox1.Width-fullWidth) div 2;
     end
   else
     begin
     Image1.Left := 0;
     end;
end;


end.