Надпись на картинке Vampyre Imaging

Общие вопросы программирования, алгоритмы и т.п.

Модератор: Модераторы

Надпись на картинке Vampyre Imaging

Сообщение zub » 09.03.2018 13:52:31

Гружу картинку с помощью Vampyre Imaging, нужно добавить на нее текст. Штатные средства для этого искал плохо и не нашел. Долго думать не стал, решил скопировать картинку в TImage, там сделать все что надо и скопировать обратно в TMultiImage.
Сработало частично, текст рисуется только белым цветом и без алиасинга. Как сделать красивую цветную надпись?

кусок отвечающий за вывод текста и картинки
Код: Выделить всё
procedure TForm1.onCreateHandler(Sender: TObject);
var
  img:TImage;
  ts:TTextStyle;
begin
  try
    if not assigned(LImg) then
      LImg:=TMultiImage.create;
    LImg.LoadMultiFromFile('Weave.jpeg');
  except
    //MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
    //OutputForm.Img.CreateFromParams(32, 32, ifA8R8G8B8, 1);
  end;

  //копируем из вампировского TMultiImage в TImage
  img:=TImage.Create(nil);
  if not assigned(img.Picture.Graphic) then
    img.Picture.Graphic:=TImagingBitmap.Create;
  img.Picture.Graphic.Assign(LImg);

  //настраиваем параметры вывода текста
  ts:=img.Picture.Bitmap.Canvas.TextStyle;
  ts.SingleLine:=false;
  ts.Alignment:=taLeftJustify;
  ts.Layout:=tlTop;

  img.Picture.Bitmap.Canvas.Font.Size:=80;
  img.Picture.Bitmap.Canvas.Font.Quality:=fqCleartypeNatural;
  img.Picture.Bitmap.Canvas.Font.Color:=clRed;
  img.Picture.Bitmap.Canvas.TextRect(Rect(0,0,Image1.Width,Image1.Height),0,0,'TEST',ts);

  //копируем обратно из TImage в вампировский TMultiImage
  LImg.Assign(img.Picture.Graphic);

  //выводим на форму то что получилось
  UpdateView(LImg);
end;


полная демка, вроде должна работать, ничего доустонавливать ненадо
https://yadi.sk/d/HByIdtJK3TBVue

Сейчас набегут художники и научат как правильно... только пжст без гитар и прочих камертонов))
zub
долгожитель
 
Сообщения: 2389
Зарегистрирован: 14.11.2005 23:51:26

Re: Надпись на картинке Vampyre Imaging

Сообщение pupsik » 09.03.2018 14:32:30

zub если память не изменяет: в либле есть класс канвы.
{
FBitmap: TImagingBitmap;
FImage: TMultiImage;
FImageCanvas: TImagingCanvas; //вот и малюйте в нём
}
pupsik
энтузиаст
 
Сообщения: 1111
Зарегистрирован: 20.08.2014 16:20:13

Re: Надпись на картинке Vampyre Imaging

Сообщение vitaly_l » 09.03.2018 14:53:00

zub писал(а):Сейчас набегут художники и научат как правильно... только пжст без гитар и прочих камертонов))


1) Создаёшь битмапку и нарисовав на ней текст, загружаешь её в image.

2)
пжст без гитар и прочих балалаек

Ты не ценишь настоящее искусство!

Добавлено спустя 333 минут 333 секунд:
3)
Код: Выделить всё
procedure TForm1.UpdateView(pic:TMultiImage);
var
  ts:TTextStyle;
begin
  if not assigned(Image1.Picture.Graphic) then
    Image1.Picture.Graphic:=TImagingBitmap.Create;
  Image1.Picture.Bitmap.Assign(pic); // это лишнее Image1 - всё умеет

  // ! => Image1.Picture.LoadFromFile('Weave.jpeg'); // замени на нормальную картинку с балалайкой! ;)

  ts:=Image1.Picture.Bitmap.Canvas.TextStyle;

  Image1.Canvas.Font.Size:=111;
  Image1.Canvas.Font.Quality:=fqCleartypeNatural;
  Image1.Canvas.Font.Color:=clRed;
  Image1.Canvas.TextRect(Rect(0,0,Image1.Width,Image1.Height),0,0,'TEST',ts);

  Image1.Proportional := False;
  Image1.Stretch := False;
end;

procedure TForm1.onCreateHandler(Sender: TObject);
begin
  try
    if not assigned(LImg) then
      LImg:=TMultiImage.create;
    LImg.Width:=Width;
    LImg.Height:=Height;
   // LImg.LoadMultiFromFile('Weave.jpeg');
  except
    //MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
    //OutputForm.Img.CreateFromParams(32, 32, ifA8R8G8B8, 1);
  end;

  UpdateView(LImg);
end;     
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Надпись на картинке Vampyre Imaging

Сообщение zub » 09.03.2018 16:22:38

pupsik
TImagingCanvas не умеет текстовые примитивы, только простейшие геометрические

vitaly_l
>>3)
Надпись нужна в картинке, минуя экран, хотел отделаться консольным приложением (без "экранных" и совместимых контекстов), но видимо по простому не получится
zub
долгожитель
 
Сообщения: 2389
Зарегистрирован: 14.11.2005 23:51:26

Re: Надпись на картинке Vampyre Imaging

Сообщение vitaly_l » 09.03.2018 16:30:39

zub писал(а):Надпись нужна в картинке, минуя экран, хотел отделаться консольным приложением (без "экранных" и совместимых контекстов), но видимо по простому не получится

Там какая-то хрень происходит после того как картинка подгружается. Если рисовать без картинки, то всё работает и текст красного цвета (см. пример кода). А после загрузки картинки, image "глючит", видимо картинка что-то там прописывает. Поэтому, рисуй всё на обычной TBitmap и будет тебе счастье.
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Надпись на картинке Vampyre Imaging

Сообщение zub » 09.03.2018 16:45:08

>>image "глючит", видимо ... что-то там ...
Всех переглючило, а художников нет))
повторяю:
Надпись нужна в картинке, минуя экран, хотел отделаться консольным приложением (без "экранных" и совместимых контекстов), но видимо по простому не получится


Добавлено спустя 3 минуты 4 секунды:
ладно, с отсутствием алиасинга я готов смириться, но цвет нужен((
zub
долгожитель
 
Сообщения: 2389
Зарегистрирован: 14.11.2005 23:51:26

Re: Надпись на картинке Vampyre Imaging

Сообщение vitaly_l » 09.03.2018 16:59:46

zub писал(а):повторяю:
Надпись нужна в картинке, минуя экран, хотел отделаться консольным приложением (без "экранных" и совместимых контекстов), но видимо по простому не получится

повторю, рисуй на обычной битмапке, как настоящий Художник:
Код: Выделить всё
var
  ts:TTextStyle;
  bmp:TBitmap;
begin
  Image1.Picture.LoadFromFile('balalayka.bmp');
  bmp:=TBitmap.Create;
  bmp.Height:=Height;
  bmp.Width:=Width;
  ts:=bmp.Canvas.TextStyle;

  bmp.Assign(Image1.Picture.Bitmap);

  bmp.Canvas.Font.Size:=111;
  bmp.Canvas.Font.Quality:=fqCleartypeNatural;
  bmp.Canvas.Font.Color:=clRed;
  bmp.Canvas.TextRect(Rect(0,0,bmp.Width,bmp.Height),0,0,'TEST',ts);
  Image1.Picture.Bitmap.Assign(bmp);


:!: И не забудь освободить битмапку, как настоящий Программист.

.
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Надпись на картинке Vampyre Imaging

Сообщение zub » 09.03.2018 17:44:13

vitaly_l
виталик, ты как клоун. давай уже исправляйся

Проблема оказалась чуток не тут. если LImg сохранить в файл, то там надпись красная :shock:
для эксперимента в исходном примере замените onCreateHandler на
Код: Выделить всё
procedure TForm1.onCreateHandler(Sender: TObject);
var
  img:TImage;
  ts:TTextStyle;
begin
  try
    if not assigned(LImg) then
      LImg:=TMultiImage.create;
    LImg.LoadMultiFromFile('Weave.jpeg');
  except
    //MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
    //OutputForm.Img.CreateFromParams(32, 32, ifA8R8G8B8, 1);
  end;

  //копируем из вампировского TMultiImage в TImage
  img:=TImage.Create(nil);
  if not assigned(img.Picture.Graphic) then
    img.Picture.Graphic:=TImagingBitmap.Create;
  img.Picture.Graphic.Assign(LImg);

  //настраиваем параметры вывода текста
  ts:=img.Picture.Bitmap.Canvas.TextStyle;
  ts.SingleLine:=false;
  ts.Alignment:=taLeftJustify;
  ts.Layout:=tlTop;

  img.Picture.Bitmap.Canvas.Font.Size:=80;
  img.Picture.Bitmap.Canvas.Font.Quality:=fqCleartypeNatural;
  img.Picture.Bitmap.Canvas.Font.Color:=clRed;
  img.Picture.Bitmap.Canvas.TextRect(Rect(0,0,Image1.Width,Image1.Height),0,0,'TEST',ts);

  //копируем обратно из TImage в вампировский TMultiImage
  LImg.Assign(img.Picture.Graphic);
  //сохраняем что у нас там получилось
  LImg.SaveMultiToFile('out.jpg');

  //выводим на форму то что получилось
  UpdateView(LImg);
end;

как это объяснить?
Вложения
Снимок.JPG
zub
долгожитель
 
Сообщения: 2389
Зарегистрирован: 14.11.2005 23:51:26

Re: Надпись на картинке Vampyre Imaging

Сообщение vitaly_l » 09.03.2018 18:01:47

zub писал(а):как это объяснить?

Маска. Там какая-то маска. Понимаешь зачем в тексте маска? Даю подсказку => прозрачность / заливка.

zub писал(а):виталик, ты как клоун. давай уже исправляйся

Сам ты клоун, сам и исправляйся. Вместо того чтобы взять обычную TBitmap,
веселишь народ, грузишь сторонние приблуды для рисования слова "тест".

zub писал(а):если LImg сохранить в файл, то там надпись красная

Сделай как написано, и там и там текст будет красным.
Код: Выделить всё
var
  ts:TTextStyle;
  bmp:TBitmap;
begin
  Image1.Picture.LoadFromFile('balalayka.jpg');
  bmp:=TBitmap.Create;
  bmp.Height:=Height;
  bmp.Width:=Width;
  ts:=bmp.Canvas.TextStyle;

  bmp.Assign(Image1.Picture.Bitmap);

  bmp.Canvas.Font.Size:=111;
  bmp.Canvas.Font.Quality:=fqCleartypeNatural;
  bmp.Canvas.Font.Color:=clRed;
  bmp.Canvas.TextRect(Rect(0,0,bmp.Width,bmp.Height),0,0,'TEST',ts);
  Image1.Picture.Bitmap.Assign(bmp);


PS: И не забудь освободить битмапку...
Вложения
zub.JPG
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Надпись на картинке Vampyre Imaging

Сообщение zub » 09.03.2018 23:59:05

>>image "глючит", видимо картинка что-то там прописывает
>>Там какая-то хрень происходит после того как картинка подгружается
>>Там какая-то маска.
Если бы меня устраивали такие ответы я бы не создавал тем на форуме

>>Понимаешь зачем в тексте маска?
нет, не понимыю. я непросил никаких масок
>>Даю подсказку => прозрачность / заливка.
Видищь сусликов? где там какие прозрачности и заливки?

>>Сделай как написано, и там и там текст будет красным.
Как надо сделать описано в первом посте. Есть TMultiImage с картинкой, в него надо вписать цветной текст и отдать обратно. ферштейн?
Ты пишешь текст на экранный канвас, мне нужно писать на "чтото" в памяти, не асоциированое с устройством отображения. ферштейн?
zub
долгожитель
 
Сообщения: 2389
Зарегистрирован: 14.11.2005 23:51:26

Re: Надпись на картинке Vampyre Imaging

Сообщение Cheb » 10.03.2018 00:39:53

zub, поступай как я и не корми:
Автором этого сообщения является vitaly_l, находящийся в вашем чёрном списке. Показать это сообщение.


По теме: не знал, что Vampyre такое умеет, я как взял версию 0.24.3 от июня 2007-го, так на ней и сижу, потихоньку фикся откровенные баги типа ptruint = cardinal
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 631
Зарегистрирован: 06.06.2005 15:54:34

Re: Надпись на картинке Vampyre Imaging

Сообщение vitaly_l » 10.03.2018 03:49:33

zub писал(а):Как надо сделать описано в первом посте. Есть TMultiImage с картинкой, в него надо вписать цветной текст и отдать обратно. ферштейн?
Ты пишешь текст на экранный канвас, мне нужно писать на "чтото" в памяти, не асоциированое с устройством отображения. ферштейн?

Это наверное очень удивит, но стоит мне загрузить ваш проект, как перестаёт работать Timage. Однако, если я создаю новый проект, загружаю картинку и там рисую текст в Timage, то он рисуется красным на картинке. Но стоит мне тоже самое сделать в вашем проекте, как текст начинает рисоваться белым. Вы как-то там поломали Timage или точнее какие-то запчасти от него, когда подключали Vampyre. Я при тесте Timage даже не подгружаю TMultiImage в вашем проекте и закомментировал его юниты, но всё равно если беру ваш проект то рисуется белым. А если создаю новый проект, то в Timage всё работает и текст рисуется красным. ферштейн, кто всё поломал? :wink:

Добавлено спустя 111 час 111 минут 111 секунд:
zub писал(а):Проблема оказалась чуток не тут. если LImg сохранить в файл, то там надпись красная

Попробуйте сохранить img и удивитесь ещё больше, т.к. текст вообще будет то серым, то красным (в зависимости где смотреть). Такое возможно из-за разной битности или иных цветовых установок у Vampyre и TImage. И похоже Vampyre, как-то "подменил" установки битности по умолчанию у TImage и последнего от этого сильно глючит, тогда дело не в маске а в битности. Короче проблема в разной битности получаемых и обрабатываемых картинок, т.к. лазарус по умолчанию работает только с 24 битами, а Vampyre с 32. + ещё маска
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Надпись на картинке Vampyre Imaging

Сообщение pupsik » 10.03.2018 14:40:16

Художники, однако :)

Добавлено спустя 2 часа 48 минут 59 секунд:
Немного попробую пояснить.
Сам вампир предназначен для просмотра изображения. Его битмап только показывает что в TMultiImage (не только) загружено. Т.е. работа с битмапом - сродни кощунству (по логике). Всё должно быть через TImagingCanvas. Поэтому и такое странное поведение. Вроде есть, а цвета нет. И, возможно, баг в самой вампирке (хотя... если битмап только для отображения... не будет это поведение багом... баг - то что показывает текст).

Верно подмечено:
TImagingCanvas не умеет текстовые примитивы, только простейшие геометрические
не только... А вот с текстом, вроде как, не умеет. Вполне возможно можно научить. Но это ещё один велик (ведь есть внутренние наборы и bgra, и agg).

То что хочет zub схоже на работу со слоями. Но опять нюанс - не работает с текстом. Сможете нарисовать текст в TSingleImage используя канву вампира. Сможете и совместить изображения, или работать с самим изображением. Т.о. получится ферштейн:
мне нужно писать на "чтото" в памяти, не асоциированое с устройством отображения. ферштейн?


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

Добавлено спустя 1 час 44 минуты 20 секунд:
походу ошибся я в суждениях. На оф форуме советуют рисовать буковки на TImagingBitmap . Оно то рисует, но...
Код: Выделить всё
  FIm.SaveMultiToFile('im' + '.' + Fext);//сохраняет всё нормально... т.е. можно и в основном битмапе такое делать
  FImage.AssignFromArray(Fim.DataArray);//этих методов хоть греблю гати, а толку нет.
  FImage.SaveMultiToFile('fim' + '.' + Fext);//сохраняет всё нормально
  Image1.Picture.Graphic.Assign(FImage);  //серая мышЬ

И схожие попытки выдают интереснейшую цветовую гамму :mrgreen:

И более/менее костыль - сбрасывать в поток и оттуда тянуть.
Шо ж там так закручено что "теряет" цвет при игре с битмапом?
Вложения
vampire_text.7z
В корне не верно.. Но.. :)
(60.45 КБ) Скачиваний: 24
pupsik
энтузиаст
 
Сообщения: 1111
Зарегистрирован: 20.08.2014 16:20:13

Re: Надпись на картинке Vampyre Imaging

Сообщение zub » 13.03.2018 01:02:40

Ковыряния показали - проблема связана с альфаканалом, на этапе
Код: Выделить всё
TPicture.Graphic.Assign(TMultiImage);

т.е. при копировании из TMultiImage в TPicture добавляется альфаканал, заполняемый значением 255. если исходники Vampyre поправить и заполнить альфу нулем, то все начинает работать.

Это ведь не баг, как можно обойти без правки Vampyre?

Добавлено спустя 11 минут 48 секунд:
>>S: И не забудь освободить битмапку...
Проблема совсем не в освобождении чегото, мемлики будут пофикшены позже - на этапе отладки. в минидемке уж извини, цель показать проблему, а не прослезить художников идеальным кодом

>>А если создаю новый проект, то в Timage всё работает и текст рисуется красным. ферштейн, кто всё поломал? :wink:
В твоем высокохудожестваенном ничегонеломающем проекте timage формощлепнуто. в моем кривущем и забагованном timage создается в рантайме и не асоциирована формой. вот и вся разница. или нет?
zub
долгожитель
 
Сообщения: 2389
Зарегистрирован: 14.11.2005 23:51:26

Re: Надпись на картинке Vampyre Imaging

Сообщение pupsik » 13.03.2018 02:20:23

zub а вы нахал, однако, барин... Доковыряли всё же :)
Вложения
vampire_text_good.7z
Так?
(60.58 КБ) Скачиваний: 20
pupsik
энтузиаст
 
Сообщения: 1111
Зарегистрирован: 20.08.2014 16:20:13

След.

Вернуться в Общее

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 7

Рейтинг@Mail.ru