Search code examples
delphicanvasfiremonkey

(Delphi FMX) How do I use Canvas.FillText to show up in the middle of an Ellipse?


I want to show numbers in the middle of an Ellipse as text drawn on a canvas. The coordinates will be stored (for the ellipse) inside of a database, as well as the text value will be stored in another part of a database.

What I have done so far is I have been working w/ a demonstration project (DrawApp) from FMXExpress (Github) where I have changed a few procedures from being Private to Public. These procedures include StartDrawing(startP:TPointF), EndDrawing(startP:TPointF), DoDraw() that way I can use these functions from the external Unit/Object. The object uses these functions in coordination with MouseUp/MouseDown, as well as few properties including fDrawing to distinguish whether or not drawing is in progress, and just what tool is being used (fdEllipse).

My Main form uses the following code inside the FormCreate to initially create the fdrawbox := TMyPaintBox.Create(Rectangle1); The Rectangle1 sits on top of an image, which represents a grid to show a body part, and will be able to draw circles on top of the image. What I have found is that it is not hard to create either the text or the ellipse, but for the purpose of creating multiple circles with an identifier to distinguish circles, as I have mentioned, I want to have a number to show up which circle is which. And even in the future, I may want to change the colour to show which circle to concentrate on.

demonstration for mypaintbox http://www.abatepain.com/abate/OHlbF.jpg

So the following code (Delphi FMX) shows creating a drawapp by utilising a TRectangle as its parent.

with fdrawbox do begin
  Parent := Rectangle1;
  Visible := True;
  ForegroundColor := TAlphaColor($FF000000); //
  BackgroundColor := TAlphaColor($00000000); //

  FuncDraw := TFunctionDraw.fdEllipse; //fdrawbox.fDrawing := True;
  StartDrawing(PointF(100, 100));
  EndDrawing(PointF(200, 200));
  FuncDraw := TFunctionDraw.fdNone;

  OnPaint := PaintBox1Paint;
end;

The circle is created using the last few lines, but in order to utilise FillText, I need to use a OnPaint Function, which I created and the code looks something like this. I believe that DrawApp handles OnPaint function internally, but just how it handles it is still unknown. But it is never the less a necessity in order to print "Hello Text!!"

procedure TMainForm.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
begin
  with Canvas do begin
    BeginScene();
    //Clear(cbbg.Color);
    Font.Style := [];
    Font.Size := 12;
    Fill.Color := TAlphaColors.Red;
    FillText(TRectF.Create(0, 0, 300, 295), 'Hello Text!!', false, 100, [], TTextAlign.Center, TTextAlign.Center); //TFillTextFlag.RightToLeft
    EndScene;
  end;
  Application.ProcessMessages;
end;

Can someone give an example of how to handle this (possibly inside a single function) where I can print multiple circles and have the associated text follow with it? I believe with the previous example, I could do it on my own, but that I would have to manually enter the PointF (for the circle) and TRectF for the Text, and they both use different values as coordinates.


Solution

  • As you have noted, the TMyPaintBox class doesn't support text rendering, nor properties often used with text output like font or color etc. But you can add those yourself by defining fields in the private section and the properties to get/set the values in the public section.

    In the following I assume addition of fields ftextout, ffontsize and ffontcolor with corresponding properties TextOut FontSize and FontColor.

    To add functionality for rendering text in the similar way other element types are drawn, add fdText as a new enum to TFunctionDraw.

      TFunctionDraw=(fdNone,fdPen,fdLine,fdRectangle,fdEllipse,fdFillBgr,fdBitmapStamp,fdPolyLine, fdText);
    

    Then in TMyPaintBox.DoDraw add a new case option to case ffdraw of like for example:

    with vCanvas do
    begin
    BeginScene();
    case ffdraw of 
      //
      // other TFunctionDraw enums
      //
      TFunctionDraw.fdText: begin
        {Canvas.}Font.Size := ffonsize; // new field
        {Canvas.}Fill.Color := ffontcolor; // new field 
        {Canvas.}FillText(r, TextOut, False, 1, [],
          TTextAlign.Center, TTextAlign.Center);
      end;
    end;
    

    Edit:

    The references to Canvas in the TFunctionDraw.fdText are superfluous. Remove the outcommented references. The canvas to use is already defined in a with statement (added to the code to show). Oh, I hate those withs!

    It is also worth to notice, that if you only want to display circles with text, and not let the user draw on the canvas, you could achieve it much simpler with a component of your own make.

    Also, do not call DoDraw directly. It is called by Paint which is fired whenever the fdrawbox is invalidated. So, call invalidate instead when you want to force an update.

    End of edit

    Then you can achieve text rendering just as any other drawing of elements (using your code template):

    with fdrawbox do begin
      Parent := Rectangle1;
      Visible := True;
      ForegroundColor := TAlphaColor($FF000000); //
      BackgroundColor := TAlphaColor($00000000); //
    
      FuncDraw := TFunctionDraw.fdEllipse; //fdrawbox.fDrawing := True;
      StartDrawing(PointF(100, 100));
      EndDrawing(PointF(200, 200));
    
      FuncDraw := TFunctionDraw.fdText;
      FontSize := 12; // set new property
      FontColor := TAlphaColorRec.Red; // set new property
      TextOut := 'Hello text!';
      StartDrawing(PointF(100, 100));
      EndDrawing(PointF(200, 200));
    
      FuncDraw := TFunctionDraw.fdNone;
    
      invalidate;
      // OnPaint := PaintBox1Paint; // no need for this
    end;