📄 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.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -