Jump to content
xorpas

write text on image with specific position fmx

Recommended Posts

Dear friends:

 

How can write on image and save it the new in fmx android I can't found similar then txtout  in fmx  this code work but can't write text in specific position

 

var
  ARect: TRectF;
  s: string;
begin
  with Image1.Bitmap do
  begin
    Canvas.Font.Family := 'Arial';
    Canvas.Fill.Color := TAlphaColorRec.Black;
    ARect.Top := 200;
    ARect.Left := 100;
    ARect.Width := 105;
    ARect.Height := 50;
    s := 'hellow Fmx';
    Canvas.BeginScene;
//    canvas.textout(20,20,'hellow Fmx');
    Canvas.FillText(ARect, s, false, 1, [], TTextAlign.Leading,
      TTextAlign.Leading);
    Canvas.EndScene;
  end;

end;

 

 

Share this post


Link to post

If you want a very simple way (but not optimized) : set a parent for your image (something linked to a form by a way or an other), add a Text component with characteristics your need, set its parent to the TImage, and do a YourImage.MakeScreenShot to get the new bitmap.

  • Confused 2

Share this post


Link to post

If it's for the purpose of just showing an image with text, I would recommend TImage32, or other libraries.

Maybe solutions based on SVG or Skia as well, but TImage32 seems to be the most clean and small solution to just the TImage replacement, with a lot of extras.

FMX internally has a lot of Scaling questions, which may drawing on a canvas make it not trivial and different on varous platforms and devices.

Edited by Rollo62
  • Like 1
  • Confused 1

Share this post


Link to post

I think the issue is with BitmapScale. With the code below I get the text in the right position.

 

procedure TForm1.Button1Click(Sender: TObject);
var
  ARect: TRectF;
  s: string;
begin
  with Image1.Bitmap do
  begin
    Canvas.Font.Family := 'Arial';
    Canvas.Fill.Color := TAlphaColorRec.Black;
    ARect.Top := 200;
    ARect.Left := 100;
    ARect.Width := 105;
    ARect.Height := 50;
    s := 'hellow Fmx';
    Canvas.BeginScene;
    Canvas.Clear(TAlphaColorRec.White);
//    canvas.textout(20,20,'hellow Fmx');
    Canvas.FillText(ARect, s, false, 1, [], TTextAlign.Leading, TTextAlign.Leading);
    Canvas.EndScene;

    SaveToFile('testBmp.png');
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Bitmap.SetSize(Round(Image1.Width), Round(Image1.Height));
  Image1.Bitmap.BitmapScale := 1;
end;

 

Edited by XylemFlow
  • Like 1

Share this post


Link to post

Yes, additionally the scaling behavior might change with platform and different devices, it can be 1,2,3, whatever.

Then you have scaling of the bitmap, scene, text matrix, etc.

That's why I prefer a "canvas" that is not so much device-depended, like Image32,

 

If this solution works for you, then better check on various different platforms and devices too.

Edited by Rollo62

Share this post


Link to post

@xorpas

maybe some like this...

  • Invalidate informs the form that its entire surface needs to be repainted. Calling Invalidate can prevent flicker caused by a series of partial repaints. There is no performance penalty for calling Invalidate multiple times before the form is actually repainted.
implementation

{$R *.fmx}

var
  LImageWidthOriginal, LImageHeightOriginal: single;
  LFontSizeScale                           : single = 1; // init value

procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Align := TAlignLayout.None;
  //
  Image1.Size.Width  := 200;
  Image1.Size.Height := 200;
  LFontSizeScale     := (Image1.Width * Image1.Height) / (LImageWidthOriginal * LImageHeightOriginal);
  //
  Invalidate; // re-do form canvas
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Image1.Align := TAlignLayout.None;
  //
  Image1.Size.Width  := 500;
  Image1.Size.Height := 600;
  LFontSizeScale     := (Image1.Width * Image1.Height) / (LImageWidthOriginal * LImageHeightOriginal);
  //
  Invalidate; // re-do form canvas
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Image1.Align := TAlignLayout.Client;
  //
  LFontSizeScale := (Image1.Width * Image1.Height) / (LImageWidthOriginal * LImageHeightOriginal);  
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // 3º - first run
  Image1.WrapMode      := TImageWrapMode.Stretch;
  LImageWidthOriginal  := Image1.Size.Width;
  LImageHeightOriginal := Image1.Size.Height;
end;

procedure TForm1.Image1Paint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
var
  LRectText  : TRectF;
  LImagePoint: TPointF;
begin
  // 4º - first run
  LImagePoint := Image1.AbsoluteToLocal(PointF(Image1.Position.x + 10, Image1.Position.Y + 10));
  LRectText   := TRectF.Create(LImagePoint.x, LImagePoint.Y, Image1.Width, Image1.Height);
  //
  Canvas.Fill.Color := TAlphaColorRec.Yellow;
  Canvas.Font.Size  := LFontSizeScale * 20;
  Canvas.FillText(LRectText, 'Hello World', false, 1, [], TTextAlign.Leading, TTextAlign.Leading);
end;

procedure TForm1.Image1Resize(Sender: TObject);
begin
  // 1 º - first run
end;

procedure TForm1.Image1Resized(Sender: TObject);
begin
  // 2 º - first run
end;

end.

image.thumb.png.fd147519001113daaf0cf3cf0f468d78.png

 

Edited by programmerdelphi2k
  • Like 2

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×