printing diffent fonts in one line

hi,

i have the following problem in D3 under WIN95 /98:
i will print some text, which consists of
different fonts, in one line.
i tried to care for the different text-height,
but the whole text doesn't stand in one line.
The diffence is very large by changing between fonts of
different pitch : variable and fixed.
below is an (simple) example for what i mean.
in the end should be printed in one(!!) line
ABCDEFABCDEF .
But the second part stands a little bit heigher
than the first.

var
a,b:Pchar;
fo1,fo2:Tfont;
il1,il2:integer;
ih1,ih2:integer;
size:Tsize;
x,y:integer;
zz:shortstring;

begin
a:='ABCDEF';
b:='ABCDEF';
fo1:=Tfont.create;
fo1.name:='Times';
fo1.size:=60;
fo1.pitch:=fpvariable;
fo2:=Tfont.create;
fo2.name:='COURIER';
fo2.size:=60;
fo2.pitch:=fpfixed;
x:=100;
y:=200;
printer.BeginDoc;
selectobject(printer.canvas.handle,fo1.handle);
gettextextentpoint32(printer.canvas.handle,a,strlen(a),size);
il1:=size.cx;
ih1:=size.cy;
zz:=strpas(a);
printer.canvas.textout(x,y,zz);
x:=x+il1;
selectobject(printer.canvas.handle,fo2.handle);
gettextextentpoint32(printer.canvas.handle,b,strlen(b),size);
il2:=size.cx;
ih2:=size.cy;
zz:=strpas(b);
y:=y+ih1-ih2;
printer.canvas.textout(x,y,zz);
printer.enddoc;
fo1.free;
fo2.free;
end;

What is the reason and what can i do ??

thanks
titz

LVL 1
titzAsked:
Who is Participating?
 
Roadrunner100598Commented:
Hello titz,

try this...

place a button and two lables on a form.


procedure TForm1.Button1Click(Sender: TObject);
var
  ARect      : TRect;
  Textmetric : TTextmetric;
  Ascent     : integer;
begin
  ARect:=Rect(100,100,1000,1000);
  Canvas.Font.Name :='Times';
  Canvas.Font.Size :=30;
  Canvas.Font.Style:=[fsBold];
  GetTextMetrics(Canvas.Handle, Textmetric);

  { Determin distance  'top - basline' for first font... }
  Ascent:=Textmetric.tmAscent;
  DrawText(Canvas.Handle, 'AaGg', -1, ARect, DT_CalcRect or DT_BOTTOM);
  DrawText(Canvas.Handle, 'AaGg', -1, ARect, DT_BOTTOM);
  label1.Caption:=format('%d  %d  %d  %d', [ARect.Top, ARect.Bottom, ARect.Left, ARect.Right]);

  Canvas.Font.Name :='Courier';
  GetTextMetrics(Canvas.Handle, Textmetric);
  { Offset by width of text and correct for baseline change in second font }
  OffsetRect(ARect, ARect.Right-ARect.Left, Ascent-Textmetric.tmAscent);
  DrawText(Canvas.Handle, 'AaGg', -1, ARect, DT_CalcRect or DT_BOTTOM);
  DrawText(Canvas.Handle, 'AaGg', -1, ARect, DT_BOTTOM);
  label2.Caption:=format('%d  %d  %d  %d', [ARect.Top, ARect.Bottom, ARect.Left, ARect.Right]);
end;

The main trick is the GetTextmetrics( ) to find the different baselines of the fonts. The rest is relatively simple. I prefer the use of DrawText( ), because it has much more flexibility than TextOut( ).



Hope you like this,

beep, beep

Roadrunner
0
 
borupCommented:
You can also consider printing through the TRichEdit component which seems to take care of the baseline problem.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    PrintButton: TButton;
    procedure PrintButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.PrintButtonClick(Sender: TObject);
var fo1, fo2  : TFont;
begin
  //Font 1
  fo1:=TFont.Create;
  fo1.name:='Times';
  fo1.size:=60;
  fo1.pitch:=fpvariable;

  //Font 2
  fo2:=TFont.Create;
  fo2.name:='COURIER';
  fo2.size:=60;
  fo2.pitch:=fpfixed;

  with RichEdit1 do
    begin
      RichEdit1.Lines.Add('ABCDEFABCDEF');

      //Change the first ABCDEF to font 1
      SelStart := 0;
      SelLength := 6;
      SelAttributes.Assign(fo1);

      //Change the second ABCDEF to font 2
      SelStart := 6;
      SelLength := 6;
      SelAttributes.Assign(fo2);

      //Print the text
      Print('Document Title');
    end;
end;

end.
0
 
borupCommented:
You can also consider printing through the TRichEdit component which seems to take care of the baseline problem.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    PrintButton: TButton;
    procedure PrintButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.PrintButtonClick(Sender: TObject);
var fo1, fo2  : TFont;
begin
  //Font 1
  fo1:=TFont.Create;
  fo1.name:='Times';
  fo1.size:=60;
  fo1.pitch:=fpvariable;

  //Font 2
  fo2:=TFont.Create;
  fo2.name:='COURIER';
  fo2.size:=60;
  fo2.pitch:=fpfixed;

  with RichEdit1 do
    begin
      RichEdit1.Lines.Add('ABCDEFABCDEF');

      //Change the first ABCDEF to font 1
      SelStart := 0;
      SelLength := 6;
      SelAttributes.Assign(fo1);

      //Change the second ABCDEF to font 2
      SelStart := 6;
      SelLength := 6;
      SelAttributes.Assign(fo2);

      //Print the text
      Print('Document Title');
    end;
end;

end.
0
 
borupCommented:
Sorry for submitting my comment twice :-)
0
 
titzAuthor Commented:
thanks roadrunner,
that was what i was looking for !
titz
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.