Page 1 of 1

Problem with TGDIPlusCanvas.TextWidth

Posted: Fri Dec 12, 2014 8:49 am
by 17570671
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 20474 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

Re: Problem with TGDIPlusCanvas.TextWidth

Posted: Fri Dec 12, 2014 9:52 am
by 16570767
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 20446 times
withWith.png
withWith.png (17.88 KiB) Viewed 20441 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;

Re: Problem with TGDIPlusCanvas.TextWidth

Posted: Fri Dec 12, 2014 11:05 am
by yeray
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.

Re: Problem with TGDIPlusCanvas.TextWidth

Posted: Fri Dec 12, 2014 11:06 am
by 16570767
And that's a good thing, I suppose?

Re: Problem with TGDIPlusCanvas.TextWidth

Posted: Fri Dec 12, 2014 12:36 pm
by 17570671
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.

Re: Problem with TGDIPlusCanvas.TextWidth

Posted: Mon Dec 22, 2014 8:42 am
by yeray
Hi Jens

I've added this to the public tracker to further investigate it:
http://bugs.teechart.net/show_bug.cgi?id=1055

Re: Problem with TGDIPlusCanvas.TextWidth

Posted: Tue Dec 23, 2014 9:56 am
by yeray
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;

Re: Problem with TGDIPlusCanvas.TextWidth

Posted: Tue Dec 23, 2014 12:31 pm
by 17570671
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 20358 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 20354 times
I cannot found your function "InternalTextWidth" in my source code. Is there a new source code version greater v2014.12.140923 ??

Thanks,
Jens

Re: Problem with TGDIPlusCanvas.TextWidth

Posted: Mon Dec 29, 2014 12:06 pm
by 17570671
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 20335 times
kind regards,
Jens

Re: Problem with TGDIPlusCanvas.TextWidth

Posted: Wed Jan 21, 2015 3:16 pm
by 17570671
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 20196 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.

Re: Problem with TGDIPlusCanvas.TextWidth

Posted: Fri Jan 23, 2015 11:14 am
by narcis
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.