QualityCentral

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?

Developer Tools

Database Tools