128 lines
4.4 KiB
ObjectPascal
128 lines
4.4 KiB
ObjectPascal
|
{*******************************************************}
|
|||
|
|
{ }
|
|||
|
|
{ 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.
|