RichEdit

开发平台：

Delphi

CRVData.pas：源码内容

{*******************************************************}
{ }
{ RichView }
{ TCustomRVData is a basic class representing }
{ RichView document. }
{ }
{ Copyright (c) Sergey Tkachenko }
{ svt@trichview.com }
{ http://www.trichview.com }
{ }
{*******************************************************}
unit CRVData;
interface
{$I RV_Defs.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
{$IFNDEF RVDONOTUSEJPEGIMAGE}
Jpeg,
{$ENDIF}
{$IFNDEF RVDONOTUSELISTS}
RVMarker,
{$ENDIF}
{$IFDEF RICHVIEWDEF4}
ImgList,
{$ENDIF}
RVStyle, RVBack, RVFuncs, RVItem, RVScroll, RVUni, RVClasses,
RVRTFErr;
type
{ State of RVData }
TRVState = (
rvstMakingSelection, // Mouse selection is in process
rvstLineSelection, // Line selection (started from the left margin)
// is in process
rvstDrawHover, // There is a highlighted hyperlink
rvstSkipFormatting, // Reformatting is not allowed
rvstIgnoreNextMouseDown, // Next mouse-down event must be ignored
rvstChangingBkPalette, // Palette of background image is being updated
// (avoiding recursive call)
rvstCompletelySelected, // RVData is completely selected (table cell)
rvstClearing, // Document is being cleared
// (avoiding recursive call)
rvstDoNotMoveChildren, // Call of AdjustChildrenCoords is not allowed
rvstForceStyleChangeEvent, // Editor must call events for changing styles
// even if next value assigned to current style
// is equal to the current value
rvstIgnoreNextChar, // Next call of WMChar or KeyPress must be ignored
// (the character is already processed in WMKeyDown)
rvstDoNotTab, // Next call of DoTabNavigation will be ignored
rvstDeselecting, // Deselection is in process
// (avoiding recursive call)
rvstUnAssigningChosen, // Unassigning chosen data is in process
// (avoiding recursive call)
rvstNoScroll, // Scrolling is not allowed
rvstFinalizingUndo, // Avoiding recursive calls of FinalizeUndoGroup
rvstRTFSkipPar, // Saving to RTF: do not save paragraph mark
rvstLoadingAsPartOfItem, // This RVData is loaded from RVF as a part of item
// (cell is loaded with table)
// (not calling AfterLoading(rvlfRVF) for items
// of this RVData: will be called for the container item
rvstNoKillFocusEvents, // Disabling processing of WMKillFocus
rvstEditorUnformatted, // TRichViewEdit was not formatted before the call of Format
rvstNameSet, // TRichView.Name was assigned. Used to detect placing
// the component on the form from the Component Palette
rvstFirstParaAborted, // This is a page saved and reloaded in ReportHelper,
// and the first paragraph is not completely on this page
rvstLastParaAborted, // The same for the last paragraph
rvstInvalidSelection, // Selection is not valid: do not create item resizer
rvstDoNotClearCurTag, // TRVEditRVData.ChangeEx must not clear "current tag"
// ("current tag" is used in methods for inserting text)
rvstStartingDragDrop, // Dragging from this RichView is about to start
// (WM_RVDRAGDROP was posted). Only in absolute
// root RVData
rvstCanDragDropDeleteSelection, // After dragging from this editor, selection
// must be deleted (set when moving data to
// another control)
rvstDragDropCursorNotMoved, // Dragging is finished, but cursor was not
// moved (it is not a d&d, it is a simple click on
// the selection)
rvstKeyPress // do some special processing related to d&d in keypress
);
TRVStates = set of TRVState;
{ Flags for RVData }
TRVFlag = (
rvflUseJumps, // List of hyperlink coords must be maintained
rvflTrim, // Formatting routine may not show spaces in line
// wrap places (always set)
rvflShareContents, // This RVData uses smb. else's items
rvflUseExternalLeading, // Formatting routine uses font external leading
// (never set)
rvflMouseXYAlwaysCorrect,// Mouse processing procedures may not preprocess
// coordinates (used in table cells)
rvflAllowCustomDrawItems,// Formatting routine may create drawing items
// of custom types (not only TRVDrawLineInfo) -
// used in RVPrint and RVReportHelper
rvflPrinting, // This is RVData with formatting for printing (or
// reports)
rvflRootEditor, // This is TRVEditRVData (not RVData of inplace)
rvflRoot, // This is TRichViewRVData or TRVEditRVData
// (not RVData of inplace)
rvflDBRichViewEdit, // This is TDBRichViewEdit.RVData
rvflCanUseCustomPPI, // Allows using RVStyle.TextStyles.PixelsPerInch
rvflCanProcessGetText); // Allows processing WM_GETTEXT, WM_SETTEXT, WM_GETTEXTLENGTH
TRVFlags = set of TRVFlag;
{ Which part to save in RVF? }
TRVFSaveScope = (
rvfss_Full, // document
rvfss_Selection, // selection
rvfss_Page); // page (for TRVPrint or TRVReportHelper)
PRVIntegerList = ^TRVIntegerList;
TRVRTFFontTable = class;
TCustomRVData = class;
TRVEnumItemsProc = procedure (RVData: TCustomRVData; ItemNo: Integer;
var UserData1: Integer; const UserData2: String;
var ContinueEnum: Boolean) of object;
{ ----------------------------------------------------------------------------
TRVLayoutInfo: information about document layout for saving and loading in
RVF.
Main properties:
- margins,
- min- and maxtextwidth,
- bidimode.
For saving RVReportHelper page, additional properties:
- LastParaAborted: <>0 if the last page paragraph is not completely on the page;
- FirstParaAborted: the same for the first page paragraph;
- FirstMarkerListNo, FirstMarkerLevel - information about marker of the
first page paragraph (marker is before this page)
}
TRVLayoutInfo = class
public
Loaded: Boolean;
LeftMargin, RightMargin, TopMargin, BottomMargin: Integer;
MinTextWidth, MaxTextWidth: Integer;
BiDiMode: TRVBiDiMode;
LastParaAborted, FirstParaAborted: Integer;
FirstMarkerListNo, FirstMarkerLevel: Integer;
constructor Create;
procedure SaveToStream(Stream: TStream; IncludeSize: Boolean);
procedure LoadFromStream(Stream: TStream; IncludeSize: Boolean);
procedure SaveTextToStream(Stream: TStream);
procedure LoadText(const s: String);
procedure LoadBinary(const s: String);
end;
{$IFNDEF RVDONOTUSEHTML}
{ ----------------------------------------------------------------------------
TRVHTMLBulletInfo: information for saving shared images in HTML
(several items can use the same image file).
Used by: "bullets", "hotspots", list markers with pictures and image lists.
}
TRVHTMLBulletInfo = class
public
FileName: String;
ImageList: TCustomImageList;
ImageIndex: Integer;
BackColor: TColor;
Graphic: TGraphic;
end;
{$ENDIF}
{ ----------------------------------------------------------------------------
TRVRTFFontTableItem: item of RTF font table (TRVRTFFontTable)
}
TRVRTFFontTableItem = class
public
FontName: String;
{$IFDEF RICHVIEWCBDEF3}
Charset: TFontCharset;
{$ENDIF}
end;
{ ----------------------------------------------------------------------------
TRVRTFFontTable: RTF font table. Created for saving to RTF, contains all
fonts used in the document (both by styles and by items)
}
TRVRTFFontTable = class (TRVList)
private
function Get(Index: Integer): TRVRTFFontTableItem;
procedure Put(Index: Integer; const Value: TRVRTFFontTableItem);
public
function Find(const FontName: String
{$IFDEF RICHVIEWCBDEF3}; Charset: TFontCharset{$ENDIF}): Integer;
function AddUnique(const FontName: String
{$IFDEF RICHVIEWCBDEF3}; Charset: TFontCharset{$ENDIF}): Integer;
property Items[Index: Integer]: TRVRTFFontTableItem read Get write Put; default;
end;
{ ----------------------------------------------------------------------------
TCustomRVData: RichView document. This class is not used directly.
Direct descendant: TCustomRVFormattedData.
}
TCustomRVData = class(TPersistent)
private
{ Private declarations }
FFirstJumpNo: Integer;
FItems: TStringList;
{ Property values }
function GetPageBreaksBeforeItems(Index: Integer): Boolean;
procedure SetPageBreaksBeforeItems(Index: Integer; Value: Boolean);
function GetItemCount: Integer;
{ HTML & RTF }
{$IFNDEF RVDONOTUSEHTML}
function ShouldSaveTextToHTML(StyleNo: Integer): Boolean;
function GetHTMLATag(ItemNo: Integer; CSS: String; UTF8: Boolean): String;
{$ENDIF}
{$IFNDEF RVDONOTUSERTF}
function ShouldSaveTextToRTF(StyleNo: Integer): Boolean;
{$ENDIF}
{ Others }
procedure AddNLTag_(const s: String; StyleNo, ParaNo, Tag: Integer);
{$IFNDEF RVDONOTUSEUNICODE}
procedure AddNLATag_(const s: String; StyleNo, ParaNo, Tag: Integer);
{$ENDIF}
function AddTextUniversal(const text: String; StyleNo, FirstParaNo, OtherParaNo: Integer;
AsSingleParagraph, CheckUnicode: Boolean; Tag: Integer): Boolean;
protected
{ Protected declarations }
FAllowNewPara: Boolean;
FirstCP, LastCP, NotAddedCP: TRVCPInfo;
CPCount: Integer;
function NextCharStr(const str: String; ItemNo, Index: Integer): Integer;
function PrevCharStr(const str: String; ItemNo, Index: Integer): Integer;
function NextChar(ItemNo: Integer; Index: Integer): Integer;
function PrevChar(ItemNo: Integer; Index: Integer): Integer;
procedure CheckItemClass(ItemNo: Integer;
RequiredClass: TCustomRVItemInfoClass);
function ShareItems: Boolean; dynamic;
function CanLoadLayout: Boolean; dynamic;
function GetURL(id: Integer): String; dynamic; abstract;
function GetOptions: TRVOptions; virtual;
procedure SetOptions(const Value: TRVOptions); virtual;
function GetRVFOptions: TRVFOptions; virtual;
procedure SetRVFOptions(const Value: TRVFOptions); virtual;
function GetRTFOptions: TRVRTFOptions; virtual;
procedure SetRTFOptions(const Value: TRVRTFOptions); virtual;
function GetRVFWarnings: TRVFWarnings; virtual;
procedure SetRVFWarnings(const Value: TRVFWarnings); virtual;
function GetDelimiters: String; dynamic;
function GetRVFTextStylesReadMode: TRVFReaderStyleMode; virtual;
function GetRVFParaStylesReadMode: TRVFReaderStyleMode; virtual;
procedure RVFGetLimits(SaveScope: TRVFSaveScope;
var StartItem, EndItem, StartOffs, EndOffs: Integer;
var StartPart, EndPart: TRVMultiDrawItemPart); dynamic;
function GetRTFProperties:TPersistent {TRVRTFReaderProperties}; dynamic;
{$IFNDEF RVDONOTUSERVF}
procedure DoOnStyleReaderError(Reader: TReader; const Message: string;
var Handled: Boolean);
function InsertRVFFromStream_(Stream: TStream; var Index: Integer;
AParaNo: Integer; AllowReplaceStyles, AppendMode, EditFlag: Boolean;
var Color: TColor; Background: TRVBackground;
Layout: TRVLayoutInfo; var NonFirstItemsAdded: Integer;
var Protect, FullReformat: Boolean):Boolean;
procedure DataWriter(Stream: TStream);
procedure DataReader(Stream: TStream);
{$ENDIF}
procedure NormalizeParas(StartItemNo: Integer);
procedure InsertCheckpoint(ItemNo, Tag: Integer; const Name: String;
RaiseEvent: Boolean);
procedure UpdateCPPos(cp: TRVCPInfo; ItemNo: Integer);
procedure UnlinkCheckpoint(cp: TRVCPInfo; DecCPCount: Boolean);
function FindCPBeforeItem(ItemNo: Integer): TRVCPInfo;
procedure UpdateCPItemNo;
procedure InternalFreeItem(item: TCustomRVItemInfo; Clearing: Boolean); virtual;
function IsDelimiter(const s: String; Index: Integer;
ItemOptions: TRVItemOptions): Boolean;
function GetItemOptions(ItemNo: Integer): TRVItemOptions;
procedure Replace0(var s: String);
function RV_CanConcateItems(FirstItemNo: Integer; item1, item2: TCustomRVItemInfo;
IgnorePara: Boolean): Boolean;
procedure SimpleConcate(FirstItemNo: Integer; item1, item2: TCustomRVItemInfo);
procedure MassSimpleConcate(FirstItemNo, LastItemNo: Integer);
procedure SimpleConcateSubitems(ItemNo: Integer);
procedure InitStyleMappings(var PTextStylesMapping, PParaStylesMapping,
PListStylesMapping: PRVIntegerList); dynamic;
procedure DoneStyleMappings(PTextStylesMapping, PParaStylesMapping,
PListStylesMapping: PRVIntegerList); dynamic;
function SupportsPageBreaks: Boolean; dynamic;
{$IFNDEF RVDONOTUSEHTML}
procedure SaveHTMLCheckpoint(Stream: TStream; Checkpoint: TRVCPInfo;
var cpno: Integer; const Prefix: String; FromNewLine: Boolean;
Options: TRVSaveOptions);
function GetTextForHTML(const Path: String; ItemNo: Integer; CSSVersion: Boolean;
SaveOptions: TRVSaveOptions): String;
{$ENDIF}
function GetFirstParaItem(ItemNo: Integer): Integer;
function GetFirstParaSectionItem(ItemNo: Integer): Integer;
{$IFNDEF RVDONOTUSELISTS}
procedure DestroyMarkers; dynamic;
function FindPreviousMarker(ItemNo: Integer): TRVMarkerItemInfo;
function FindMarkerLocalLocationFrom(StartItemNo: Integer;
Marker: TRVMarkerItemInfo): Integer;
function FindLastMarkerIndex(StartAfterMeIndex: Integer; ListStyles: TRVIntegerList): Integer;
{$ENDIF}
function GetFlags: TRVFlags; virtual; abstract;
procedure SetFlags(const Value: TRVFlags); virtual; abstract;
procedure AddStringFromFile(const s: String; StyleNo,ParaNo: Integer;
FromNewLine, AsSingleParagraph: Boolean; var FirstTime, PageBreak: Boolean);
procedure AfterDeleteStyles(Data: TRVDeleteUnusedStylesData); dynamic;
public
State: TRVStates;
{ Constructors - destructors }
constructor Create;
destructor Destroy; override;
{ Document/control & styles properties }
function GetRVData: TCustomRVData; virtual;
function GetSourceRVData: TCustomRVData; virtual;
function GetStyleCodePage(StyleNo: Integer): TRVCodePage;
function GetStyleLocale(StyleNo: Integer): Cardinal;
function GetDefaultCodePage: TRVCodePage;
function GetRVStyle: TRVStyle; virtual;
function GetParentControl: TWinControl; dynamic;
procedure GetParentInfo(var ParentItemNo: Integer;
var Location: TRVStoreSubRVData); dynamic;
function GetChosenRVData: TCustomRVData; dynamic;
function GetChosenItem: TCustomRVItemInfo; dynamic;
function GetParentData: TCustomRVData; virtual;
function GetRootData: TCustomRVData; virtual;
function GetAbsoluteParentData: TCustomRVData; virtual;
function GetAbsoluteRootData: TCustomRVData; virtual;
{ Palette }
function GetRVPalette: HPALETTE; virtual;
function GetRVLogPalette: PLogPalette; virtual;
function GetDoInPaletteMode: TRVPaletteAction; virtual;
procedure UpdateItemsPaletteInfo;
{ Item properties }
function GetItemNo(Item: TCustomRVItemInfo): Integer;
function GetItem(ItemNo: Integer): TCustomRVItemInfo;
function SetItemExtraIntProperty(ItemNo: Integer;
Prop: TRVExtraItemProperty; Value: Integer): Boolean;
function GetItemExtraIntProperty(ItemNo: Integer;
Prop: TRVExtraItemProperty; var Value: Integer): Boolean;
function SetItemExtraStrProperty(ItemNo: Integer;
Prop: TRVExtraItemStrProperty; const Value: String): Boolean;
function GetItemExtraStrProperty(ItemNo: Integer;
Prop: TRVExtraItemStrProperty; var Value: String): Boolean;
function GetItemTag(ItemNo: Integer): Integer;
function IsParaStart(ItemNo: Integer): Boolean;
function GetItemPara(ItemNo: Integer): Integer;
function IsFromNewLine(ItemNo: Integer): Boolean;
function GetOffsAfterItem(ItemNo: Integer): Integer;
function GetOffsBeforeItem(ItemNo: Integer): Integer;
function ItemLength(ItemNo: Integer): Integer;
procedure SetItemTag(ItemNo: Integer; ATag: Integer);
function GetItemStyle(ItemNo: Integer): Integer;
function GetActualStyle(Item: TCustomRVItemInfo): Integer;
function GetActualStyle2(StyleNo, ParaNo: Integer): Integer;
function GetItemText(ItemNo: Integer): String;
procedure SetItemText(ItemNo: Integer; const s: String);
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
function GetTextInItemFormatW(ItemNo: Integer; const s: WideString): String;
function GetItemTextW(ItemNo: Integer): WideString;
procedure SetItemTextW(ItemNo: Integer; const s: WideString);
{$ENDIF}
function GetTextInItemFormatA(ItemNo: Integer; const s: String): String;
procedure SetItemTextA(ItemNo: Integer; const s: String);
{$ENDIF}
function GetItemTextA(ItemNo: Integer): String;
function FindControlItemNo(actrl: TControl): Integer;
{ BiDi }
function GetItemBiDiMode(ItemNo: Integer): TRVBiDiMode;
function GetParaBiDiMode(ParaNo: Integer): TRVBiDiMode;
function GetBiDiMode: TRVBiDiMode; virtual;
{ Operations on items - internal }
procedure FreeItem(ItemNo: Integer; Clearing: Boolean);
{ Operations on items - public }
procedure Clear; dynamic;
procedure DeleteItems(FirstItemNo, Count: Integer); dynamic;
procedure DeleteSection(const CpName: String);
{ Related to events }
function IsAssignedOnProgress: Boolean; dynamic;
procedure DoProgress(Operation: TRVLongOperation; Stage: TRVProgressStage;
PercentDone: Byte); dynamic;
function GetExtraRTFCode(Area: TRVRTFSaveArea; Obj: TObject;
Index1, Index2: Integer; InStyleSheet: Boolean): String; dynamic;
function GetExtraHTMLCode(Area: TRVHTMLSaveArea;
CSSVersion: Boolean): String; dynamic;
function GetParaHTMLCode(RVData: TCustomRVData; ItemNo: Integer;
ParaStart, CSSVersion: Boolean): String; dynamic;
procedure ReadHyperlink(const Target, Extras: String; DocFormat: TRVLoadFormat;
var StyleNo, ItemTag: Integer; var ItemName: String); dynamic;
procedure WriteHyperlink(id: Integer; RVData: TCustomRVData; ItemNo: Integer;
SaveFormat: TRVSaveFormat; var Target, Extras: String); dynamic;
function SaveItemToFile(const Path: String; RVData: TCustomRVData;
ItemNo: Integer; SaveFormat: TRVSaveFormat; Unicode: Boolean;
var Text: String): Boolean; virtual;
function ImportPicture(const Location: String;
Width, Height: Integer; var Invalid: Boolean): TGraphic; dynamic;
function GetItemHint(RVData: TCustomRVData; ItemNo: Integer;
const UpperRVDataHint: String): String; dynamic;
function DoSavePicture(DocumentSaveFormat: TRVSaveFormat;
const imgSavePrefix, Path: String; var imgSaveNo: Integer;
OverrideFiles: Boolean; CurrentFileColor: TColor;
gr: TGraphic): String; virtual;
function SavePicture(DocumentSaveFormat: TRVSaveFormat;
const imgSavePrefix, Path: String; var imgSaveNo: Integer;
OverrideFiles: Boolean; CurrentFileColor: TColor;
gr: TGraphic): String;
function RVFPictureNeeded(const ItemName: String; ItemTag: Integer): TGraphic; dynamic;
procedure ControlAction(ControlAction: TRVControlAction; ItemNo: Integer;
Item: TCustomRVItemInfo);
procedure ItemAction(ItemAction: TRVItemAction; Item: TCustomRVItemInfo;
var Text: String; RVData: TCustomRVData); virtual;
procedure ControlAction2(ControlAction: TRVControlAction; ItemNo: Integer;
var Control: TControl); dynamic; abstract;
function RVFControlNeeded(const ItemName: String; ItemTag: Integer): TControl; dynamic;
function RVFImageListNeeded(ImageListTag: Integer): TCustomImageList; dynamic;
procedure HTMLSaveImage(RVData: TCustomRVData; ItemNo: Integer;
const Path: String; BackgroundColor: TColor; var Location: String;
var DoDefault: Boolean); dynamic;
procedure SaveImage2(Graphic: TGraphic; SaveFormat: TRVSaveFormat;
const Path, ImagePrefix: String; var ImageSaveNo: Integer;
var Location: String; var DoDefault: Boolean); dynamic;
function SaveComponentToFile(const Path: String; SaveMe: TComponent;
SaveFormat: TRVSaveFormat): String; virtual;
{ Text save and load }
{$IFNDEF RVDONOTUSEUNICODE}
function LoadTextFromStreamW(Stream: TStream; StyleNo, ParaNo: Integer;
DefAsSingleParagraph: Boolean):Boolean;
function LoadTextW(const FileName: String; StyleNo, ParaNo: Integer;
DefAsSingleParagraph: Boolean):Boolean;
{$ENDIF}
function SaveTextToStream(const Path: String; Stream: TStream;
LineWidth: Integer; SelectionOnly, TextOnly, Unicode,
UnicodeWriteSignature: Boolean):Boolean;
function SaveText(const FileName: String; LineWidth: Integer;
Unicode: Boolean):Boolean;
function LoadText(const FileName: String; StyleNo, ParaNo: Integer;
AsSingleParagraph: Boolean):Boolean;
function LoadTextFromStream(Stream: TStream; StyleNo, ParaNo: Integer;
AsSingleParagraph: Boolean):Boolean;
{ HTML save }
{$IFNDEF RVDONOTUSEHTML}
function SaveBackgroundToHTML(bmp: TBitmap; Color: TColor;
const Path, ImagesPrefix: String; var imgSaveNo: Integer;
SaveOptions: TRVSaveOptions): String;
function SaveHTMLToStreamEx(Stream: TStream;
const Path, Title, ImagesPrefix, ExtraStyles, ExternalCSS, CPPrefix: String;
Options: TRVSaveOptions; Color: TColor; var CurrentFileColor: TColor;
var imgSaveNo: Integer; LeftMargin, TopMargin, RightMargin, BottomMargin: Integer;
Background: TRVBackground; Bullets: TRVList): Boolean; dynamic;
function SaveHTMLToStream(Stream: TStream; const Path, Title,ImagesPrefix: String;
Options: TRVSaveOptions; Color: TColor; var imgSaveNo: Integer;
LeftMargin, TopMargin, RightMargin, BottomMargin: Integer;
Background: TRVBackground; Bullets: TRVList): Boolean; dynamic;
function SaveHTMLEx(const FileName, Title, ImagesPrefix, ExtraStyles,
ExternalCSS, CPPrefix: String; Options: TRVSaveOptions;
Color: TColor; var CurrentFileColor: TColor;
var imgSaveNo: Integer; LeftMargin, TopMargin, RightMargin, BottomMargin: Integer;
Background: TRVBackground): Boolean;
function SaveHTML(const FileName,Title,ImagesPrefix: String;
Options: TRVSaveOptions; Color: TColor; var imgSaveNo: Integer;
LeftMargin, TopMargin, RightMargin, BottomMargin: Integer;
Background: TRVBackground): Boolean;
{$ENDIF}
function GetNextFileName(const ImagesPrefix, Path, Ext: String;
var imgSaveNo: Integer; OverrideFiles: Boolean): String; dynamic;
{ RVF save and load }
{$IFNDEF RVDONOTUSERVF}
function LoadRVFFromStream(Stream: TStream; var Color: TColor;
Background: TRVBackground; Layout: TRVLayoutInfo):Boolean;
function InsertRVFFromStream(Stream: TStream; Index: Integer;
var Color: TColor; Background: TRVBackground; Layout: TRVLayoutInfo;
AllowReplaceStyles: Boolean):Boolean;
function AppendRVFFromStream(Stream: TStream; ParaNo: Integer;
var Color: TColor; Background: TRVBackground):Boolean;
function LoadRVF(const FileName: String;
var Color: TColor; Background: TRVBackground;
Layout: TRVLayoutInfo):Boolean;
//SelectionOnly=True - reserved here
function SaveRVFToStream(Stream: TStream; SelectionOnly: Boolean;
Color: TColor; Background: TRVBackground;
Layout: TRVLayoutInfo):Boolean;
function SaveRVFToStreamEx(Stream: TStream; SaveScope: TRVFSaveScope;
Color: TColor; Background: TRVBackground;
Layout: TRVLayoutInfo):Boolean;
//SelectionOnly=True - reserved here
function SaveRVF(const FileName: String; SelectionOnly: Boolean;
Color: TColor; Background: TRVBackground;
Layout: TRVLayoutInfo):Boolean;
{$ENDIF}
function InsertFirstRVFItem(var Index: Integer; var s: String;
var item: TCustomRVItemInfo; EditFlag: Boolean; var FullReformat: Boolean;
var NewListNo: Integer): Boolean; dynamic;
function GetRVFSaveScope(SelectionOnly: Boolean):TRVFSaveScope;
{ RTF save and load }
{$IFNDEF RVDONOTUSERTF}
{$IFNDEF RVDONOTUSELISTS}
procedure SaveRTFListTable97(Stream: TStream; ColorList: TRVColorList;
ListOverrideOffsetsList: TRVIntegerList;
FontTable: TRVRTFFontTable; tpp: Double);
{$ENDIF}
function SaveRTFToStream(Stream: TStream; const Path: String; SelectionOnly: Boolean;
Level: Integer; Color: TColor; Background: TRVBackground; ColorList: TRVColorList;
StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
FontTable: TRVRTFFontTable; tpp: Double):Boolean; dynamic;
function SaveRTF(const FileName: String; SelectionOnly: Boolean;
Color: TColor; Background: TRVBackground):Boolean;
{$ENDIF}
{$IFNDEF RVDONOTUSERTFIMPORT}
function LoadRTFFromStream(Stream: TStream):TRVRTFErrorCode;
function LoadRTF(const FileName: String):TRVRTFErrorCode;
{$IFDEF RVUSEWORDDOC}
function LoadWordDoc(const FileName: String):TRVRTFErrorCode;
{$ENDIF}
{$ENDIF}
procedure MakeRTFTables(ColorList: TRVColorList;
ListOverrideCountList: TRVIntegerList; TopLevel: Boolean);
{ Adding items - general }
procedure AddItem(const Text: String; Item: TCustomRVItemInfo);
procedure AddItemAsIs(const Text: String; Item: TCustomRVItemInfo);
{ Adding items - text }
procedure AddFmt(const FormatStr: String; const Args: array of const;
StyleNo, ParaNo: Integer);
procedure AddNL(const s: String; StyleNo, ParaNo: Integer);
procedure AddNLTag(const s: String; StyleNo, ParaNo, Tag: Integer);
procedure AddTextNL(const s: String; StyleNo, FirstParaNo, OtherParaNo: Integer
{$IFDEF RICHVIEWDEF4};Tag: Integer=0{$ENDIF});
{$IFNDEF RVDONOTUSEUNICODE}
procedure AddTextNLA(const s: String; StyleNo, FirstParaNo, OtherParaNo: Integer
{$IFDEF RICHVIEWDEF4};Tag: Integer=0{$ENDIF});
{$ENDIF}
procedure AddTextBlockNL(const s: String; StyleNo, ParaNo: Integer
{$IFDEF RICHVIEWDEF4};Tag: Integer=0{$ENDIF});
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
procedure AddNLWTag(const s: WideString; StyleNo, ParaNo, Tag: Integer);
{$ENDIF}
procedure AddNLWTagRaw(const s: String; StyleNo, ParaNo, Tag: Integer);
procedure AddNLATag(const s: String; StyleNo, ParaNo, Tag: Integer);
procedure AddTextNLW(const s: String; StyleNo, FirstParaNo,
OtherParaNo: Integer; DefAsSingleParagraph: Boolean);
{$ENDIF}
{ Adding items - others }
{$IFNDEF RVDONOTUSETABS}
procedure AddTab(TextStyleNo, ParaNo: Integer);
{$ENDIF}
procedure AddBreakExTag(Width: Byte; Style: TRVBreakStyle;
Color: TColor; Tag: Integer);
procedure AddBreak;
procedure AddBreakEx(Width: Byte; Style: TRVBreakStyle; Color: TColor);
procedure AddBreakTag(Tag: Integer);
procedure AddBulletEx(const Name: String; ImageIndex: Integer;
ImageList: TCustomImageList; ParaNo: Integer);
procedure AddBulletExTag(const Name: String; ImageIndex: Integer;
ImageList: TCustomImageList; ParaNo, Tag: Integer);
procedure AddHotspotEx(const Name: String; ImageIndex,
HotImageIndex: Integer; ImageList: TCustomImageList; ParaNo: Integer);
procedure AddHotspotExTag(const Name: String; ImageIndex,
HotImageIndex: Integer; ImageList: TCustomImageList; ParaNo, Tag: Integer);
procedure AddPictureExTag(const Name: String; gr: TGraphic; ParaNo: Integer;
VAlign: TRVVAlign; Tag: Integer);
procedure AddControlExTag(const Name: String; ctrl: TControl;
ParaNo: Integer; VAlign: TRVVAlign; Tag: Integer);
procedure AddPictureEx(const Name: String; gr: TGraphic; ParaNo: Integer;
VAlign: TRVVAlign);
procedure AddControlEx(const Name: String; ctrl: TControl;
ParaNo: Integer; VAlign: TRVVAlign);
procedure AddHotPicture(const Name: String; gr: TGraphic; ParaNo: Integer;
VAlign: TRVVAlign);
procedure AddHotPictureTag(const Name: String; gr: TGraphic; ParaNo: Integer;
VAlign: TRVVAlign; Tag: Integer);
{ Checkpoints - internal }
procedure FreeCheckpoint(var cp: TRVCPInfo; AdjustLinks, DecCPCount: Boolean);
procedure SetCP(Item: TCustomRVItemInfo; var PrevCP, CP: TRVCPInfo);
{ Checkpoints - public }
function AddNamedCheckpointExTag(const CpName: String; RaiseEvent: Boolean;
Tag: Integer): Integer;
procedure SetCheckpointInfo(ItemNo: Integer; ATag: Integer; const AName: String;
ARaiseEvent: Boolean);
function RemoveCheckpoint(ItemNo: Integer): Boolean;
function GetFirstCheckpoint: TCheckpointData;
function GetNextCheckpoint(CheckpointData: TCheckpointData): TCheckpointData;
function GetLastCheckpoint: TCheckpointData;
function GetPrevCheckpoint(CheckpointData: TCheckpointData): TCheckpointData;
function GetItemCheckpoint(ItemNo: Integer):TCheckpointData;
function FindCheckpointByName(const Name: String): TCheckpointData;
function FindCheckpointByTag(Tag: Integer): TCheckpointData;
function GetCheckpointByNo(No: Integer): TCheckpointData;
function GetCheckpointItemNo(CheckpointData: TCheckpointData): Integer;
function GetCheckpointNo(CheckpointData: TCheckpointData): Integer;
procedure GetCheckpointInfo(CheckpointData: TCheckpointData;
var Tag: Integer; var Name: String; var RaiseEvent: Boolean);
{ Get info for specific item types }
procedure GetBreakInfo(ItemNo: Integer; var AWidth: Byte;
var AStyle: TRVBreakStyle; var AColor: TColor; var ATag: Integer);
procedure GetBulletInfo(ItemNo: Integer; var AName: String;
var AImageIndex: Integer; var AImageList: TCustomImageList;
var ATag: Integer);
procedure GetHotspotInfo(ItemNo: Integer; var AName: String;
var AImageIndex, AHotImageIndex: Integer; var AImageList: TCustomImageList;
var ATag: Integer);
procedure GetPictureInfo(ItemNo: Integer; var AName: String;
var Agr: TGraphic; var AVAlign: TRVVAlign; var ATag: Integer);
procedure GetControlInfo(ItemNo: Integer; var AName: String;
var Actrl: TControl; var AVAlign: TRVVAlign; var ATag: Integer);
procedure GetTextInfo(ItemNo: Integer; var AText: String;
var ATag: Integer);
{ Set info for specific item types }
procedure SetGrouped(ItemNo: Integer; Grouped: Boolean);
procedure SetBreakInfo(ItemNo: Integer; AWidth: Byte; AStyle: TRVBreakStyle;
AColor: TColor; ATag: Integer);
procedure SetBulletInfo(ItemNo: Integer; const AName: String;
AImageIndex: Integer; AImageList: TCustomImageList; ATag: Integer);
procedure SetHotspotInfo(ItemNo: Integer; const AName: String;
AImageIndex, AHotImageIndex: Integer; AImageList: TCustomImageList;
ATag: Integer);
function SetPictureInfo(ItemNo: Integer; const AName: String;
Agr: TGraphic; AVAlign: TRVVAlign; ATag: Integer): Boolean;
function SetControlInfo(ItemNo: Integer; const AName: String;
AVAlign: TRVVAlign; ATag: Integer): Boolean;
{ Styles }
procedure DoMarkStylesInUse(Data: TRVDeleteUnusedStylesData);
procedure DoUpdateStyles(Data: TRVDeleteUnusedStylesData);
procedure MarkStylesInUse(Data: TRVDeleteUnusedStylesData); dynamic;
procedure DeleteMarkedStyles(Data: TRVDeleteUnusedStylesData);
procedure DeleteUnusedStyles(TextStyles, ParaStyles, ListStyles: Boolean);
{ Paragraph list markers}
{$IFNDEF RVDONOTUSELISTS}
function GetMarkers(AllowCreate: Boolean): TRVMarkerList; dynamic;
function GetPrevMarkers: TRVMarkerList; dynamic;
function SetListMarkerInfo(AItemNo, AListNo, AListLevel, AStartFrom,
AParaNo: Integer; AUseStartFrom: Boolean): Integer;
procedure RecalcMarker(AItemNo: Integer; AllowCreateList: Boolean);
procedure RemoveListMarker(ItemNo: Integer);
function GetListMarkerInfo(AItemNo: Integer; var AListNo, AListLevel,
AStartFrom: Integer; var AUseStartFrom: Boolean): Integer;
procedure AddMarkerInList(ItemNo: Integer);
procedure DeleteMarkerFromList(Item: TCustomRVItemInfo; Clearing: Boolean);
{$ENDIF}
{ Others }
function IsDelimiterA(ch: Char): Boolean;
function IsDelimiterW(ch: Word): Boolean;
function EnumItems(Proc: TRVEnumItemsProc; var UserData1: Integer;
const UserData2: String): Boolean;
procedure ShareItemsFrom(Source: TCustomRVData);
procedure AssignItemsFrom(Source: TCustomRVData);
procedure DrainFrom(Victim: TCustomRVData);
procedure SetParagraphStyleToAll(ParaNo: Integer);
procedure SetAddParagraphMode(AllowNewPara: Boolean);
procedure AppendFrom(Source: TCustomRVData);
procedure Inserting(RVData: TCustomRVData; Safe: Boolean);
function Edit: TCustomRVData; dynamic;
procedure Beep;
procedure ExpandToParaSection(ItemNo1,ItemNo2: Integer;
var FirstItemNo, LastItemNo: Integer);
procedure ExpandToPara(ItemNo1,ItemNo2: Integer;
var FirstItemNo, LastItemNo: Integer);
function ReplaceTabs(const s: String; StyleNo: Integer;
UnicodeDef: Boolean): String;
procedure AdjustInItemsRange(var ItemNo: Integer);
{ Properties }
function GetDocProperties: TStringList; dynamic;
property Flags: TRVFlags read GetFlags write SetFlags;
property Items: TStringList read FItems;
property ItemCount: Integer read GetItemCount;
property Options: TRVOptions read GetOptions write SetOptions;
property RVFOptions: TRVFOptions read GetRVFOptions write SetRVFOptions;
property RTFOptions: TRVRTFOptions read GetRTFOptions write SetRTFOptions;
property RVFWarnings: TRVFWarnings read GetRVFWarnings write SetRVFWarnings;
property FirstJumpNo: Integer read FFirstJumpNo write FFirstJumpNo;
property PageBreaksBeforeItems[Index: Integer]: Boolean
read GetPageBreaksBeforeItems write SetPageBreaksBeforeItems;
end;
procedure RVCheckUni(Length: Integer);
function RVCompareLocations(RVData1: TCustomRVData; ItemNo1: Integer;
RVData2: TCustomRVData; ItemNo2: Integer): Integer;
{$IFNDEF RVDONOTUSERTF}
procedure RVSaveFontToRTF(Stream: TStream; Font: TFont;
ColorList: TRVColorList; FontTable: TRVRTFFontTable;
RVStyle: TRVStyle);
{$ENDIF}
const
RichViewSavePInHTML: Boolean = False;
RichViewSavePageBreaksInText: Boolean = False;
RichViewDoNotCheckRVFStyleRefs: Boolean = False;
cssBKAttStrFixed = 'fixed';
cssBKAttStrScroll = 'scroll';
cssBKRepStrRepeat = 'repeat';
cssBKRepStrNoRepeat = 'no-repeat';
rv_cssBkAttachment : array[TBackgroundStyle] of PChar
= ('', cssBKAttStrFixed, cssBKAttStrFixed, cssBKAttStrScroll, cssBKAttStrFixed,
cssBKAttStrFixed, cssBKAttStrFixed, cssBKAttStrFixed, cssBKAttStrFixed);
rv_cssBkRepeat : array[TBackgroundStyle] of PChar =
('', cssBKRepStrNoRepeat, cssBKRepStrRepeat, cssBKRepStrRepeat,
cssBKRepStrNoRepeat, cssBKRepStrNoRepeat, cssBKRepStrNoRepeat,
cssBKRepStrNoRepeat, cssBKRepStrNoRepeat);
procedure RV_RegisterHTMLGraphicFormat(ClassType: TGraphicClass);
procedure RV_RegisterPngGraphic(ClassType: TGraphicClass);
function RV_IsHTMLGraphicFormat(gr: TGraphic): Boolean;
procedure RV_ReplaceStr(var str: String; oldstr, newstr: String);
var RVPngGraphiClass: TGraphicClass;
implementation
uses RVFMisc, RVStr, RVRTFProps;
const RVF_DOCPROP_TEXTSTYLES = 1;
RVF_DOCPROP_PARASTYLES = 2;
RVF_DOCPROP_LISTSTYLES = 4;
RVF_DOCPROP_LAYOUT = 3;
RVF_DOCPROP_DOCPROPLIST = 5;
RVF_DOCPROP_PREVMARKERS = 6;
const RVFVersion = 1;
RVFSubVersion = 3;
const
crlf = #13#10;
{==============================================================================}
{ Replaces in str all substrings oldstr with substring newstr.
Case insensitive. Newstr CANNOT contain oldstr as a substring. }
procedure RV_ReplaceStr(var str: String; oldstr, newstr: String);
var p: Integer;
begin
while true do begin
p := pos(oldstr, str);
if p=0 then break;
Delete(str,p, Length(oldstr));
Insert(newstr, str, p);
end;
end;
{------------------------------------------------------------------------------}
{ Raises an exception - error in processing Unicode text. }
procedure RVRaiseUni;
begin
raise ERichViewError.Create(errRVUnicode);
end;
{------------------------------------------------------------------------------}
{ Raises an exception is Length is odd value. It's used to check lengths of
"raw Unicode" string. }
procedure RVCheckUni(Length: Integer);
begin
if Length mod 2 <> 0 then
RVRaiseUni;
end;
{========================== HTML Graphic Classes ==============================}
{ List of HTML graphic classes.
Pictures of HTML graphic classes will be saved in HTML without
converting to Jpegs.
Initialization: nilled.
Finalization: freed and nilled. }
var HTMLGraphicFormats: TList;
{------------------------------------------------------------------------------}
{ Registers the graphic class ClassType as an HTML graphic class. }
procedure RV_RegisterHTMLGraphicFormat(ClassType: TGraphicClass);
begin
if HTMLGraphicFormats=nil then
HTMLGraphicFormats := TList.Create;
if HTMLGraphicFormats.IndexOf(ClassType)<0 then
HTMLGraphicFormats.Add(ClassType);
end;
{------------------------------------------------------------------------------}
{ Is this a picture of HTML graphic class? }
function RV_IsHTMLGraphicFormat(gr: TGraphic): Boolean;
begin
Result := (HTMLGraphicFormats<>nil) and
(HTMLGraphicFormats.IndexOf(gr.ClassType)>=0)
end;
{================================ Png =========================================}
procedure RV_RegisterPngGraphic(ClassType: TGraphicClass);
begin
RVPngGraphiClass := ClassType;
end;
{================================ TRTFFontTable ===============================}
{ Returns an index of (FontName, Charset) item, or -1 if not found.
Charset is not supported in D2/CB1 version.
FontName is case insensitive. }
function TRVRTFFontTable.Find(const FontName: String
{$IFDEF RICHVIEWCBDEF3}; Charset: TFontCharset{$ENDIF}): Integer;
var i: Integer;
begin
for i := 0 to Count-1 do
if (AnsiCompareText(Items[i].FontName,FontName)=0)
{$IFDEF RICHVIEWCBDEF3}
and (Items[i].Charset = Charset)
{$ENDIF}
then begin
Result := i;
exit;
end;
Result := -1;
end;
{------------------------------------------------------------------------------}
{ Adds (FontName, Charset) item if it does not present.
In any case, returns an index of (FontName, Charset) item.
Charset is not supported in D2/CB1 version.
FontName is case insensitive. }
function TRVRTFFontTable.AddUnique(const FontName: String
{$IFDEF RICHVIEWCBDEF3}; Charset: TFontCharset{$ENDIF}): Integer;
var item: TRVRTFFontTableItem;
begin
Result := Find(FontName{$IFDEF RICHVIEWCBDEF3}, Charset{$ENDIF});
if Result<0 then begin
item := TRVRTFFontTableItem.Create;
item.FontName := FontName;
{$IFDEF RICHVIEWCBDEF3}
item.Charset := Charset;
{$ENDIF}
Add(item);
Result := Count-1;
end;
end;
{------------------------------------------------------------------------------}
{ Reads Items[Index] }
function TRVRTFFontTable.Get(Index: Integer): TRVRTFFontTableItem;
begin
Result := TRVRTFFontTableItem(inherited Get(Index));
end;
{------------------------------------------------------------------------------}
{ Writes Items[Index] }
procedure TRVRTFFontTable.Put(Index: Integer; const Value: TRVRTFFontTableItem);
begin
inherited Put(Index, Value);
end;
{============================ TRVLayoutInfo ===================================}
{ Constructor. }
constructor TRVLayoutInfo.Create;
begin
inherited Create;
FirstMarkerListNo := -1;
end;
{------------------------------------------------------------------------------}
{ Loads iteslf from the Stream.
If IncludeSize=True, first reads size (4 bytes) of the rest of data; reports
error is the size is too small; reads at least size bytes (for compatibility
with possible future extensions). }
procedure TRVLayoutInfo.LoadFromStream(Stream: TStream; IncludeSize: Boolean);
var v: Integer;
const defsize1 = sizeof(Integer)*(4+2)+sizeof(TRVBiDiMode);
begin
if IncludeSize then
Stream.ReadBuffer(v, sizeof(Integer)); // ignoring
Stream.ReadBuffer(v, sizeof(Integer));
Stream.ReadBuffer(v, sizeof(Integer));
if v<defsize1 then
raise ERichViewError.Create(errRVFDocProp);
Stream.ReadBuffer(LeftMargin, sizeof(Integer));
Stream.ReadBuffer(RightMargin, sizeof(Integer));
Stream.ReadBuffer(TopMargin, sizeof(Integer));
Stream.ReadBuffer(BottomMargin, sizeof(Integer));
Stream.ReadBuffer(MinTextWidth, sizeof(Integer));
Stream.ReadBuffer(MaxTextWidth, sizeof(Integer));
Stream.ReadBuffer(BiDiMode, sizeof(TRVBiDiMode));
dec(v, defsize1);
if v>=sizeof(Integer)*4 then begin
Stream.ReadBuffer(FirstParaAborted, sizeof(Integer));
Stream.ReadBuffer(LastParaAborted, sizeof(Integer));
Stream.ReadBuffer(FirstMarkerListNo, sizeof(Integer));
Stream.ReadBuffer(FirstMarkerLevel, sizeof(Integer));
dec(v, sizeof(Integer)*4);
end;
if v>0 then
Stream.Seek(v,soFromCurrent);
Loaded := True;
end;
{------------------------------------------------------------------------------}
{ Saves itself to the stream.
If IncluseSize=True, first saves its size (4 bytes).
Size is usually processed by RVF loading procedures. }
procedure TRVLayoutInfo.SaveToStream(Stream: TStream; IncludeSize: Boolean);
var v,size: Integer;
const defsize1 = sizeof(Integer)*(4+2)+sizeof(TRVBiDiMode);
begin
size := defsize1;
if (FirstParaAborted<>0) or (LastParaAborted<>0) then
inc(size, sizeof(Integer)*4);
if IncludeSize then begin
v := size+sizeof(Integer)*2;
Stream.WriteBuffer(v, sizeof(Integer));
end;
v := 0;
Stream.WriteBuffer(v, sizeof(Integer));
v := size;
Stream.WriteBuffer(v, sizeof(Integer));
Stream.WriteBuffer(LeftMargin, sizeof(Integer));
Stream.WriteBuffer(RightMargin, sizeof(Integer));
Stream.WriteBuffer(TopMargin, sizeof(Integer));
Stream.WriteBuffer(BottomMargin, sizeof(Integer));
Stream.WriteBuffer(MinTextWidth, sizeof(Integer));
Stream.WriteBuffer(MaxTextWidth, sizeof(Integer));
Stream.WriteBuffer(BiDiMode, sizeof(TRVBiDiMode));
if (FirstParaAborted<>0) or (LastParaAborted<>0) then begin
Stream.WriteBuffer(FirstParaAborted, sizeof(Integer));
Stream.WriteBuffer(LastParaAborted, sizeof(Integer));
Stream.WriteBuffer(FirstMarkerListNo, sizeof(Integer));
Stream.WriteBuffer(FirstMarkerLevel, sizeof(Integer));
end;
end;
{------------------------------------------------------------------------------}
{ Loads itself from the hexadecimal string: extracts the string to a temporal
memory stream, and calls LoadFromStream(..., False). }
procedure TRVLayoutInfo.LoadText(const s: String);
var TmpStream: TMemoryStream;
begin
TmpStream := TMemoryStream.Create;
try
RVFTextString2Stream(s, TmpStream);
TmpStream.Position := 0;
LoadFromStream(TmpStream, False);
finally
TmpStream.Free;
end;
end;
{------------------------------------------------------------------------------}
{ Loads itself from the binary string: copies the string to a temporal memory
stream, and calls LoadFromStream(..., False). }
procedure TRVLayoutInfo.LoadBinary(const s: String);
var TmpStream: TMemoryStream;
begin
TmpStream := TMemoryStream.Create;
try
TmpStream.WriteBuffer(PChar(s)^, Length(s));
TmpStream.Position := 0;
LoadFromStream(TmpStream, False);
finally
TmpStream.Free;
end;
end;
{------------------------------------------------------------------------------}
{ Saves itself to stream as a hexadecimal string that can be loaded by
LoadText. }
procedure TRVLayoutInfo.SaveTextToStream(Stream: TStream);
var TmpStream: TMemoryStream;
s: String;
begin
TmpStream := TMemoryStream.Create;
try
SaveToStream(TmpStream, False);
TmpStream.Position := 0;
s := RVFStream2TextString(TmpStream);
RVFWriteLine(Stream, s);
finally
TmpStream.Free;
end;
end;
{$I+}
{================================ TCustomRVData ===============================}
constructor TCustomRVData.Create;
begin
inherited Create;
if not ShareItems then
FItems := TStringList.Create;
FAllowNewPara := True;
CPCount := 0;
State := [];
end;
{------------------------------------------------------------------------------}
destructor TCustomRVData.Destroy;
begin
Clear;
if not ShareItems then
FItems.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SavePicture(DocumentSaveFormat: TRVSaveFormat;
const imgSavePrefix, Path: String; var imgSaveNo: Integer;
OverrideFiles: Boolean; CurrentFileColor: TColor;
gr: TGraphic): String;
var fn: String;
bmp: TBitmap;
ext: String;
{$IFNDEF RVDONOTUSEJPEGIMAGE}
jpg: TJpegImage;
{$ENDIF}
begin
{$IFNDEF RVDONOTUSEJPEGIMAGE}
if DocumentSaveFormat=rvsfHTML then begin
ext := '.jpg';
if RV_IsHTMLGraphicFormat(gr) then
ext := '.'+GraphicExtension(TGraphicClass(gr.ClassType));
end
else
ext := '.bmp';
{$ELSE}
ext := '.bmp';
{$ENDIF}
fn := GetNextFileName(imgSavePrefix, Path, Ext, imgSaveNo, OverrideFiles);
Result := ExtractFilePath(imgSavePrefix);
if (Length(Result)>0) and (Result[Length(Result)]<>'') then
Result := Result+'';
Result := Result+ExtractFileName(fn);
{$IFNDEF RVDONOTUSEJPEGIMAGE}
if (DocumentSaveFormat=rvsfHTML) and
((gr is TJpegImage) or RV_IsHTMLGraphicFormat(gr)) then begin
gr.SaveToFile(fn);
exit;
end;
{$ENDIF}
bmp := TBitmap.Create;
try
if gr is TBitmap then
bmp.Assign(gr)
else begin
{$IFDEF RICHVIEWCBDEF3}
bmp.PixelFormat := pf32bit;
{$ENDIF}
bmp.Height := gr.Height;
bmp.Width := gr.Width;
if CurrentFileColor=clNone then
CurrentFileColor := clWhite;
bmp.Canvas.Brush.Color := CurrentFileColor;
bmp.Canvas.Pen.Color := CurrentFileColor;
bmp.Canvas.FillRect(Rect(0,0,gr.Width,gr.Height));
bmp.Canvas.Draw(0,0,gr);
end;
{$IFNDEF RVDONOTUSEJPEGIMAGE}
if DocumentSaveFormat=rvsfHTML then begin
jpg := TJpegImage.Create;
try
jpg.Assign(bmp);
jpg.SaveToFile(fn);
finally
jpg.Free;
end;
end
else
bmp.SaveToFile(fn);
{$ELSE}
bmp.SaveToFile(fn);
{$ENDIF}
finally
bmp.Free;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.DoSavePicture(DocumentSaveFormat: TRVSaveFormat;
const imgSavePrefix, Path: String; var imgSaveNo: Integer;
OverrideFiles: Boolean; CurrentFileColor: TColor;
gr: TGraphic): String;
var DoDefault: Boolean;
begin
SaveImage2(gr, DocumentSaveFormat, Path, imgSavePrefix, imgSaveNo, Result,
DoDefault);
if not DoDefault then
exit;
Result := SavePicture(DocumentSaveFormat, imgSavePrefix, Path, imgSaveNo,
OverrideFiles, CurrentFileColor, gr);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.ItemLength(ItemNo: Integer): Integer;
begin
with GetItem(ItemNo) do
if StyleNo<0 then
Result := 1
else
Result := RVU_Length(Items[ItemNo], ItemOptions);
end;
{------------------------------------------------------------------------------}
{ Returns the file name in the directory Path. File name is built as
ImagesPrefix + <number> + Ext.
If OverrideFiles=True, <number> is imgSaveNo+1.
If not, <number> is increased until file name does not belong to an existing
file.
On exit, imgSaveNo = <number>.
Notes:
- ImagesPrefix can contain path. It may be the full path (contains ':')
or relative path. In the last case the file is assumed to be in
Path + ExtractFilePath(ImagesPrefix).
- It's assumed that the directory exists. }
function TCustomRVData.GetNextFileName(const ImagesPrefix, Path, Ext: String;
var imgSaveNo: Integer; OverrideFiles: Boolean): String;
var FullPath: String;
begin
if {$IFDEF RICHVIEWCBDEF3}AnsiPos{$ELSE}Pos{$ENDIF}(':',ImagesPrefix)>0 then
FullPath := ImagesPrefix
else
FullPath := Path+ImagesPrefix;
while True do begin
inc(imgSaveNo);
Result := FullPath+IntToStr(imgSaveNo)+Ext;
if not FileExists(Result) then
exit;
{$WARNINGS OFF}
if OverrideFiles and ((FileGetAttr(Result) and faReadOnly)=0) then
exit;
{$WARNINGS ON}
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddItem(const Text: String; Item: TCustomRVItemInfo);
var s: String;
begin
if (Item.ParaNo=-1) and (Items.Count<>0) and
not GetItem(Items.Count-1).GetBoolValue(rvbpFullWidth) then begin
Item.SameAsPrev := True;
Item.ParaNo := TCustomRVItemInfo(Items.Objects[Items.Count-1]).ParaNo;
end
else begin
{$IFNDEF RVDONOTUSELISTS}
if (Items.Count<>0) and (GetItemStyle(Items.Count-1)=rvsListMarker) then
AddNL('',0,-1);
{$ENDIF}
Item.SameAsPrev := False;
Item.BR := (Item.BR or not FAllowNewPara) and not Item.GetBoolValue(rvbpFullWidth);
if Item.ParaNo=-1 then
Item.ParaNo := 0;
end;
if Item.Checkpoint<>nil then
with Item.Checkpoint do
AddNamedCheckpointExTag(Name, RaiseEvent, Tag);
SetCP(Item, LastCP, NotAddedCP);
Item.UpdatePaletteInfo(GetDoInPaletteMode, False, GetRVPalette, GetRVLogPalette);
s := Text;
Item.Inserting(Self, s, False);
Items.AddObject(s, Item);
Item.Inserted(Self, Items.Count-1);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddItemAsIs(const Text: String; Item: TCustomRVItemInfo);
var s: String;
begin
if Item.Checkpoint<>nil then
with Item.Checkpoint do
AddNamedCheckpointExTag(Name, RaiseEvent, Tag);
SetCP(Item, LastCP, NotAddedCP);
Item.UpdatePaletteInfo(GetDoInPaletteMode, False, GetRVPalette, GetRVLogPalette);
s := Text;
Item.Inserting(Self, s, False);
Items.AddObject(s, Item);
Item.Inserted(Self, Items.Count-1);
end;
{------------------------------------------------------------------------------}
{ Does not replace tabs }
procedure TCustomRVData.AddNLTag_(const s: String; StyleNo, ParaNo, Tag: Integer);
var Item: TCustomRVItemInfo;
begin
Item := RichViewTextItemClass.Create(Self);
if StyleNo<0 then
Item.StyleNo := rvsDefStyle
else
Item.StyleNo := StyleNo;
Item.ParaNo := ParaNo;
Item.Tag := Tag;
{$IFNDEF RVDONOTUSEUNICODE}
if (GetRVStyle<>nil) and (GetRVStyle.TextStyles[GetActualStyle(Item)].Unicode) then
Include(Item.ItemOptions, rvioUnicode);
{$ENDIF}
AddItem(s, Item);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEUNICODE}
procedure TCustomRVData.AddNLATag_(const s: String; StyleNo, ParaNo, Tag: Integer);
var ress: String;
LParaNo: Integer;
begin
LParaNo := ParaNo;
if (StyleNo<0) or (StyleNo=rvsDefStyle) then begin
StyleNo := rvsDefStyle;
if LParaNo=-1 then begin
if Items.Count<>0 then
LParaNo := GetItemPara(Items.Count-1)
else
LParaNo := 0;
end;
end;
if (GetRVStyle<>nil) and
(GetRVStyle.TextStyles[GetActualStyle2(StyleNo, LParaNo)].Unicode) then
ress := RVU_AnsiToUnicode(GetStyleCodePage(GetActualStyle2(StyleNo, LParaNo)), s)
else
ress := s;
AddNLTag_(ress, StyleNo, ParaNo, Tag);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddNLTag(const s: String; StyleNo, ParaNo, Tag: Integer);
var Item: TCustomRVItemInfo;
begin
Item := RichViewTextItemClass.Create(Self);
if StyleNo<0 then
Item.StyleNo := rvsDefStyle
else
Item.StyleNo := StyleNo;
Item.ParaNo := ParaNo;
Item.Tag := Tag;
{$IFNDEF RVDONOTUSEUNICODE}
if (GetRVStyle<>nil) and (GetRVStyle.TextStyles[GetActualStyle(Item)].Unicode) then
Include(Item.ItemOptions, rvioUnicode);
{$ENDIF}
AddItem(ReplaceTabs(s, GetActualStyle(Item), False), Item);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEUNICODE}
function TCustomRVData.GetTextInItemFormatA(ItemNo: Integer; const s: String): String;
begin
if (GetItemStyle(ItemNo)>=0) and (rvioUnicode in GetItemOptions(ItemNo)) then
Result := RVU_AnsiToUnicode(GetStyleCodePage(GetItemStyle(ItemNo)), s)
else
Result := s;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddNLWTagRaw(const s: String; StyleNo, ParaNo, Tag: Integer);
var ansis: String;
begin
ansis := s;
if StyleNo<0 then
StyleNo := rvsDefStyle;
if (GetRVStyle<>nil) and
not GetRVStyle.TextStyles[GetActualStyle2(StyleNo, ParaNo)].Unicode then
ansis := RVU_UnicodeToAnsi(GetStyleCodePage(GetActualStyle2(StyleNo, ParaNo)), ansis);
AddNLTag(ansis, StyleNo, ParaNo, Tag);
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
function TCustomRVData.GetTextInItemFormatW(ItemNo: Integer; const s: WideString): String;
begin
Result := RVU_GetRawUnicode(s);
if (GetItemStyle(ItemNo)<0) or not (rvioUnicode in GetItemOptions(ItemNo)) then
Result := RVU_UnicodeToAnsi(GetStyleCodePage(GetItemStyle(ItemNo)), Result);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddNLWTag(const s: WideString; StyleNo, ParaNo, Tag: Integer);
begin
AddNLWTagRaw(RVU_GetRawUnicode(s), StyleNo, ParaNo, Tag);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemTextW(ItemNo: Integer): WideString;
var s: String;
begin
s := Items[ItemNo];
if (GetItemStyle(ItemNo)<0) or (not (rvioUnicode in GetItemOptions(ItemNo))) then
s := RVU_AnsiToUnicode(GetStyleCodePage(GetItemStyle(ItemNo)), s);
Result := RVU_RawUnicodeToWideString(s);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetItemTextW(ItemNo: Integer; const s: WideString);
begin
Items[ItemNo] := GetTextInItemFormatW(ItemNo, s);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddNLATag(const s: String; StyleNo, ParaNo, Tag: Integer);
var ress: String;
LParaNo: Integer;
begin
LParaNo := ParaNo;
if (StyleNo<0) or (StyleNo=rvsDefStyle) then begin
StyleNo := rvsDefStyle;
if LParaNo=-1 then begin
if Items.Count<>0 then
LParaNo := GetItemPara(Items.Count-1)
else
LParaNo := 0;
end;
end;
if (GetRVStyle<>nil) and
(GetRVStyle.TextStyles[GetActualStyle2(StyleNo, LParaNo)].Unicode) then
ress := RVU_AnsiToUnicode(GetStyleCodePage(GetActualStyle2(StyleNo, LParaNo)), s)
else
ress := s;
AddNLTag(ress, StyleNo, ParaNo, Tag);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetItemTextA(ItemNo: Integer; const s: String);
begin
Items[ItemNo] := GetTextInItemFormatA(ItemNo, s);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemTextA(ItemNo: Integer): String;
begin
Result := Items[ItemNo];
{$IFNDEF RVDONOTUSEUNICODE}
if (GetItemStyle(ItemNo)>=0) and (rvioUnicode in GetItemOptions(ItemNo)) then
Result := RVU_UnicodeToAnsi(GetStyleCodePage(GetItemStyle(ItemNo)), Result);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddNL(const s: String; StyleNo, ParaNo: Integer);
begin
AddNLTag(s, StyleNo, ParaNo, 0);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddFmt(const FormatStr: String; const Args: array of const;
StyleNo, ParaNo: Integer);
begin
AddNL(Format(FormatStr,Args), StyleNo, ParaNo);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddTextNL(const s: String; StyleNo,
FirstParaNo, OtherParaNo : Integer
{$IFDEF RICHVIEWDEF4};Tag: Integer=0{$ENDIF});
begin
AddTextUniversal(s, StyleNo, FirstParaNo, OtherParaNo, False, False,
{$IFDEF RICHVIEWDEF4}Tag{$ELSE}0{$ENDIF});
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEUNICODE}
procedure TCustomRVData.AddTextNLA(const s: String; StyleNo,
FirstParaNo, OtherParaNo : Integer
{$IFDEF RICHVIEWDEF4};Tag: Integer=0{$ENDIF});
begin
AddTextUniversal(s, StyleNo, FirstParaNo, OtherParaNo, False, True,
{$IFDEF RICHVIEWDEF4}Tag{$ELSE}0{$ENDIF});
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddTextBlockNL(const s: String; StyleNo, ParaNo: Integer
{$IFDEF RICHVIEWDEF4};Tag: Integer=0{$ENDIF});
begin
AddTextUniversal(s, StyleNo, ParaNo, ParaNo, True, False,
{$IFDEF RICHVIEWDEF4}Tag{$ELSE}0{$ENDIF});
end;
{------------------------------------------------------------------------------}
function TCustomRVData.AddNamedCheckpointExTag(const CpName: String;
RaiseEvent: Boolean;
Tag: Integer): Integer;
begin
{$IFDEF RVALLOWCPBYCP}
if NotAddedCP<>nil then begin
Result := CPCount-1;
exit;
end;
{$ELSE}
if NotAddedCP<>nil then
raise ERichViewError.Create(errCPByCP);
{$ENDIF}
NotAddedCP := TRVCPInfo.Create;
NotAddedCP.Name := CPName;
NotAddedCP.Tag := Tag;
NotAddedCP.Next := nil;
NotAddedCP.Prev := nil;
//NotAddedCP.ItemNo := -1;
NotAddedCP.RaiseEvent := RaiseEvent;
Result := CPCount;
inc(CPCount);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSETABS}
procedure TCustomRVData.AddTab(TextStyleNo, ParaNo: Integer);
var Item: TRVTabItemInfo;
begin
Item := TRVTabItemInfo.Create(Self);
Item.StyleNo := rvsTab;
Item.TextStyleNo := TextStyleNo;
Item.ParaNo := ParaNo;
Item.SameAsPrev := ParaNo=-1;
AddItem('', Item);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddBreakExTag(Width: Byte; Style: TRVBreakStyle;
Color: TColor; Tag: Integer);
var Item: TRVBreakItemInfo;
begin
Item := TRVBreakItemInfo.CreateEx(Self, Width, Style, Color);
Item.SameAsPrev := False;
Item.ParaNo := 0;
Item.Tag := Tag;
AddItem('',Item);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddBreakEx(Width: Byte; Style: TRVBreakStyle;
Color: TColor);
begin
AddBreakExTag(Width, Style, Color, 0);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddBreakTag(Tag: Integer);
begin
AddBreakExTag(1, rvbsLine, clNone, Tag);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddBreak;
begin
AddBreakTag(0);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddHotspotExTag(const Name: String;
ImageIndex, HotImageIndex: Integer;
ImageList: TCustomImageList;
ParaNo, Tag: Integer);
var Item: TRVHotspotItemInfo;
begin
Item := TRVHotspotItemInfo.CreateEx(Self, ImageIndex, HotImageIndex,
ImageList, rvvaBaseLine);
Item.ParaNo := ParaNo;
Item.Tag := Tag;
AddItem(Name, Item);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddHotspotEx(const Name: String;
ImageIndex, HotImageIndex: Integer;
ImageList: TCustomImageList;
ParaNo: Integer);
begin
AddHotspotExTag(Name, ImageIndex, HotImageIndex, ImageList, ParaNo, 0);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddBulletExTag(const Name: String; ImageIndex: Integer;
ImageList: TCustomImageList;
ParaNo, Tag: Integer);
var Item: TRVBulletItemInfo;
begin
Item := TRVBulletItemInfo.CreateEx(Self, ImageIndex, ImageList, rvvaBaseline);
Item.ParaNo := ParaNo;
Item.Tag := Tag;
AddItem(Name, Item);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddBulletEx(const Name: String; ImageIndex: Integer;
ImageList: TCustomImageList;
ParaNo: Integer);
begin
AddBulletExTag(Name, ImageIndex, ImageList, ParaNo, 0)
end;
{------------------------------------------------------------------------------}
{ "gr" does not copied, do not free it! }
procedure TCustomRVData.AddPictureExTag(const Name: String; gr: TGraphic;
ParaNo: Integer; VAlign: TRVVAlign;
Tag: Integer);
var Item: TRVGraphicItemInfo;
begin
Item := TRVGraphicItemInfo.CreateEx(Self, gr, VAlign);
Item.ParaNo := ParaNo;
Item.Tag := Tag;
AddItem(Name, Item);
end;
{------------------------------------------------------------------------------}
{ gr does not copied, do not free it! }
procedure TCustomRVData.AddPictureEx(const Name: String; gr: TGraphic;
ParaNo: Integer;
VAlign: TRVVAlign);
begin
AddPictureExTag(Name, gr, ParaNo, VAlign, 0);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddHotPicture(const Name: String; gr: TGraphic;
ParaNo: Integer; VAlign: TRVVAlign);
begin
AddHotPictureTag(Name, gr, ParaNo, VAlign, 0);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddHotPictureTag(const Name: String; gr: TGraphic;
ParaNo: Integer; VAlign: TRVVAlign; Tag: Integer);
var Item: TRVHotGraphicItemInfo;
begin
Item := TRVHotGraphicItemInfo.CreateEx(Self, gr, VAlign);
Item.ParaNo := ParaNo;
Item.Tag := Tag;
AddItem(Name, Item);
end;
{------------------------------------------------------------------------------}
{ do not free ctrl yourself! }
procedure TCustomRVData.AddControlExTag(const Name: String; ctrl: TControl;
ParaNo: Integer; VAlign: TRVVAlign;
Tag: Integer);
var Item: TRVControlItemInfo;
begin
Item := TRVControlItemInfo.CreateEx(Self, ctrl, VAlign);
Item.StyleNo := rvsComponent;
Item.ParaNo := ParaNo;
Item.Tag := Tag;
AddItem(Name, Item);
ctrl.Parent := GetParentControl;
end;
{------------------------------------------------------------------------------}
{ do not free ctrl yourself! }
procedure TCustomRVData.AddControlEx(const Name: String; ctrl: TControl;
ParaNo: Integer;
VAlign: TRVVAlign);
begin
AddControlExTag(Name, ctrl, ParaNo, VAlign, 0);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetAddParagraphMode(AllowNewPara: Boolean);
begin
FAllowNewPara := AllowNewPara;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetCP(Item: TCustomRVItemInfo; var PrevCP, CP: TRVCPInfo);
begin
if CP=nil then
exit;
CP.Prev := PrevCP;
CP.ItemInfo := Item;
if (PrevCP=nil) then begin // inserting before first, making first
if FirstCP<>nil then
FirstCP.Prev := CP;
CP.Next := FirstCP;
FirstCP := CP;
end
else
CP.Next := PrevCP.Next;
if PrevCP<>nil then
PrevCP.Next := CP;
if CP.Next<>nil then
CP.Next.Prev := CP;
if PrevCP=LastCP then
LastCP := CP;
Item.Checkpoint := CP;
CP := nil;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.UnlinkCheckpoint(cp: TRVCPInfo; DecCPCount: Boolean);
begin
if cp<>nil then begin
cp.ItemInfo := nil;
if FirstCP = cp then FirstCP := cp.Next;
if LastCP = cp then LastCP := cp.Prev;
if cp.Prev<>nil then cp.Prev.Next := cp.Next;
if cp.Next<>nil then cp.Next.Prev := cp.Prev;
if DecCPCount then
dec(CPCount);
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.FreeCheckpoint(var cp: TRVCPInfo; AdjustLinks,DecCPCount: Boolean);
begin
if cp<>nil then begin
if AdjustLinks then
UnlinkCheckpoint(cp,False);
if rvoTagsArePChars in Options then
StrDispose(PChar(cp.Tag));
cp.Free;
cp := nil;
if DecCPCount then
dec(CPCount);
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.ShareItems: Boolean;
begin
Result := False;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.CanLoadLayout: Boolean;
begin
Result := False;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DeleteItems(FirstItemNo, Count: Integer);
var i: Integer;
begin
if ShareItems then exit;
if FirstItemNo>=Items.Count then exit;
if FirstItemNo+Count>Items.Count then
Count := Items.Count-FirstItemNo;
Items.BeginUpdate;
try
for i := FirstItemNo to FirstItemNo+Count-1 do
FreeItem(i,False);
for i :=1 to Count do
Items.Delete(FirstItemNo);
finally
Items.EndUpdate;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DeleteSection(const CpName: String);
var startno, endno: Integer;
cp: TRVCPInfo;
begin
if ShareItems then exit;
cp := FirstCP;
startno := -1;
endno := -1;
while cp<>nil do begin
if cp.Name=CpName then begin
startno := Items.IndexOfObject(cp.ItemInfo);
endno := Items.Count-1;
break;
end;
cp := cp.Next;
end;
if startno=-1 then exit;
cp := cp.Next;
while cp<>nil do begin
if cp.Name<>'' then begin
endno := Items.IndexOfObject(cp.ItemInfo)-1;
break;
end;
cp := cp.Next;
end;
DeleteItems(startno, endno-startno+1);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.InternalFreeItem(item: TCustomRVItemInfo; Clearing: Boolean);
begin
if Item=nil then
exit;
{$IFNDEF RVDONOTUSELISTS}
DeleteMarkerFromList(item, Clearing);
{$ENDIF}
FreeCheckpoint(Item.Checkpoint, True, True);
if rvoTagsArePChars in Options then
StrDispose(PChar(Item.Tag));
Item.Free;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.FreeItem(ItemNo: Integer; Clearing: Boolean);
var item: TCustomRVItemInfo;
s: String;
begin
item := TCustomRVItemInfo(Items.Objects[ItemNo]);
s := Items[ItemNo];
ItemAction(rviaDestroying, item, s, Self);
ControlAction(rvcaDestroy, ItemNo, item);
InternalFreeItem(item, Clearing);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.Clear;
var i: Integer;
Clearing: Boolean;
begin
Clearing := rvstClearing in State;
Include(State, rvstClearing);
try
Exclude(State, rvstFirstParaAborted);
Exclude(State, rvstLastParaAborted);
if not ShareItems then begin
Items.BeginUpdate;
for i:=0 to Items.Count-1 do
FreeItem(i,True);
Items.Clear;
Items.EndUpdate;
end;
FreeCheckpoint(NotAddedCP, False, True);
FirstCP := nil;
LastCP := nil;
if GetDocProperties<>nil then
GetDocProperties.Clear;
finally
if not Clearing then
Exclude(State, rvstClearing);
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetOffsBeforeItem(ItemNo: Integer): Integer;
begin
if GetItemStyle(ItemNo)<0 then
Result := 0
else
Result := 1;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetOffsAfterItem(ItemNo: Integer): Integer;
begin
if GetItemStyle(ItemNo)<0 then
Result := 1
else
Result := RVU_Length(Items[ItemNo], GetItemOptions(ItemNo))+1;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.ReplaceTabs(const s: String; StyleNo: Integer;
UnicodeDef: Boolean): String;
begin
if GetRVStyle = nil then begin
{$IFNDEF RVDONOTUSEUNICODE}
if UnicodeDef then
Result := RV_ReplaceTabsW(s,8)
else
{$ENDIF}
Result := RV_ReplaceTabsA(s,8)
end
else
{$IFNDEF RVDONOTUSEUNICODE}
if GetRVStyle.TextStyles[StyleNo].Unicode then
Result := RV_ReplaceTabsW(s, GetRVStyle.SpacesInTab)
else
{$ENDIF}
Result := RV_ReplaceTabsA(s, GetRVStyle.SpacesInTab);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddStringFromFile(const s: String;
StyleNo,ParaNo: Integer; FromNewLine, AsSingleParagraph: Boolean;
var FirstTime, PageBreak: Boolean);
begin
if not FromNewLine then
ParaNo := -1;
{$IFNDEF RVDONOTUSEUNICODE}
AddNLATag(s,StyleNo,ParaNo,0);
{$ELSE}
AddNLTag(s,StyleNo,ParaNo,0);
{$ENDIF}
if AsSingleParagraph and FirstTime then begin
SetAddParagraphMode(False);
FirstTime := False;
end;
if PageBreak then begin
PageBreaksBeforeItems[Items.Count-1] := True;
PageBreak := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.LoadText(const FileName: String; StyleNo, ParaNo: Integer;
AsSingleParagraph: Boolean): Boolean;
var Stream: TFileStream;
{
f: TextFile;
s: String;
}
begin
{
AssignFile(f, FileName);
Reset(f);
while not eof(f) do begin
Readln(f, s);
AddTextNL(s, StyleNo, ParaNo, ParaNo);
end;
CloseFile(f);
Result := True;
exit;
}
try
Stream := TFileStream.Create(FileName, fmOpenRead);
try
Result := LoadTextFromStream(Stream, StyleNo, ParaNo, AsSingleParagraph)
finally
Stream.Free;
end;
except
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.AddTextUniversal(const text: String; StyleNo, FirstParaNo,
OtherParaNo: Integer; AsSingleParagraph, CheckUnicode: Boolean; Tag: Integer): Boolean;
var ANP: Boolean;
FromNewLine, FirstTime, ProcessPageBreaks, PageBreak, ProcessTabs,
CopyTags: Boolean;
ParaNo : Integer;
fulltextstartptr, startptr, ptr, endptr: PChar;
SkipIfEqual: Char;
TabItem: TRVTabItemInfo;
{........................................................}
procedure AddTextItem;
var AParaNo, ATag: Integer;
s: String;
begin
s := System.Copy(text, startptr-fulltextstartptr+1, ptr-startptr);
if (s='') and not FromNewLine then
exit;
if FromNewLine or PageBreak then
AParaNo := ParaNo
else
AParaNo := -1;
if CopyTags then
ATag := RV_CopyTag(Tag, True)
else
ATag := Tag;
{$IFNDEF RVDONOTUSEUNICODE}
if not CheckUnicode then
{$ENDIF}
if ProcessTabs then
AddNLTag_(s, StyleNo, AParaNo, ATag)
else
AddNLTag(s, StyleNo, AParaNo, ATag)
{$IFNDEF RVDONOTUSEUNICODE}
else
if ProcessTabs then
AddNLATag_(s, StyleNo, AParaNo, ATag)
else
AddNLATag(s, StyleNo, AParaNo, ATag)
{$ENDIF};
FromNewLine := False;
if PageBreak then begin
PageBreaksBeforeItems[Items.Count-1] := True;
PageBreak := False;
end;
if AsSingleParagraph and FirstTime then begin
SetAddParagraphMode(False);
FirstTime := False;
end;
end;
{........................................................}
begin
ANP := FAllowNewPara;
FirstTime := True;
Result := True;
ProcessPageBreaks := SupportsPageBreaks;
PageBreak := False;
ProcessTabs := (GetRVStyle<>nil) and (GetRVStyle.SpacesInTab<=0);
CopyTags := (Tag<>0) and (rvoTagsArePChars in Options);
ParaNo := FirstParaNo;
FromNewLine := ParaNo>=0;
try
fulltextstartptr := PChar(text);
startptr := fulltextstartptr;
ptr := startptr;
endptr := PChar(text)+Length(text);
SkipIfEqual := #0;
while ptr<endptr do begin
if SkipIfEqual<>#0 then begin
if (ptr^=SkipIfEqual) then begin
inc(startptr);
inc(ptr);
SkipIfEqual := #0;
continue;
end;
SkipIfEqual := #0;
end;
if ((ptr^) in [#10, #12, #13]) or (ProcessTabs and ((ptr^)=#9)) then begin
AddTextItem;
startptr := ptr+1;
end;
case ptr^ of
#9: // tab
begin
if ProcessTabs then begin
TabItem := TRVTabItemInfo.Create(Self);
TabItem.StyleNo := rvsTab;
TabItem.TextStyleNo := StyleNo;
if FromNewLine then
TabItem.ParaNo := ParaNo
else
TabItem.ParaNo := -1;
AddItem('', TabItem);
FromNewLine := False;
end;
end;
#12: // page break
begin
PageBreak := ProcessPageBreaks;
FromNewLine := True;
ParaNo := OtherParaNo;
end;
#13:
begin
FromNewLine := True;
SkipIfEqual := #10;
ParaNo := OtherParaNo;
end;
#10:
begin
FromNewLine := True;
SkipIfEqual := #13;
ParaNo := OtherParaNo;
end;
end;
inc(ptr);
end;
AddTextItem;
except
Result := False;
end;
SetAddParagraphMode(ANP);
if CopyTags then
StrDispose(PChar(Tag));
end;
{------------------------------------------------------------------------------}
function TCustomRVData.LoadTextFromStream(Stream: TStream; StyleNo,
ParaNo: Integer; AsSingleParagraph: Boolean):Boolean;
var FullText: String;
begin
if Stream.Size=Stream.Position then begin
Result := True;
exit;
end;
SetLength(FullText, Stream.Size-Stream.Position);
Stream.ReadBuffer(PChar(FullText)^, Length(FullText));
Replace0(FullText);
Result := AddTextUniversal(FullText, StyleNo, ParaNo, ParaNo,
AsSingleParagraph, True, 0);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SaveTextToStream(const Path: String; Stream: TStream;
LineWidth: Integer;
SelectionOnly, TextOnly, Unicode, UnicodeWriteSignature: Boolean):Boolean;
var i, StartItemNo,EndItemNo,StartOffs,EndOffs: Integer;
{$IFNDEF RVDONOTUSELISTS}
MarkerItemNo: Integer;
{$ENDIF}
Item: TCustomRVItemInfo;
s: String;
NotUsedPart: TRVMultiDrawItemPart;
CustomSave: Boolean;
{$IFNDEF RVDONOTUSEUNICODE}
UniSign: Word;
{$ENDIF}
{..................................................}
function GetStr(Item:TCustomRVItemInfo; const s: String;
CustomSave: Boolean) : String;
begin
{$IFNDEF RVDONOTUSEUNICODE}
if not CustomSave then begin
if (Item=nil) or (Item.StyleNo<0) then begin
if Unicode and ((Item=nil) or not Item.GetBoolValue(rvbpCanSaveUnicode)) then
Result := RVU_AnsiToUnicode(GetDefaultCodePage, s)
else
Result := s
end
else if (rvioUnicode in Item.ItemOptions) and not Unicode then
Result := RVU_UnicodeToAnsi(GetDefaultCodePage, s)
else if not (rvioUnicode in Item.ItemOptions) and Unicode then
Result := RVU_AnsiToUnicode(GetStyleCodePage(GetActualStyle(Item)), s)
else
Result := s;
end
else
{$ENDIF}
Result := s;
end;
{..................................................}
function GetTextStr(ItemNo, StartOffs, EndOffs: Integer;
var CustomSave: Boolean): String;
begin
if StartOffs<0 then
Result := Items[ItemNo]
else
Result := RVU_Copy(Items[ItemNo], StartOffs, EndOffs-StartOffs,
GetItem(ItemNo).ItemOptions);
CustomSave := SaveItemToFile(Path, Self, ItemNo, rvsfText, Unicode, Result);
end;
{..................................................}
function GetNonTextStr(ItemNo, StartOffs, EndOffs: Integer;
var CustomSave: Boolean): String;
var SaveUnicode: Boolean;
Item: TCustomRVItemInfo;
begin
CustomSave := False;
Item := GetItem(ItemNo);
Result := '';
if (not TextOnly or Item.GetBoolValue(rvbpAlwaysInText)) and
(StartOffs<EndOffs) then begin
CustomSave := SaveItemToFile(Path, Self, ItemNo, rvsfText, Unicode, Result);
if not CustomSave then begin
{$IFNDEF RVDONOTUSEUNICODE}
SaveUnicode := Unicode and Item.GetBoolValue(rvbpCanSaveUnicode);
{$ELSE}
SaveUnicode := False;
{$ENDIF}
Result := GetItem(ItemNo).AsText(LineWidth, Self, Items[ItemNo], Path,
TextOnly, SaveUnicode);
end;
end;
end;
{..................................................}
begin
try
Result := True;
RVFGetLimits(GetRVFSaveScope(SelectionOnly),StartItemNo,EndItemNo,StartOffs,EndOffs,NotUsedPart,NotUsedPart);
if (StartItemNo=-1) or (StartItemNo>EndItemNo) then
exit;
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode and UnicodeWriteSignature then begin
UniSign := UNI_LSB_FIRST;
Stream.WriteBuffer(UniSign, 2);
end;
{$ENDIF}
{$IFNDEF RVDONOTUSELISTS}
if SelectionOnly then begin
MarkerItemNo := GetFirstParaSectionItem(StartItemNo);
if GetItemStyle(MarkerItemNo)=rvsListMarker then begin
s := GetNonTextStr(MarkerItemNo, 0, 1, CustomSave);
RVFWrite(Stream, GetStr(GetItem(MarkerItemNo), s, CustomSave));
end;
end;
{$ENDIF}
Item := GetItem(StartItemNo);
if StartItemNo = EndItemNo then begin
if Item.StyleNo<0 then
s := GetNonTextStr(StartItemNo, StartOffs, EndOffs, CustomSave)
else
s := GetTextStr(StartItemNo, StartOffs, EndOffs, CustomSave);
RVFWrite(Stream, GetStr(Item, s, CustomSave));
end
else begin
if Item.StyleNo < 0 then
s := GetNonTextStr(StartItemNo, StartOffs, 1, CustomSave)
else
s := GetTextStr(StartItemNo, StartOffs, RVU_Length(Items[StartItemNo],
Item.ItemOptions)+1, CustomSave);
RVFWrite(Stream, GetStr(Item, s, CustomSave));
for i := StartItemNo+1 to EndItemNo-1 do begin
Item := GetItem(i);
if Item.PageBreakBefore and RichViewSavePageBreaksInText then
RVFWrite(Stream, GetStr(nil, #$0C, False))
else if not Item.SameAsPrev then
RVFWrite(Stream, GetStr(nil, crlf, False));
if Item.StyleNo < 0 then
s := GetNonTextStr(i, 0, 1, CustomSave)
else
s := GetTextStr(i, -1, -1, CustomSave);
RVFWrite(Stream, GetStr(Item, s, CustomSave));
end;
Item := GetItem(EndItemNo);
if Item.PageBreakBefore and RichViewSavePageBreaksInText then
RVFWrite(Stream, GetStr(nil, #$0C, False))
else if not Item.SameAsPrev then
RVFWrite(Stream, GetStr(nil, crlf, False));
if Item.StyleNo < 0 then
s := GetNonTextStr(EndItemNo, 0, EndOffs, CustomSave)
else
s := GetTextStr(EndItemNo, 1, EndOffs, CustomSave);
RVFWrite(Stream, GetStr(Item, s, CustomSave));
end;
except
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SaveText(const FileName: String; LineWidth: Integer;
Unicode: Boolean): Boolean;
var Stream: TFileStream;
begin
try
Stream := TFileStream.Create(FileName, fmCreate);
try
Result := SaveTextToStream(ExtractFilePath(FileName), Stream, LineWidth,
False, False, Unicode, Unicode);
finally
Stream.Free;
end;
except
Result := False;
end;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEUNICODE}
procedure TCustomRVData.AddTextNLW(const s: String; StyleNo, FirstParaNo,
OtherParaNo : Integer; DefAsSingleParagraph: Boolean);
var
ParaNo: Integer;
startptr,ptr,endptr: PWord;
SkipIfEqual: Word;
ANP: Boolean;
ProcessTabs, ProcessPageBreaks, PageBreak, FromNewLine: Boolean;
TabItem: TRVTabItemInfo;
{.................................}
procedure AddTextItem(AllowAddingEmpty: Boolean);
var str: String;
AParaNo: Integer;
begin
if (startptr=ptr) and (not FromNewLine or not AllowAddingEmpty) then
exit;
str := Copy(s, PChar(startptr)-PChar(s)+1, PChar(ptr)-PChar(startptr));
if FromNewLine or PageBreak then
AParaNo := ParaNo
else
AParaNo := -1;
AddNLWTagRaw(str, StyleNo, AParaNo, 0);
FromNewLine := False;
if PageBreak then begin
PageBreaksBeforeItems[Items.Count-1] := True;
PageBreak := False;
end;
end;
{.................................}
begin
ANP := FAllowNewPara;
RVCheckUni(Length(s));
startptr := PWord(PChar(s));
endptr := PWord(PChar(s)+Length(s));
RVU_ProcessByteOrderMark(startptr, Length(s) div 2);
ptr := startptr;
if ptr=endptr then begin
if FirstParaNo<>-1 then
AddNL(s, StyleNo, FirstParaNo);
exit;
end;
ParaNo := FirstParaNo;
FromNewLine := ParaNo>=0;
SkipIfEqual := 0;
ProcessPageBreaks := SupportsPageBreaks;
PageBreak := False;
ProcessTabs := (GetRVStyle<>nil) and (GetRVStyle.SpacesInTab<=0);
SetAddParagraphMode(not DefAsSingleParagraph);
while PChar(ptr)<PChar(endptr) do begin
if SkipIfEqual<>0 then begin
if (ptr^=SkipIfEqual) then begin
inc(PChar(startptr),2);
inc(PChar(ptr), 2);
SkipIfEqual := 0;
continue;
end;
SkipIfEqual := 0;
end;
case ptr^ of
UNI_LineSeparator, UNI_VerticalTab:
begin
AddTextItem(True);
SetAddParagraphMode(False);
ParaNo := OtherParaNo;
FromNewLine := True;
startptr := PWord(PChar(ptr)+2);
end;
UNI_ParagraphSeparator:
begin
AddTextItem(True);
SetAddParagraphMode(True);
ParaNo := OtherParaNo;
FromNewLine := True;
startptr := PWord(PChar(ptr)+2);
end;
UNI_FF:
begin
AddTextItem(True);
PageBreak := ProcessPageBreaks;
ParaNo := OtherParaNo;
FromNewLine := True;
startptr := PWord(PChar(ptr)+2);
end;
UNI_CR:
begin
AddTextItem(True);
SetAddParagraphMode(not DefAsSingleParagraph);
SkipIfEqual := UNI_LF;
ParaNo := OtherParaNo;
FromNewLine := True;
startptr := PWord(PChar(ptr)+2);
end;
UNI_LF:
begin
AddTextItem(True);
SetAddParagraphMode(not DefAsSingleParagraph);
SkipIfEqual := UNI_CR;
ParaNo := OtherParaNo;
FromNewLine := True;
startptr := PWord(PChar(ptr)+2);
end;
UNI_Tab:
begin
if ProcessTabs then begin
AddTextItem(False);
TabItem := TRVTabItemInfo.Create(Self);
TabItem.StyleNo := rvsTab;
TabItem.TextStyleNo := StyleNo;
if FromNewLine then
TabItem.ParaNo := ParaNo
else
TabItem.ParaNo := -1;
AddItem('', TabItem);
FromNewLine := False;
SetAddParagraphMode(not DefAsSingleParagraph);
startptr := PWord(PChar(ptr)+2);
end;
end;
end;
inc(PChar(ptr), 2);
end;
AddTextItem(True);
SetAddParagraphMode(ANP);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.LoadTextFromStreamW(Stream: TStream; StyleNo, ParaNo: Integer;
DefAsSingleParagraph: Boolean):Boolean;
var s: String;
begin
Result := True;
try
RVCheckUni(Stream.Size-Stream.Position);
SetLength(s, Stream.Size-Stream.Position);
Stream.ReadBuffer(PChar(s)^,Stream.Size-Stream.Position);
AddTextNLW(s, StyleNo, ParaNo, ParaNo, DefAsSingleParagraph);
except
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.LoadTextW(const FileName: String; StyleNo, ParaNo: Integer;
DefAsSingleParagraph: Boolean): Boolean;
var Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead);
try
Result := LoadTextFromStreamW(Stream, StyleNo, ParaNo, DefAsSingleParagraph);
finally
Stream.Free;
end;
end;
{$ENDIF}
{$IFNDEF RVDONOTUSEHTML}
{------------------------------------------------------------------------------}
function TCustomRVData.SaveHTML(const FileName, Title,
ImagesPrefix: String; Options: TRVSaveOptions; Color: TColor;
var imgSaveNo: Integer;
LeftMargin, TopMargin, RightMargin, BottomMargin: Integer;
Background: TRVBackground): Boolean;
var Stream: TFileStream;
begin
try
Stream := TFileStream.Create(FileName, fmCreate);
try
Result := SaveHTMLToStream(Stream, ExtractFilePath(FileName),
Title, ImagesPrefix, Options,
Color, imgSaveNo,
LeftMargin, TopMargin,
RightMargin, BottomMargin,
Background, nil);
finally
Stream.Free;
end;
except
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SaveHTMLEx(const FileName, Title, ImagesPrefix,
ExtraStyles, ExternalCSS, CPPrefix: String; Options: TRVSaveOptions;
Color: TColor; var CurrentFileColor: TColor; var imgSaveNo: Integer;
LeftMargin, TopMargin, RightMargin, BottomMargin: Integer;
Background: TRVBackground):Boolean;
var Stream: TFileStream;
begin
try
Stream := TFileStream.Create(FileName, fmCreate);
try
Result := SaveHTMLToStreamEx(Stream, ExtractFilePath(FileName),
Title, ImagesPrefix, ExtraStyles, ExternalCSS, CPPrefix, Options,
Color, CurrentFileColor, imgSaveNo, LeftMargin, TopMargin,
RightMargin, BottomMargin, Background, nil);
finally
Stream.Free;
end;
except
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.ShouldSaveTextToHTML(StyleNo: Integer): Boolean;
begin
with GetRVStyle.TextStyles[StyleNo] do
Result := (rvteoHTMLCode in Options) or not (rvteoRTFCode in Options)
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetHTMLATag(ItemNo: Integer; CSS: String;
UTF8: Boolean): String;
var Target, Extras: String;
begin
WriteHyperlink(GetItem(ItemNo).JumpID+FirstJumpNo, Self, ItemNo, rvsfHTML,
Target, Extras);
if (Target<>'') or (Extras<>'') then begin
if Extras<>'' then
Extras := ' '+Extras;
if CSS<>'' then
CSS := ' '+CSS;
Result := Format('<a%s href="%s"%s>',[CSS, Target, Extras]);
if UTF8 then
Result := RVU_AnsiToUTF8(GetRVStyle.DefCodePage, Result);
end
else
Result := '';
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SaveHTMLCheckpoint(Stream: TStream;
Checkpoint: TRVCPInfo; var cpno: Integer; const Prefix: String;
FromNewLine: Boolean; Options: TRVSaveOptions);
begin
if Checkpoint<>nil then begin
if FromNewLine then
RVWriteLn(Stream,'');
if (rvsoUseCheckpointsNames in Options) and (Checkpoint.Name<>'') then
RVWriteLn(Stream,'<a name="'+Checkpoint.Name+'"></a>')
else
RVWriteLn(Stream,'<a name='+Prefix+IntToStr(cpno)+'></a>');
inc(cpno);
end;
end;
{------------------------------------------------------------------------------}
{ Returns text string for saving to HTML. Path - path for saving HTML (pictures).
ItemNo - index of text item to save.
CSSVersion is True is called from SaveHTMLEx.
Calls OnSaveItemToHTML, if assigned.
If CSSVersion, special processing for "Symbol" font }
function TCustomRVData.GetTextForHTML(const Path: String; ItemNo: Integer;
CSSVersion: Boolean; SaveOptions: TRVSaveOptions): String;
var Item: TCustomRVItemInfo;
FontInfo: TFontInfo;
StyleNo: Integer;
begin
Result := Items[ItemNo];
if not SaveItemToFile(Path, Self, ItemNo, rvsfHTML, False, Result) then begin
if (Result='') and IsFromNewLine(ItemNo) and
((ItemNo+1=ItemCount) or IsFromNewLine(ItemNo+1)) then begin
Result := Format('<br%s>', [RV_HTMLGetEndingSlash(SaveOptions)]);
exit;
end;
Item := GetItem(ItemNo);
StyleNo := GetActualStyle(Item);
FontInfo := GetRVStyle.TextStyles[StyleNo];
{$IFNDEF RVDONOTUSEUNICODE}
if rvioUnicode in Item.ItemOptions then
if CSSVersion and (AnsiCompareText(FontInfo.FontName, RVFONT_SYMBOL)=0) then
Result := RV_MakeHTMLSymbolStrRaw(Result)
else if rvsoUTF8 in SaveOptions then
Result := RVU_UnicodeToUTF8(Result, rvteoHTMLCode in FontInfo.Options)
else
Result := RVU_GetHTMLEncodedUnicode(Result, rvteoHTMLCode in FontInfo.Options)
else
{$ENDIF}
if CSSVersion and (AnsiCompareText(FontInfo.FontName, RVFONT_SYMBOL)=0) then
Result := RV_MakeHTMLSymbolStr(Result)
else begin
Result := RV_MakeHTMLStr(Result, rvteoHTMLCode in FontInfo.Options);
if rvsoUTF8 in SaveOptions then
Result := RVU_AnsiToUTF8(GetStyleCodePage(StyleNo), Result);
end;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SaveHTMLToStream(Stream: TStream; const Path, Title,
ImagesPrefix: String; Options: TRVSaveOptions; Color: TColor;
var imgSaveNo: Integer; LeftMargin, TopMargin, RightMargin, BottomMargin: Integer;
Background: TRVBackground; Bullets: TRVList): Boolean;
{......................................................}
procedure WriteExtraHTMLCode(Area: TRVHTMLSaveArea; AddSpace: Boolean);
var s: String;
begin
s := GetExtraHTMLCode(Area, False);
if s<>'' then
if AddSpace then
RVWrite(Stream,' '+s)
else
RVWrite(Stream, s);
end;
{...........................................................}
procedure SaveFirst(Stream: TStream; const Path, Title: String);
var s: String;
begin
if rvsoXHTML in Options then begin
RVWrite(Stream, '<?xml version="1.0"');
{$IFDEF RICHVIEWCBDEF3}
if rvsoUTF8 in Options then
s := 'UTF-8'
else
s := RV_CharSet2HTMLLang(GetRVStyle.TextStyles[0].CharSet);
if s<>'' then
RVWrite(Stream,SysUtils.Format(' encoding="%s"',[s]));
{$ENDIF}
RVWriteLn(Stream, '?>');
end;
s := Title;
if rvsoUTF8 in Options then
s := RVU_AnsiToUTF8(GetRVStyle.DefCodePage, Title);
RVWriteLn(Stream,'<html><head><title>'+s+'</title>');
{$IFDEF RICHVIEWCBDEF3}
if rvsoUTF8 in Options then
s := 'UTF-8'
else
s := RV_CharSet2HTMLLang(GetRVStyle.TextStyles[0].CharSet);
if s<>'' then
RVWriteLn(Stream,SysUtils.Format('<meta http-equiv="Content-Type" content="text/html; charset=%s"%s>',
[s, RV_HTMLGetEndingSlash(Options)]));
{$ENDIF}
WriteExtraHTMLCode(rv_thms_Head, False);
RVWriteLn(Stream,'</head>');
RVWrite(Stream,'<body');
if Color<>clNone then
RVWrite(Stream,' bgcolor='+RV_GetHTMLRGBStr(Color, True));
if (Background.Style<>bsNoBitmap) and
(not Background.Bitmap.Empty) then begin
s := SaveBackgroundToHTML(Background.Bitmap, Color, Path, ImagesPrefix,
imgSaveNo, Options);
if s<>'' then begin
RVWrite(Stream, Format(' background="%s"', [s]));
if (Background.Style<>bsTiledAndScrolled) then
RVWrite(Stream,Format(' bgproperties=%s', [RV_HTMLGetStrAttrVal('fixed', Options)]));
end;
end;
WriteExtraHTMLCode(rv_thms_BodyAttribute, True);
RVWriteLn(Stream, Format(' leftmargin=%s topmargin=%s rightmargin=%s bottommargin=%s>',
[RV_HTMLGetIntAttrVal(LeftMargin, Options),
RV_HTMLGetIntAttrVal(TopMargin, Options),
RV_HTMLGetIntAttrVal(RightMargin, Options),
RV_HTMLGetIntAttrVal(BottomMargin, Options)]));
WriteExtraHTMLCode(rv_thms_Body, False);
end;
{...........................................................}
procedure SaveLast(Stream: TStream);
begin
WriteExtraHTMLCode(rv_thms_End, False);
RVWriteLn(Stream,'</body></html>');
end;
{......................................................}
function GetPageBreakCSS(item: TCustomRVItemInfo): String;
begin
if (rvsoForceNonTextCSS in Options) and item.PageBreakBefore then
Result := ' style="page-break-before: always;"'
else
Result := '';
end;
{...........................................................}
function GetOpenDIVTag(Align: TRVAlignment; item: TCustomRVItemInfo): String;
var s: String;
begin
s := '<%%s align=%s%%s>';
case Align of
rvaCenter:
Result := Format(s, [RV_HTMLGetStrAttrVal('center', Options)]);
rvaRight:
Result := Format(s, [RV_HTMLGetStrAttrVal('right', Options)]);
rvaJustify:
Result := Format(s, [RV_HTMLGetStrAttrVal('justify', Options)]);
else
Result := '<%s%s>';
end;
if RichViewSavePInHTML then
s := 'p'
else
s := 'div';
Result := SysUtils.Format(Result, [s, GetPageBreakCSS(item)]);
end;
{...........................................................}
function GetCloseDIVTag: String;
begin
if RichViewSavePInHTML then
Result := '</p>'
else