Problem with TGDIPlusCanvas.TextWidth

TeeChart VCL for Borland/CodeGear/Embarcadero RAD Studio, Delphi and C++ Builder.
Post Reply
Jens Gr.
Newbie
Newbie
Posts: 6
Joined: Mon Nov 10, 2014 12:00 am

Problem with TGDIPlusCanvas.TextWidth

Post by Jens Gr. » Fri Dec 12, 2014 8:49 am

Hello,
I have a problem with the TGDIPlusCanvas.TextWidth function in the TDraw3D box (with Std v2014.12.140923 on Win7 32bit). If I use the following code:

Code: Select all

procedure TForm1.Draw3D1Paint(Sender: TObject; const ARect: TRect);
var
  s:String;
  x,y:Integer;
begin
  x:=10; y:=10;
  with Draw3D1.Canvas do begin
    Font.Height:=-11;
    s:='XXXXXXXXXXXXXXXXXXXXXXXXXXX';
    Brush.Color:=clSilver;
    FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
    TextOut(x,y,s);
    s:='AAAAAAAAAAAAAAAAAAAAAAAAAAA';
    y:=y+20;
    Brush.Color:=clSilver;
    FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
    TextOut(x,y,s);
    s:='FFFFFFFFFFFFFFFFFFFFFFFFFFF';
    y:=y+20;
    Brush.Color:=clSilver;
    FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
    TextOut(x,y,s);
  end;
end;
The result is:
img1.png
img1.png (808 Bytes) Viewed 19184 times
If I use the normal GDI canvas all rectangles are filled full with text. I think, the value of the TextWidth function is sometimes to large.
What is wrong?? :(

The other problem is: If I use a positive value for Font.Height, no text is displayed.

Thank you
Jens

jens.mertelmeyer
Newbie
Newbie
Posts: 31
Joined: Fri Nov 21, 2014 12:00 am

Re: Problem with TGDIPlusCanvas.TextWidth

Post by jens.mertelmeyer » Fri Dec 12, 2014 9:52 am

I have a feeling that this is going to be another prime example of why the with-statement in Pascal is a terrible abomination.

I refactored your code a bit. Please have a look at the produced output.
noWith.png
noWith.png (16.95 KiB) Viewed 19156 times
withWith.png
withWith.png (17.88 KiB) Viewed 19151 times
The code:

Code: Select all

procedure printText(
	const	onCanvas:	TTeeCanvas;
	const   atPosition:	TPoint;
	const	text: 		String
);
var
	backgroundRect: TRect;
begin
	Assert( Assigned(onCanvas) );

	onCanvas.Brush.Color := clSilver;
	backgroundRect := TRect.Create(
		atPosition.X,
		atPosition.Y,
		atPosition.X + onCanvas.TextWidth(text),
		atPosition.Y + onCanvas.TextHeight(text)
	  );

	onCanvas.FillRect(backgroundRect);
	onCanvas.TextOut(atPosition.X, atPosition.Y, text);
end;

procedure TForm5.Draw3D1Paint(Sender: TObject; const ARect: TRect);
const
	fontSize: Integer = 12;
var
	s:String;
	textPositon: TPoint;
	myCanvas: TTeeCanvas;
	x,y :Integer;
begin

	if not useWithAbominationCheckbox.Checked then begin
		textPositon := TPoint.Create(10, 10);

		myCanvas := Draw3D1.Canvas;
		myCanvas.Font.Size := fontSize;
		myCanvas.Brush.Color := clSilver;

		printText(myCanvas, textPositon, 'XXXXXXXXXXXXXXXXXXXXXXXXXXX');

		textPositon.Offset(0, 20);
		printText(myCanvas, textPositon, 'AAAAAAAAAAAAAAAAAAAAAAAAAAA');

		textPositon.Offset(0, 20);
		printText(myCanvas, textPositon, 'FFFFFFFFFFFFFFFFFFFFFFFFFFF');

		textPositon.Offset(0, 20);
		printText(myCanvas, textPositon, '... ..');

	end else begin
		x := 10; y:=10;
		with Draw3D1.Canvas do begin
			Font.Height:=-11;
			s:='XXXXXXXXXXXXXXXXXXXXXXXXXXX';
			Brush.Color:=clSilver;
			FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
			TextOut(x,y,s);
			s:='AAAAAAAAAAAAAAAAAAAAAAAAAAA';
			y:=y+20;
			Brush.Color:=clSilver;
			FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
			TextOut(x,y,s);
			s:='FFFFFFFFFFFFFFFFFFFFFFFFFFF';
			y:=y+20;
			Brush.Color:=clSilver;
			FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
			TextOut(x,y,s);
		end;
	end;
end;

procedure TForm5.useWithAbominationCheckboxClick(Sender: TObject);
begin
	Draw3D1.Invalidate();
end;

Yeray
Site Admin
Site Admin
Posts: 9514
Joined: Tue Dec 05, 2006 12:00 am
Location: Girona, Catalonia
Contact:

Re: Problem with TGDIPlusCanvas.TextWidth

Post by Yeray » Fri Dec 12, 2014 11:05 am

Hi Jens,

Changing this:

Code: Select all

      with Draw3D1.Canvas do begin
         Font.Height:=-11;
For this:

Code: Select all

      with Draw3D1.Canvas do begin
         Font.Size:=fontSize;
Seems to make your example code to draw the same when the checkbox is checked and when it's unchecked.
Best Regards,
ImageYeray Alonso
Development & Support
Steema Software
Av. Montilivi 33, 17003 Girona, Catalonia (SP)
Image Image Image Image Image Image Please read our Bug Fixing Policy

jens.mertelmeyer
Newbie
Newbie
Posts: 31
Joined: Fri Nov 21, 2014 12:00 am

Re: Problem with TGDIPlusCanvas.TextWidth

Post by jens.mertelmeyer » Fri Dec 12, 2014 11:06 am

And that's a good thing, I suppose?

Jens Gr.
Newbie
Newbie
Posts: 6
Joined: Mon Nov 10, 2014 12:00 am

Re: Problem with TGDIPlusCanvas.TextWidth

Post by Jens Gr. » Fri Dec 12, 2014 12:36 pm

Hello,

Thank you for the new code. But I think, this is not the solution. If you use Font.Size=8 (this is on 96dpi screens the same as font.height=-11), you will see the same bad result....

Can it be the problem with the TGPGraphics.MeasureString limitations??
Please see: http://www.codeproject.com/Articles/211 ... imitations

I think, this is important, because the TextWidth function is the base function for correct displaying centered and right bounded text.

Jens G.

Yeray
Site Admin
Site Admin
Posts: 9514
Joined: Tue Dec 05, 2006 12:00 am
Location: Girona, Catalonia
Contact:

Re: Problem with TGDIPlusCanvas.TextWidth

Post by Yeray » Mon Dec 22, 2014 8:42 am

Hi Jens

I've added this to the public tracker to further investigate it:
http://bugs.teechart.net/show_bug.cgi?id=1055
Best Regards,
ImageYeray Alonso
Development & Support
Steema Software
Av. Montilivi 33, 17003 Girona, Catalonia (SP)
Image Image Image Image Image Image Please read our Bug Fixing Policy

Yeray
Site Admin
Site Admin
Posts: 9514
Joined: Tue Dec 05, 2006 12:00 am
Location: Girona, Catalonia
Contact:

Re: Problem with TGDIPlusCanvas.TextWidth

Post by Yeray » Tue Dec 23, 2014 9:56 am

Hi Jens,

A bit more on this.

There's a new, special and internal function, called InternalTextwidth.
GDIPlus can return the width "normal" or "shrunk" (typographic).
"Normal" is like in GDI. It returns a width with margins included. I'm afraid we can't control this.
"Shrunk" (typographic) should be similar to what's described in the article you posted.

There are many blog posts regarding this subject. Ie:
http://theartofdev.com/2014/04/21/text- ... i-revised/

At the moment, we are only using this "typographic" technique on the legend when using GDIPlus and when the text is right aligned (TA_RIGHT) or centered (TA_CENTER), for better positioning on places like the legend.

Code: Select all

Function TGDIPlusCanvas.InternalTextWidth(const St:String; TypoGraphic:Boolean=False):Integer;

  procedure ApplyShadow(const AShadow:TTeeShadow);
  begin
    if Assigned(AShadow) and AShadow.Visible then
       Inc(result,Abs(AShadow.HorizSize));
  end;

var tmpBox : TGPRectF;
begin
  if TypoGraphic then
     FGraphics.MeasureString(St,Length(St),FGPFont,TeeZeroPoint,TGPStringFormat.GenericTypographic,tmpBox)
  else
     FGraphics.MeasureString(St,Length(St),FGPFont,TeeZeroPoint,tmpBox);

  result:=Round(tmpBox.Width{+0.5});

  ApplyShadow(TFontAccess(Font).FShadow);
  ApplyShadow(TFontAccess(Font).FEmboss);
end;

Function TGDIPlusCanvas.TextWidth(const St:String):Integer;
begin
  result:=InternalTextWidth(St);
end;
Best Regards,
ImageYeray Alonso
Development & Support
Steema Software
Av. Montilivi 33, 17003 Girona, Catalonia (SP)
Image Image Image Image Image Image Please read our Bug Fixing Policy

Jens Gr.
Newbie
Newbie
Posts: 6
Joined: Mon Nov 10, 2014 12:00 am

Re: Problem with TGDIPlusCanvas.TextWidth

Post by Jens Gr. » Tue Dec 23, 2014 12:31 pm

Hi Yeray,

I am a little confused. I have checked the same code with the old GDI Canvas and the buggy result is as follow:
Bild1.png
Bild1.png (3.44 KiB) Viewed 19068 times
Here the code:

Code: Select all

const
  fHeight=-11;

procedure TForm1.Draw3D1Paint(Sender: TObject; const ARect: TRect);
var
  s:String;
  x,y:Integer;
begin
  x:=10; y:=10;
  with Draw3D1.Canvas do begin
     Font.Height:=fHeight;
     TextOut(x,y,ClassName); y:=y+20;
     s:='XXXXXXXXXXXXXXXXXXXXXXXXXXX';
     Brush.Color:=clSilver;
     FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
     TextOut(x,y,s); y:=y+20;
     s:='FFFFFFFFFFFFFFFFFFFFFFFFFFF';
     Brush.Color:=clSilver;
     FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
     TextOut(x,y,s); y:=y+20;
     s:='AAAAAAAAAAAAAAAAAAAAAAAAAAAA';
     Brush.Color:=clSilver;
     FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
     TextOut(x,y,s); y:=y+20;
     TextOut(x,y,'FFFFFFFFFFFFFFFFFFFFFFFFFFF<b>HH</b> ',True); y:=y+20;
     TextOut(x,y,'AAAAAAAAAAAAAAAAAAAAAAAAAAA<b>HH</b> ',True);
  end;
end;
procedure TForm1.cbGDIPlusClick(Sender: TObject);
begin
  if cbGDIPlus.Checked then begin
    Draw3D1.Canvas:=TGDIPlusCanvas.Create;
  end else begin
    Draw3D1.Canvas:=TTeeCanvas3D.Create;
    TCanvasAccess(Draw3D1.Canvas).FontQuality:=fqDefault;
  end;
end;
In the source code I can find in VCLTee.TeeGDIPlus the lines:

Code: Select all

  FGraphics.MeasureString(St,Length(St),FGPFont,TeeZeroPoint, {TGPStringFormat.GenericTypographic,} tmpBox);
If I remove the comments to use Typographic, the result is better, but not good:
Bild2.png
Bild2.png (1.82 KiB) Viewed 19064 times
I cannot found your function "InternalTextWidth" in my source code. Is there a new source code version greater v2014.12.140923 ??

Thanks,
Jens

Jens Gr.
Newbie
Newbie
Posts: 6
Joined: Mon Nov 10, 2014 12:00 am

Re: Problem with TGDIPlusCanvas.TextWidth

Post by Jens Gr. » Mon Dec 29, 2014 12:06 pm

Hi,
I have spent a few hours and checked the function MeasureCharacterRanges. I think, this is a good alternative for the GDI TextSize function. Here is the code:

Code: Select all

function TextSizeGP(Graphics:TGPgraphics; Text:string; Font:TGPFont):TSize;
var
  format:TGPStringFormat;
  rect:TGPRectF;
  ranges: TCharacterRange;
  regions:array [0..0] of TGPRegion;
begin
  Result.cx:=0; Result.cy:=0;
  if length(Text)=0 then exit;
  if Text[length(Text)]=' ' then Text[length(Text)]:='-';
  format:=TGPStringFormat.Create;
  rect.X:=0; rect.Y:=0; rect.Width:=9999999;  rect.Height:=9999999;
  ranges := MakeCharacterRange(0,length(Text));
  format.SetMeasurableCharacterRanges(1,@ranges);
  regions[0]:=TGPRegion.Create;
  Graphics.MeasureCharacterRanges(text, -1, font, rect, format, 1, regions);
  regions[0].GetBounds(rect,graphics);
  result.cx:=Trunc(rect.Width +rect.X);
  result.cy:=Trunc(rect.Height +rect.Y);
end;
And here the result:
Bild1.png
Bild1.png (1.52 KiB) Viewed 19045 times
kind regards,
Jens

Jens Gr.
Newbie
Newbie
Posts: 6
Joined: Mon Nov 10, 2014 12:00 am

Re: Problem with TGDIPlusCanvas.TextWidth

Post by Jens Gr. » Wed Jan 21, 2015 3:16 pm

Hi,

Long silence? I hope, you are interested in a solution...

Here is a source code sample for better GDI+ text results. I have deleted your special code for publication. If you need the full code, please contact me per E-Mail.

Code: Select all

  TTeeFontMetric=record
    Name : String;
    Height : Integer;
    Style : TFontStyles;
    OX,OY:Single;
    BaseLine:Integer;
    TextHeight:Integer;
    Rotation:Integer; //0..359
  end;

procedure TGDIPlusCanvas.DoChangedFont;
begin
  if Assigned(FGPFont) and ((Font.Name<>FontMetric.Name) or (Font.Height<>FontMetric.Height) or (Font.Style<>FontMetric.Style)) then
    FreeAndNil(FGPFont);
end;

procedure TGDIPlusCanvas.NeedGPFont;
var
  tmpFontStyle : TFontStyle;
  tmpHeight:Integer;
  Family:TGPFontFamily;
  tmpQuality : TGDIPlusFontQuality;
  R: TGPRectF;
begin
  if Assigned(FGPFont) or not (Assigned(Font) and Assigned(FGraphics)) then Exit;
  if Font.Height<3 then
    tmpHeight:=Max(1,abs(Font.Height))
  else begin
    //Simple trick
    tmpHeight:=Font.Height;
    Font.Height:=-tmpHeight;
    while (Font.Height<-3) and (TextHeight('X')>tmpHeight) do
      Font.Height:=Font.Height+1;
    exit;
  end;
  FGPFont.Free;
  tmpFontStyle:=FontStyleRegular;
  if Font.Style<>[] then // optimization
  begin
    if fsBold in Font.Style then tmpFontStyle:=tmpFontStyle or FontStyleBold;
    if fsItalic in Font.Style then tmpFontStyle:=tmpFontStyle or FontStyleItalic;
    if fsUnderline in Font.Style then tmpFontStyle:=tmpFontStyle or FontStyleUnderline;
    if fsStrikeOut in Font.Style then tmpFontStyle:=tmpFontStyle or FontStyleStrikeout;
  end;
  FGPFont:=TGPFont.Create(Font.Name,tmpHeight,tmpFontStyle,UnitPixel);
  FontMetric.Name:=Font.Name;
  FontMetric.Height:=tmpHeight;
  FontMetric.Style:=Font.Style;
  R:=CalcTextRange('X');
  FontMetric.OX:=R.X;
  FontMetric.OY:=R.Y;
  FontMetric.TextHeight:=Round(R.Height+R.Y+0.1);
  Family:=TGPFontFamily.Create;
  FGPFont.GetFamily(Family);
  FontMetric.BaseLine:=Round(FGPFont.GetSize*Family.GetCellAscent(FGPFont.GetStyle)/Family.GetEmHeight(FGPFont.GetStyle))+Round(R.Y-0.1);
  Family.Free;
end;

function TGDIPlusCanvas.CalcTextRange(const Text:string):TGPRectF;
var
  format:TGPStringFormat;
  rect:TGPRectF;
  ranges: TCharacterRange;
  regions:array [0..0] of TGPRegion;
begin
  Result.Width:=0; Result.Height:=0; Result.X:=0; Result.Y:=0;
  if length(Text)=0 then exit;
  NeedGPFont;
  format:=TGPStringFormat.Create(StringFormatFlagsMeasureTrailingSpaces);
  rect.X:=0; rect.Y:=0; rect.Width:=9999999;  rect.Height:=9999999;
  ranges := MakeCharacterRange(0,length(Text));
  format.SetMeasurableCharacterRanges(1,@ranges);
  regions[0]:=TGPRegion.Create;
  FGraphics.MeasureCharacterRanges(text, -1, FGPFont, rect, format, 1, regions);
  regions[0].GetBounds(Result,FGraphics);
  regions[0].Free;
  format.Free;
end;

Function TGDIPlusCanvas.TextSize(const St:String):TPointFloat;
begin
  NeedGPFont;
  if (FontMetric.Rotation mod 90)<>0 then with CalcTextRange(St) do
    Result.x:=Round(Width+X*2-FontMetric.OX)  //Approximation
  else
    Result.x:=Round(CalcTextRange(St).Width);  //Excat Textwidth
  Result.y:=FontMetric.TextHeight;
end;

Function TGDIPlusCanvas.TextWidth(const St:String):Integer;
begin
  Result:=Round(TextSize(St).x);
end;

Function TGDIPlusCanvas.TextHeight(const St:String):Integer;
begin
  Result:=Round(TextSize('').y);
end;

Procedure TGDIPlusCanvas.TextOut(X,Y:Single; const Text:String);
var
  Origin : TGPPointF;
  matrix : TGPMatrix;
  tmpBack: TCanvasBackMode;
begin
  Origin.X:=X; Origin.Y:=Y;
  NeedGPFont;
  matrix:=nil;
  FontMetric.Rotation:=(Round(ITextRotation)+360000000) mod 360; //0..359
  if (FontMetric.Rotation<>0) then begin
    matrix:=TGPMatrix.Create;
    if FGraphics.GetTransform(matrix) = Ok then
       if matrix.RotateAt(FontMetric.Rotation,Origin) = Ok then
          FGraphics.MultiplyTransform(matrix);
  end;

  case TextAlign and (TA_RIGHT or TA_CENTER) of
  TA_RIGHT: Origin.X:=Origin.X-TextWidth(Text);
  TA_CENTER: Origin.X:=Origin.X-(TextWidth(Text) div 2); //avoid half pixels
  end;
  case TextAlign and (TA_BOTTOM or TA_BASELINE) of
  TA_BOTTOM: Origin.Y:=Origin.Y-TextHeight(Text);
  TA_BASELINE: Origin.Y:=Origin.Y-FontMetric.BaseLine;
  end;

  tmpBack:=BackMode;
  if (BackMode=cbmOpaque) then begin
    Brush.Color:=BackColor;
    FillRect(CalcTextRect(Origin,Text));
  end;

  FGPBrush.Free;
  FGPBrush:=TextBrush(Font.Color,Origin,Text);

  Origin.X:=Origin.X-(FontMetric.OX*0.6); //negative Offset
  if (FontMetric.Rotation mod 90)<>0 then Origin.Y:=Origin.Y+FontMetric.OY; //Bug or Feature???
  FGraphics.DrawString(Text,Length(Text),FGPFont,Origin,FGPBrush);

  BackMode:=tmpBack;
  if Assigned(matrix) then begin
    if FGraphics.ResetTransform = Ok then FreeAndNil(matrix);
    FontMetric.Rotation:=0;
  end;
Truly, the GDI+ text function are very strange. But the result with the new code is not bad and you can also use the HTML-Out functions with GDI+:
PicTee1.png
PicTee1.png (18.16 KiB) Viewed 18906 times

Code: Select all

procedure TForm1.Draw3D1Paint(Sender: TObject; const ARect: TRect);
var
  s:String;
  x,y,h,xp,yp:Integer;
  w:Single;
begin
  x:=10; y:=10;
  with Draw3D1.Canvas do begin
     Brush.Clear;
     h:=TextHeight('-');
     TextOut(x,y,Format('%s TH=%d FH=%d %s',[ClassName,h,Font.Height,Font.Name]));
     h:=h+5;
     y:=y+h;
     s:='XXXXXXXXXXXX█XXXXXXXXXXXXXXX';
     Brush.Color:=clSilver;
     FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
     TextOut(x,y,s); y:=y+h;
     s:='FFFFFFFFFFFF█FFFFFFFFFFFFFFF';
     Brush.Color:=clSilver;
     FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
     TextOut(x,y,s); y:=y+h;
     s:='AAAAAAAAAAAA█AAAAAAAAAAAAAAA';
     Brush.Color:=clSilver;
     FillRect(Rect(x,y,x+TextWidth(s),y+TextHeight(s)));
     TextOut(x,y,s); y:=y+h;
     Font.Style:=[];
     TextOut(x,y,'HtmlText<i>Out</i>: FFFF</b>FF<font color=#FF0000>F</font><font color=#00FF00>F</font><b>HH</b> ',True); y:=y+h;
     TextOut(x,y,'HtmlText<i>Out</i>: AAAA</b>AAAA<b>HH</b> ',True); y:=y+h;
     Font.Style:=[];
     y:=y+20;
     TextAlign:=TA_BASELINE;
     xp:=x; s:='H';
     Brush.Color:=clSilver;
     FillRect(Rect(x,y,x+300,y+1));
     for yp:=6 to 28 do begin
       Font.Height:=-yp;
       TextOut(xp,y,s);
       xp:=xp+TextWidth(s);
     end;
     Font.Height:=-11;
     s:='WWW█WWW';
     //TextAlign:=TA_RIGHT; h:=100;
     //TextAlign:=TA_CENTER; h:=50;
     //TextAlign:=TA_BASELINE;
     //TextAlign:=TA_BOTTOM;
     x:=(ARect.Left+Arect.Height) div 2; y:=y+110;
     Brush.Color:=clWhite;
     Ellipse(x-h,y-h,x+h,y+h);
     w:=0;
     while (w<360) do begin
       xp:=x+Round(h*cos(w/180*PI));
       yp:=y-Round(h*sin(w/180*PI));
       BackColor:=clSilver;
       BackMode:=cbmOpaque;
       RotateLabel(xp,yp,s,w);
       w:=w+45;
     end;
  end;
end;
I hope, I could help you and you can improve your software.

Another problem: Please look to the function TeEngine.TChartAxis.DrawAxisLabel. You define tmpAlign but don't use it. I think, all Axis Labels are drawn with center alignment. The result is not good.

Thanks,
Jens Gr.

Narcís
Site Admin
Site Admin
Posts: 14730
Joined: Mon Jun 09, 2003 4:00 am
Location: Banyoles, Catalonia
Contact:

Re: Problem with TGDIPlusCanvas.TextWidth

Post by Narcís » Fri Jan 23, 2015 11:14 am

Hello Jens,

Thank you very much for your collaboration and many apologies for the lack of feedback from our side.

This needs to be investigated very carefully as it may provide the desired output but also involve performance regressions. MeasureCharacterRanges is more precise but very slow. We need to investigate if we can make some sort of caching to optimize performance and get the desired rendering output.
Best Regards,
Narcís Calvet / Development & Support
Steema Software
Avinguda Montilivi 33, 17003 Girona, Catalonia
Tel: 34 972 218 797
http://www.steema.com
Image Image Image Image Image Image
Instructions - How to post in this forum

Post Reply