RichEdit

开发平台：
Delphi

Unit1.pas：源码内容
							{-------------------------------------------------------------------------------
  Working with RVF files containing shared images.
  This demo stores them in the special subdirectory, but you can store them
  in a database, etc.
  The main setting - rvfoSavePicturesBody is EXCLUDED from
  RichViewEdit1.RVFOptions
-------------------------------------------------------------------------------}
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, RVStyle, RVScroll, RichView, RVEdit, RVFuncs, StdCtrls,
  CRVData, RVTable, RVItem;
type
  TForm1 = class(TForm)
    RichViewEdit1: TRichViewEdit;
    RVStyle1: TRVStyle;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Button3: TButton;
    OpenDialog2: TOpenDialog;
    SaveDialog1: TSaveDialog;
    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);
  private
    { Private declarations }
    function CopyImageToTheImagesDir(ImageFileName: String; gr: TGraphic): String;
    procedure SaveAllUnknownImages(RVData: TCustomRVData);
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
  RichViewEdit1.LoadRVF(ExtractFilePath(Application.ExeName)+'demo.rvf');
  RichViewEdit1.Format;
end;
// 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
  Name := ExtractFilePath(Application.ExeName)+'Images'+Name;
  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;
// Inserting image.
// If this image is not from the Images subdirectory, copying it there
// (under an unique file name)
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);
        ImageName := ExtractFileName(CopyImageToTheImagesDir(OpenDialog1.FileName, nil));
        RichViewEdit1.InsertPicture(ImageName, gr, rvvaBaseline);
      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.
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, ImageFileName, Ext: String;
begin
  for i := 0 to RVData.ItemCount-1 do
    case RVData.GetItemStyle(i) of
      rvsPicture, rvsHotPicture:
        begin
          ImageFileName := ExtractFilePath(Application.ExeName)+'Images'+RVData.GetItemText(i);
          if not (FileExists(ImageFileName)) then begin
            RVData.GetPictureInfo(i, s, gr, VAlign, Tag);
            Ext := GraphicExtension(TGraphicClass(gr.ClassType));
            RVData.SetItemText(i, ExtractFileName(CopyImageToTheImagesDir('Image.'+Ext, gr)));
          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;
// Before copying to the clipboard
procedure TForm1.RichViewEdit1Copy(Sender: TObject);
begin
  SaveAllUnknownImages(RichViewEdit1.RVData);
end;
// Loading doc
procedure TForm1.Button3Click(Sender: TObject);
begin
  if OpenDialog2.Execute then begin
    if not RichViewEdit1.LoadRVF(OpenDialog2.FileName) then
      Application.MessageBox('Document loading error', 'Error', 0);
    RichViewEdit1.Format;
  end;
end;
// Saving doc
procedure TForm1.Button2Click(Sender: TObject);
begin
  if SaveDialog1.Execute then begin
    SaveAllUnknownImages(RichViewEdit1.RVData);
    if not RichViewEdit1.SaveRVF(SaveDialog1.FileName, False) then
      Application.MessageBox('Document saving error', 'Error', 0);
  end;
end;
end.

						