{-------------------------------------------------------------------------------
  Working with RVF and RTF files containing shared images.
  This demo stores them in the special subdirectory, but you can store them
  in a database, etc.
  How to save pictures as references in RVF:
    rvfoSavePicturesBody is EXCLUDED from srv.RichViewEdit.RVFOptions.
  How to save pictures as references in RTF:
    see RichViewEdit1SaveItemToFile.
  How to load pictures when reading such RVF files:
    see RichViewEdit1RVFPictureNeeded.
  How to load pictures when reading such RTF files:
    see RichViewEdit1ImportPicture.

  Paths to image file names are stored in rvespImageFileName properties.
  Normally, full paths to images are stored there.
  In this demo, path is stored relative to the application directory.
  Saved RTF and HTML files will be opened normally in other applications
  only if they are stored in the application directory.
-------------------------------------------------------------------------------}
{ This is the second version of this demo.
  Changes:
  - RTF support;
  - HTML saving;  
  - storing file names in rvespImageFileName property instead of item names;
  - storing paths relative to the application path instead of storing just
    file names (allows external applications to open RTF and HTML files
    correctly, if they are saved in the application path)
-------------------------------------------------------------------------------}

{$I RV_Defs.inc}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, RVStyle, RVScroll, RichView, RVEdit, RVFuncs, StdCtrls,
  CRVData, RVTable, RVItem, RVTypes, SclRView;

type
  TForm1 = class(TForm)
    RVStyle1: TRVStyle;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Button3: TButton;
    OpenDialog2: TOpenDialog;
    SaveDialog1: TSaveDialog;
    srv: TSRichViewEdit;
    procedure RichViewEdit1RVFPictureNeeded(Sender: TCustomRichView;
      Name: String; Tag: Integer; var gr: TGraphic);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure RichViewEdit1Copy(Sender: TObject);
    procedure RichViewEdit1ImportPicture(Sender: TCustomRichView;
      const Location: String; Width, Height: Integer;
      var Graphic: TGraphic);
    procedure srvSaveItemToFile(Sender: TCustomRichView;
      const Path: String; RVData: TCustomRVData; ItemNo: Integer;
      SaveFormat: TRVSaveFormat; Unicode: Boolean;
      var OutStr: TRVRawByteString; var DoDefault: Boolean);
  private
    { Private declarations }
    function CopyImageToTheImagesDir(ImageFileName: String; gr: TGraphic): String;
    procedure SaveAllUnknownImages(RVData: TCustomRVData);
    procedure ConvertAllPathsToRelativePaths(RVData: TCustomRVData);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$IFDEF RVUNICODESTR}uses AnsiStrings;{$ENDIF}

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
  OpenDialog2.InitialDir := ExtractFilePath(Application.ExeName);
  SaveDialog1.InitialDir := ExtractFilePath(Application.ExeName);
  srv.RichViewEdit.LoadRVF(ExtractFilePath(Application.ExeName)+'demo.rvf');
  srv.RichViewEdit.Format;
end;
{------------------------------------------------------------------------------}
// srv.RichViewEdit.OnRVFPictureNeeded
// This event occurs when reading RVF files.
// Image file name is stored in the Name parameter.
// This event load this image from the Images subdirectory.
procedure TForm1.RichViewEdit1RVFPictureNeeded(Sender: TCustomRichView;
  Name: String; Tag: Integer; var gr: TGraphic);
var pic: TPicture;
begin
  // First time, this event is called with item name (empty)
  // Second time, this event is called with rvespImageFileName property
  if Name='' then
    exit;
  Name := ExtractFilePath(Application.ExeName)+Name; // path is relative to the application path
  pic := TPicture.Create;
  try
    try
      pic.LoadFromFile(Name);
    except
      pic.Assign(RVStyle1.InvalidPicture);
    end;
    gr := RV_CreateGraphics(TGraphicClass(pic.Graphic.ClassType));
    gr.Assign(pic.Graphic);
  finally
    pic.Free;
  end;
end;
{------------------------------------------------------------------------------}
// srv.RichViewEdit.OnImportPicture
// This event occurs when loading RTF files with external pictures
procedure TForm1.RichViewEdit1ImportPicture(Sender: TCustomRichView;
  const Location: String; Width, Height: Integer; var Graphic: TGraphic);
var FileName: String;
begin
  FileName := ExtractRelativePath(ExtractFilePath(Application.ExeName), Location);
  RichViewEdit1RVFPictureNeeded(Sender, FileName, 0, Graphic);
end;
{------------------------------------------------------------------------------}
// srv.RichViewEdit.OnSaveItemToFile
// Modifying how pictures are saved in RTF: saving as external pictures
procedure TForm1.srvSaveItemToFile(Sender: TCustomRichView;
  const Path: String; RVData: TCustomRVData; ItemNo: Integer;
  SaveFormat: TRVSaveFormat; Unicode: Boolean;
  var OutStr: TRVRawByteString; var DoDefault: Boolean);
var FileName: String;
begin
 if (SaveFormat=rvsfRTF) and
    ((RVData.GetItemStyle(ItemNo)=rvsPicture) or
     (RVData.GetItemStyle(ItemNo)=rvsHotPicture)) then begin
    RVData.GetItemExtraStrProperty(ItemNo, rvespImageFileName, FileName);
    OutStr := {$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}
      Format('{\field{\*\fldinst INCLUDEPICTURE "%s" \\d }}',
      [RVMakeRTFFileNameStr(FileName, srv.RichViewEdit.Style.DefCodePage,
       rvrtfDuplicateUnicode in srv.RTFOptions)]);
    DoDefault := False;
 end;
end;
{------------------------------------------------------------------------------}
// Inserting image.
// If this image is not from the Images subdirectory, copying it there
// (under the unique file name)
// Image file name is written in rvespImageFileName
//  (relative to the application path)
procedure TForm1.Button1Click(Sender: TObject);
var pic: TPicture;
    gr: TGraphic;
    ImageName: String;
begin
  if OpenDialog1.Execute then begin
    try
      pic := TPicture.Create;
      try
        pic.LoadFromFile(OpenDialog1.FileName);
        gr := RV_CreateGraphics(TGraphicClass(pic.Graphic.ClassType));
        gr.Assign(pic.Graphic);
        // using relative path
        ImageName := ExtractRelativePath(ExtractFilePath(Application.ExeName),
          CopyImageToTheImagesDir(OpenDialog1.FileName, nil));
        srv.RichViewEdit.TopLevelEditor.BeginUndoGroup(rvutInsert);
        srv.RichViewEdit.TopLevelEditor.SetUndoGroupMode(True);
        try
          if srv.RichViewEdit.InsertPicture('', gr, rvvaBaseline) then
            srv.RichViewEdit.SetCurrentItemExtraStrProperty(rvespImageFileName, ImageName, True);
        finally
          srv.RichViewEdit.TopLevelEditor.SetUndoGroupMode(False);
        end;
      finally
        pic.Free;
      end;
    except
      Application.MessageBox('Image loading error', 'Error', 0);
    end;
  end;
end;
{------------------------------------------------------------------------------}
// Copying the file ImageFileName to the images subdirectory (if gr=nil)
// or saving gr in the images subdirectory.
// Assigning an unique file name.
// Both ImageFileName and returned value are fully qualified paths.
function TForm1.CopyImageToTheImagesDir(ImageFileName: String; gr: TGraphic): String;
var ImagesDir, NewImageFileName, ImageExt: String;
    RandomValue: Integer;
begin
  ImageFileName := AnsiLowerCase(ImageFileName);
  ImagesDir := AnsiLowerCase(ExtractFilePath(Application.ExeName)+'Images\');
  if Pos(ImagesDir,ImageFileName)<>1 then begin
    NewImageFileName := ImagesDir+ExtractFileName(ImageFileName);
    if FileExists(NewImageFileName) then begin
      ImageExt := ExtractFileExt(NewImageFileName);
      NewImageFileName := Copy(NewImageFileName, 1, Length(NewImageFileName)-Length(ImageExt));
      RandomValue := Random(MaxInt);
      while FileExists(NewImageFileName+IntToStr(RandomValue)+ImageExt) do
        inc(RandomValue);
      NewImageFileName := NewImageFileName+IntToStr(RandomValue)+ImageExt;
    end;
    if gr=nil then
      CopyFile(PChar(ImageFileName), PChar(NewImageFileName), False)
    else
      gr.SaveToFile(NewImageFileName);
    Result := NewImageFileName;
    end
  else
    Result := ImageFileName;
end;
{------------------------------------------------------------------------------}
// Saving all images that not in the images directory
// Such images can appear when loading or pasting files with images
procedure TForm1.SaveAllUnknownImages(RVData: TCustomRVData);
var i,r,c, Tag: Integer;
    VAlign: TRVVAlign;
    table: TRVTableItemInfo;
    gr: TGraphic;
    s: TRVAnsiString;
    ImageFileName, Ext: String;
begin
  for i := 0 to RVData.ItemCount-1 do
    case RVData.GetItemStyle(i) of
      rvsPicture, rvsHotPicture:
        begin
          RVData.GetItemExtraStrProperty(i, rvespImageFileName, ImageFileName);
          ImageFileName := ExtractFilePath(Application.ExeName)+ImageFileName;
          if not (FileExists(ImageFileName)) then begin
            RVData.GetPictureInfo(i, s, gr, VAlign, Tag);
            Ext := GraphicExtension(TGraphicClass(gr.ClassType));
            // using relative path
            ImageFileName := ExtractRelativePath(ExtractFilePath(Application.ExeName),
               CopyImageToTheImagesDir('Image.'+Ext, gr));
            RVData.SetItemExtraStrProperty(i, rvespImageFileName, ImageFileName);
          end;
        end;
      rvsTable:
        begin
          table := TRVTableItemInfo(RVData.GetItem(i));
          for r := 0 to table.Rows.Count-1 do
            for c := 0 to table.Rows[r].Count-1 do
              if table.Cells[r,c]<>nil then
                SaveAllUnknownImages(table.Cells[r,c].GetRVData);
        end;
    end;
end;
{------------------------------------------------------------------------------}
// After loading from RTF, full file names are assigned to rvespImageFileName
// properties. This procedure is called to convert them to relative paths.
procedure TForm1.ConvertAllPathsToRelativePaths(RVData: TCustomRVData);
var i,r,c: Integer;
    table: TRVTableItemInfo;
    ImageFileName: String;
begin
  for i := 0 to RVData.ItemCount-1 do
    case RVData.GetItemStyle(i) of
      rvsPicture, rvsHotPicture:
        begin
          RVData.GetItemExtraStrProperty(i, rvespImageFileName, ImageFileName);
          ImageFileName := ExtractRelativePath(ExtractFilePath(Application.ExeName),
            ImageFileName);
          RVData.SetItemExtraStrProperty(i, rvespImageFileName, ImageFileName);
        end;
      rvsTable:
        begin
          table := TRVTableItemInfo(RVData.GetItem(i));
          for r := 0 to table.Rows.Count-1 do
            for c := 0 to table.Rows[r].Count-1 do
              if table.Cells[r,c]<>nil then
                ConvertAllPathsToRelativePaths(table.Cells[r,c].GetRVData);
        end;
    end;
end;

{------------------------------------------------------------------------------}
// Before copying to the clipboard
procedure TForm1.RichViewEdit1Copy(Sender: TObject);
begin
  SaveAllUnknownImages(srv.RichViewEdit.RVData);
end;
{------------------------------------------------------------------------------}
// Loading doc
procedure TForm1.Button3Click(Sender: TObject);
var r: Boolean;
begin
  if OpenDialog2.Execute then begin
    srv.RichViewEdit.Clear;
    r := False;
    case OpenDialog2.FilterIndex of
      1:  r := srv.RichViewEdit.LoadRVF(OpenDialog2.FileName);
      2:
        begin
          r := srv.RichViewEdit.LoadRTF(OpenDialog2.FileName);
          ConvertAllPathsToRelativePaths(srv.RichViewEdit.RVData);
        end;
    end;
    srv.RichViewEdit.Format;
    if not r then
      Application.MessageBox('Document loading error', 'Error', 0);
  end;
end;
{------------------------------------------------------------------------------}
// Saving doc
procedure TForm1.Button2Click(Sender: TObject);
var r: Boolean;
begin
  if SaveDialog1.Execute then begin
    SaveAllUnknownImages(srv.RichViewEdit.RVData);
    r := False;
    case SaveDialog1.FilterIndex of
      1: r := srv.RichViewEdit.SaveRVF(SaveDialog1.FileName, False);
      2: r := srv.RichViewEdit.SaveRTF(SaveDialog1.FileName, False);
      3: r := srv.RichViewEdit.SaveHTMLEx(SaveDialog1.FileName, 'Shared Image Demo',
        'img', '', '', '', [rvsoUseCheckpointsNames, rvsoUseItemImageFileNames]);
    end;
    if not r then
      Application.MessageBox('Document saving error', 'Error', 0);
  end;
end;

end.
