Jump to content

[TfgCanvas] Не могу поверх фото текст наложить


Recommended Posts

Всем привет! Позвольте и эту тему апнуть

Не могу поверх фото текст наложить. Пробую так.

Как это необходимо делать верно?

 

AResult.Bitmap - приходит из CameraCapturePhotoReady(Sender: TObject;  const AResult: TfgCameraCaptureResult);

  filename := filename + strDate + '.png';
  var B := AResult.Bitmap;
//  B.Canvas.BeginPaint;
  B.Canvas.Font.Size:= 50;
  B.Canvas.Fill.Color := TAlphaColorRec.Red;
  B.Canvas.Fill.Kind := TfgBrushKind.Solid;
//  var mRect :=B.LogicalBounds;
//  mRect.Width := mRect.Width - mRect.Width * 0.05;
//  mRect.Height := mRect.Height - mRect.Height * 0.05;
  B.Canvas.FillText(B.Bounds, DateTimeToStr(now) ,False, TfgHorizontalAlignment.Right, TfgVerticalAlignment.Bottom);
  B.SaveToFile(filename);
//  B.Canvas.EndPaint;
  TfgAssetsManager.Current.AddBitmap('asset_' + mainf.md5(filename), B);

Edited by Артем
Link to post
Share on other sites
  • Administrators

Добрый вечер,

12 hours ago, Артем said:

Как это необходимо делать верно?

  1. Создать битмап
  2. Выполнить любую отрисовку поверх битмапа.

Вот пример:

Создал битмап FBitmap.

procedure TForm4.fgFormCreate(Sender: TObject);
begin
  FBitmap := TfgBitmap.Create(100, 100);

  FBitmap.Canvas.BeginPaint;
  try
    FBitmap.Canvas.Font.Size:= 50;
    FBitmap.Canvas.Fill.Color := TAlphaColorRec.Red;
    FBitmap.Canvas.Fill.Kind := TfgBrushKind.Solid;
    FBitmap.Canvas.FillText(FBitmap.Bounds, DateTimeToStr(now) ,False, TfgHorizontalAlignment.Right, TfgVerticalAlignment.Bottom);
  finally
    FBitmap.Canvas.EndPaint;
  end;
end;

И вывожу для проверки через TfgPaintBox:

procedure TForm4.fgPaintBox1Paint(Sender: TObject; const Canvas: TfgCanvas);
begin
  Canvas.DrawBitmap(FBitmap, FBitmap.Bounds);
end;

 

Link to post
Share on other sites
14 часов назад, Yaroslav Brovin сказал:

Добрый вечер,

  1. Создать битмап
  2. Выполнить любую отрисовку поверх битмапа.

Вот пример:

Создал битмап FBitmap.


procedure TForm4.fgFormCreate(Sender: TObject);
begin
  FBitmap := TfgBitmap.Create(100, 100);

  FBitmap.Canvas.BeginPaint;
  try
    FBitmap.Canvas.Font.Size:= 50;
    FBitmap.Canvas.Fill.Color := TAlphaColorRec.Red;
    FBitmap.Canvas.Fill.Kind := TfgBrushKind.Solid;
    FBitmap.Canvas.FillText(FBitmap.Bounds, DateTimeToStr(now) ,False, TfgHorizontalAlignment.Right, TfgVerticalAlignment.Bottom);
  finally
    FBitmap.Canvas.EndPaint;
  end;
end;

И вывожу для проверки через TfgPaintBox:


procedure TForm4.fgPaintBox1Paint(Sender: TObject; const Canvas: TfgCanvas);
begin
  Canvas.DrawBitmap(FBitmap, FBitmap.Bounds);
end;

 

 

Не выходит image.thumb.png.5dc2d8135fa3da1dae47146f2a8bd274.png

Link to post
Share on other sites
  • Yaroslav Brovin changed the title to [TfgCanvas] Не могу поверх фото текст наложить
  • Viktor Akselrod locked this topic
Guest
This topic is now closed to further replies.
  • Similar Content

    • By Артем
      В продолжение темы.
      Пишу текст на фото. Но не срабатывает перенос строки. Что-то не так делаю?
        var Bitmap := TfgBitmap.Create;
        Bitmap.LoadFromFile(filename);
        Bitmap.Canvas.BeginPaint;
        try
          Bitmap.Canvas.Font.Size:= 50;
          Bitmap.Canvas.Fill.Color := TAlphaColorRec.Red;
          Bitmap.Canvas.Fill.Kind := TfgBrushKind.Solid;
          Bitmap.Canvas.FillText(Bitmap.Bounds, DateTimeToStr(now) + sLineBreak + DateTimeToStr(now) + sLineBreak + DateTimeToStr(now) ,True, TfgHorizontalAlignment.Right, TfgVerticalAlignment.Bottom);
        finally
          Bitmap.SaveToFile(filename);
          Bitmap.Canvas.EndPaint;
        end;
        FreeAndNil(Bitmap);
      Успешный сценарий который ожидаю. Дата в трех строчках
    • By Stas
      Здравствуйте, обнаружил неприятную особенность отрисовки текста.
      Охватило меня желание нарисовать текст в круге.
      procedure TFormMain.fgButton1Tap(Sender: TObject); var B:TfgBitmap; Sz:Integer; begin B:=TfgBitmap.Create; Sz:=128; B.Size:=Tsize.Create(Sz,Sz); B.Canvas.Fill.Color:=TAlphaColorRec.Green; B.Canvas.FillCircle(B.Size.cx/2,B.Size.cy/2,B.Size.cx/2); B.Canvas.Font.Size:=Sz/2; B.Canvas.Fill.Color := TAlphaColorRec.Red; B.Canvas.Fill.Kind := TfgBrushKind.Solid; B.Canvas.FillText(B.Bounds,'100',False); TfgAssetsManager.Current.AddBitmap('test',B); fgImage1.ImageName:='test'; end; И показать его на картинке.
      И не получилось
      Спасибо

    • By s.fedotenko@gmail.com
      xx_1 := 0; yy_1 := 0; xx := 0; i := 0; APoints:=nil; while xx < pCanvas.Width do begin xx := i * (1 / 100); yy := (pCanvas.Height / 2) - 100 * sin(2 * pi * 0.05 * i / 100); pCanvas.DrawLine(pointf(xx_1, yy_1), pointf(xx, yy)); SetLength(APoints, Length(APoints) + 1); APoints[Length(APoints) - 1] := pointf(xx, yy - 50); xx_1 := xx; yy_1 := yy; inc(i); end; if Length(APoints) > 0 then pCanvas.DrawLines(APoints); рисуется функция двумя способами:
      через DrawLine - нормально
      через DrawLines -нет
      Project_TestBM.zip
    • By s.fedotenko@gmail.com
      Здравствуйте.
      Имеем код:
      procedure TFormMain.fgPaintBox1Paint(Sender: TObject; const ACanvas: TfgCanvas); var aBm: TFgBitMap; begin try aBm := TFgBitMap.Create; aBm.Size := Tsize.Create(round(fgPaintBox1.Width), round(fgPaintBox1.Height)); aBm.Canvas.FillColor(TAlphaColorRec.Gray); aBm.Canvas.Stroke.Kind := TfgBrushKind.Solid; aBm.Canvas.Stroke.Color := TAlphaColorRec.Red; aBm.Canvas.Fill.Kind := TfgBrushKind.Solid; aBm.Canvas.Fill.Color := TAlphaColorRec.Yellow; aBm.Canvas.DrawCircle(aBm.Width / 2, aBm.Height / 2, aBm.Width / 2); ACanvas.DrawBitmap(aBm, 0, 0); finally aBm.DisposeOf; aBm := nil; end; end; Скэйл устройства =2.
      получили результат:

      Два вопроса:
      1. на PaintBox битмап выводится с размерами в 2 раза меньше. Насколько я понял это связано со скэйлом устройства, и что бы битмап отобразился на весь PaintBox на экране, нужно задавать физические размеры битмапа в 2 раза (для данного устройства) больше. Где можно узнать скэйл устройства, что бы задать размеры битмапа соответствующие выводу на PaintBox? 
      2. Не очень понятно, почему примитивы на битмапе рисуются со скэйлом устройства?  
    • By s.fedotenko@gmail.com
      Здравствуйте.
      При установке размеров битмапа через свойства .Width и .Height происходит исключение:

       
       
       
       
       
       
       
       
       
       
       
       
       
       
      Через свойство .Size - размеры устанавливаются нормально.
  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...