The TTextPrinter Component

First, you need to derive the TTextPrinter component from TComponent using the New VCL Component wizard. Save the TTextPrinter component under  TextPrinter.pas and add it to your component package.

To enable the user to print multiple lines of text using whatever font is available and supported by the printer, we have to create two properties: Font and Strings. In order to use the TFont class, you have to add the Graphics unit to the component's uses list.

Here's the initial code of the component that sets up these two object properties:

unit TextPrinter; interface uses   SysUtils, Classes, Graphics; type   TTextPrinter = class(TComponent)   private     { Private declarations }     FFont: TFont;     FStrings: TStrings;   protected     { Protected declarations }     procedure SetFont(Value: TFont); virtual;     procedure SetStrings(Value: TStrings); virtual;   public     { Public declarations }     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;   published     { Published declarations }     property Font: TFont read FFont write SetFont;     property Strings: TStrings read FStrings write SetStrings;   end; procedure Register; implementation procedure Register; begin   RegisterComponents('My Components', [TTextPrinter]); end; constructor TTextPrinter.Create(AOwner: TComponent); begin   inherited Create(AOwner);   FFont := TFont.Create;   FStrings := TStringList.Create; end; destructor TTextPrinter.Destroy; begin   FFont.Free;   FStrings.Free;   inherited Destroy; end; procedure TTextPrinter.SetStrings(Value: TStrings); begin   FStrings.Assign(Value); end; procedure TTextPrinter.SetFont(Value: TFont); begin   FFont.Assign(Value); end; end.

Measurement System and Resolution

Now it's time to duplicate a portion of the TPageSetupDialog component's functionality. We have to determine which measurement system the user is using and we have to create the Margins and the Units properties, which will contain either 2500 if the user uses the metric system or 1000 if the user uses the U.S. measurement system. We also have to determine the printer's pixels per inch values, both horizontal and vertical.

We can determine the measurement system by calling the GetLocaleInfo API function, declared in the Windows unit:

function GetLocaleInfo(Locale: LCID; LCType: LCTYPE;    lpLCData: PChar; cchData: Integer): Integer; stdcall;

When calling the GetLocaleInfo function to determine the measurement system, you have to do the following:

1. Pass the LOCALE_SYSTEM_DEFAULT constant as the Locale parameter to get the information about the system's default locale settings.

2. Get the measurement system information by passing the LOCALE_ IMEASURE constant as the LCType parameter.

3. Accept the information about the measurement system by declaring an array of two characters and passing the array's pointer as the @lpLCData parameter (you have to use a two-character array, which is the maximum allowed number of characters).

4. Finally, you have to pass the size of the buffer as the cchData parameter, which is 2 in this case.

The following code shows the TTextPrinter's private method called GetLocaleUnit, which uses the GetLocaleInfo API function to determine the measurement system (don't forget to add the Windows unit to the uses list):

// ------------------------------------------------------------------------ // Name: GetLocaleUnit // Desc: Returns 0 for mm (metric system) and 1 for inch (U.S. system). // ------------------------------------------------------------------------ function TTextPrinter.GetLocaleUnit: Integer; var   localeData: array[0..1] of char; begin   GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, @localeData, 2);   Result := StrToInt(localeData); end;

Now that we know which measurement system is used, we need to find out the printer's resolution in order to correctly convert inches and millimeters into pixels. To determine the number of pixels per inch, both horizontally and vertically, we need to call the GetDeviceCaps API function:

function GetDeviceCaps(DC: HDC; Index: Integer): Integer; stdcall; 

To determine the pixels per inch values of the printer, we have to call the GetDeviceCaps function twice. We have to pass the LOGPIXELSX constant as the Index parameter to determine the number of pixels per inch horizontally, and then pass the LOGPIXELSY constant as the Index parameter to determine the number of pixels per inch vertically. Both times, we have to pass the Printer's handle as the DC parameter.

Since we're going to need these values later, we should store them in two public read-only properties: PXPerInchX and PXPerInchY. The best place to call the GetDeviceCaps function is in the component's constructor. Here's the code related to the pixels per inch properties (don't forget to add the Printers unit to the uses list, because the code in the constructor uses the global Printer object):

type   TTextPrinter = class(TComponent)   private     { Private declarations }     FPXPerInchX: Integer;     FPXPerInchY: Integer;   public     { Public declarations }     property PXPerInchX: Integer read FPXPerInchX;     property PXPerInchY: Integer read FPXPerInchY; end; ... constructor TTextPrinter.Create(AOwner: TComponent); begin   inherited Create(AOwner);   FFont := TFont.Create;   FStrings := TStringList.Create;   { Get pixels per inch }   FPXPerInchX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);   FPXPerInchY := GetDeviceCaps(Printer.Handle, LOGPIXELSY); end;

Margins and Units Properties

Let's solve the easier problem first and create the Units property. The Units property is a simple direct-access published property of type TPageMeasure- Units. In order to use the TPageMeasureUnits enumeration, you have to add the Dialogs unit to the component's uses list.

Here's the declaration of the Units property, which is, like the same property in the TPageSetupDialog component, set by default to the pmDefault value:

TTextPrinter = class(TComponent) private   { Private declarations }   FUnits: TPageMeasureUnits; published   { Published declarations }   property Units: TPageMeasureUnits     read FUnits write FUnits default pmDefault; end; 

The TTextPrinter component has eight (yes, eight) properties that define the margins. Four properties are read-only and public, and specify margin values in pixels. The other four properties are published and specify margin values like the TPageSetupDialog component — in thousandths of an inch or thousandths of a millimeter, depending on the measurement system.

Here are the declarations of the simple read-only properties:

  TTextPrinter = class(TComponent)   private     { Private declarations }     FPXMarginBottom: Integer;     FPXMarginLeft: Integer;     FPXMarginRight: Integer;     FPXMarginTop: Integer;   public     { Public declarations }     property PXMarginBottom: Integer read FPXMarginBottom;     property PXMarginLeft: Integer read FPXMarginLeft;     property PXMarginRight: Integer read FPXMarginRight;     property PXMarginTop: Integer read FPXMarginTop; end;

The four margin-related published properties are a bit more complex than the above read-only properties. The published properties are indexed properties that share a single write method called SetMarginValue, which not only updates the published property that called it, but also automatically calculates the margin value in pixels for the appropriate PXMargin property.

Here are the declarations of the four margin-related published properties:

  TTextPrinter = class(TComponent)   private     { Private declarations }     FMarginBottom: Integer;     FMarginLeft: Integer;     FMarginRight: Integer;     FMarginTop: Integer;   published     { Published declarations }     property MarginBottom: Integer       index 1 read FMarginBottom write SetMarginValue;     property MarginLeft: Integer       index 2 read FMarginLeft write SetMarginValue;     property MarginRight: Integer       index 3 read FMarginRight write SetMarginValue;     property MarginTop: Integer       index 4 read FMarginTop write SetMarginValue; end;

To automatically calculate the margin values in pixels, the SetMarginValue method must first check the Units property to see which measurement unit is used. If the U.S. measurement system is used, the method must divide the margin value by 1000 to get inches instead of thousandths of an inch and then multiply by PXPerInchX or PXPerInchY to get the margin value in pixels. If the metric system is used, the method must divide the margin value by 1000 to get millimeters instead of thousandths of millimeters, then it must divide the millimeters by 2.54 to get inches, and finally it must multiply that value by PXPerInchX or PXPerInchY to get the margin value in pixels.

Here's the SetMarginValue method:

type   TTextPrinter = class(TComponent)   protected     { Protected declarations }     procedure SetMarginValue(Index, Value: Integer); virtual; end; ... procedure TTextPrinter.SetMarginValue(Index, Value: Integer); var   conv: Double; begin   case FUnits of     { if we're using the metric system, use 2.54 to get inches }     pmMillimeters: conv := 2.54;     { if we're using the U.S. system, set conv to 1.0,       to use the original margin value }     pmInches: conv := 1.00;     else begin       if GetLocaleUnit = 0 then         conv := 2.54       else         conv := 1.00;     end;      // pmDefault   end;       // case FUnits   case Index of     1: begin       FMarginBottom := Value;       FPXMarginBottom := Round(FMarginBottom / conv / 1000 * pxPerInchY);     end;      // bottom     2: begin       FMarginLeft := Value;       FPXMarginLeft := Round(FMarginLeft / conv / 1000 * pxPerInchX);     end;      // left     3: begin       FMarginRight := Value;       FPXMarginRight := Round(FMarginRight / conv / 1000 * pxPerInchX);     end;      // right     4: begin       FMarginTop := Value;       FPXMarginTop := Round(FMarginTop / conv / 1000 * pxPerInchY);     end;      // top   end;       // case Index end;

The TTextPrinter component also has two public overloaded methods that enable us to easily change margin values. One method accepts a TPageSetupDialog parameter and copies the margin settings from the passed component. The other method accepts a single integer value and assigns that value to all four margins.

Here are both SetMargins overloads:

type   TTextPrinter = class(TComponent)   public     { Public declarations }     procedure SetMargins(ADialog: TPageSetupDialog); overload;     procedure SetMargins(SingleValue: Integer); overload; end; ... procedure TTextPrinter.SetMargins(ADialog: TPageSetupDialog); begin   FUnits := ADialog.Units;   MarginBottom := ADialog.MarginBottom;   MarginLeft := ADialog.MarginLeft;   MarginRight := ADialog.MarginRight;   MarginTop := ADialog.MarginTop; end; procedure TTextPrinter.SetMargins(SingleValue: Integer); begin   MarginBottom := SingleValue;   MarginLeft := SingleValue;   MarginRight := SingleValue;   MarginTop := SingleValue; end;

Finally, in order to set default margin values when the component is created, we have to update the component's constructor and set all margins to 2500 if the metric system is used or 1000 if the U.S. system is used.

Here's the final version of the constructor, which calls the GetLocaleUnit function to determine the measurement system and updates all margins appropriately:

constructor TTextPrinter.Create(AOwner: TComponent); const   DEFAULT_MARGINS: array[0..1] of Integer = (2500, 1000); begin   inherited Create(AOwner);   FFont := TFont.Create;   FStrings := TStringList.Create;   { Get pixels per inch. }   FPXPerInchX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);   FPXPerInchY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);   { Set default Units value. }    FUnits := pmDefault;   { Set default margins. These are the same as in the TPageSetupDialog. }   SetMargins(DEFAULT_MARGINS[GetLocaleUnit]); end;

Syntax Highlighting Utility Functions

Before writing the printing code, we need to create two functions to determine if a word is a reserved word or not. The IsReservedWord function, which determines whether or not the passed string is a reserved word, is pretty simple: It has a large array that contains all reserved words and directives of the Delphi language and returns True if it can find the passed string in the array and False if the passed string cannot be found.

Here's the IsReservedWord function:

{ returns True if the AReservedWord is a reserved word or a directive } function IsReservedWord(const AReservedWord: string): Boolean; const   RESERVED: array[1..116] of string = ('and', 'else', 'inherited',     'packed', 'then', 'array', 'end', 'end;', 'end.', 'initialization',     'procedure', 'threadvar', 'as', 'except', 'inline', 'program', 'to',     'asm', 'exports', 'interface', 'property', 'try', 'begin', 'file',     'is', 'raise', 'type', 'case', 'final', 'label', 'record', 'unit',     'class', 'finalization', 'library', 'repeat', 'unsafe', 'const',     'finally', 'mod', 'resourcestring', 'until', 'constructor', 'for',     'nil', 'sealed', 'uses', 'destructor', 'function', 'not', 'set',     'var', 'dispinterface', 'goto', 'object', 'shl', 'while', 'div',     'if', 'of', 'shr', 'with', 'do', 'implementation', 'or', 'static',     'xor', 'downto', 'in', 'out', 'string', 'absolute', 'dynamic',     'local', 'platform', 'requires', 'abstract', 'export', 'message',     'private', 'resident', 'assembler', 'external', 'name', 'protected',     'safecall', 'automated', 'far', 'near', 'public', 'stdcall', 'cdecl',     'forward', 'nodefault', 'published', 'stored', 'contains',     'implements', 'overload', 'read', 'varargs', 'default', 'index',     'override', 'readonly', 'virtual', 'deprecated', 'package',     'register', 'write', 'dispid', 'library', 'pascal', 'reintroduce',     'writeonly'); var   lcaseWord: string;   reservedWord: string; begin   lcaseWord := LowerCase(Trim(AReservedWord));   Result := False;   { see if it's a reserved word }   for reservedWord in RESERVED do     if reservedWord = lcaseWord then     begin       Result := True;       Exit;     end; end;

The second function solves a part of the problem that occurs with the array and class reserved words. Since these words are closely followed by a left parenthesis or the left square bracket plus additional text, the above IsReservedWord function can't identify them successfully. So, in order to solve this problem, the following SpecialCases function tests whether the passed string contains the "class(" or "array[" strings:

{ check if the word contains "class(" or "array[" } function SpecialCases(const AReservedWord: string): Boolean; var   lowWord: string; begin   lowWord := LowerCase(AReservedWord);   Result := (Pos('class(', lowWord) > 0) or (Pos('array[', lowWord) > 0); end;

Printing

The printing code is separated into two procedures: the public Print method that does 99% of the printing, and the private NewLine method that increments the vertical line position and creates a new page if the line doesn't fit on the current page.

Here's the NewLine method:

type   TTextPrinter = class(TComponent)   private     procedure NewLine(var YPos: Integer; LineHeight: Integer); end; ... procedure TTextPrinter.NewLine(var YPos: Integer; LineHeight: Integer); begin   Inc(YPos, LineHeight);   if YPos + LineHeight > Printer.PageHeight - PXMarginBottom then   begin     YPos := PXMarginTop;     Printer.NewPage;   end; end;

The Print method is the largest and most complex of all TTextPrinter methods because it must print the entire text document word by word in order to break a line if it doesn't fit inside the margins and to determine whether or not one of the words is a reserved word. Even more complexity arises from the fact that it also supports comments, both single-line and block comments. To manage the comments, the TTextPrinter component uses a custom TCommentType enumeration because it has to manage each comment type differently.

Here's the TCommentType enumeration:

TCommentType = (ctNoComment, ctSingleLine, ctBlockComment);

The following list describes the most important parts of the Print method:

1. The method enters a global for loop that loops though all strings stored in the Strings property.

2. Then it enters a second inner loop that breaks each line into individual words.

3. Each acquired word is first tested for the two special cases — "array[" and "class(" — because they must be handled differently from all other words.

4. The word is then tested for reserved words and comments and the Canvas Font is updated appropriately to display either boldfaced reserved words or italicized comments.

5. After the syntax highlighting code determines how the word should be printed, the NewLine method is called before printing if the word cannot fit in the current line.

6. At the end of the inner loop, the method tests whether an opened block comment should be closed.

7. Finally, the method exits to the outer loop and calls NewLine to move to the next line.

8. If there are more strings in the Strings property, the method again enters the inner loop and prints the new line word by word.

The following listing displays the fully commented Print method. Be sure to carefully read the comments since they describe in detail what's going on with each word that is printed.

Listing 27-2: The Print method of the TTextPrinter component

procedure TTextPrinter.Print; var   i: Integer;   fntHeight: Integer;   yPos: Integer;   xPos: Integer;   maxWidth: Integer;   currLine: string;   oneWord: string;   wordWidth: Integer;   spacing: Integer;   comment: TCommentType; begin   comment := ctNoComment;   { assign the selected font to the printer }   Printer.Canvas.Font.Assign(Font);   { determine the line height }   fntHeight := Printer.Canvas.TextHeight('W');   { see how much horizontal space is available }   maxWidth := Printer.PageWidth - PXMarginRight;   { start printing }   Printer.BeginDoc;   try     yPos := PXMarginTop; { print all lines } for i := 0 to Pred(FStrings.Count) do begin   { add a space to the end of the string to simplify the process     of breaking the string into separate words }   currLine := FStrings[i] + ' ';   xPos := PXMarginLeft;   { find the end of the first word }   spacing := Pos(' ', currLine);   while spacing <> 0 do   begin     { get one word }     oneWord := Copy(currLine, 1, spacing);     { see if the line contains "class(" or "array[" }     if SpecialCases(oneWord) then     begin       { use only the first 5 chars, "class" or "array" }       oneWord := Copy(oneWord, 1, 5);       Delete(currLine, 1, 5);     end else       { if the word doesn't contain "class(" or "array[",         then delete the entire word from the current line }       Delete(currLine, 1, spacing);       { check if we're dealing with a comment of any type }       if Pos('//', oneWord) > 0 then         comment := ctSingleLine       else if Pos('{', oneWord) > 0 then         comment := ctBlockComment;       with Printer.Canvas.Font do       begin         { assume we're printing "normal text" }         Style := [];         Color := clBlack;         { check for a reserved word, but only if neither a           single-line nor a block comment are opened }         if (comment = ctNoComment) and IsReservedWord(oneWord) then         begin           Style := Style + [fsBold];           Color := clNavy;         end;         { check if the word is inside a block or a single-line           comment and render appropriately }         if comment <> ctNoComment then         begin           Style := Style + [fsItalic];           Color := clGreen;         end;       end;          // with Printer.Canvas.Font           { get the word's width }           wordWidth := Printer.Canvas.TextWidth(oneWord);           { if the word doesn't fit in the current line,             move to the next line and print it in the next line }           if xPos + wordWidth > maxWidth then           begin             xPos := PXMarginLeft;             NewLine(yPos, fntHeight);           end;      // if xPos           { display the word and update the print position }           Printer.Canvas.TextOut(xPos, yPos, oneWord);           Inc(xPos, wordWidth);           { if a block comment is opened, close it if end char is found }           if (comment = ctBlockComment) and (Pos('}', oneWord) > 0) then             comment := ctNoComment;           { update the loop to print the next word }           spacing := Pos(' ', currLine);         end;          // while spacing       { when the entire FStrings[n] line is printed,         move to the next line }       NewLine(yPos, fntHeight);       { if there's a single-line comment,         reset comment status before printing the next line}       if comment = ctSingleLine then comment := ctNoComment;       if Printer.Aborted then Exit;     end;            // for i   finally     Printer.EndDoc;   end;             // try end;

Final Touches

If you try to print the contents of a TMemo component that doesn't use WordWrap, you'll have no problems. But when the WordWrap property is set to True, the TMemo component breaks lines at the right margin in a way that messes up printing. So, in order to print a TMemo properly, we shouldn't assign the contents of the TMemo to the Strings property directly. We need a method that will first disable the TMemo's WordWrap, then copy the TMemo's Lines to the TTextPrinter's Strings property, and finally restore the TMemo's original WordWrap property.

Here's the code of the GetText method that does exactly that:

procedure TTextPrinter.GetText(AMemo: TMemo); begin   oldWordWrap := AMemo.WordWrap;   try     AMemo.WordWrap := False; { temporarily disable wrapping }     FLines.Assign(AMemo.Lines);   finally     AMemo.WordWrap := oldWordWrap;   end;       // try..finally end; 

The GetText method does exactly what it's supposed to do, but it doesn't compile because it uses an undeclared identifier: oldWordWrap. Although you can resolve this problem by declaring the variable manually, we are going to use one of the Refactoring commands to declare the oldWordWrap variable. To declare the oldWordWrap variable, right-click the oldWordWrap identifier in the Code Editor, point to Refactoring on the context menu, and select the Declare Variable command, as shown in Figure 27-6.

Figure 27-6: Using the Declare Variable command

After you select the Declare Variable command, the refactoring engine displays the Declare Variable dialog box, which automatically determines the appropriate data type for the new variable.

Figure 27-7: The Declare Variable dialog box

To declare the local oldWordWrap Boolean variable you only have to click the OK button:

procedure TTextPrinter.GetText(AMemo: TMemo); var   oldWordWrap: Boolean; begin   oldWordWrap := AMemo.WordWrap;   try     AMemo.WordWrap := False; { temporarily disable wrapping }     FLines.Assign(AMemo.Lines);   finally     AMemo.WordWrap := oldWordWrap;   end;       // try..finally end;

Now the entire component is finished, and you can drop it on the Designer Surface and use it by writing something as simple as this:

procedure TMainForm.TextPrinterPrintClick(Sender: TObject); begin   if PageSetupDialog.Execute then   with TextPrinter do   begin     Font.Assign(Memo1.Font); { use the TMemo's Font }     GetText(Memo1); { get the contents of the TMemo }     Print;   end; end;

The following figure shows how the TTextPrinter component prints Delphi units.

Figure 27-08: Printing with the TTextPrinter component