Watch, Follow, &
Connect with Us
Public Report
Report From: Delphi-BCB/VCL/Printing    [ Add a report in this area ]  
Report #:  74206   Status: Closed
Side effects of GetTextMetrics
Project:  Delphi Build #:  12.0.3210.17555
Version:    12.1 Submitted By:   Malcolm Coulter
Report Type:  Basic functionality failure Date Reported:  5/25/2009 2:59:29 AM
Severity:    Serious / Highly visible problem Last Updated: 11/6/2009 6:20:41 AM
Platform:    All versions Internal Tracking #:  
Resolution: Test Case Error (Resolution Comments) Resolved in Build: : None
Duplicate of:  None
Voting and Rating
Overall Rating: No Ratings Yet
0.00 out of 5
Total Votes: None
Description
-Delphi 2009 Update 2 on Vista Business
-HP printers  (and probably all printers)

In the example given, the printed font size (visual) gets smaller and smaller on successive pages. The Printer.Canvas.Font.Size as viewed in the debugger does not change.

If the lines marked with an asterisk (those referring to Metrics) are commented out, the font size (visual) does not change from page to page, and is the expected default size. These lines have no functional purpose in the example, but would be essential in other circumstances.
Steps to Reproduce:
Run the following code:-

unit PrintTestFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Printers;

type
  TTestForm = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    List : tStringList;
  end;

var
  TestForm: TTestForm;

implementation

{$R *.dfm}

procedure TTestForm.FormCreate(Sender: TObject);
begin
  List := tStringList.Create;
  List.Add('Line 1');
  List.Add('Line 2');
  List.Add('Line 3');
  List.Add('Line 4');
end;

procedure TTestForm.Button1Click(Sender: TObject);
var
  I     : integer;
  x,y   : integer;
  Ph,Lh : integer;
  s     : string;
{*}  Metrics: TTextMetric;
begin
  with Printer do begin
    BeginDoc;
    Ph := 100;
{*}    GetTextMetrics(Canvas.Handle, Metrics);
{*}    if Metrics.tmHeight=0 then exit;
    Lh := 40;
    x := 0;
    y := 0;
    for I := 0 to List.Count-1 do begin
      s := List[I];
      TextOut(Handle,x,y,pwidechar(s),Length(s));
      y := y+Lh;
      if y+Lh>Ph then begin
        y := 0;
        NewPage;
        end;
      end;
    EndDoc;
    end;
end;

end.
Workarounds
No workaround is known.
Attachment
None
Comments

Lucian Radulescu at 5/26/2009 6:10:59 AM -
How about changing the TextOut line to :

      TextOut(Canvas.Handle, x, y, pwidechar(s), Length(s));

Malcolm Coulter at 11/4/2009 9:00:20 PM -
Problem resolved

Tomohiro Takahashi at 11/5/2009 5:09:37 AM -
Malcolm-san
May I close this report as Sysop?

Server Response from: ETNACODE01