[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    rgilland@ecn.net.au (Robert Gilland)

    "Guy Vandenberg" <guyvdb@MindSpring>

    You are a genius. After pulling my hair out and downloading anything that
    had anything to do with printing in delphi on the net and getting
    nowhere fast. Your little piece of code actually made sence to me
    and was userfrindly. I put it together with other code other small
    hints on printing and I got the below. Use it to your delight.
    You were the initiator.

    --------------------------------------------------------------------------------

    const INCHES_PER_MILIMETER : Real  = 0.04;

    type
      TOffset =   record
                   X,Y: Integer;
                  end;

    var FDeviceName : String;  {Get the name}
        FPageHeightPixel, FPageWidthPixel : Integer ;  {Page height and Page Width}
        FOrientation : TPrinterOrientation; {Orientation}
        FPrintOffsetPixels : TOffset;
        FPixelsPerMMX,FPixelsPerMMY: Real;
        MMSize, FPageHeightMM : Integer;
        TheReport, TheHead, HeadLine, RecordLine, TFname, TLname :String;

    procedure TMissing_Rep.GetDeviceSettings;

    var
      retval: integer;
      PixX, PixY: Integer;

    begin
        FDeviceName := Printer.Printers[Printer.PrinterIndex];  {Get the name}
        FPageHeightPixel := Printer.PageHeight;                 {Page height}
        FPageWidthPixel := Printer.PageWidth;                   {Page Width}
        FOrientation := Printer.Orientation;
    {Orientation}
        {Get the printable area offsets}
        {$IFDEF WIN32}
           FPrintOffsetPixels.X := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
           FPrintOffsetPixels.Y := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
        {$ELSE}
           retval := Escape(Printer.Handle,GETPRINTINGOFFSET,
                            0, nil, @FPrintOffsetPixels);
        {$ENDIF}
        {Get Pixels per Milimeter Ratio}
        PixX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
        PixY :=  GetDeviceCaps(Printer.Handle, LOGPIXELSY);
        FPixelsPerMMX := INCHES_PER_MILIMETER * PixX;
        FPixelsPerMMY := INCHES_PER_MILIMETER  * PixY;
        FPageHeightMM := Round(FPageHeightPixel/FPixelsPerMMY);
     end;

    function TMissing_Rep.PutText(mmX,mmY: Integer; S: string; LeftAlign:
    Boolean): boolean;
    var
      X, Y: Integer;
      align: WORD;
    begin
      if LeftAlign then
        align :=  SetTextAlign(Printer.Handle,TA_BOTTOM or TA_LEFT)
      else
        align :=  SetTextAlign(Printer.Handle,TA_BOTTOM or TA_RIGHT);
      result := FALSE; {Assume fail}
      X := Trunc(mmX * FPixelsPerMMX) - FPrintOffsetPixels.X;
      Y := Trunc(mmY * FPixelsPerMMY) - FPrintOffsetPixels.Y;
      if X < 0 then exit;
      if Y < 0 then exit;
      Printer.Canvas.TextOut(X,Y,S);
      result := TRUE;
    end;

    procedure TMissing_Rep.Print_ButClick(Sender: TObject);

    var PixelSize: Integer;

    begin
    Print_But.Enabled := False;
    if PrintDialog1.Execute then
     begin
     Printer.Canvas.Font := Missing_Rep.Font;
     PixelSize := Printer.Canvas.TextHeight('Yy');
     MMSize := Round(PixelSize/FPixelsPerMMY);
     Printer.Title := 'Breast Cancer Project Missing Report';
     Printer.BeginDoc;                        { begin to send print job to printer }
     PrintGenerator;
     Printer.EndDoc;                 { EndDoc ends and starts printing print job }
     end;
     Print_But.Enabled := True;
     end;

    procedure TMissing_Rep.PrintGenerator;

    Var
      yLoc , NumRows, TheRow :Integer;

      procedure Heading;
      begin
       yLoc := 20;
       PutText(20, 20, TheHead, TRUE);
       yLoc := yLoc + MMSize;
       PutText(20,  yLoc, StringGrid1.Cells[0,0], TRUE);
       PutText(60,  yLoc, StringGrid1.Cells[1,0], TRUE);
       PutText(100, yLoc, StringGrid1.Cells[2,0], TRUE);
       PutText(120, yLoc, StringGrid1.Cells[3,0], TRUE);
       PutText(150, yLoc, StringGrid1.Cells[4,0], TRUE);
       yLoc := yLoc + MMSize;
     end;

      procedure Footer;
      begin
      PutText(100,FPageHeightMM,InttoStr(Printer.PageNumber), TRUE);
      end;

    begin
       Heading;
       TheRow := 1;
       while (TheRow < StringGrid1.RowCount) do
       begin
           if (yLoc > (FPageHeightMM - MMSize)) then
    	   begin
    		  Footer;
    		  Printer.NewPage;
    		  Heading;
      	   end;
    	 TheGauge.Progress := Round(100 * TheRow/(StringGrid1.RowCount - 1));
    	 PutText(20,  yLoc, StringGrid1.Cells[0,TheRow], TRUE);
    	 PutText(60,  yLoc, StringGrid1.Cells[1,TheRow], TRUE);
    	 PutText(100, yLoc, StringGrid1.Cells[2,TheRow], TRUE);
    	 PutText(120, yLoc, StringGrid1.Cells[3,TheRow], TRUE);
    	 PutText(150, yLoc, StringGrid1.Cells[4,TheRow], TRUE);
    	 yLoc := yLoc + MMSize;
    	 TheRow := TheRow + 1;
     end;
    Footer;
    end;

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]