327 lines
13 KiB
ObjectPascal
327 lines
13 KiB
ObjectPascal
|
unit Unit1;
|
||
|
|
|
||
|
|
interface
|
||
|
|
{==============================================================================}
|
||
|
|
{ Demo: }
|
||
|
|
{ 1. how to load RVF file saved in demo editor. }
|
||
|
|
{ 2. HTML export with custom saving of images }
|
||
|
|
{------------------------------------------------------------------------------}
|
||
|
|
{ Note: Gif images have 256 colors or less. Some pictures may lose quality }
|
||
|
|
{ when converting to Gifs }
|
||
|
|
{------------------------------------------------------------------------------}
|
||
|
|
{ Sergey Tkachenko }
|
||
|
|
{==============================================================================}
|
||
|
|
|
||
|
|
uses
|
||
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||
|
|
RVScroll, RichView, StdCtrls, ExtCtrls, RVStyle, OleCtnrs,
|
||
|
|
ImgList,
|
||
|
|
GifImg, ComCtrls, CRVData, CRVFData, RVTable, RVTypes;
|
||
|
|
|
||
|
|
type
|
||
|
|
TForm1 = class(TForm)
|
||
|
|
RichView1: TRichView;
|
||
|
|
OpenDialog1: TOpenDialog;
|
||
|
|
Panel1: TPanel;
|
||
|
|
Button1: TButton;
|
||
|
|
StatusBar1: TStatusBar;
|
||
|
|
Button2: TButton;
|
||
|
|
CheckBox1: TCheckBox;
|
||
|
|
SaveDialog1: TSaveDialog;
|
||
|
|
Label1: TLabel;
|
||
|
|
Edit1: TEdit;
|
||
|
|
Label2: TLabel;
|
||
|
|
Edit2: TEdit;
|
||
|
|
ImageList1: TImageList;
|
||
|
|
RVStyle1: TRVStyle;
|
||
|
|
procedure Button1Click(Sender: TObject);
|
||
|
|
procedure RichView1RVFImageListNeeded(Sender: TCustomRichView;
|
||
|
|
ImageListTag: Integer; var il: TCustomImageList);
|
||
|
|
procedure FormCreate(Sender: TObject);
|
||
|
|
procedure RichView1RVMouseMove(Sender: TObject; id: Integer);
|
||
|
|
procedure RichView1Jump(Sender: TObject; id: Integer);
|
||
|
|
procedure RichView1HTMLSaveImage(Sender: TCustomRichView;
|
||
|
|
RVData: TCustomRVData; ItemNo: Integer; const Path: String;
|
||
|
|
BackgroundColor: TColor; var Location: String;
|
||
|
|
var DoDefault: Boolean);
|
||
|
|
procedure Button2Click(Sender: TObject);
|
||
|
|
procedure RichView1SaveComponentToFile(Sender: TCustomRichView; Path: string;
|
||
|
|
SaveMe: TPersistent; SaveFormat: TRVSaveFormat; var OutStr: string);
|
||
|
|
procedure RichView1SaveHTMLExtra(Sender: TCustomRichView;
|
||
|
|
Area: TRVHTMLSaveArea; CSSVersion: Boolean; var HTMLCode: String);
|
||
|
|
procedure RichView1WriteHyperlink(Sender: TCustomRichView; id: Integer;
|
||
|
|
RVData: TCustomRVData; ItemNo: Integer; SaveFormat: TRVSaveFormat;
|
||
|
|
var Target, Extras: String);
|
||
|
|
private
|
||
|
|
{ Private declarations }
|
||
|
|
public
|
||
|
|
{ Public declarations }
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
Form1: TForm1;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
{$R *.DFM}
|
||
|
|
|
||
|
|
{==================== Notes about loading from RVF files:=======================
|
||
|
|
1. In the simplest cases you can just write: RichView1.LoadRVF(<file name>);
|
||
|
|
2. If file contains inserted Delphi Controls, these controls must be registered
|
||
|
|
with RegisterClasses functions before loading (see FormCreate below)
|
||
|
|
3. If file contains images from image lists, you need to process
|
||
|
|
OnRVFImageListNeeded event (see RichView1RVFImageListNeeded below)
|
||
|
|
If you have several image lists, you can distinguish them using
|
||
|
|
ImageListTag parameter of this event.
|
||
|
|
4. You must have the same (or compatible) TRVStyle object assigned to
|
||
|
|
RichView1.Style as in editor.
|
||
|
|
Otherwise, you need to set option "Allow adding styles dynamically"
|
||
|
|
both in richview which saves and in richview which loads RVF
|
||
|
|
(right-click RichView in Delphi, choose "Settings" in the context menu)
|
||
|
|
5. If some items in RVF file have character strings associated as items' tags
|
||
|
|
(rvoTagsArePChars was in editor's Options), you need also set rvoTagsArePChars
|
||
|
|
in RichView1.Options.
|
||
|
|
===============================================================================}
|
||
|
|
{===================== Notes about HTML export =================================
|
||
|
|
1. There are 2 methods for saving HTML files:
|
||
|
|
a) SaveHTML - saving HTML file, where formatting is made by <FONT>,<B>,
|
||
|
|
<I> tags, etc.
|
||
|
|
b) SaveHTMLEx - saving HTML file, where formatting is made by Cascading
|
||
|
|
Style Sheet (CSS).
|
||
|
|
2. Images are saved in separate files. By default, they are saved as JPEGs.
|
||
|
|
3. By default, images are saved in the same directory as HTML file, and have
|
||
|
|
names built as Prefix + Number + .JPG.
|
||
|
|
You can specify your own prefix as a parameter of SaveHTML[Ex].
|
||
|
|
You can include subdirectory in prefix (such as 'images\img'), but this
|
||
|
|
subdirectory will NOT be created automatically.
|
||
|
|
4. JPEGs do not support transparency. Transparent color (of metafiles,
|
||
|
|
icons, imagelist images) is replaced with the current background color
|
||
|
|
(of RichView or table cell or paragraph background)
|
||
|
|
5. By default, images from imagelists (bullets and hotspot) are saved like
|
||
|
|
other images, but the same image saved only one time (next occurrences
|
||
|
|
point to the same image file, if they have the same background color)
|
||
|
|
6. You can save images yourself using OnHTMLSaveImage event.
|
||
|
|
You need to store image to file and return its location in 'Location'
|
||
|
|
parameter.
|
||
|
|
This demo shows
|
||
|
|
a) how to save images in GIF-files
|
||
|
|
b) how to save bullets in a way allowing to use the same image files for
|
||
|
|
the whole HTML document generated by your application.
|
||
|
|
7. By default hypertext is not saved.
|
||
|
|
You can specify destinations of [some/all] hypertext jumps
|
||
|
|
using OnWriteHyperlink event.
|
||
|
|
8. By default inserted controls are not saved.
|
||
|
|
You can save them using OnSaveComponentToFile event
|
||
|
|
9. You can save additional information in OnSaveHTMLExtra.
|
||
|
|
===============================================================================}
|
||
|
|
|
||
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
||
|
|
begin
|
||
|
|
RegisterClasses([TButton, TEdit, TOleContainer]);
|
||
|
|
OpenDialog1.InitialDir := ExtractFilePath(Application.ExeName)+'..\..\Editors\Editor 1\';
|
||
|
|
end;
|
||
|
|
|
||
|
|
{============================== RVF loading ===================================}
|
||
|
|
procedure TForm1.Button1Click(Sender: TObject);
|
||
|
|
begin
|
||
|
|
if OpenDialog1.Execute then begin
|
||
|
|
if not RichView1.LoadRVF(OpenDialog1.FileName) then
|
||
|
|
Application.MessageBox('Error Loading File', nil, MB_OK);
|
||
|
|
RichView1.Format;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
{------------------------------------------------------------------------------}
|
||
|
|
procedure TForm1.RichView1RVFImageListNeeded(Sender: TCustomRichView;
|
||
|
|
ImageListTag: Integer; var il: TCustomImageList);
|
||
|
|
begin
|
||
|
|
il := ImageList1;
|
||
|
|
end;
|
||
|
|
{============================ Hypertext testing ===============================}
|
||
|
|
procedure TForm1.RichView1RVMouseMove(Sender: TObject; id: Integer);
|
||
|
|
var RVData: TCustomRVFormattedData;
|
||
|
|
ItemNo: Integer;
|
||
|
|
begin
|
||
|
|
if id=-1 then
|
||
|
|
StatusBar1.SimpleText := ''
|
||
|
|
else begin
|
||
|
|
RichView1.GetJumpPointLocation(id, RVData, ItemNo);
|
||
|
|
StatusBar1.SimpleText := PChar(RVData.GetItemTag(ItemNo));
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
{------------------------------------------------------------------------------}
|
||
|
|
procedure TForm1.RichView1Jump(Sender: TObject; id: Integer);
|
||
|
|
var RVData: TCustomRVFormattedData;
|
||
|
|
ItemNo: Integer;
|
||
|
|
begin
|
||
|
|
RichView1.GetJumpPointLocation(id, RVData, ItemNo);
|
||
|
|
StatusBar1.SimpleText := PChar(RVData.GetItemTag(ItemNo));
|
||
|
|
Application.MessageBox(PChar(StatusBar1.SimpleText),'Click', 0);
|
||
|
|
end;
|
||
|
|
{============================ SAVING TO HTML ==================================}
|
||
|
|
procedure TForm1.Button2Click(Sender: TObject);
|
||
|
|
var SaveOptions: TRVSaveOptions;
|
||
|
|
var r: Boolean;
|
||
|
|
begin
|
||
|
|
if SaveDialog1.Execute then begin
|
||
|
|
Screen.Cursor := crHourglass;
|
||
|
|
if Checkbox1.Checked then
|
||
|
|
SaveOptions := [rvsoOverrideImages, rvsoUTF8]
|
||
|
|
else
|
||
|
|
SaveOptions := [rvsoUTF8];
|
||
|
|
case SaveDialog1.FilterIndex of
|
||
|
|
1:
|
||
|
|
r := RichView1.SaveHTML(SaveDialog1.FileName,
|
||
|
|
'Demo File',Edit2.Text, SaveOptions);
|
||
|
|
2:
|
||
|
|
r := RichView1.SaveHTMLEx(SaveDialog1.FileName,
|
||
|
|
'Demo File',Edit1.Text, '','','',SaveOptions);
|
||
|
|
else
|
||
|
|
r := False;
|
||
|
|
end;
|
||
|
|
Screen.Cursor := crDefault;
|
||
|
|
if not r then
|
||
|
|
Application.MessageBox('Error during saving', 'Error', 0);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
{------------------------------------------------------------------------------}
|
||
|
|
// Event: overriding default saving of images: saving as Gifs
|
||
|
|
procedure TForm1.RichView1HTMLSaveImage(Sender: TCustomRichView;
|
||
|
|
RVData: TCustomRVData; ItemNo: Integer; const Path: String;
|
||
|
|
BackgroundColor: TColor; var Location: String; var DoDefault: Boolean);
|
||
|
|
var gif: TGifImage;
|
||
|
|
wmf: TMetafile;
|
||
|
|
gr: TGraphic;
|
||
|
|
s: TRVAnsiString;
|
||
|
|
AVAlign: TRVVAlign;
|
||
|
|
ATag: Integer;
|
||
|
|
ImageList: TCustomImageList;
|
||
|
|
ImageIndex: Integer;
|
||
|
|
Canvas: TMetafileCanvas;
|
||
|
|
begin
|
||
|
|
// Parameters:
|
||
|
|
//The item to save is defined by the pair (RVData, ItemNo).
|
||
|
|
// It is the ItemNo-th item in RVData object.
|
||
|
|
// RVData may be RichView.RVData, or cell, or RVData of cell inplace editor.
|
||
|
|
// Path - destination directory of HTML file.
|
||
|
|
// BackgroundColor - color of background under this item. Not used here
|
||
|
|
// because GIFs support a true transparency.
|
||
|
|
// Location - output parameter to specify filename of image file
|
||
|
|
// DoDefault - set to false if you save this item as image yourself.
|
||
|
|
if ItemNo<0 then begin
|
||
|
|
// saving background
|
||
|
|
gif := TGifImage.Create;
|
||
|
|
try
|
||
|
|
gif.ColorReduction := rmQuantize;
|
||
|
|
if RVData is TRVTableCellData then
|
||
|
|
gif.Assign(TRVTableCellData(RVData).BackgroundImage) // table cell background
|
||
|
|
else
|
||
|
|
gif.Assign(Sender.BackgroundBitmap); // document background
|
||
|
|
Location := RVData.GetNextFileName(Edit2.Text, Path, '.gif', RichView1.imgSaveNo, Checkbox1.Checked);
|
||
|
|
gif.SaveToFile(Location);
|
||
|
|
Location := ExtractRelativePath(Path, Location);
|
||
|
|
DoDefault := False;
|
||
|
|
finally
|
||
|
|
gif.Free;
|
||
|
|
end;
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
gif := nil;
|
||
|
|
case RVData.GetItemStyle(ItemNo) of
|
||
|
|
rvsPicture, rvsHotPicture:
|
||
|
|
begin
|
||
|
|
// Assigning image to GIF and saving
|
||
|
|
// (metafiles and icons will be saved with transparency)
|
||
|
|
gif := TGifImage.Create;
|
||
|
|
gif.ColorReduction := rmQuantizeWindows;
|
||
|
|
RVData.GetPictureInfo(ItemNo, s, gr, AVAlign, ATag);
|
||
|
|
gif.Assign(gr);
|
||
|
|
Location := RVData.GetNextFileName(Edit2.Text, Path, '.gif', RichView1.imgSaveNo, Checkbox1.Checked);
|
||
|
|
end;
|
||
|
|
rvsTable:
|
||
|
|
begin
|
||
|
|
// Saving table background image
|
||
|
|
gif := TGifImage.Create;
|
||
|
|
gif.ColorReduction := rmQuantizeWindows;
|
||
|
|
gif.Assign(TRVTableItemInfo(RVData.GetItem(ItemNo)).BackgroundImage);
|
||
|
|
Location := RVData.GetNextFileName(Edit2.Text, Path, '.gif', RichView1.imgSaveNo, Checkbox1.Checked);
|
||
|
|
end;
|
||
|
|
rvsBullet, rvsHotspot:
|
||
|
|
begin
|
||
|
|
// This is not efficient way, because the same image will be
|
||
|
|
// saved many times. In your application you can save bullets
|
||
|
|
// before saving HTMLs, and here only return file name.
|
||
|
|
RVData.GetBulletInfo(ItemNo, s, ImageIndex, ImageList, ATag);
|
||
|
|
wmf := TMetafile.Create;
|
||
|
|
try
|
||
|
|
gif := TGifImage.Create;
|
||
|
|
gif.ColorReduction := rmQuantizeWindows;
|
||
|
|
// Drawing image from imagelist to metafile
|
||
|
|
// This method allows to save transparency
|
||
|
|
wmf.Width := TImageList(ImageList).Width;
|
||
|
|
wmf.Height := TImageList(ImageList).Height;
|
||
|
|
Canvas := TMetafileCanvas.Create(wmf, 0);
|
||
|
|
ImageList.Draw(Canvas,0,0, ImageIndex);
|
||
|
|
Canvas.Free;
|
||
|
|
// Assigning metafile to GIF and saving
|
||
|
|
gif.Assign(wmf);
|
||
|
|
// Saving to Path + Bullets Prefix + ImageIndex + .gif
|
||
|
|
Location := Format('%s%s%d.gif', [Path, Edit1.Text, ImageIndex]);
|
||
|
|
finally
|
||
|
|
wmf.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
// List markers can also have pictures. Not processed in this demo
|
||
|
|
end;
|
||
|
|
if gif<>nil then begin
|
||
|
|
gif.SaveToFile(Location);
|
||
|
|
Location := ExtractRelativePath(Path, Location);
|
||
|
|
DoDefault := False;
|
||
|
|
gif.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
{------------------------------------------------------------------------------}
|
||
|
|
// Event: saving hyperlinks
|
||
|
|
procedure TForm1.RichView1WriteHyperlink(Sender: TCustomRichView;
|
||
|
|
id: Integer; RVData: TCustomRVData; ItemNo: Integer;
|
||
|
|
SaveFormat: TRVSaveFormat; var Target, Extras: String);
|
||
|
|
begin
|
||
|
|
Target := PChar(RVData.GetItemTag(ItemNo));
|
||
|
|
end;
|
||
|
|
{------------------------------------------------------------------------------}
|
||
|
|
// Event: saving components
|
||
|
|
procedure TForm1.RichView1SaveComponentToFile(Sender: TCustomRichView;
|
||
|
|
Path: string; SaveMe: TPersistent; SaveFormat: TRVSaveFormat;
|
||
|
|
var OutStr: string);
|
||
|
|
begin
|
||
|
|
case SaveFormat of
|
||
|
|
rvsfHTML:
|
||
|
|
begin
|
||
|
|
if SaveMe is TButton then begin
|
||
|
|
OutStr := '<input type="button" value="'+TButton(SaveMe).Caption+'" '+
|
||
|
|
'onClick="alert(''Just a demo'')">';
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
if SaveMe is TEdit then begin
|
||
|
|
OutStr := '<input type="text" value="'+TEdit(SaveMe).Text+'">';
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
{------------------------------------------------------------------------------}
|
||
|
|
// Event: saving additional information
|
||
|
|
procedure TForm1.RichView1SaveHTMLExtra(Sender: TCustomRichView;
|
||
|
|
Area: TRVHTMLSaveArea; CSSVersion: Boolean; var HTMLCode: String);
|
||
|
|
begin
|
||
|
|
case Area of
|
||
|
|
rv_thms_Head:
|
||
|
|
HTMLCode := '<script></script>';
|
||
|
|
rv_thms_BodyAttribute:
|
||
|
|
HTMLCode := 'alink=#ff0000';
|
||
|
|
rv_thms_Body:
|
||
|
|
HTMLCode := 'This document was generated by '+
|
||
|
|
'<A href="http://www.trichview.com">RichView</A><BR>';
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|