adding text to an image in SRV page

ScaleRichView support and discussion (TRichView add-on for WYSIWYG editing)
Post Reply
fara2000
Posts: 19
Joined: Mon Sep 07, 2015 5:59 pm

adding text to an image in SRV page

Post by fara2000 »

Hello
assuming I could catch the image item in SRV page by:
Item:=SRV.RichViewEdit.GetItem(ItemNo) as TRVGraphicItemInfo;
How can I combine by code a text(example: 'image no 1' ) to this catched image ?
Thanks in advance
Sergey Tkachenko
Site Admin
Posts: 15960
Joined: Sat Aug 27, 2005 10:28 am
Contact:

Re: adding text to an image in SRV page

Post by Sergey Tkachenko »

Do you want to draw a text on the image (by modifying the image?)
Or do you want to insert text before or after this image?
fara2000
Posts: 19
Joined: Mon Sep 07, 2015 5:59 pm

Re: adding text to an image in SRV page

Post by fara2000 »

I wish drawing atext on the image. I want the text to be a part of the image item
standay
Posts: 73
Joined: Fri Jun 18, 2021 3:07 pm

Re: adding text to an image in SRV page

Post by standay »

Here's one way to do it (note that I'm using a plain TRichViewEdit, not an SRV but it should work the same). You'd have to work out how to size the text, set text color, font and all that in your app:

Code: Select all

var
  i, centerText: integer;
  item: TRVGraphicItemInfo;
  gr: TGraphic;
  grOut: boolean;
  bmp:TBitmap;
begin
  rve.LoadRVF('Image Test.rvf');
  rve.Format;
  for i := 0 to rve.ItemCount-1 do
  begin
    if rve.GetItemStyle(i) = rvsPicture then
    begin
      item := rve.GetItem(i) as TRVGraphicItemInfo;
      item.GraphicHolder.GetGraphicTemporary(gr,grOut);
      bmp := TBitmap.Create;
      bmp.SetSize(gr.Width,gr.Height);
      bmp.Canvas.Brush.Color := clWhite;
      bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
      bmp.Assign(gr);

      bmp.Canvas.Font.Size := 72;
      bmp.Canvas.Font.Color := clBlack;
      bmp.Canvas.Brush.Style := bsClear;

      centerText := (bmp.Width - bmp.Canvas.TextWidth('Image Caption Test')) div 2;
      bmp.Canvas.TextOut(centerText,10,'Image Caption Test');

      bmp.Canvas.Font.Color := clWhite;
      bmp.Canvas.TextOut(centerText-4,10-4,'Image Caption Test');

      gr.Assign(bmp);
      item.GraphicHolder.ReplaceGraphic(gr);
      bmp.Free;
    end;
  end;
end;
Original image (no caption):
before.png
before.png (203.46 KiB) Viewed 675 times
Captioned image:
After.png
After.png (208.03 KiB) Viewed 675 times
Once saved, the caption is no longer editable which may be what you want. If not, you might be better off to add captions in an image app like photoshop or paint shop pro and then insert the image (saving the original image to re-caption later), or just put a formatted text caption below the image so it remains editable. That said, I was surprised how well the code above worked to add a caption!

Stan
Sergey Tkachenko
Site Admin
Posts: 15960
Joined: Sat Aug 27, 2005 10:28 am
Contact:

Re: adding text to an image in SRV page

Post by Sergey Tkachenko »

Thank you very much!

I suggest several corrections:
1) I highly recommend using SetPictureInfo to change pictures. It performs some additional operations (such as updating thumbnails if the image is resized)
2) This procedure does not change pictures in table cells. Recursive calls are needed.
3) This procedure does not process hypertext pictures, because they have different StyleNo. So it's better to check if the item has type TRVGraphicItemInfo.
4) Not all graphic classes can be assigned to TBitmap and back. So I suggest using methods of TRVGraphicHandler (RVGrHandler unit) and try...except.

My code is below:

Code: Select all

procedure AddCaptions(RVData: TCustomRVData);
var
  i, r, c, centerText: integer;
  gr, newgr: TGraphic;
  bmp:TBitmap;
  Table: TRVTableItemInfo;
  GrName: TRVUnicodeString;
  GrVAlign: TRVVAlign;
  GrTag: TRVTag;
begin
  for i := 0 to RVData.ItemCount-1 do
  begin
    if RVData.GetItem(i) is TRVTableItemInfo then
    begin
      Table := TRVTableItemInfo(RVData.GetItem(i));
      for r := 0 to Table.RowCount - 1 do
        for c := 0 to Table.ColCount - 1 do
          AddCaptions(Table.Cells[r,c].GetRVData);
    end
    else if RVData.GetItem(i) is TRVGraphicItemInfo then
    begin
      RVData.GetPictureInfo(i, GrName, Gr, GrVAlign, GrTag);
      newgr := RVGraphicHandler.Clone(gr);
      bmp := RVGraphicHandler.ToBitmap(gr);

      bmp.Canvas.Font.Size := 72;
      bmp.Canvas.Font.Color := clBlack;
      bmp.Canvas.Brush.Style := bsClear;

      centerText := (bmp.Width - bmp.Canvas.TextWidth('Image Caption Test')) div 2;
      bmp.Canvas.TextOut(centerText,10,'Image Caption Test');

      bmp.Canvas.Font.Color := clWhite;
      bmp.Canvas.TextOut(centerText-4,10-4,'Image Caption Test');
      try 
        newgr.Assign(bmp);
        RVData.SetPictureInfo(i, GrName, newgr, GrVAlign, GrTag);
        bmp.Free;
      except
        RVData.SetPictureInfo(i, GrName, bmp, GrVAlign, GrTag);
        newgr.Free;
      end;
    end;
  end;
end;
use:

Code: Select all

AddCaptions(RichViewEdit1.RVData);
standay
Posts: 73
Joined: Fri Jun 18, 2021 3:07 pm

Re: adding text to an image in SRV page

Post by standay »

Thanks Sergey, that's a lot cleaner than what I was trying to do. I made a couple of changes to try and help with some of it. I added a vertical position param. If it's set to -1 it puts the caption at the bottom. I also use my rve current item number so I only change the caption on a selected image. I tried to add some adjustment for font size and drop shadow size. What I put in is better than when I hard coded it, but what I did may not be correct in all circumstances. And, I added an edit box to set the caption text.

The current drawbacks are:
  • Captions are not editable (or undoable) after they are set. One way to get around that would be to insert a new image in place of the original one. You can then set up an undo group. I actually did that before I saw your update, but your update works better.
  • Font size and drop shadow offset are variable depending on how much the image has been resized. In other words, a 12pt caption on one image may look completely different (relatively speaking) when used on another image. I got around that a little with bmp.Canvas.Font.Size := gr.Height div 16
Below is my slightly modified code. Oh, I did this when calling it so it would update immediately:

Code: Select all

  AddCaptions(rve.RVData,-1);
  rve.Reformat;
Stan

Code: Select all

procedure TForm1.AddCaptions(RVData: TCustomRVData; VPos:integer);
var
  i, r, c, centerText, dropShadow: integer;
  gr, newgr: TGraphic;
  bmp:TBitmap;
  Table: TRVTableItemInfo;
  GrName: TRVUnicodeString;
  GrVAlign: TRVVAlign;
  GrTag: TRVTag;
begin

  i := rve.CurItemNo; //my test rve

  if RVData.GetItem(i) is TRVTableItemInfo then
  begin
    Table := TRVTableItemInfo(RVData.GetItem(i));
    for r := 0 to Table.RowCount - 1 do
      for c := 0 to Table.ColCount - 1 do
        AddCaptions(Table.Cells[r,c].GetRVData,VPos);
  end
  else if RVData.GetItem(i) is TRVGraphicItemInfo then
  begin
    RVData.GetPictureInfo(i, GrName, Gr, GrVAlign, GrTag);
    newgr := RVGraphicHandler.Clone(gr);
    bmp := RVGraphicHandler.ToBitmap(gr);

    bmp.Canvas.Font.Size := gr.Height div 16 ;
    bmp.Canvas.Font.Color := clBlack;
    bmp.Canvas.Brush.Style := bsClear;

    dropShadow := bmp.Canvas.Font.Size div 16;
    if dropShadow < 1 then dropShadow := 1;

    //Place caption at bottom:
    if VPos = -1 then
      VPos := bmp.Height - (bmp.Canvas.TextHeight(Edit1.Text) + 10) ;

    centerText := (bmp.Width - bmp.Canvas.TextWidth(Edit1.Text)) div 2;
    bmp.Canvas.TextOut(centerText,VPos,Edit1.Text);

    bmp.Canvas.Font.Color := clWhite;
    bmp.Canvas.TextOut(centerText-dropShadow,VPos-dropShadow,Edit1.Text);

    try
      newgr.Assign(bmp);
      RVData.SetPictureInfo(i, GrName, newgr, GrVAlign, GrTag);
      bmp.Free;
    except
      RVData.SetPictureInfo(i, GrName, bmp, GrVAlign, GrTag);
      newgr.Free;
    end;

  end;

end;
bottom cap.png
bottom cap.png (218.24 KiB) Viewed 662 times
Post Reply