{*******************************************************}
{                                                       }
{       RichView                                        }
{       Custom hints demo                               }
{       For Delphi 2009+                                }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       svt@trichview.com                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}

// Property settings:
// RichViewEdit1.ShowHints = True
// rvoShowItemHints in RichViewEdit1.Options
// RichViewEdit1.CustomHint = BalloonHint1

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList, RVStyle, RVScroll, RichView, RVEdit, CRVData, RVItem,
  Jpeg, GifImg, PngImage, RVTypes, ExtCtrls;

type
  TForm1 = class(TForm)
    BalloonHint1: TBalloonHint;
    ImageList1: TImageList;
    RichViewEdit1: TRichViewEdit;
    RVStyle1: TRVStyle;
    Image1: TImage;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure RichViewEdit1ItemHint(Sender: TCustomRichView;
      RVData: TCustomRVData; ItemNo: Integer; var HintText: string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var gr: TGraphic;
begin
  RichViewEdit1.Clear;
  RichViewEdit1.AddNL('Custom Hints', 1, 1);
  RichViewEdit1.AddNL('Hyperlinks: ', 0, 0);
  RichViewEdit1.AddNLTag('trichview.com', 2, -1, Integer(StrNew('http://www.trichview.com')));
  RichViewEdit1.SetItemExtraStrProperty(RichViewEdit1.ItemCount-1, rvespHint, 'TRichView homepage');

  RichViewEdit1.AddNL('Hypertext pictures: ', 0, 0);
  gr := TBitmap.Create;
  gr.Assign(Image2.Picture.Graphic);
  RichViewEdit1.AddHotPictureTag('',  gr, -1, rvvaAbsMiddle, Integer(StrNew('http://en.wikipedia.org/wiki/Greek_alphabet')));
  RichViewEdit1.SetItemExtraStrProperty(RichViewEdit1.ItemCount-1, rvespHint, 'Αβγ');

  RichViewEdit1.AddNL('Pictures: ', 0, 0);
  gr := TIcon.Create;
  gr.Assign(Image1.Picture.Graphic);
  RichViewEdit1.AddPictureEx( '',  gr, -1, rvvaAbsMiddle);
  RichViewEdit1.SetItemExtraStrProperty(RichViewEdit1.ItemCount-1, rvespHint, 'Солнце'); // "Sun" in Russian

  RichViewEdit1.Format;
end;
{------------------------------------------------------------------------------}
function GetGraphicFormatName(gr: TGraphic): String;
begin
  if gr is TBitmap then
    Result := 'Windows bitmap'
  else if gr is TIcon then
    Result := 'Icon'
  else if gr is TMetafile then
    Result := 'Windows metafile'
  else if gr is TJpegImage then
    Result := 'JPEG image'
  else if gr is TGifImage then
    Result := 'GIF image'
  else if gr is TPngImage then
    Result := 'PNG image'
  else
    Result := 'Unknown image format';
end;
{------------------------------------------------------------------------------}
{ OnItemHint event }
procedure TForm1.RichViewEdit1ItemHint(Sender: TCustomRichView;
  RVData: TCustomRVData; ItemNo: Integer; var HintText: string);
var DefaultHint, Target, PicDetails: String;
  i, Tag: Integer;
  ItemName: TRVAnsiString;
  Align: TRVVAlign;
  Graphic: TGraphic;
begin
  DefaultHint := HintText;
  for i := 1 to Length(DefaultHint) do
    if DefaultHint[i]='|' then
      DefaultHint[i] := ' ';
  if DefaultHint<>'' then
    DefaultHint := ': '+DefaultHint;
  if (RVData.GetItemStyle(ItemNo)=rvsPicture) or
     (RVData.GetItemStyle(ItemNo)=rvsHotPicture) then begin
    // image
    RVData.GetPictureInfo(ItemNo, ItemName, Graphic, Align, Tag);
    if RVData.GetItemStyle(ItemNo)=rvsHotPicture then
      Target := '; Target: '+PChar(Tag)
    else
      Target := '';
    PicDetails := Format('%s %d×%d', [GetGraphicFormatName(Graphic),
      Graphic.Width, Graphic.Height]);
    HintText := 'Image'+DefaultHint+'|'+PicDetails+Target+'|1';
    end
  else if RVData.GetItem(ItemNo).GetBoolValueEx(rvbpJump, RVStyle1) then begin
    // hyperlink
    Target := 'Target: '+PChar(RVData.GetItemTag(ItemNo));
    HintText := 'Hyperlink'+DefaultHint+'|'+Target+'|0';
  end;
end;

end.