home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / delphi.swg / 0161_Nice Printer Control Object.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-30  |  42.0 KB  |  1,445 lines
  1. {
  2. Here is an example that prints columns that are right, left, and center
  3. justified.  There are headers, footers, and, generally, a bunch o' things
  4. here.  This app encapsulates functionality to print text, lines, boxes
  5. and shaded boxes. Text can be left or right justified and centered.
  6. Columns can be  created and text can be left or right justified within the
  7. columns or  text can be centered.  Lines of any thickness can be drawn.
  8. Boxes can be drawn with any thickness.  The boxes can be shaded if desired.
  9. Headers and footers can be created and the header/footer areas can be shaded
  10. if desired.  Page numbering can contain custom text and can be placed
  11. anywhere desired.
  12. }
  13.  
  14.  
  15. {******* prnMain.pas *******}
  16.  
  17. unit Prnmain;
  18.  
  19. interface
  20.  
  21. uses
  22.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  23.   Forms, Dialogs, StdCtrls, ExtCtrls, Printers;
  24.  
  25. const
  26.   HeaderLines = 5;                        { Number of allowable header lines }
  27.   FooterLines = 5;                        { Number of allowable footer lines }
  28.   Columns = 20;                           { Number of allowable columns }
  29.         
  30. type
  31.   THeaderRecord = Record
  32.      Text: String[240];                   { Header text }
  33.      YPosition: Single;                   { Inches from the top }
  34.      Alignment: Integer;                  { 0:Left 1:Center 2:Right }
  35.  
  36.      FontName: String[80];                { Font name }
  37.      FontSize: Integer;                   { Font size }
  38.      FontStyle: TFontStyles;              { Font style }
  39.      End;
  40.  
  41.   TFooterRecord = Record
  42.      Text: String[240];                   { Footer text }
  43.      YPosition: Single;                   { Inches from the top }
  44.      Alignment: Integer;                  { 0:Left 1:Center 2:Right }
  45.      FontName: String[80];                { Font name }
  46.      FontSize: Integer;                   { Font size }
  47.      FontStyle: TFontStyles;              { Font style }
  48.  
  49.      End;
  50.  
  51.   THeaderCoordinates = Record
  52.      XTop: Single;
  53.      YTop: Single;
  54.      XBottom: Single;
  55.      YBottom: Single;
  56.      Boxed: Boolean;
  57.      Shading: Word;
  58.      LineWidth: Word;
  59.      End;   
  60.  
  61.   TFooterCoordinates = Record
  62.      XTop: Single;
  63.      YTop: Single;
  64.      XBottom: Single;
  65.      YBottom: Single;
  66.      Boxed: Boolean;
  67.      Shading: Word;
  68.      LineWidth: Word;
  69.      End;   
  70.  
  71.   TPageNumberRecord = Record
  72.      YPosition: Single;
  73.      Text: String[240];
  74.      Alignment: Word; 
  75.      FontName: String[80];
  76.      FontSize: Word;
  77.      FontStyle: TFontStyles;
  78.  
  79.      End;
  80.  
  81.   TColumnInformationRecord = Record
  82.      XPosition: Single;
  83.      Length: Single;
  84.      End;
  85.  
  86.   TPrintObject = class
  87.      private
  88.         TopMargin: Integer;               { Top margin in pixels }
  89.         BottomMargin: Integer;            { Bottom margin in pixels }
  90.         LeftMargin: Integer;              { Left margin in pixels }
  91.         RightMargin: Integer;             { Right margin in pixels }
  92.         PixelsPerInchVertical: Integer;   { Number of pixels per inch along Y axis }
  93.         PixelsPerInchHorizontal: Integer; { Number of pixels per inch along X axis }
  94.         TotalPageWidthPixels: Integer;    { Full width of page in pixels - includes gutters }
  95.  
  96.         TotalPageHeightPixels: Integer;   { Full height of page in pixels - includes gutters }
  97.         TotalPageHeightInches: Single;    { Height of page in inches }
  98.         TotalPageWidthInches: Single;     { Width of page in inches }
  99.         GutterLeft: Integer;              { Unprintable area on left }
  100.         GutterRight: Integer;             { Unprintable area on right }
  101.         GutterTop: Integer;               { Unprintable area on top }
  102.         GutterBottom: Integer;            { Unprintable area on bottom }
  103.         DetailTop: Single;                { Inches from the top where the detail section starts }
  104.         DetailBottom: Single;             { Inches from the top where the detail section ends }
  105.  
  106.         LastYPosition: Single;            { The Y position where the last write occurred }
  107.         AutoPaging: Boolean;              { Are new pages automatically generated? }
  108.         CurrentTab: Single;               { The value of the current tab }
  109.         CurrentFontName: String[30];
  110.         CurrentFontSize: Integer;
  111.         CurrentFontStyle: TFontStyles;
  112.         TextMetrics: TTextMetric;
  113.         Header: Array[1..HeaderLines] of THeaderRecord;
  114.         Footer: Array[1..FooterLines] of TFooterRecord;
  115.         ColumnInformation: Array[1..Columns] of TColumnInformationRecord;
  116.         PageNumber: TPageNumberRecord;
  117.  
  118.         HeaderCoordinates: THeaderCoordinates;
  119.         FooterCoordinates: TFooterCoordinates;
  120.         function CalculateLineHeight: Integer;
  121.         function InchesToPixelsHorizontal( Inches: Single ): Integer;
  122.         function InchesToPixelsVertical( Inches: Single ): Integer;
  123.         function PixelsToInchesHorizontal( Pixels: Integer ): Single;
  124.         function PixelsToInchesVertical( Pixels: Integer ): Single;
  125.         function LinesToPixels( Line:Integer ): Integer;
  126.         procedure CalculateMeasurements;
  127.         procedure _DrawBox( XTop:Word; YTop:Word; XBottom:Word; YBottom:Word; LineWidth:Word; Shading:Word );
  128.      public
  129.         procedure Start;
  130.  
  131.         procedure Quit;
  132.         procedure Abort;
  133.         procedure SetMargins( Top:Single; Bottom:Single; Left:Single; Right:Single );
  134.         procedure SetFontInformation( Name:String; Size:Word; Style: TFontStyles );
  135.         procedure WriteLine( X:Single; Y:Single; Text:String );
  136.         procedure WriteLineRight( Y:Single; Text:String );
  137.         procedure WriteLineCenter( Y:Single; Text:String );
  138.         procedure WriteLineColumnRight( ColumnNumber:Word; Y:Single; Text:String );
  139.         procedure WriteLineColumnCenter( ColumnNumber:Word; Y:Single; Text:String );
  140.         procedure DrawLine( TopX:Single; TopY:Single; BottomX:Single; BottomY:Single; LineWidth:Word );
  141.         procedure SetLineWidth( Width:Word );
  142.  
  143.         function  GetLineWidth: Word;
  144.         procedure SetTab( Inches:Single );
  145.         procedure NewPage;
  146.         function  GetLinesPerPage: Integer;
  147.         procedure GetPixelsPerInch( var X:Word; var Y:Word );
  148.         procedure GetPixelsPerPage( var X:Word; var Y:Word );
  149.         procedure GetGutter( var Top:Word; var Bottom:Word; var Left:Word; var Right:Word );
  150.         function  GetTextWidth( Text:String ): Integer;
  151.         function  GetLineHeightPixels: Word;
  152.         function  GetLineHeightInches: Single;
  153.         function  GetPageNumber:Integer;
  154.         function  GetColumnsPerLine: Integer;
  155.         procedure SetOrientation( Orient: TPrinterOrientation );
  156.  
  157.         procedure SetHeaderInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word; 
  158.                      FontName:String; FontSize: Word; FontStyle: TFontStyles );
  159.         procedure SetFooterInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word; 
  160.                      FontName:String; FontSize: Word; FontStyle: TFontStyles );
  161.         procedure WriteHeader;
  162.         procedure WriteFooter;
  163.         procedure SaveCurrentFont;
  164.         procedure RestoreCurrentFont;
  165.         procedure SetDetailTopBottom( Top: Single; Bottom: Single );
  166.         procedure SetAutoPaging( Value: Boolean );
  167.         procedure SetPageNumberInformation( YPosition:Single; Text:String; Alignment:Word; FontName:String; 
  168.                      FontSize:Word; FontStyle:TFontStyles );
  169.  
  170.         procedure WritePageNumber;
  171.         procedure WriteLineColumn( ColumnNumber:Word; Y:Single; Text:String );
  172.         procedure DrawBox( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word );
  173.         procedure DrawBoxShaded( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word; Shading:Word );
  174.         procedure SetHeaderDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
  175.                   Boxed: Boolean; LineWidth:Word; Shading:Word );
  176.         procedure SetFooterDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
  177.                   Boxed: Boolean; LineWidth:Word; Shading:Word );
  178.         procedure CreateColumn( Number:Word; XPosition:Single; Length:Single );
  179.         procedure SetYPosition( YPosition:Single );
  180.         function  GetYPosition: Single;
  181.         procedure NextLine;
  182.         function  GetLinesLeft: Word;
  183.         function  GetLinesInDetailArea: Word;
  184.  
  185.         procedure SetTopOfPage;
  186.         procedure NewLines( Number:Word );
  187.         function GetFontName: String;
  188.         function GetFontSize: Word;
  189.    End;
  190.  
  191. implementation
  192.  
  193. procedure TPrintObject.Start;
  194.  
  195.    { This function MUST be called first before any other printing function }
  196.  
  197.    var
  198.       Top,Bottom,Left,Right: Single;
  199.       I: Integer;
  200.  
  201.    Begin
  202.    Printer.BeginDoc;
  203.  
  204.    AutoPaging := True;
  205.  
  206.    CalculateMeasurements;
  207.  
  208.    PageNumber.Text := '';
  209.  
  210.    Top := PixelsToInchesVertical( GutterTop );
  211.    Bottom := PixelsToInchesVertical( GutterBottom );
  212.    Left := PixelsToInchesHorizontal( GutterLeft );
  213.    Right := PixelsToInchesHorizontal( GutterRight );
  214.    SetMargins( Top,Bottom,Left,Right );
  215.  
  216.    For I := 1 To HeaderLines Do
  217.  
  218.       Header[I].Text := '';
  219.    HeaderCoordinates.Boxed := False;
  220.    HeaderCoordinates.Shading := 0;
  221.    For I := 1 To FooterLines Do
  222.       Footer[I].Text := '';
  223.    FooterCoordinates.Boxed := False;
  224.    FooterCoordinates.Shading := 0;
  225.  
  226.    CurrentTab := 0.0;
  227.  
  228.    LastYPosition := 0.0;
  229.    End;              
  230.  
  231. procedure TPrintObject.Quit;
  232.  
  233.    { 'Quit' must always be called when printing is completed }
  234.  
  235.    Begin
  236.    WriteHeader;
  237.    WriteFooter;
  238.    WritePageNumber;
  239.  
  240.    Printer.EndDoc
  241.    End;
  242.  
  243. procedure TPrintObject.SetMargins( Top:Single; Bottom:Single; Left:Single; Right:Single );
  244.  
  245.    { Set the top, bottom, left and right margins in inches }
  246.  
  247.  
  248.    var
  249.       Value: Single;
  250.       Buffer: String;
  251.  
  252.    Begin
  253.    { If the sum of the left and right margins exceeds the width of the page,
  254.      set the left margin to the value of 'GutterLeft' and set the right
  255.      margin to the value of 'GutterRight' }
  256.    If ( Left + Right >= TotalPageWidthInches ) Then
  257.       Begin
  258.       Left := GutterLeft;
  259.       Right := GutterRight;
  260.       End;
  261.    If ( Left <= 0 ) Then
  262.       Left := GutterLeft;
  263.    If ( Right <= 0 ) Then
  264.       Right := GutterRight;
  265.  
  266.    { If the sum of the top and bottom margins exceeds the height of the 
  267.      page, set the top margin to the value of 'GutterTop' and set the 
  268.      bottom margin to the value of 'GutterBottom' }
  269.  
  270.    If ( Top + Bottom >= TotalPageHeightInches ) Then
  271.       Begin
  272.       Top := GutterTop;
  273.       Bottom := GutterBottom;
  274.       End;
  275.    If ( Top <= 0 ) Then
  276.       Top := GutterTop;
  277.    If ( Bottom <= 0 ) Then
  278.       Bottom := GutterBottom;
  279.  
  280.    { Convert everything to pixels }
  281.    TopMargin := InchesToPixelsVertical( Top );
  282.    If ( TopMargin < GutterTop ) Then
  283.       TopMargin := GutterTop;
  284.  
  285.    BottomMargin := InchesToPixelsVertical( Bottom );
  286.    If ( BottomMargin < GutterBottom ) Then
  287.       BottomMargin := GutterBottom;
  288.  
  289.    LeftMargin := InchesToPixelsHorizontal( Left );
  290.    If ( LeftMargin < GutterLeft ) Then
  291.       LeftMargin := GutterLeft;
  292.  
  293.    RightMargin := InchesToPixelsHorizontal( Right );
  294.  
  295.    If ( RightMargin < GutterRight ) Then
  296.       RightMargin := GutterRight;
  297.    End;
  298.  
  299. procedure TPrintObject.WriteLine( X:Single; Y:Single; Text:String );
  300.  
  301.    { Write some text.  The parameters represent inches from the left ('X')
  302.      and top ('Y') margins. }
  303.  
  304.    var
  305.       XPixels: Integer;
  306.       YPixels: Integer;
  307.  
  308.    Begin
  309.    { How many pixels are there in the inches represented by 'X'? }
  310.    If ( X >= 0.0 ) Then
  311.       XPixels := InchesToPixelsHorizontal( X )
  312.    Else
  313.       XPixels := LeftMargin;
  314.    If ( XPixels < GutterLeft ) Then
  315.       XPixels := GutterLeft;
  316.  
  317.    { If there is a tab set, increase 'XPixels' by the amount of the tab }
  318.    If ( CurrentTab > 0.0 ) Then
  319.  
  320.       Inc( XPixels,InchesToPixelsHorizontal(CurrentTab) );
  321.  
  322.    { How many pixels are there in the inches represented by 'Y'? }
  323.    If ( Y > -0.01 ) Then
  324.       { Printing will occur at an absolute location from the top of the 
  325.         page. }
  326.       Begin
  327.       YPixels := InchesToPixelsVertical( Y );
  328.       If ( YPixels < GutterTop ) Then
  329.          YPixels := GutterTop;
  330.       If ( YPixels > TotalPageHeightPixels ) Then
  331.          YPixels := TotalPageHeightPixels - GutterBottom;
  332.  
  333.       LastYPosition := Y;
  334.       End;
  335.    If ( Y = -1.0 ) Then
  336.       { Write the text at the next line }
  337.       Begin
  338.       If ( AutoPaging = True ) Then
  339.          Begin
  340.          { If the next line we're going to write to exceeds beyond the 
  341.  
  342.            bottom of the detail section, issue a new page }
  343.          If ( LastYPosition + GetLineHeightInches > DetailBottom ) Then
  344.             NewPage;
  345.          End;
  346.       YPixels := InchesToPixelsVertical( LastYPosition + GetLineHeightInches );
  347.       LastYPosition := LastYPosition + GetLineHeightInches;
  348.       End;
  349.    If ( Y = -2.0 ) Then
  350.       { Write the text on the current line }
  351.       YPixels := InchesToPixelsVertical( LastYPosition );      
  352.  
  353.    Printer.Canvas.TextOut( XPixels-GutterLeft,YPixels-GutterTop,Text );
  354.    End;
  355.  
  356. procedure TPrintObject.WriteLineColumn( ColumnNumber:Word; Y:Single; Text:String );
  357.  
  358.    { Write text, left aligned against the column represented by
  359.      'ColumnInformation[ColumnNumber]' }
  360.  
  361.    Begin
  362.    WriteLine( ColumnInformation[ColumnNumber].XPosition,Y,Text );
  363.  
  364.    End;
  365.  
  366. procedure TPrintObject.WriteLineColumnRight( ColumnNumber:Word; Y:Single; Text:String );
  367.  
  368.    { Write text, right aligned against the column represented by
  369.      'ColumnInformation[ColumnNumber]' }
  370.  
  371.    var
  372.       PixelLength: Word;
  373.       StartPixel: Word;
  374.  
  375.    Begin
  376.    { How many pixels does the text in 'Text' require? }
  377.    PixelLength := Printer.Canvas.TextWidth( Text );
  378.  
  379.    { Calculate where printing should start }
  380.    StartPixel := InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].XPosition + 
  381.       ColumnInformation[ColumnNumber].Length ) - PixelLength;
  382.  
  383.    SetTab( 0.0 );
  384.    WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
  385.    SetTab( CurrentTab );
  386.    End;
  387.  
  388. procedure TPrintObject.WriteLineRight( Y:Single; Text:String );
  389.  
  390.    { Print a line of text right justified 'Y' inches from the top }
  391.  
  392.    var
  393.       PixelLength: Word;
  394.       StartPixel: Word;
  395.  
  396.  
  397.    Begin
  398.    { How many pixels does the text in 'Text' require? }
  399.    PixelLength := Printer.Canvas.TextWidth( Text );
  400.  
  401.    { Calculate where printing should start }
  402.    StartPixel := (TotalPageWidthPixels-GutterLeft-GutterRight) - PixelLength;
  403.  
  404.    SetTab( 0.0 );       
  405.    WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
  406.    SetTab( CurrentTab );       
  407.    End;
  408.  
  409. procedure TPrintObject.WriteLineCenter( Y:Single; Text:String );
  410.  
  411.    { Print a line of text centered at Y inches from the top }
  412.  
  413.    var
  414.       PixelLength: Integer;
  415.       StartPixel: Integer;
  416.  
  417.    Begin
  418.    { How many pixels does the text in 'Text' require? }
  419.    PixelLength := Printer.Canvas.TextWidth( Text );
  420.  
  421.    { Calculate where printing should start }
  422.    StartPixel := ((GutterLeft+(TotalPageWidthPixels-GutterRight)) Div 2) - (PixelLength Div 2);   
  423.  
  424.    SetTab( 0.0 );
  425.    WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
  426.  
  427.    SetTab( CurrentTab );
  428.    End;
  429.  
  430. procedure TPrintObject.WriteLineColumnCenter( ColumnNumber:Word; Y:Single; Text:String );
  431.  
  432.    { Print a line of text centered within the column number represented by
  433.      'ColumnNumber', at Y inches from the top }
  434.  
  435.    var
  436.       PixelLength: Integer;
  437.       StartPixel: Integer;
  438.       Pixels: Integer;
  439.  
  440.    Begin
  441.    { How many pixels does the text in 'Text' require? }
  442.    PixelLength := Printer.Canvas.TextWidth( Text );
  443.  
  444.    { Calculate where printing should start }
  445.    Pixels := InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].Length );
  446.    StartPixel := (InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].Length ) Div 2) +
  447.       InchesToPixelsHorizontal(ColumnInformation[ColumnNumber].XPosition) - (PixelLength Div 2);
  448.  
  449.    SetTab( 0.0 );
  450.    WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
  451.    SetTab( CurrentTab );
  452.    End;
  453.  
  454.  
  455. procedure TPrintObject.DrawLine( TopX:Single; TopY:Single; BottomX:Single; BottomY:Single; LineWidth:Word );
  456.  
  457.    { Draw a line beginning at a particular X,Y coordinate and ending at a
  458.      particular X,Y coordinate. }
  459.  
  460.    var
  461.       TopXPixels, BottomXPixels, TopYPixels, BottomYPixels: Integer;
  462.  
  463.    Begin
  464.    TopXPixels := InchesToPixelsHorizontal( TopX );
  465.    BottomXPixels := InchesToPixelsHorizontal( BottomX );
  466.    TopYPixels := InchesToPixelsVertical( TopY );
  467.    BottomYPixels := InchesToPixelsVertical( BottomY );
  468.  
  469.    Dec( TopXPixels,GutterLeft );
  470.    Dec( BottomXPixels,GutterLeft );
  471.    Dec( TopYPixels,GutterTop );
  472.    Dec( BottomYPixels,GutterTop );
  473.  
  474.  
  475.    Printer.Canvas.Pen.Width := LineWidth;
  476.  
  477.    Printer.Canvas.MoveTo( TopXPixels,TopYPixels );
  478.    Printer.Canvas.LineTo( BottomXPixels,BottomYPixels );
  479.    End;
  480.  
  481. procedure TPrintObject.SetFontInformation( Name:String; Size:Word; Style: TFontStyles );
  482.  
  483.    { Change the current font information }
  484.  
  485.    Begin
  486.    Printer.Canvas.Font.Name := Name;
  487.    Printer.Canvas.Font.Size := Size;
  488.    Printer.Canvas.Font.Style := Style;
  489.  
  490.    CalculateMeasurements;
  491.    End;
  492.  
  493. function TPrintObject.GetFontName: String;
  494.  
  495.    { Return the current font name }
  496.  
  497.    Begin
  498.    Result := Printer.Canvas.Font.Name;
  499.    End;
  500.  
  501. function TPrintObject.GetFontSize: Word;
  502.  
  503.    { Return the current font size }
  504.  
  505.    Begin
  506.    Result := Printer.Canvas.Font.Size;
  507.    End;
  508.  
  509.  
  510. procedure TPrintObject.SetOrientation( Orient: TPrinterOrientation );
  511.  
  512.    Begin
  513.    Printer.Orientation := Orient;
  514.                                        
  515.    CalculateMeasurements;
  516.    End;
  517.  
  518. function TPrintObject.CalculateLineHeight: Integer;
  519.  
  520.    { Calculate the height of a line plus the normal amount of space between
  521.      each line }
  522.  
  523.    Begin
  524.    Result := TextMetrics.tmHeight + TextMetrics.tmExternalLeading;
  525.    End;
  526.  
  527. procedure TPrintObject.NewPage;
  528.  
  529.    { Issue a new page }
  530.  
  531.    Begin
  532.    WriteHeader;
  533.    WriteFooter;
  534.    WritePageNumber;
  535.    LastYPosition := DetailTop - GetLineHeightInches;
  536.  
  537.    Printer.NewPage;
  538.  
  539.    End;
  540.  
  541. function TPrintObject.GetPageNumber;
  542.  
  543.    { Return the current page number }
  544.  
  545.    Begin
  546.    Result := Printer.PageNumber;
  547.    End;
  548.  
  549. function TPrintObject.GetTextWidth( Text:String ): Integer;
  550.  
  551.    { Return the width of the text contained in 'Text' in pixels }
  552.  
  553.    Begin
  554.    Result := Printer.Canvas.TextWidth( Text );
  555.    End;
  556.  
  557. function TPrintObject.GetLineHeightPixels: Word;
  558.  
  559.    Begin
  560.    Result := CalculateLineHeight;
  561.    End;
  562.  
  563. function TPrintObject.GetLineHeightInches: Single;
  564.  
  565.    Begin
  566.    Result := PixelsToInchesVertical( GetLineHeightPixels );
  567.    End;
  568.  
  569. procedure TPrintObject._DrawBox( XTop:Word; YTop:Word; XBottom:Word; YBottom:Word; LineWidth:Word; Shading:Word );
  570.  
  571.    { The low level routine which actually draws the box and shades it as
  572.  
  573.      desired. The paramaters are in pixels and not inches. }
  574.  
  575.    Begin
  576.    Printer.Canvas.Pen.Width := LineWidth;
  577.    Printer.Canvas.Brush.Color := RGB( Shading,Shading,Shading );
  578.  
  579.    Printer.Canvas.Rectangle( XTop,YTop,XBottom,YBottom );
  580.    End;
  581.  
  582. procedure TPrintObject.DrawBox( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word );
  583.  
  584.    { Draw a box at the X,Y coordinates passed in the parameters }
  585.  
  586.    var
  587.       BLinePixels,BColPixels,ELinePixels,EColPixels: Integer;
  588.  
  589.    Begin
  590.    BLinePixels := InchesToPixelsVertical( YTop ) - GutterTop;
  591.    ELinePixels := InchesToPixelsVertical( YBottom ) - GutterTop;
  592.  
  593.    BColPixels := InchesToPixelsHorizontal( XTop ) - GutterLeft;
  594.    EColPixels := InchesToPixelsHorizontal( XBottom ) - GutterLeft;
  595.  
  596.    _DrawBox( BColPixels,BLinePixels,EColPixels,ELinePixels,LineWidth,255 );
  597.    End;
  598.  
  599. procedure TPrintObject.DrawBoxShaded( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word; Shading:Word );
  600.  
  601.    { Draw a box at the X,Y coordinates passed in the parameters }
  602.  
  603.  
  604.    var
  605.       BLinePixels,BColPixels,ELinePixels,EColPixels: Integer;
  606.  
  607.    Begin
  608.    BLinePixels := InchesToPixelsVertical( YTop ) - GutterTop;
  609.    ELinePixels := InchesToPixelsVertical( YBottom ) - GutterTop;
  610.  
  611.    BColPixels := InchesToPixelsHorizontal( XTop ) - GutterLeft;
  612.    EColPixels := InchesToPixelsHorizontal( XBottom ) - GutterLeft;
  613.  
  614.    _DrawBox( BColPixels,BLinePixels,EColPixels,ELinePixels,LineWidth,Shading );
  615.    End;
  616.  
  617. function TPrintObject.GetLinesPerPage: Integer;
  618.  
  619.    { Return the number of lines on the entire page }
  620.  
  621.    Begin
  622.    Result := (TotalPageHeightPixels - GutterTop - GutterBottom) Div CalculateLineHeight;
  623.    End;
  624.  
  625. function TPrintObject.GetLinesInDetailArea: Word;
  626.  
  627.    { Return the number of lines in the detail area }
  628.  
  629.    Begin
  630.    Result := InchesToPixelsVertical( DetailBottom - DetailTop ) Div CalculateLineHeight;
  631.    End;
  632.  
  633.  
  634. procedure TPrintObject.GetPixelsPerInch( var X:Word; var Y:Word );
  635.  
  636.    Begin
  637.    X := PixelsPerInchHorizontal;
  638.    Y := PixelsPerInchVertical;
  639.    End;
  640.  
  641. procedure TPrintObject.GetPixelsPerPage( var X:Word; var Y:Word );
  642.  
  643.    Begin
  644.    X := TotalPageWidthPixels - GutterLeft - GutterRight;
  645.    Y := TotalPageHeightPixels - GutterTop - GutterBottom;
  646.    End;
  647.  
  648. procedure TPrintObject.GetGutter( var Top:Word; var Bottom:Word; var Left:Word; var Right:Word );
  649.  
  650.    Begin
  651.    Top := GutterTop;
  652.    Bottom := GutterBottom;
  653.    Left := GutterLeft;
  654.    Right := GutterRight;
  655.    End;
  656.  
  657. procedure TPrintObject.Abort;
  658.  
  659.    Begin
  660.    Printer.Abort;
  661.    End;
  662.  
  663. function TPrintObject.GetColumnsPerLine: Integer;
  664.  
  665.    { How many columns are there in a Line? }
  666.  
  667.  
  668.    var
  669.       Pixels: Integer;
  670.  
  671.    Begin
  672.    Pixels := TotalPageWidthPixels - GutterLeft - GutterRight;
  673.  
  674.    Result := Pixels Div Printer.Canvas.TextWidth( 'B' );      
  675.    End;  
  676.  
  677. function TPrintObject.InchesToPixelsHorizontal( Inches: Single ): Integer;
  678.  
  679.    { Convert the horizontal inches represented in 'Inches' to pixels }
  680.  
  681.    var
  682.       Value: Single;
  683.       Buffer: String;
  684.       I: Integer;
  685.                   
  686.    Begin
  687.    Value := Inches * PixelsPerInchHorizontal;
  688.    Buffer := FloatToStr( Value );
  689.  
  690.    { If there is a decimal point in 'Buffer', remove it. }
  691.    I := 1;
  692.    While( (Buffer[I] <> '.') And (I <= Length(Buffer)) ) Do
  693.       Inc( I );
  694.    Buffer[0] := Chr( I-1 );
  695.  
  696.  
  697.    Result := StrToInt( Buffer );
  698.    End;
  699.  
  700. function TPrintObject.InchesToPixelsVertical( Inches: Single ): Integer;
  701.  
  702.    { Convert the vertical inches represented in 'Inches' to pixels }
  703.  
  704.    var
  705.       Value: Single;
  706.       Buffer: String;
  707.       I: Integer;
  708.  
  709.    Begin
  710.    Value := Inches * PixelsPerInchVertical;
  711.    Buffer := FloatToStr( Value );
  712.  
  713.       { If there is a decimal point in 'Buffer', remove it. }
  714.    I := 1;
  715.    While( (Buffer[I] <> '.') And (I <= Length(Buffer)) ) Do
  716.       Inc( I );
  717.    Buffer[0] := Chr( I-1 );
  718.  
  719.    Result := StrToInt( Buffer );
  720.    End;
  721.  
  722. function TPrintObject.PixelsToInchesHorizontal( Pixels: Integer ): Single;
  723.  
  724.  
  725.    Begin
  726.    Result := Pixels / PixelsPerInchHorizontal;
  727.    End;
  728.  
  729. function TPrintObject.PixelsToInchesVertical( Pixels: Integer ): Single;
  730.  
  731.    Begin
  732.    Result := Pixels / PixelsPerInchVertical;
  733.    End;
  734.  
  735. function TPrintObject.LinesToPixels( Line:Integer ): Integer;
  736.  
  737.    { Calculate the number of vertical pixels in 'Line' }
  738.  
  739.    Begin
  740.    If ( Line <= 0 ) Then
  741.       Line := 1;
  742.  
  743.    Result := (Line-1) * CalculateLineHeight;
  744.    End;
  745.  
  746. procedure TPrintObject.SetLineWidth( Width:Word );
  747.  
  748.    Begin
  749.    Printer.Canvas.Pen.Width := Width;
  750.    End;
  751.  
  752. function TPrintObject.GetLineWidth: Word;
  753.  
  754.    Begin
  755.    Result := Printer.Canvas.Pen.Width;
  756.    End;
  757.  
  758. procedure TPrintObject.CalculateMeasurements;
  759.  
  760.  
  761.    { Calculate some necessary measurements.  Thanks to Robert Fabiszak
  762.      CompuServe: 70304,2047 for the Escape() Windows API calls. }
  763.  
  764.    var
  765.       pt: TPoint;
  766.  
  767.    Begin
  768.    { Call the Windows API function GetTextMetrics() to get the specifics
  769.      of the particular font. }
  770.    GetTextMetrics( Printer.Canvas.Handle,TextMetrics );
  771.  
  772.    { Calculate the number of pixels per inch vertical and horizontal.
  773.      'GetDeviceCaps' is a Windows API call. }
  774.    PixelsPerInchVertical := GetDeviceCaps( Printer.Handle,LOGPIXELSY );
  775.    PixelsPerInchHorizontal := GetDeviceCaps( Printer.Handle,LOGPIXELSX );
  776.  
  777.    { Get the gutter on the left and top.  'Escape' is a Windows API 
  778.  
  779.      call. }
  780.    Escape( Printer.Canvas.Handle,GETPRINTINGOFFSET,0,Nil,@pt );
  781.    GutterLeft := pt.X;
  782.    GutterTop := pt.Y;
  783.  
  784.    Escape( Printer.Canvas.Handle,GETPHYSPAGESIZE,0,Nil,@pt );
  785.    TotalPageWidthPixels := pt.X;
  786.    TotalPageHeightPixels := pt.Y;
  787.    TotalPageWidthInches := pt.X / PixelsPerInchHorizontal;
  788.    TotalPageHeightInches := pt.Y / PixelsPerInchVertical;
  789.  
  790.    GutterRight := TotalPageWidthPixels - GutterLeft - Printer.PageWidth;
  791.    GutterBottom := TotalPageHeightPixels - GutterTop - Printer.PageHeight;
  792.  
  793.    If ( TopMargin < GutterTop ) Then
  794.       TopMargin := GutterTop;
  795.    If ( BottomMargin < GutterBottom ) Then
  796.       BottomMargin := GutterBottom;
  797.    If ( LeftMargin < GutterLeft ) Then
  798.       LeftMargin := GutterLeft;
  799.  
  800.    If ( RightMargin < GutterRight ) Then
  801.       RightMargin := GutterRight;   
  802.    End;
  803.  
  804. procedure TPrintObject.SetHeaderInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word; 
  805.    FontName:String; FontSize: Word; FontStyle: TFontStyles );
  806.  
  807.    Begin
  808.    If ( Line > HeaderLines ) Then
  809.       Exit;
  810.  
  811.    Header[Line].Text := Text;
  812.    Header[Line].YPosition := YPosition;
  813.    Header[Line].Alignment := Alignment;
  814.    Header[Line].FontName := FontName;
  815.    Header[Line].FontSize := FontSize;
  816.    Header[Line].FontStyle := FontStyle;
  817.    End;
  818.  
  819. procedure TPrintObject.SetFooterInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word; 
  820.  
  821.    FontName:String; FontSize: Word; FontStyle: TFontStyles );
  822.  
  823.    Begin
  824.    If ( Line > FooterLines ) Then
  825.       Exit;
  826.  
  827.    Footer[Line].Text := Text;
  828.    Footer[Line].YPosition := YPosition;
  829.    Footer[Line].Alignment := Alignment;
  830.    Footer[Line].FontName := FontName;
  831.    Footer[Line].FontSize := FontSize;
  832.    Footer[Line].FontStyle := FontStyle;   
  833.    End;
  834.  
  835. procedure TPrintObject.WriteHeader;
  836.  
  837.    { If any headers are defined, write them }
  838.  
  839.    var
  840.       I: Integer;
  841.  
  842.    Begin
  843.    SaveCurrentFont;
  844.    For I := 1 To HeaderLines Do
  845.       Begin
  846.       If ( Length(Header[I].Text) > 0 ) Then
  847.  
  848.          Begin
  849.          With Header[I] Do
  850.             Begin
  851.             SetFontInformation( FontName,FontSize,FontStyle );
  852.             If ( Alignment = 0 ) Then
  853.                WriteLine( LeftMargin, YPosition, Text );
  854.             If ( Alignment = 1 ) Then
  855.                WriteLineCenter( YPosition, Text );
  856.             If ( Alignment = 2 ) Then
  857.                WriteLineRight( YPosition, Text );
  858.             End;
  859.          End;
  860.  
  861.       RestoreCurrentFont;
  862.       End;
  863.  
  864.    { Does the user desire a box around the header? }
  865.    If ( HeaderCoordinates.Boxed = True ) Then
  866.       Begin
  867.       If ( HeaderCoordinates.Shading > 0 ) Then
  868.  
  869.          DrawBoxShaded( HeaderCoordinates.XTop,HeaderCoordinates.YTop,HeaderCoordinates.XBottom,
  870.             HeaderCoordinates.YBottom,HeaderCoordinates.LineWidth,HeaderCoordinates.Shading)
  871.       Else
  872.          DrawBox( HeaderCoordinates.XTop,HeaderCoordinates.YTop,HeaderCoordinates.XBottom,
  873.             HeaderCoordinates.YBottom,HeaderCoordinates.LineWidth );
  874.       End;
  875.    End;
  876.  
  877. procedure TPrintObject.WriteFooter;
  878.  
  879.    { If any footers are defined, write them }
  880.  
  881.    var
  882.       I: Integer;
  883.       Temp: Boolean;
  884.  
  885.    Begin
  886.    SaveCurrentFont;
  887.  
  888.    { Set 'AutoPaging' off.  Otherwise the footer will not get written
  889.      correctly. }
  890.    Temp := AutoPaging;
  891.    AutoPaging := False;
  892.       
  893.    For I := 1 To FooterLines Do
  894.  
  895.       Begin
  896.       If ( Length(Footer[I].Text) > 0 ) Then
  897.          Begin
  898.          With Footer[I] Do
  899.             Begin
  900.             SetFontInformation( FontName,FontSize,FontStyle );
  901.             If ( Alignment = 0 ) Then
  902.                WriteLine( LeftMargin, YPosition, Text );
  903.             If ( Alignment = 1 ) Then
  904.                WriteLineCenter( YPosition, Text );
  905.             If ( Alignment = 2 ) Then
  906.                WriteLineRight( YPosition, Text );
  907.             End;
  908.          End;
  909.  
  910.       RestoreCurrentFont;
  911.       End;
  912.  
  913.    { Does the user desire a box around the footer? }
  914.  
  915.    If ( FooterCoordinates.Boxed = True ) Then
  916.       Begin
  917.       If ( FooterCoordinates.Shading > 0 ) Then
  918.          DrawBoxShaded( FooterCoordinates.XTop,FooterCoordinates.YTop,FooterCoordinates.XBottom,
  919.             FooterCoordinates.YBottom,FooterCoordinates.LineWidth,FooterCoordinates.Shading )
  920.       Else
  921.          DrawBox( FooterCoordinates.XTop,FooterCoordinates.YTop,FooterCoordinates.XBottom,
  922.             FooterCoordinates.YBottom,FooterCoordinates.LineWidth );
  923.       End;
  924.  
  925.    AutoPaging := Temp;
  926.    End;
  927.  
  928. procedure TPrintObject.SaveCurrentFont;
  929.  
  930.    Begin
  931.    CurrentFontName := Printer.Canvas.Font.Name;
  932.    CurrentFontSize := Printer.Canvas.Font.Size;
  933.    CurrentFontStyle := Printer.Canvas.Font.Style;
  934.    End;                                       
  935.  
  936.  
  937. procedure TPrintObject.RestoreCurrentFont;
  938.  
  939.    Begin
  940.    SetFontInformation( CurrentFontName,CurrentFontSize,CurrentFontStyle );
  941.    End;
  942.  
  943. procedure TPrintObject.SetDetailTopBottom( Top: Single; Bottom: Single );
  944.  
  945.    Begin
  946.    DetailTop := Top;
  947.    DetailBottom := Bottom;
  948.  
  949.    LastYPosition := Top - GetLineHeightInches;
  950.    End;
  951.  
  952. procedure TPrintObject.SetAutoPaging( Value: Boolean );
  953.  
  954.    Begin
  955.    AutoPaging := Value;
  956.    End;
  957.  
  958. procedure TPrintObject.SetPageNumberInformation( YPosition:Single; Text:String; Alignment:Word; FontName:String; 
  959.    FontSize:Word; FontStyle:TFontStyles );
  960.  
  961.    Begin
  962.    PageNumber.Text := Text;
  963.  
  964.    PageNumber.YPosition := YPosition;
  965.    PageNumber.Alignment := Alignment;
  966.    PageNumber.FontName := FontName;
  967.    PageNumber.FontSize := FontSize;
  968.    PageNumber.FontStyle := FontStyle;
  969.    End;
  970.  
  971. procedure TPrintObject.WritePageNumber;
  972.  
  973.    var
  974.       Buffer: String;
  975.       Temp: Boolean;
  976.  
  977.    Begin
  978.    Buffer := Format( PageNumber.Text,[Printer.PageNumber] );
  979.  
  980.    SaveCurrentFont;
  981.    SetFontInformation( PageNumber.FontName,PageNumber.FontSize,PageNumber.FontStyle );
  982.  
  983.    Temp := AutoPaging;
  984.    AutoPaging := False;
  985.                                    
  986.  
  987.    If ( PageNumber.Alignment = 0 ) Then
  988.       WriteLine( LeftMargin, PageNumber.YPosition, Buffer );
  989.    If ( PageNumber.Alignment = 1 ) Then
  990.       WriteLineCenter( PageNumber.YPosition, Buffer );
  991.    If ( PageNumber.Alignment = 2 ) Then
  992.       WriteLineRight( PageNumber.YPosition, Buffer );
  993.  
  994.    AutoPaging := Temp;
  995.  
  996.    RestoreCurrentFont;
  997.    End;
  998.  
  999. procedure TPrintObject.SetTab( Inches:Single );
  1000.  
  1001.    Begin
  1002.    CurrentTab := Inches;
  1003.    End;
  1004.  
  1005. procedure TPrintObject.SetHeaderDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
  1006.    Boxed: Boolean; LineWidth:Word; Shading:Word );
  1007.  
  1008.    Begin
  1009.    HeaderCoordinates.XTop := XTop;
  1010.  
  1011.    HeaderCoordinates.XBottom := XBottom;
  1012.    HeaderCoordinates.YTop := YTop;
  1013.    HeaderCoordinates.YBottom := YBottom;
  1014.    HeaderCoordinates.Boxed := Boxed;
  1015.    HeaderCoordinates.LineWidth := LineWidth;
  1016.    HeaderCoordinates.Shading := Shading;
  1017.    End;
  1018.  
  1019. procedure TPrintObject.SetFooterDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
  1020.    Boxed: Boolean; LineWidth:Word; Shading:Word );
  1021.  
  1022.    Begin
  1023.    FooterCoordinates.XTop := XTop;
  1024.    FooterCoordinates.XBottom := XBottom;
  1025.    FooterCoordinates.YTop := YTop;
  1026.    FooterCoordinates.YBottom := YBottom;
  1027.    FooterCoordinates.Boxed := Boxed;
  1028.    FooterCoordinates.LineWidth := LineWidth;
  1029.    FooterCoordinates.Shading := Shading;
  1030.    End;
  1031.  
  1032. procedure TPrintObject.CreateColumn( Number:Word; XPosition:Single; Length:Single );
  1033.  
  1034.  
  1035.    Begin
  1036.    ColumnInformation[Number].XPosition := XPosition;
  1037.    ColumnInformation[Number].Length := Length;
  1038.    End;
  1039.  
  1040. procedure TPrintObject.SetYPosition( YPosition:Single );
  1041.  
  1042.    Begin
  1043.    LastYPosition := YPosition;
  1044.    End;
  1045.     
  1046. function TPrintObject.GetYPosition: Single;
  1047.  
  1048.    Begin
  1049.    Result := LastYPosition;
  1050.    End;
  1051.  
  1052. procedure TPrintObject.NextLine;
  1053.  
  1054.    Begin
  1055.    LastYPosition := LastYPosition + GetLineHeightInches;
  1056.    End;   
  1057.  
  1058. function TPrintObject.GetLinesLeft: Word;
  1059.  
  1060.    { Return the number of lines left in the detail area }
  1061.  
  1062.    var
  1063.       Lines: Single;
  1064.       Buffer: String[20];
  1065.       I: Word;
  1066.  
  1067.    Begin
  1068.    Lines := (DetailBottom - LastYPosition) / GetLineHeightInches;
  1069.  
  1070.    Buffer := FloatToStr( Lines );
  1071.  
  1072.    { Buffer contains the number of lines left as a floating point number.
  1073.      Find the decimal and truncate the string at that point.  So, if there
  1074.      are 2.99 lines left, 2 will be returned.  Better to be conservative. }
  1075.    For I := 1 To Length(Buffer) Do
  1076.       Begin
  1077.       If ( Buffer[I] = '.' ) Then
  1078.          Begin
  1079.          Buffer[0] := Chr(I-1);
  1080.          Break;
  1081.          End;
  1082.       End;
  1083.  
  1084.    Result := StrToInt( Buffer );
  1085.    End;
  1086.  
  1087. procedure TPrintObject.SetTopOfPage;
  1088.  
  1089.    Begin
  1090.    LastYPosition := DetailTop;
  1091.    End;
  1092.  
  1093. procedure TPrintObject.NewLines( Number:Word );
  1094.  
  1095.  
  1096.    { Generate the number of line feeds represented in 'Number' }
  1097.  
  1098.    var
  1099.       I: Word;
  1100.  
  1101.    Begin
  1102.    For I := 1 To Number Do
  1103.       NextLine;
  1104.    End;
  1105.  
  1106. end.
  1107.  
  1108. {******* demo.pas *******}
  1109.  
  1110. unit Demo;
  1111.  
  1112. interface
  1113.  
  1114. uses
  1115.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  1116.   Forms, Dialogs, ExtCtrls, StdCtrls, Mask, DBCtrls, Menus, PrnMain;
  1117.  
  1118. const
  1119.   LeftMargin = 0.5;
  1120.   RightMargin = 0.5;
  1121.   TopMargin = 0.5;
  1122.   BottomMargin = 0.5;
  1123.  
  1124. type
  1125.   TPrintForm = class(TForm)
  1126.    Button1: TButton;
  1127.    Button2: TButton;
  1128.    PixelsPerInch: TPanel;
  1129.    PixelsPerPage: TPanel;
  1130.    Gutters: TPanel;
  1131.    LineHeight: TPanel;
  1132.    FontInformation: TPanel;
  1133.  
  1134.    LinesInDetailArea: TPanel;
  1135.    procedure Button1Click(Sender: TObject);
  1136.    procedure FormCreate(Sender: TObject);
  1137.    procedure Button2Click(Sender: TObject);
  1138.   private
  1139.    { Private declarations }
  1140.   public
  1141.    { Public declarations }
  1142.   end;
  1143.  
  1144. var
  1145.   PrintForm: TPrintForm;
  1146.   Prn: TPrintObject;
  1147.  
  1148. implementation
  1149.  
  1150. {$R *.DFM}
  1151.  
  1152. procedure TPrintForm.Button1Click(Sender: TObject);
  1153.  
  1154.   var
  1155.      Buffer: String;
  1156.      Code: String[10];
  1157.      ECHOCode: String[10];
  1158.      HeaderLine: Boolean;
  1159.      I: Word;
  1160.  
  1161.   Begin
  1162.   { Define the dimensions of the header area.  I want the header area
  1163.     lightly shaded.  If I wanted no shading, the last parameter would be
  1164.     255. }
  1165.   with prn do 
  1166.   begin
  1167.     SetHeaderDimensions( 0.25,0.25,8.25,1.25,True,0,225 );
  1168.  
  1169.     { Define two header lines }
  1170.     SetHeaderInformation( 1,0.5,'This is header line number 1',1,'Arial',14,[fsBold] );
  1171.  
  1172.     SetHeaderInformation( 2,1.0,DateToStr(Date),1,'Arial',11,[] );
  1173.  
  1174.     { Define the dimensions of the footer area.  I want the footer area
  1175.       lightly shaded.  If I wanted no shading, the last parameter would be
  1176.       255. }
  1177.     SetFooterDimensions( 0.25,9.40,8.25,10.20,True,0,225 );
  1178.  
  1179.     { Define two footer lines }
  1180.     SetFooterInformation( 1,9.5,'This is footer line number 1',1,'Arial',14,[fsBold] );
  1181.     SetFooterInformation( 2,9.85,'This is footer line number 2',1,'Arial',12,[fsBold] );
  1182.  
  1183.     { I would like page numbering, right justified on the very bottom of the
  1184.       page. }
  1185.     SetPageNumberInformation( 10.25,'Page: %d',2,'Arial',9,[fsBold] );
  1186.  
  1187.  
  1188.     { Set the current position to the top of the detail area }
  1189.     SetTopOfPage;
  1190.  
  1191.     { Write three lines, the first left justified, the second centered and
  1192.       the third right justified.  The first line gets printed two inches
  1193.       from the top.  The next two lines get printed at the next line from
  1194.       the previous line. The '-1' for the first parameter indicates that
  1195.       printing should be on the next line.  If '-2' is passed as a 
  1196.       parameter, printing would occur on the current line. }
  1197.     WriteLine( -1.0,2.0,'This is a line left justified' );
  1198.     WriteLineCenter( -1.0,'This is a line centered' );
  1199.     WriteLineRight( -1.0,'This is a line right justified' );
  1200.  
  1201.  
  1202.     { Create five columns.  The first parameter is the column number, the
  1203.       second parameter is the location in inches from the left and the third
  1204.       parameter is the length in inches. }
  1205.     CreateColumn( 1,0.25,1.5 );
  1206.     CreateColumn( 2,1.80,1.5 );
  1207.     CreateColumn( 3,3.35,1.5 );
  1208.     CreateColumn( 4,4.90,1.5 );
  1209.     CreateColumn( 5,6.50,1.5 );
  1210.  
  1211.     { Start writing column text (left justified) at three inches from the
  1212.       top }
  1213.     SetYPosition( 3.0 );
  1214.     For I := 1 To 10 Do
  1215.        Begin
  1216.        { The first parameter of 'WriteLineColumn' is the column number and
  1217.          the second parameter indicates that printing should occur on the
  1218.          current line (in this case, three inches from the top).  If the 
  1219.  
  1220.          second parameter was -1, printing would occur on the next line. }
  1221.        WriteLineColumn( 1,-2,Format('Column 1, Line %d',[I]) );
  1222.        WriteLineColumn( 2,-2,Format('Column 2, Line %d',[I]) );
  1223.        WriteLineColumn( 3,-2,Format('Column 3, Line %d',[I]) );
  1224.        WriteLineColumn( 4,-2,Format('Column 4, Line %d',[I]) );
  1225.        WriteLineColumn( 5,-2,Format('Column 5, Line %d',[I]) );
  1226.        { Generate a line feed }
  1227.        NextLine;
  1228.        End;
  1229.  
  1230.     { Start writing column text (right justified) at six inches from the 
  1231.       top }
  1232.     SetYPosition( 5.0 );
  1233.  
  1234.     For I := 1 To 10 Do
  1235.        Begin
  1236.        WriteLineColumnRight( 1,-2,Format('Column 1, Line %d',[I]) );
  1237.        WriteLineColumnRight( 2,-2,Format('Column 2, Line %d',[I]) );
  1238.        WriteLineColumnRight( 3,-2,Format('Column 3, Line %d',[I]) );
  1239.        WriteLineColumnRight( 4,-2,Format('Column 4, Line %d',[I]) );
  1240.        WriteLineColumnRight( 5,-2,Format('Column 5, Line %d',[I]) );
  1241.        NextLine;
  1242.        End;
  1243.                                                              
  1244.     { Start writing column text (centered) at seven inches from the 
  1245.       top }
  1246.     SetYPosition( 7.0 );
  1247.     For I := 1 To 10 Do
  1248.        Begin
  1249.        WriteLineColumnCenter( 1,-2,Format('Column 1, Line %d',[I]) );
  1250.  
  1251.        WriteLineColumnCenter( 2,-2,Format('Column 2, Line %d',[I]) );
  1252.        WriteLineColumnCenter( 3,-2,Format('Column 3, Line %d',[I]) );
  1253.        WriteLineColumnCenter( 4,-2,Format('Column 4, Line %d',[I]) );
  1254.        WriteLineColumnCenter( 5,-2,Format('Column 5, Line %d',[I]) );
  1255.        NextLine;
  1256.        End;
  1257.  
  1258.     { Start a new page }
  1259.     NewPage;
  1260.  
  1261.     { Change the font information }
  1262.     SetFontInformation( 'Courier',20,[fsBold,fsUnderline] );
  1263.  
  1264.     For I := 1 To 10 Do
  1265.        WriteLine( LeftMargin,-1,Format('This is line %d',[I]) );
  1266.  
  1267.     { Set a tab of .5 inches }
  1268.     SetTab( 0.5 );
  1269.  
  1270.     { Change the font information }
  1271.     SetFontInformation( 'Arial',10,[fsItalic] );
  1272.  
  1273.     NextLine;
  1274.     For I := 1 To 10 Do
  1275.        { Since a tab of .5 is set, this text will actually get printed at
  1276.          1.0 inches from the left }
  1277.        WriteLine( LeftMargin,-1,Format('This is line %d',[I]) );
  1278.  
  1279.     { Draw some lines of varying thickness }
  1280.     DrawLine( 2.5,5.0,6.0,8.5,5 );
  1281.     DrawLine( 6.2,5.2,3.0,8.7,20 );
  1282.                                                             
  1283.     { We're all done.  Always call 'Quit' }
  1284.     Quit;
  1285.     Free;
  1286.     Exit;
  1287.   end;
  1288. End;
  1289.  
  1290. procedure TPrintForm.FormCreate(Sender: TObject);
  1291. var
  1292.   X,Y: Word;
  1293.  
  1294.   Top,Bottom,Left,Right: Word;
  1295.  
  1296. Begin
  1297.     { Create a TPrintObject }
  1298.     Prn := TPrintObject.Create;
  1299.     with prn do 
  1300.     begin
  1301.  
  1302.     { Must always call 'Start' first thing }
  1303.     Start;
  1304.  
  1305.     { Set left, right, top and bottom margins - in inches }
  1306.     SetMargins( LeftMargin,RightMargin,TopMargin,BottomMargin );
  1307.  
  1308.     { Define what the 'detail' section dimensions will be.  The detail section
  1309.       is the space between the header and the footer areas. }
  1310.     SetDetailTopBottom( 1.4,9.4 );
  1311.  
  1312.     { Set default information }
  1313.     SetFontInformation( 'Arial',11,[] ); 
  1314.  
  1315.     GetPixelsPerInch( X,Y );
  1316.     PixelsPerInch.Caption := Format( 'Pixels Per Inch      X: %d  Y: %d',[X,Y] );
  1317.  
  1318.  
  1319.     GetPixelsPerPage( X,Y );
  1320.     PixelsPerPage.Caption := Format( 'Pixels Per Page      X: %d  Y: %d',[X,Y] );
  1321.  
  1322.     GetGutter( Top,Bottom,Left,Right );
  1323.     Gutters.Caption := Format( 'Gutters     Top: %d   Bottom: %d   Left: %d   Right: %d',[Top,Bottom,Left,Right] );
  1324.  
  1325.     LineHeight.Caption := Format( 'Height of Each Line:   %d',[GetLineHeightPixels] );
  1326.  
  1327.     FontInformation.Caption := Format( 'Font Name: %s     Font Size: %d',[GetFontName,GetFontSize] );
  1328.  
  1329.     LinesInDetailArea.Caption := Format( 'Lines in Detail Area: %d',[GetLinesInDetailArea] );
  1330.  
  1331.     end; {with}
  1332. End;
  1333.  
  1334. procedure TPrintForm.Button2Click(Sender: TObject);
  1335.  
  1336.   Begin
  1337.   Close;
  1338.   Halt;
  1339.   End;
  1340.  
  1341. end.
  1342.  
  1343.  
  1344. {******* project.dpr *******}
  1345.  
  1346. program Project;
  1347.  
  1348. uses
  1349.   Forms,
  1350.   Prnmain in 'PRNMAIN.PAS',
  1351.   Demo in 'DEMO.PAS' {PrintForm};
  1352.  
  1353. {$R *.RES}
  1354.  
  1355. begin
  1356.   Application.CreateForm(TPrintForm, PrintForm);
  1357.   Application.Run;
  1358. end.
  1359.  
  1360.  
  1361. {******* demo.dfm *******}
  1362.  
  1363. object PrintForm: TPrintForm
  1364.   Left = 104
  1365.   Top = 90
  1366.   BorderIcons = [biSystemMenu]
  1367.   BorderStyle = bsDialog
  1368.   Caption = 'Print Demonstration'
  1369.   ClientHeight = 317
  1370.  
  1371.   ClientWidth = 427
  1372.   Color = clSilver
  1373.   Font.Color = clWindowText
  1374.   Font.Height = -13
  1375.   Font.Name = 'System'
  1376.   Font.Style = []
  1377.   PixelsPerInch = 96
  1378.   Position = poScreenCenter
  1379.   OnCreate = FormCreate
  1380.   TextHeight = 16
  1381.   object Button1: TButton
  1382.     Left = 276
  1383.     Top = 270
  1384.     Width = 61
  1385.     Height = 33
  1386.     Caption = '&Print'
  1387.     TabOrder = 0
  1388.     OnClick = Button1Click
  1389.   end
  1390.   object Button2: TButton
  1391.     Left = 342
  1392.     Top = 270
  1393.     Width = 61
  1394.     Height = 33
  1395.     Cancel = True
  1396.     Caption = '&Cancel'
  1397.     ModalResult = 2
  1398.     TabOrder = 1
  1399.     OnClick = Button2Click
  1400.   end
  1401.   object PixelsPerInch: TPanel
  1402.     Left = 6
  1403.     Top = 12
  1404.     Width = 415
  1405.     Height = 25
  1406.     TabOrder = 2
  1407.   end
  1408.   object PixelsPerPage: TPanel
  1409.     Left = 6
  1410.     Top = 42
  1411.     Width = 415
  1412.  
  1413.     Height = 25
  1414.     TabOrder = 3
  1415.   end
  1416.   object Gutters: TPanel
  1417.     Left = 6
  1418.     Top = 72
  1419.     Width = 415
  1420.     Height = 25
  1421.     TabOrder = 4
  1422.   end
  1423.   object LineHeight: TPanel
  1424.     Left = 6
  1425.     Top = 102
  1426.     Width = 415
  1427.     Height = 25
  1428.     TabOrder = 5
  1429.   end
  1430.   object FontInformation: TPanel
  1431.     Left = 6
  1432.     Top = 132
  1433.     Width = 415
  1434.     Height = 25
  1435.     TabOrder = 6
  1436.   end
  1437.   object LinesInDetailArea: TPanel
  1438.     Left = 6
  1439.     Top = 162
  1440.     Width = 415
  1441.     Height = 25
  1442.     TabOrder = 7
  1443.   end
  1444. end
  1445.