Перейти к содержанию
Fire Monkey от А до Я
  • 0

Текст на битмапе


M1shQa

Вопрос

Есть задача написать дату на полученной только что фотографии с камеры. С камеры фотку получаю и выгружаю в TImage, далее нашел пару способов, а именно:

image.bitmap.canvas.textout

image.bitmap.canvas.filltext

и оба у меня не работают, первый вариант не удается запустить, пишет, что нету такого свойства textout у TCanvas, а второй тупо вешает программу. Подскажите как можно решить эту проблему пожалуйста.

Ссылка на комментарий

Рекомендуемые сообщения

  • 0
  • Модераторы

как-то так

Image.Bitmap.Canvas.BeginScene;
Image.Bitmap.Canvas.FillText(RectF(0,0,100,100), 'Date', false, 1, [], TTextAlign.Center, TTextAlign.Center);
Image.Bitmap.Canvas.EndScene;
Ссылка на комментарий
  • 0
17 часов назад, ZuBy сказал:

как-то так


Image.Bitmap.Canvas.BeginScene;
Image.Bitmap.Canvas.FillText(RectF(0,0,100,100), 'Date', false, 1, [], TTextAlign.Center, TTextAlign.Center);
Image.Bitmap.Canvas.EndScene;

Большое спасибо, подогнал, все работает замечательно, минимум кода и все понятно. Возник еще вопрос: можно ли как то сделать обводку текста или если проще на пример сзади текста отрисовать черный квадрат позади текста? пытаюсь сделать так:

Image.Canvas.DrawRect(RectF(0,0, 100, 100), 0, 0, AllCorners, 1);

Но не до конца понимаю как работает дроурект..(

Ссылка на комментарий
  • 0
  • Модераторы

да конечно можно, вы просто не указали цвет

нужно запомнить если метод начинается на Fill..., значит нужно менять цвет через 

Image.Bitmap.Canvas.Fill.Color := TAlphaColorRec.Black;

если на Draw..., то 

Image.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Black;
Изменено пользователем ZuBy
Ссылка на комментарий
  • 0
7 минут назад, ZuBy сказал:

да конечно можно, вы просто не указали цвет

нужно запомнить если метод начинается на Fill..., значит нужно менять цвет через 


Image.Bitmap.Canvas.Fill.Color := TAlphaColorRec.Black;

если на Draw..., то 


Image.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Black;

Не отображается сам прямоугольник =(

Цитата

begin
Image.Bitmap.Canvas.BeginScene;
Image.Bitmap.Canvas.Fill.Color := TAlphaColorRec.Black;
Image.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.White;
image.Bitmap.Canvas.Font.Size:=18;
Image.Bitmap.Canvas.FillText(RectF(0,0,100,100), DateToStr(Date), false, 1, [], TTextAlign.Center, TTextAlign.Center);
Image.Canvas.DrawRect(RectF(0, 0, 100, 100), 0, 1, AllCorners, 1);
Image.Bitmap.Canvas.EndScene;
end;

 

Ссылка на комментарий
  • 0
  • Модераторы
procedure TForm1.Button1Click(Sender: TObject);
var
  aBitmap: TBitmap;
begin
  aBitmap := TBitmap.Create;
  aBitmap.SetSize(trunc(Image1.Width), trunc(Image1.Height));

  aBitmap.Canvas.BeginScene;
  aBitmap.Canvas.Fill.Color := TAlphaColorRec.Black;
  aBitmap.Canvas.Font.Size := 18;
  aBitmap.Canvas.FillText(RectF(0, 0, 100, 100), DateToStr(Date), false, 1, [], TTextAlign.Center, TTextAlign.Center);
  aBitmap.Canvas.Stroke.Color := TAlphaColorRec.Red;
  aBitmap.Canvas.DrawRect(RectF(0, 0, 100, 100), 0, 1, AllCorners, 1);
  aBitmap.Canvas.EndScene;

  Image1.Bitmap.Assign(aBitmap);
  aBitmap.Free;
end;

 

2016-05-13_12-09-50.png

Ссылка на комментарий
  • 0
4 минуты назад, ZuBy сказал:

procedure TForm1.Button1Click(Sender: TObject);
var
  aBitmap: TBitmap;
begin
  aBitmap := TBitmap.Create;
  aBitmap.SetSize(trunc(Image1.Width), trunc(Image1.Height));

  aBitmap.Canvas.BeginScene;
  aBitmap.Canvas.Fill.Color := TAlphaColorRec.Black;
  aBitmap.Canvas.Font.Size := 18;
  aBitmap.Canvas.FillText(RectF(0, 0, 100, 100), DateToStr(Date), false, 1, [], TTextAlign.Center, TTextAlign.Center);
  aBitmap.Canvas.Stroke.Color := TAlphaColorRec.Red;
  aBitmap.Canvas.DrawRect(RectF(0, 0, 100, 100), 0, 1, AllCorners, 1);
  aBitmap.Canvas.EndScene;

  Image1.Bitmap.Assign(aBitmap);
  aBitmap.Free;
end;

 

2016-05-13_12-09-50.png

Ваш вариант работает, но он перекрывает битмап который уже имеется на компоненте TImage.. попытаюсь сейчас прикрутить как то это, а прямоугольник можно закрасить? (суть: на любом полученном фото с телефона отпечатать дату, прямоугольник нужен что бы цифры всегда были видны). Еще раз спасибо Вам, большая часть сделана благодаря Вам :) 

Ссылка на комментарий
  • 0
  • Модераторы
procedure TForm1.Button1Click(Sender: TObject);
var
  aBitmap: TBitmap;
  aRectF: TRectF;
begin
  aBitmap := TBitmap.Create;
  aBitmap.SetSize(trunc(Image1.Width), trunc(Image1.Height));

  aBitmap.Assign(Image1.Bitmap);
  aBitmap.Canvas.BeginScene;

  aRectF := RectF(aBitmap.Width - 100, aBitmap.Height - 25, aBitmap.Width, aBitmap.Height);
  aBitmap.Canvas.Fill.Color := $B4FFFFE5;
  aBitmap.Canvas.FillRect(aRectF, 0, 0, AllCorners, 1);
  aBitmap.Canvas.Font.Size := 18;
  aBitmap.Canvas.Fill.Color := TAlphaColorRec.Black;
  aBitmap.Canvas.FillText(aRectF, DateToStr(Date), false, 1, [], TTextAlign.Center, TTextAlign.Center);
  aBitmap.Canvas.EndScene;

  Image1.Bitmap.Assign(aBitmap);
  aBitmap.Free;
end;

 

2016-05-13_12-26-58.png

Ссылка на комментарий
  • 0
24 минуты назад, ZuBy сказал:

procedure TForm1.Button1Click(Sender: TObject);
var
  aBitmap: TBitmap;
  aRectF: TRectF;
begin
  aBitmap := TBitmap.Create;
  aBitmap.SetSize(trunc(Image1.Width), trunc(Image1.Height));

  aBitmap.Assign(Image1.Bitmap);
  aBitmap.Canvas.BeginScene;

  aRectF := RectF(aBitmap.Width - 100, aBitmap.Height - 25, aBitmap.Width, aBitmap.Height);
  aBitmap.Canvas.Fill.Color := $B4FFFFE5;
  aBitmap.Canvas.FillRect(aRectF, 0, 0, AllCorners, 1);
  aBitmap.Canvas.Font.Size := 18;
  aBitmap.Canvas.Fill.Color := TAlphaColorRec.Black;
  aBitmap.Canvas.FillText(aRectF, DateToStr(Date), false, 1, [], TTextAlign.Center, TTextAlign.Center);
  aBitmap.Canvas.EndScene;

  Image1.Bitmap.Assign(aBitmap);
  aBitmap.Free;
end;

 

2016-05-13_12-26-58.png

Черт и выглядит круто, спасибо!)

Ссылка на комментарий
Гость
Эта тема закрыта для публикации ответов.
×
×
  • Создать...