RichEdit

开发平台：

Delphi

CRVData.pas：源码内容

Result := '</div>';
end;
{...........................................................}
procedure SaveMiddle(Stream: TStream;
const Path: String);
var
i: Integer;
item: TCustomRVItemInfo;
CloseDIV: Boolean;
s2, s3, ATag, HintTag: String;
cpno: Integer;
CreateBulletList: Boolean;
RVStyle: TRVStyle;
TextStyleNo: Integer;
{$IFNDEF RVDONOTUSELISTS}
marker: TRVMarkerItemInfo;
{$ENDIF}
begin
cpno := 0;
{$IFNDEF RVDONOTUSELISTS}
marker := nil;
{$ENDIF}
RVStyle := GetRVStyle;
CreateBulletList := Bullets=nil;
if CreateBulletList then
Bullets := TRVList.Create;
try
if not (rvsoDefault0Style in Options) then begin
s3 := RV_HTMLOpenFontTag(RVStyle.TextStyles[0],
RVStyle.TextStyles[0], False, Options);
if rvsoUTF8 in Options then
s3 := RVU_AnsiToUTF8(CP_ACP, s3);
RVWriteLn(Stream, s3);
end;
CloseDIV := False;
for i:=0 to Items.Count-1 do begin
item := GetItem(i);
if not item.SameAsPrev then begin
if item.BR then
RVWriteLn(Stream, Format('<br%s>', [RV_HTMLGetEndingSlash(Options)]))
else begin
{$IFNDEF RVDONOTUSELISTS}
if marker<>nil then begin
RVWriteLn(Stream,'</li>');
RVWrite(Stream, GetParaHTMLCode(Self, i, False, False));
end;
{$ENDIF}
if CloseDIV then begin
RVWriteLn(Stream,GetCloseDIVTag);
RVWrite(Stream, GetParaHTMLCode(Self, i, False, False));
CloseDIV := False;
end;
end;
if not item.BR then
case item.StyleNo of
rvsBreak: ;
{$IFNDEF RVDONOTUSELISTS}
rvsListMarker:
begin
if (rvsoMarkersAsText in Options) or
(TRVMarkerItemInfo(item).GetLevelInfo(RVStyle)=nil) then begin
RVWrite(Stream, GetParaHTMLCode(Self, i, True, False));
RVWrite(Stream, GetOpenDIVTag(RVStyle.ParaStyles[item.ParaNo].Alignment, item));
CloseDIV := True;
end
else begin
TRVMarkerItemInfo(item).SaveHTMLSpecial(Stream, marker, RVStyle, False);
RVWrite(Stream, GetParaHTMLCode(Self, i, True, False));
marker := TRVMarkerItemInfo(item);
if marker.GetLevelInfo(RVStyle).HasNumbering then
RVWrite(Stream,Format('<li value=%s%s>',
[RV_HTMLGetIntAttrVal(marker.Counter, Options), GetPageBreakCSS(marker)]))
else
RVWrite(Stream,Format('<li%s>',[GetPageBreakCSS(marker)]));
end;
end;
{$ENDIF}
else
begin
{$IFNDEF RVDONOTUSELISTS}
if marker<>nil then begin
marker.HTMLOpenOrCloseTags(Stream, marker.Level, -1, RVStyle, False);
marker := nil;
end;
{$ENDIF}
RVWrite(Stream, GetParaHTMLCode(Self, i, True, False));
RVWrite(Stream, GetOpenDIVTag(RVStyle.ParaStyles[item.ParaNo].Alignment, item));
CloseDIV := True;
end;
end;
end;
SaveHTMLCheckpoint(Stream, item.Checkpoint, cpno, RVDEFAULTCHECKPOINTPREFIX, True, Options);
ATag := '';
HintTag := '';
if item.GetBoolValueEx(rvbpJump, RVStyle) then
ATag := GetHTMLATag(i, '', rvsoUTF8 in Options);
if ATag<>'' then
RVWrite(Stream, ATag)
else begin
item.GetExtraStrProperty(rvespHint, HintTag);
if HintTag<>'' then
HintTag := RV_GetHintStr(rvsfHTML, HintTag);
end;
if (item.StyleNo<0) and (item.AssociatedTextStyleNo<0) then begin // non-text
s2 := '';
if SaveItemToFile(Path, Self, i, rvsfHTML, False, s2) then
RVWrite(Stream, s2)
else begin
item.SaveToHTML(Stream, Self, i, Items[i], Path, ImagesPrefix,
imgSaveNo, Color, Options, False, Bullets);
if item.StyleNo=rvsBreak then
RVWriteLn(Stream,'');
end;
end
else begin
if item.StyleNo<0 then
TextStyleNo := item.AssociatedTextStyleNo
else
TextStyleNo := GetActualStyle(item);
if ShouldSaveTextToHTML(TextStyleNo) then begin // text or tab
if HintTag<>'' then
RVWrite(Stream, '<span '+HintTag+'>');
if TextStyleNo<>0 then begin
s3 := RV_HTMLOpenFontTag(RVStyle.TextStyles[TextStyleNo],
RVStyle.TextStyles[0], True, Options);
if rvsoUTF8 in Options then
s3 := RVU_AnsiToUTF8(CP_ACP, s3);
RVWrite(Stream, s3);
end;
if item.StyleNo>=0 then begin
s2 := GetTextForHTML(Path, i, False, Options);
RVWrite(Stream, s2);
end
else begin
s2 := '';
if SaveItemToFile(Path, Self, i, rvsfHTML, False, s2) then
RVWrite(Stream, s2)
else
item.SaveToHTML(Stream, Self, i, Items[i], Path, ImagesPrefix,
imgSaveNo, Color, Options, False, Bullets);
end;
if TextStyleNo<>0 then
RVWrite(Stream,
RV_HTMLCloseFontTag(RVStyle.TextStyles[TextStyleNo],
RVStyle.TextStyles[0], True));
if HintTag<>'' then
RVWrite(Stream, '</span>');
end;
end;
if ATag<>'' then
RVWrite(Stream,'</a>');
end;
{$IFNDEF RVDONOTUSELISTS}
if marker<>nil then begin
RVWriteLn(Stream,'</li>');
RVWrite(Stream, GetParaHTMLCode(Self, ItemCount, False, False));
marker.HTMLOpenOrCloseTags(Stream, marker.Level, -1, RVStyle, False);
end;
{$ENDIF}
if CloseDIV then begin
RVWriteLn(Stream,GetCloseDIVTag);
RVWrite(Stream, GetParaHTMLCode(Self, ItemCount, False, False));
end;
if not (rvsoDefault0Style in Options) then
RVWriteLn(Stream,
RV_HTMLCloseFontTag(RVStyle.TextStyles[0], RVStyle.TextStyles[0], False));
SaveHTMLCheckpoint(Stream, NotAddedCP, cpno, RVDEFAULTCHECKPOINTPREFIX, False, Options);
finally
if CreateBulletList then begin
Bullets.Free;
end;
end;
end;
{...........................................................}
begin
Result := False;
if GetRVStyle = nil then exit;
Result := True;
try
if not (rvsoMiddleOnly in Options) and
not (rvsoLastOnly in Options) then
SaveFirst(Stream, Path, Title);
if not (rvsoFirstOnly in Options) and
not (rvsoLastOnly in Options) then
SaveMiddle(Stream, Path);
if not (rvsoFirstOnly in Options) and
not (rvsoMiddleOnly in Options) then
SaveLast(Stream);
except
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SaveBackgroundToHTML(bmp: TBitmap; Color: TColor;
const Path, ImagesPrefix: String; var imgSaveNo: Integer;
SaveOptions: TRVSaveOptions): String;
var DoDefault: Boolean;
begin
Result := '';
HTMLSaveImage(Self, -1, Path, Color, Result, DoDefault);
if DoDefault then
Result := RV_GetHTMLPath(DoSavePicture(rvsfHTML, ImagesPrefix, Path,
imgSaveNo, rvsoOverrideImages in SaveOptions, Color, bmp), SaveOptions,
GetRVStyle.DefCodePage);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.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;
{......................................................}
procedure WriteExtraHTMLCode(Area: TRVHTMLSaveArea; AddSpace: Boolean);
var s: String;
begin
s := GetExtraHTMLCode(Area, True);
if s<>'' then
if AddSpace then
RVWrite(Stream,' '+s)
else
RVWrite(Stream, s);
end;
{......................................................}
function GetBackgroundVPos(BStyle: TBackgroundStyle): String;
begin
case BStyle of
bsTopLeft, bsTopRight:
Result := 'top';
bsBottomLeft, bsBottomRight:
Result := 'bottom';
else
Result := 'center';
end;
end;
{......................................................}
function GetBackgroundHPos(BStyle: TBackgroundStyle): String;
begin
case BStyle of
bsTopLeft, bsBottomLeft:
Result := 'left';
bsTopRight, bsBottomRight:
Result := 'right';
else
Result := 'center';
end;
end;
{......................................................}
procedure SaveFirst(Stream: TStream;
const Path,Title,ExtraStyles,ExternalCSS: String);
var s: String;
CSSOptions: TRVSaveCSSOptions;
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, '?>');
RVWriteLn(Stream, '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">');
RVWriteLn(Stream, '<html xmlns="http://www.w3.org/1999/xhtml">');
end
else begin
RVWriteLn(Stream,'<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">');
RVWrite(Stream, '<html>');
end;
s := Title;
if rvsoUTF8 in Options then
s := RVU_AnsiToUTF8(GetRVStyle.DefCodePage, Title);
RVWriteLn(Stream,'<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}
RVWrite(Stream,'<style type="text/css">');
if rvsoXHTML in Options then
RVWriteLn(Stream,'')
else
RVWriteLn(Stream,'<!--');
s := RV_GetHTMLRGBStr(Color, False);
RVWriteLn(Stream, 'body {');
RVWriteLn(Stream, SysUtils.Format(' margin: %dpx %dpx %dpx %dpx;',
[TopMargin, RightMargin, BottomMargin, LeftMargin]));
if s<>'' then
RVWriteLn(Stream, ' background-color: '+s+';');
if (Background.Style<>bsNoBitmap) and
(not Background.Bitmap.Empty) then begin
s := SaveBackgroundToHTML(Background.Bitmap, Color, Path, ImagesPrefix,
imgSaveNo, Options);
if s<>'' then begin
RVWriteLn(Stream, SysUtils.Format(' background-image: url("%s");', [s]));
RVWriteLn(Stream, ' background-repeat: '+rv_cssBkRepeat[Background.Style]+';');
RVWriteLn(Stream, ' background-attachment: '+rv_cssBkAttachment[Background.Style]+';');
if Background.Style in [bsStretched, bsCentered, bsTopLeft, bsTopRight,
bsBottomLeft, bsBottomRight] then
RVWriteLn(Stream, ' background-position: '+GetBackgroundVPos(Background.Style)+
' '+GetBackgroundHPos(Background.Style)+';');
end;
end;
RVWriteLn(Stream, '}');
if (ExternalCSS='') and not (rvsoInlineCSS in Options) then begin
CSSOptions := [];
if (rvsoNoDefCSSStyle in Options) then
Include(CSSOptions, rvcssNoDefCSSStyle);
if (rvsoUTF8 in Options) then
Include(CSSOptions, rvcssUTF8);
GetRVStyle.SaveCSSToStream(Stream, CSSOptions);
end;
if ExtraStyles<>'' then begin
s := ExtraStyles;
if (rvsoUTF8 in Options) then
s := RVU_AnsiToUTF8(GetRVStyle.DefCodePage, s);
RVWriteLn(Stream, s);
end;
if not (rvsoXHTML in Options) then
RVWrite(Stream,'-->');
RVWriteLn(Stream,'</style>');
if (ExternalCSS<>'') and not (rvsoInlineCSS in Options) then begin
s := ExternalCSS;
if (rvsoUTF8 in Options) then
s := RVU_AnsiToUTF8(GetRVStyle.DefCodePage, s);
RVWriteLn(Stream, '<link type="text/css" href="'+s+'" rel="stylesheet">');
end;
WriteExtraHTMLCode(rv_thms_Head, False);
RVWriteLn(Stream,'</head>');
RVWrite(Stream,'<body');
WriteExtraHTMLCode(rv_thms_BodyAttribute, True);
RVWriteLn(Stream,'>');
WriteExtraHTMLCode(rv_thms_Body, False);
end;
{......................................................}
procedure SaveLast(Stream: TStream);
begin
RVWriteLn(Stream,'');
WriteExtraHTMLCode(rv_thms_End, False);
RVWriteLn(Stream,'</body></html>');
end;
{......................................................}
function GetTextCSS(TextStyleNo: Integer; RVStyle: TRVStyle): String;
var MemoryStream: TStream;
begin
if (rvsoInlineCSS in Options) then begin
MemoryStream := TMemoryStream.Create;
try
RVStyle.TextStyles[TextStyleNo].SaveCSSToStream(MemoryStream,
nil, False, rvsoUTF8 in Options);
SetLength(Result, MemoryStream.Size);
MemoryStream.Position := 0;
MemoryStream.ReadBuffer(PChar(Result)^, Length(Result));
finally
MemoryStream.Free;
end;
Result := 'style="'+Result+'"';
end
else
Result := 'class='+RV_HTMLGetStrAttrVal('rvts'+IntToStr(TextStyleNo), Options);
end;
{......................................................}
function GetPageBreakCSS(item: TCustomRVItemInfo; OnlyValue, SpaceBefore: Boolean): String;
begin
if item.PageBreakBefore then begin
Result := 'page-break-before: always;';
if not OnlyValue then
Result := 'style="'+Result+'"';
end
else
Result := '';
if (Result<>'') and SpaceBefore then
Result := ' '+Result;
end;
{......................................................}
function GetParaCSSValue(item: TCustomRVItemInfo; RVStyle: TRVStyle;
IgnoreLeftIndents: Boolean): String;
var MemoryStream: TStream;
begin
if (rvsoInlineCSS in Options) then begin
MemoryStream := TMemoryStream.Create;
try
RVStyle.ParaStyles[item.ParaNo].SaveCSSToStream(MemoryStream, nil,
False, False, IgnoreLeftIndents);
SetLength(Result, MemoryStream.Size);
MemoryStream.Position := 0;
MemoryStream.ReadBuffer(PChar(Result)^, Length(Result));
finally
MemoryStream.Free;
end;
end
else
Result := '';
Result := Result+GetPageBreakCSS(item, True, Result<>'')
end;
{......................................................}
function GetParaCSS(item: TCustomRVItemInfo; RVStyle: TRVStyle;
IgnoreLeftIndents: Boolean): String;
begin
if (rvsoInlineCSS in Options) then
Result := 'style="'+GetParaCSSValue(item, RVStyle, IgnoreLeftIndents)+'"'
else if (Item.ParaNo>0) or (rvsoNoDefCSSStyle in Options) then
Result := 'class='+RV_HTMLGetStrAttrVal('rvps'+IntToStr(item.ParaNo), Options)+
GetPageBreakCSS(item, False, True)
else
Result := GetPageBreakCSS(item, False, False);
end;
{......................................................}
function GetItemTextStyleNo(ItemNo: Integer): Integer;
var item: TCustomRVItemInfo;
begin
item := GetItem(ItemNo);
if item.StyleNo>=0 then
Result := GetActualStyle(item)
else begin
Result := item.AssociatedTextStyleNo;
if Result<0 then
Result := item.StyleNo;
end;
end;
{......................................................}
procedure SaveMiddle(Stream: TStream; const Path: String; CPPrefix: String);
var i: Integer;
item: TCustomRVItemInfo;
s, s2, ATag, HintAttr: String;
cpno, CurFont, OpenedPara, TextStyleNo: Integer;
CreateBulletList, Use0StyleAsDef, DIVOpened: Boolean;
RVStyle: TRVStyle;
{$IFNDEF RVDONOTUSELISTS}
marker: TRVMarkerItemInfo;
{$ENDIF}
begin
if CPPrefix='' then
CPPrefix := RVDEFAULTCHECKPOINTPREFIX;
RVStyle := GetRVStyle;
cpno := 0;
CurFont := -1;
OpenedPara := -1;
DIVOpened := False;
{$IFNDEF RVDONOTUSELISTS}
marker := nil;
{$ENDIF}
CreateBulletList := Bullets=nil;
if CreateBulletList then
Bullets := TRVList.Create;
try
Use0StyleAsDef := (RVStyle.TextStyles.Count>=1) and
not RVStyle.TextStyles[0].Jump and
(RVStyle.TextStyles[0].BackColor=clNone) and
not (rvsoNoDefCSSStyle in Options);
for i:=0 to Items.Count-1 do begin
item := GetItem(i);
if (not item.SameAsPrev) then begin
if ((OpenedPara<0) {$IFNDEF RVDONOTUSELISTS}and (marker=nil){$ENDIF}) or
item.BR then
RVWriteLn(Stream,'');
if item.BR then
RVWrite(Stream, Format('<br%s>', [RV_HTMLGetEndingSlash(Options)]))
else begin
{$IFNDEF RVDONOTUSELISTS}
if marker<>nil then begin
RVWriteLn(Stream,'</li>');
RVWrite(Stream, GetParaHTMLCode(Self, i, False, True));
end
else if (OpenedPara>=0) then
{$ENDIF}
begin
if DIVOpened then
RVWriteLn(Stream,'</div>')
else
RVWriteLn(Stream,'</p>');
DIVOpened := False;
RVWrite(Stream, GetParaHTMLCode(Self, i, False, True));
end;
CurrentFileColor := RVStyle.ParaStyles[item.ParaNo].Background.Color;
if CurrentFileColor=clNone then
CurrentFileColor := Color;
case item.StyleNo of
rvsBreak:
OpenedPara := -1;
{$IFNDEF RVDONOTUSELISTS}
rvsListMarker:
begin
if TRVMarkerItemInfo(item).GetLevelInfo(RVStyle)<>nil then begin
if rvsoMarkersAsText in Options then begin
RVWrite(Stream, GetParaHTMLCode(Self, i, True, True));
if ((item.ParaNo=0) and not (rvsoNoDefCSSStyle in Options)) or
(rvsoInlineCSS in Options) then
RVWrite(Stream, Format('<p style="%s %s">',
[GetParaCSSValue(item, RVStyle, True),
TRVMarkerItemInfo(item).GetLevelInfo(RVStyle).GetIndentCSSForTextVersion]))
else
RVWrite(Stream, Format('<p %s style="%s">',
[GetParaCSS(item, RVStyle, True),
TRVMarkerItemInfo(item).GetLevelInfo(RVStyle).GetIndentCSSForTextVersion]));
OpenedPara := item.ParaNo;
end
else begin
TRVMarkerItemInfo(item).SaveHTMLSpecial(Stream, marker, RVStyle, True);
RVWrite(Stream, GetParaHTMLCode(Self, i, True, True));
marker := TRVMarkerItemInfo(item);
if marker.GetLevelInfo(RVStyle).HasNumbering then
RVWrite(Stream,Format('<li value=%s',[RV_HTMLGetIntAttrVal(marker.Counter, Options)]))
else
RVWrite(Stream,'<li');
s := GetParaCSS(item, RVStyle, True);
if s<>'' then
RVWrite(Stream, ' '+s);
RVWrite(Stream, marker.GetLICSS(Self, i, Path,
ImagesPrefix, imgSaveNo, CurrentFileColor, Options,
Bullets));
RVWrite(Stream,'>');
OpenedPara := -1;
end
end
else begin
{$IFNDEF RVDONOTUSELISTS}
if marker<>nil then begin
marker.HTMLOpenOrCloseTags(Stream, marker.Level, -1, RVStyle, True);
marker := nil;
end;
{$ENDIF}
RVWrite(Stream, GetParaHTMLCode(Self, i, True, True));
s := GetParaCSS(item, RVStyle, False);
if item.GetBoolValue(rvbpNoHTML_P) then
if s='' then
RVWrite(Stream, '<p>')
else
RVWrite(Stream, Format('<p %s>',[s]));
OpenedPara := item.ParaNo;
end;
end;
{$ENDIF}
else
begin
{$IFNDEF RVDONOTUSELISTS}
if marker<>nil then begin
marker.HTMLOpenOrCloseTags(Stream, marker.Level, -1, RVStyle, True);
marker := nil;
end;
{$ENDIF}
RVWrite(Stream, GetParaHTMLCode(Self, i, True, True));
s := GetParaCSS(item, RVStyle, False);
if item.GetBoolValue(rvbpNoHTML_P) then begin
DIVOpened := True;
if s='' then
RVWrite(Stream, '<div>')
else
RVWrite(Stream, Format('<div %s>',[s]))
end
else
if s='' then
RVWrite(Stream, '<p>')
else
RVWrite(Stream, Format('<p %s>',[s]));
OpenedPara := item.ParaNo;
end;
end
end;
end;
SaveHTMLCheckpoint(Stream, item.Checkpoint, cpno, CPPrefix, False, Options);
if (item.StyleNo<0) and (item.AssociatedTextStyleNo<0) then begin
ATag := '';
if item.GetBoolValueEx(rvbpJump, RVStyle) then begin
ATag := GetHTMLATag(i, '', rvsoUTF8 in Options);
if ATag<>'' then
RVWrite(Stream, ATag);
end;
s2 := '';
if SaveItemToFile(Path, Self, i, rvsfHTML, False, s2) then
RVWrite(Stream, s2)
else
item.SaveToHTML(Stream, Self, i, Items[i], Path, ImagesPrefix,
imgSaveNo, CurrentFileColor, Options, True, Bullets);
if item.GetBoolValueEx(rvbpJump, RVStyle) then begin
if ATag<>'' then
RVWrite(Stream, '</a>');
end;
end
else begin
TextStyleNo := GetItemTextStyleNo(i);
if ShouldSaveTextToHTML(TextStyleNo) then begin
ATag := '';
if item.GetBoolValueEx(rvbpJump, RVStyle) then
ATag := GetHTMLATag(i, GetTextCSS(TextStyleNo, RVStyle), rvsoUTF8 in Options);
if ATag<>'' then
RVWrite(Stream, ATag)
else begin
if CurFont<>TextStyleNo then begin
if (TextStyleNo=0) and Use0StyleAsDef and
not (rvsoInlineCSS in Options) then
CurFont := -1
else begin
CurFont := TextStyleNo;
RVWrite(Stream, SysUtils.Format('<span %s>',
[GetTextCSS(TextStyleNo, RVStyle)]));
end;
end;
end;
HintAttr := '';
if ATag='' then begin
item.GetExtraStrProperty(rvespHint, HintAttr);
HintAttr := RV_GetHintStr(rvsfHTML, HintAttr);
if HintAttr<>'' then
RVWrite(Stream, SysUtils.Format('<span %s>', [HintAttr]));
end;
if item.StyleNo>=0 then begin
s2 := GetTextForHTML(Path, i, True, Options);
RVWrite(Stream, s2);
end
else begin
s2 := '';
if SaveItemToFile(Path, Self, i, rvsfHTML, False, s2) then
RVWrite(Stream, s2)
else
item.SaveToHTML(Stream, Self, i, Items[i], Path, ImagesPrefix,
imgSaveNo, CurrentFileColor, Options, True, Bullets);
end;
if HintAttr<>'' then
RVWrite(Stream,'</span>');
if ATag<>'' then
RVWrite(Stream,'</a>')
else
if (CurFont<>-1) and
((i=Items.Count-1) or (GetItemTextStyleNo(i+1)<>TextStyleNo) or
RVStyle.TextStyles[GetItemTextStyleNo(i)].Jump or
(not GetItem(i+1).SameAsPrev)) then begin
RVWrite(Stream, '</span>');
CurFont := -1;
end;
end;
end;
end;
{$IFNDEF RVDONOTUSELISTS}
if marker<>nil then begin
RVWriteLn(Stream,'</li>');
RVWrite(Stream, GetParaHTMLCode(Self, ItemCount, False, True));
marker.HTMLOpenOrCloseTags(Stream, marker.Level, -1, RVStyle, True);
end;
{$ENDIF}
if (OpenedPara<>-1) then begin
if DIVOpened then
RVWriteLn(Stream,'</div>')
else
RVWriteLn(Stream,'</p>');
RVWrite(Stream, GetParaHTMLCode(Self, ItemCount, False, True));
end;
SaveHTMLCheckpoint(Stream, NotAddedCP, cpno, CPPrefix, False, Options);
finally
if CreateBulletList then begin
Bullets.Free;
end;
end;
end;
{......................................................}
begin
Result := False;
if GetRVStyle = nil then exit;
Result := True;
CurrentFileColor := Color;
try
if not (rvsoMiddleOnly in Options) and
not (rvsoLastOnly in Options) then
SaveFirst(Stream, Path, Title, ExtraStyles, ExternalCSS);
if not (rvsoFirstOnly in Options) and
not (rvsoLastOnly in Options) then
SaveMiddle(Stream, Path, CPPrefix);
if not (rvsoFirstOnly in Options) and
not (rvsoMiddleOnly in Options) then
SaveLast(Stream);
except
Result := False;
end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TCustomRVData.CheckItemClass(ItemNo: Integer; RequiredClass: TCustomRVItemInfoClass);
begin
if not (Items.Objects[ItemNo] is RequiredClass) then
raise ERichViewError.Create(errRVTypesMismatch);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.FindControlItemNo(actrl: TControl): Integer;
var i: Integer;
begin
for i := 0 to Items.Count-1 do
if TCustomRVItemInfo(Items.Objects[i]).OwnsControl(actrl) then begin
Result := i;
exit;
end;
Result := -1;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.RemoveCheckpoint(ItemNo: Integer): Boolean;
var OldCP: TRVCPInfo;
begin
with TCustomRVItemInfo(Items.Objects[ItemNo]) do begin
OldCP := Checkpoint;
FreeCheckpoint(Checkpoint, True, True);
end;
Result := OldCP<>nil;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetGrouped(ItemNo: Integer; Grouped: Boolean);
begin
with GetItem(ItemNo) do
if Grouped then
Include(ItemOptions, rvioGroupWithNext)
else
Exclude(ItemOptions, rvioGroupWithNext)
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetBreakInfo(ItemNo: Integer; AWidth: Byte;
AStyle: TRVBreakStyle; AColor: TColor; ATag: Integer);
begin
CheckItemClass(ItemNo, TRVBreakItemInfo);
with TRVBreakItemInfo(Items.Objects[ItemNo]) do begin
Color := AColor;
LineWidth := AWidth;
Style := AStyle;
end;
SetItemTag(ItemNo, ATag);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetBulletInfo(ItemNo: Integer; const AName: String;
AImageIndex: Integer; AImageList: TCustomImageList; ATag: Integer);
begin
CheckItemClass(ItemNo, TRVBulletItemInfo);
with TRVBulletItemInfo(Items.Objects[ItemNo]) do
ImageIndex := AImageIndex;
SetItemTag(ItemNo, ATag);
Items[ItemNo] := AName;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SetControlInfo(ItemNo: Integer; const AName: String;
AVAlign: TRVVAlign; ATag: Integer): Boolean;
begin
CheckItemClass(ItemNo, TRVControlItemInfo);
with TRVControlItemInfo(Items.Objects[ItemNo]) do begin
Result := (VAlign<>AVAlign);
VAlign := AVAlign;
end;
SetItemTag(ItemNo, ATag);
Items[ItemNo] := AName;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetHotspotInfo(ItemNo: Integer;
const AName: String; AImageIndex, AHotImageIndex: Integer;
AImageList: TCustomImageList; ATag: Integer);
begin
CheckItemClass(ItemNo, TRVHotspotItemInfo);
with TRVHotspotItemInfo(Items.Objects[ItemNo]) do begin
ImageIndex := AImageIndex;
HotImageIndex := AHotImageIndex;
end;
SetItemTag(ItemNo, ATag);
Items[ItemNo] := AName;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetCheckpointInfo(ItemNo, ATag: Integer;
const AName: String; ARaiseEvent: Boolean);
begin
with TCustomRVItemInfo(Items.Objects[ItemNo]) do begin
if Checkpoint=nil then
InsertCheckpoint(ItemNo, ATag, AName, ARaiseEvent)
else begin
if rvoTagsArePChars in Options then
StrDispose(PChar(Checkpoint.Tag));
Checkpoint.Tag := ATag;
Checkpoint.Name := AName;
Checkpoint.RaiseEvent := ARaiseEvent;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetItemTag(ItemNo, ATag: Integer);
begin
with GetItem(ItemNo) do begin
if Tag=ATag then exit;
if rvoTagsArePChars in Options then
StrDispose(PChar(Tag));
Tag := ATag;
end;
end;
{------------------------------------------------------------------------------}
{ Sets item's property of integer type.
ItemNo - index of item. Prop identifies the property. Value - new property
value.
Returns true is this item type has this property }
function TCustomRVData.SetItemExtraIntProperty(ItemNo: Integer;
Prop: TRVExtraItemProperty; Value: Integer): Boolean;
begin
Result := GetItem(ItemNo).SetExtraIntProperty(Prop, Value);
{$IFNDEF RVDONOTUSEANIMATION}
if Result and (Prop in [rvepAnimationInterval, rvepImageWidth, rvepImageHeight]) then
GetItem(ItemNo).UpdateAnimator(Self);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
{ Gets item's property of integer type.
ItemNo - index of item. Prop identifies the property. Value receives a
property value.
Returns true is this item type has this property }
function TCustomRVData.GetItemExtraIntProperty(ItemNo: Integer;
Prop: TRVExtraItemProperty; var Value: Integer): Boolean;
begin
Result := GetItem(ItemNo).GetExtraIntProperty(Prop, Value);
end;
{------------------------------------------------------------------------------}
{ Sets item's property of string type.
ItemNo - index of item. Prop identifies the property. Value - new property
value.
Returns true is this item type has this property }
function TCustomRVData.SetItemExtraStrProperty(ItemNo: Integer;
Prop: TRVExtraItemStrProperty; const Value: String): Boolean;
begin
Result := GetItem(ItemNo).SetExtraStrProperty(Prop, Value);
end;
{------------------------------------------------------------------------------}
{ Gets item's property of string type.
ItemNo - index of item. Prop identifies the property. Value receives a
property value.
Returns true is this item type has this property }
function TCustomRVData.GetItemExtraStrProperty(ItemNo: Integer;
Prop: TRVExtraItemStrProperty; var Value: String): Boolean;
begin
Result := GetItem(ItemNo).GetExtraStrProperty(Prop, Value);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SetPictureInfo(ItemNo: Integer; const AName: String;
Agr: TGraphic; AVAlign: TRVVAlign; ATag: Integer): Boolean;
begin
CheckItemClass(ItemNo, TRVGraphicItemInfo);
with TRVGraphicItemInfo(Items.Objects[ItemNo]) do begin
Result := (Agr.Width<>Image.Width) or
(Agr.Height<>Image.Height) or
(VAlign<>AVAlign);
if Agr<>Image then begin
Image.Free;
Image := Agr;
{$IFNDEF RVDONOTUSEANIMATION}
UpdateAnimator(Self);
{$ENDIF}
end;
VAlign := AVAlign;
end;
SetItemTag(ItemNo, ATag);
Items[ItemNo] := AName;
GetItem(ItemNo).UpdatePaletteInfo(GetDoInPaletteMode, True, GetRVPalette,
GetRVLogPalette);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemStyle(ItemNo: Integer): Integer;
begin
Result := GetActualStyle(GetItem(ItemNo));
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetActualStyle(Item: TCustomRVItemInfo): Integer;
begin
Result := Item.StyleNo;
if Result=rvsDefStyle then begin
if GetRVStyle.ParaStyles[Item.ParaNo].DefStyleNo>=0 then
Result := GetRVStyle.ParaStyles[Item.ParaNo].DefStyleNo
else
Result := 0;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetActualStyle2(StyleNo, ParaNo: Integer): Integer;
begin
Result := StyleNo;
if Result=rvsDefStyle then begin
if GetRVStyle.ParaStyles[ParaNo].DefStyleNo>=0 then
Result := GetRVStyle.ParaStyles[ParaNo].DefStyleNo
else
Result := 0;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.GetBreakInfo(ItemNo: Integer; var AWidth: Byte;
var AStyle: TRVBreakStyle; var AColor: TColor; var ATag: Integer);
begin
CheckItemClass(ItemNo, TRVBreakItemInfo);
with TRVBreakItemInfo(Items.Objects[ItemNo]) do begin
AWidth := LineWidth;
AStyle := Style;
AColor := Color;
ATag := Tag;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.GetBulletInfo(ItemNo: Integer; var AName: String;
var AImageIndex: Integer; var AImageList: TCustomImageList; var ATag: Integer);
begin
CheckItemClass(ItemNo, TRVBulletItemInfo);
with Items.Objects[ItemNo] as TRVBulletItemInfo do begin
AImageIndex := ImageIndex;
AImageList := ImageList;
ATag := Tag;
end;
AName := Items[ItemNo];
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.GetControlInfo(ItemNo: Integer; var AName: String;
var Actrl: TControl; var AVAlign: TRVVAlign; var ATag: Integer);
begin
CheckItemClass(ItemNo, TRVControlItemInfo);
with TRVControlItemInfo(Items.Objects[ItemNo]) do begin
Actrl := Control;
ATag := Tag;
AVAlign := VAlign;
end;
AName := Items[ItemNo];
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.GetHotspotInfo(ItemNo: Integer; var AName: String;
var AImageIndex, AHotImageIndex: Integer; var AImageList: TCustomImageList;
var ATag: Integer);
begin
CheckItemClass(ItemNo, TRVHotspotItemInfo);
with TRVHotspotItemInfo(Items.Objects[ItemNo]) do begin
AImageIndex := ImageIndex;
AHotImageIndex := HotImageIndex;
AImageList := ImageList;
ATag := Tag;
end;
AName := Items[ItemNo];
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemTag(ItemNo: Integer): Integer;
begin
Result := GetItem(ItemNo).Tag;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.GetPictureInfo(ItemNo: Integer; var AName: String;
var Agr: TGraphic; var AVAlign: TRVVAlign; var ATag: Integer);
begin
CheckItemClass(ItemNo, TRVGraphicItemInfo);
with Items.Objects[ItemNo] as TRVGraphicItemInfo do begin
Agr := Image;
ATag := Tag;
AVAlign := VAlign;
end;
AName := Items[ItemNo];
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.GetTextInfo(ItemNo: Integer; var AText: String;
var ATag: Integer);
begin
if (GetItemStyle(ItemNo)<0) then
raise ERichViewError.Create(errRVTypesMismatch);
ATag := GetItem(ItemNo).Tag;
AText := Items[ItemNo];
end;
{------------------------------------------------------------------------------}
function TCustomRVData.IsFromNewLine(ItemNo: Integer): Boolean;
begin
Result := not GetItem(ItemNo).SameAsPrev;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemPara(ItemNo: Integer): Integer;
begin
Result := GetItem(ItemNo).ParaNo;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.IsParaStart(ItemNo: Integer): Boolean;
begin
Result := not GetItem(ItemNo).SameAsPrev and
not GetItem(ItemNo).BR;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetPageBreaksBeforeItems(Index: Integer): Boolean;
begin
if (Index<0) or (Index>=Items.Count) then
raise ERichViewError.Create(errRVItemRangeError);
{$IFNDEF RVDONOTUSELISTS}
if (Index>0) and (GetItemStyle(Index-1)=rvsListMarker) then
dec(Index);
{$ENDIF}
Result := GetItem(Index).PageBreakBefore;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetPageBreaksBeforeItems(Index: Integer;
Value: Boolean);
begin
if (Index<0) or (Index>=Items.Count) then
raise ERichViewError.Create(errRVItemRangeError);
TCustomRVItemInfo(Items.Objects[Index]).PageBreakBefore := Value;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.FindCheckpointByName(
const Name: String): TCheckpointData;
var cp: TRVCPInfo;
begin
Result := nil;
cp := FirstCP;
while cp<>nil do begin
if cp.Name=Name then begin
Result := cp;
exit;
end;
cp := cp.Next;
end;
if (NotAddedCP<>nil) and (NotAddedCP.Name=Name) then
Result := NotAddedCP;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.FindCheckpointByTag(Tag: Integer): TCheckpointData;
var cp: TRVCPInfo;
begin
Result := nil;
cp := FirstCP;
while cp<>nil do begin
if RV_CompareTags(cp.Tag,Tag, rvoTagsArePChars in Options) then begin
Result := cp;
exit;
end;
cp := cp.Next;
end;
if (NotAddedCP<>nil) and RV_CompareTags(NotAddedCP.Tag,Tag,rvoTagsArePChars in Options) then
Result := NotAddedCP;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetCheckpointByNo(No: Integer): TCheckpointData;
var i: Integer;
cp: TRVCPInfo;
begin
if (no<0) or (no>=CPCount) then begin
raise ERichViewError.Create(SysUtils.Format(errRVNoSuchCP,[no]));
exit;
end;
if (no=CPCount-1) and (NotAddedCP<>nil) then
Result := NotAddedCP
else begin
cp := FirstCP;
for i := 1 to no do begin
if cp = nil then break;
cp := cp.Next;
end;
//Assert(cp<>nil, 'Can''t find checkpoint');
Result := cp;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetFirstCheckpoint: TCheckpointData;
begin
Result := FirstCP;
if Result = nil then
Result := NotAddedCP;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetLastCheckpoint: TCheckpointData;
begin
Result := NotAddedCP;
if Result = nil then
Result := LastCP;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetNextCheckpoint(CheckpointData: TCheckpointData): TCheckpointData;
begin
Result := nil;
if CheckpointData=nil then
raise ERichViewError.Create(errRVNil);
if CheckpointData=NotAddedCP then exit;
Result := TRVCPInfo(CheckpointData).Next;
if Result = nil then
Result := NotAddedCP;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetPrevCheckpoint(CheckpointData: TCheckpointData): TCheckpointData;
begin
if CheckpointData=nil then
raise ERichViewError.Create(errRVNil);
if CheckpointData=NotAddedCP then begin
Result := LastCP;
exit;
end;
Result := TRVCPInfo(CheckpointData).Prev;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemCheckpoint(ItemNo: Integer): TCheckpointData;
begin
Result := TCustomRVItemInfo(Items.Objects[ItemNo]).Checkpoint;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetCheckpointItemNo(CheckpointData: TCheckpointData): Integer;
begin
if CheckpointData = nil then
raise ERichViewError.Create(errRVNil);
if CheckpointData=NotAddedCP then
Result := -1
else begin
Result := Items.IndexOfObject(TRVCPInfo(CheckpointData).ItemInfo);
if Result=-1 then
raise ERichViewError.Create(errRVNoSuchCP2);
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetCheckpointNo(CheckpointData: TCheckpointData): Integer;
var cp: TRVCPInfo;
begin
if CheckpointData = nil then
raise ERichViewError.Create(errRVNil);
cp := FirstCP;
Result := 0;
while cp<>nil do begin
if cp=CheckpointData then exit;
cp := cp.Next;
inc(Result);
end;
if CheckpointData=NotAddedCP then exit;
if CheckpointData = nil then
raise ERichViewError.Create(errRVNoSuchCP2);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.GetCheckpointInfo(CheckpointData: TCheckpointData;
var Tag: Integer; var Name: String; var RaiseEvent: Boolean);
begin
if CheckpointData = nil then
raise ERichViewError.Create(errRVNil);
Name := TRVCPInfo(CheckpointData).Name;
Tag := TRVCPInfo(CheckpointData).Tag;
RaiseEvent := TRVCPInfo(CheckpointData).RaiseEvent;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.NormalizeParas(StartItemNo: Integer);
var i,ParaNo: Integer;
begin
if Items.Count=0 then exit;
i := StartItemNo;
if i>=Items.Count then
i := Items.Count-1;
while (i>0) and not TCustomRVItemInfo(Items.Objects[i]).CanBeBorderStart do
dec(i);
ParaNo := TCustomRVItemInfo(Items.Objects[i]).ParaNo;
inc(i);
while (i<Items.Count) and not TCustomRVItemInfo(Items.Objects[i]).CanBeBorderStart do begin
TCustomRVItemInfo(Items.Objects[i]).ParaNo := ParaNo;
inc(i);
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.FindCPBeforeItem(ItemNo: Integer): TRVCPInfo;
begin
UpdateCPItemNo;
if (FirstCP=nil) or
(FirstCP.ItemNo>=ItemNo) then begin
Result := nil; // no CP before
exit;
end;
Result := FirstCP;
while Result.Next<>nil do begin
if Result.Next.ItemNo>=ItemNo then exit;
Result := Result.Next;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.RVFGetLimits(SaveScope: TRVFSaveScope; var StartItem,
EndItem, StartOffs, EndOffs: Integer; var StartPart, EndPart: TRVMultiDrawItemPart);
begin
StartItem := 0;
EndItem := Items.Count-1;
if StartItem<Items.Count then begin
StartOffs := GetOffsBeforeItem(StartItem);
if EndItem>=0 then
EndOffs := GetOffsAfterItem(EndItem);
end;
StartPart := nil;
EndPart := nil;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRVFOptions: TRVFOptions;
begin
Result := GetRootData.GetRVFOptions;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetExtraRTFCode(Area: TRVRTFSaveArea; Obj: TObject; Index1, Index2: Integer; InStyleSheet: Boolean): String;
begin
Result := GetAbsoluteRootData.GetExtraRTFCode(Area, Obj, Index1, Index2, InStyleSheet);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetExtraHTMLCode(Area: TRVHTMLSaveArea; CSSVersion: Boolean): String;
begin
Result := GetAbsoluteRootData.GetExtraHTMLCode(Area, CSSVersion);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.IsAssignedOnProgress: Boolean;
begin
Result := GetAbsoluteRootData.IsAssignedOnProgress;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DoProgress(Operation: TRVLongOperation;
Stage: TRVProgressStage; PercentDone: Byte);
begin
GetAbsoluteRootData.DoProgress(Operation, Stage, PercentDone);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetParaHTMLCode(RVData: TCustomRVData; ItemNo: Integer;
ParaStart, CSSVersion: Boolean): String;
begin
Result := GetAbsoluteRootData.GetParaHTMLCode(RVData, ItemNo, ParaStart,
CSSVersion);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetRVFOptions(const Value: TRVFOptions);
begin
GetRootData.SetRVFOptions(Value);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRVFWarnings: TRVFWarnings;
begin
Result := GetRootData.GetRVFWarnings;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetRVFWarnings(const Value: TRVFWarnings);
begin
GetRootData.SetRVFWarnings(Value);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRVFSaveScope(SelectionOnly: Boolean):TRVFSaveScope;
begin
if SelectionOnly then
Result := rvfss_Selection
else
Result := rvfss_Full;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSERVF}
{------------------------------------------------------------------------------}
type
TRVFHeader = record
StyleNo,ParaNo, ReadType, ExtraValue: Integer;
DataCount, DataRead: Integer;
Item: TCustomRVItemInfo;
ClassName: String;
Name: String;
Version, SubVersion: Integer;
RaiseEvent: Integer;
PersistentCheckpoint: Integer;
CheckPointTag: Integer;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DataReader(Stream: TStream);
var Size: Integer;
MemStream: TMemoryStream;
Color: TColor;
Back: TRVBackground;
begin
MemStream := TMemoryStream.Create;
Include(State, rvstLoadingAsPartOfItem);
try
Stream.ReadBuffer(Size, SizeOf(Size));
MemStream.SetSize(Size);
Stream.ReadBuffer(MemStream.Memory^, Size);
Back := nil;
LoadRVFFromStream(MemStream, Color, Back, nil);
finally
MemStream.Free;
Exclude(State, rvstLoadingAsPartOfItem);
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DataWriter(Stream: TStream);
var StartPos,Size: Integer;
sb: Boolean;
begin
Size := 0;
StartPos := Stream.Position;
Stream.WriteBuffer(Size, SizeOf(Size));
sb := rvfoSaveBack in RVFOptions;
RVFOptions := RVFOptions - [rvfoSaveBack];
GetRVData.SaveRVFToStream(Stream, False, clNone, nil, nil);
if sb then
RVFOptions := RVFOptions + [rvfoSaveBack];
Size := Stream.Position-SizeOf(Size)-StartPos;
Stream.Position := StartPos;
Stream.WriteBuffer(Size, SizeOf(Size));
Stream.Position := StartPos+SizeOf(Size)+Size;
end;
{------------------------------------------------------------------------------}
function InsertRVFHeaderData(RVData: TCustomRVData; const Caption: String;
var Header: TRVFHeader; var PrevCP, CurCP: TRVCPInfo;
var Index, InsertPoint: Integer; var FirstTime: Boolean; AParaNo: Integer;
AppendMode, EditFlag: Boolean; var NonFirstItemsAdded: Integer;
var FullReformat: Boolean; TextStylesMapping,
ListStylesMapping: TRVIntegerList): Boolean;
var item: TCustomRVItemInfo;
CP: TRVCPInfo;
Caption2: String;
NewListNo: Integer;
{$IFNDEF RVDONOTUSELISTS}
OldListNo: Integer;
{$ENDIF}
begin
Result := True;
{$IFNDEF RVDONOTUSELISTS}
OldListNo := -1;
{$ENDIF}
if (Header.StyleNo=rvsBack) or
(Header.StyleNo=rvsVersionInfo) then exit;
if Header.Item<>nil then begin
if Header.StyleNo>=0 then begin
if EditFlag and
(rvprRVFInsertProtect in RVData.GetRVStyle.TextStyles[RVData.GetActualStyle(Header.Item)].Protection) then
exit;
item := RichViewTextItemClass.Create(RVData);
item.BeforeLoading(rvlfRVF);
item.Assign(Header.Item);
item.Tag := RV_CopyTag(Header.Item.Tag, rvoTagsArePChars in RVData.Options);
end
else begin
item := Header.Item;
Header.Item := nil;
if (item.AssociatedTextStyleNo>=0) and not RichViewDoNotCheckRVFStyleRefs then begin
if TextStylesMapping<>nil then begin
if item.AssociatedTextStyleNo>=TextStylesMapping.Count then begin
RVData.RVFWarnings := RVData.RVFWarnings + [rvfwConvUnknownStyles];
if rvfoConvUnknownStylesToZero in RVData.RVFOptions then
item.AssociatedTextStyleNo := 0
else begin
item.Free;
exit;
end;
end;
item.AssociatedTextStyleNo := TextStylesMapping[item.AssociatedTextStyleNo];
end;
if item.AssociatedTextStyleNo>=RVData.GetRVStyle.TextStyles.Count then begin
RVData.RVFWarnings := RVData.RVFWarnings + [rvfwConvUnknownStyles];
if rvfoConvUnknownStylesToZero in RVData.RVFOptions then
Header.Item.StyleNo := 0
else begin
item.Free;
exit;
end;
end;
end;
if not item.GetBoolValue(rvbpValid) then begin
item.Free;
exit;
end;
end;
if (Header.ParaNo=-1) and (RVData.Items.Count<>0) and (InsertPoint>0) and
not RVData.GetItem(InsertPoint-1).GetBoolValue(rvbpFullWidth) then begin
item.SameAsPrev := True;
item.ParaNo := RVData.GetItem(InsertPoint-1).ParaNo;
end
else begin
item.SameAsPrev := False;
if (Header.ParaNo<>-1) then
item.ParaNo := Header.ParaNo
else
item.ParaNo := 0;
end;
item.UpdatePaletteInfo(RVData.GetDoInPaletteMode, False,
RVData.GetRVPalette, RVData.GetRVLogPalette);
if CurCP<> nil then begin
if CurCP=RVData.NotAddedCP then begin
dec(RVData.CPCount);
RVData.NotAddedCP := nil;
end;
CP := CurCP;
if not EditFlag then begin
inc(RVData.CPCount);
RVData.SetCP(item, PrevCP, CurCP)
end
else begin
item.Checkpoint := CurCP;
CurCP.ItemInfo := item;
CurCP := nil;
end;
PrevCP := CP;
end;
Caption2 := Caption;
{$IFNDEF RVDONOTUSEUNICODE}
if (rvioUnicode in item.ItemOptions) and (item.StyleNo>=0) and
(Header.ReadType=3) then
Caption2 := RVDecodeString(Caption);
if (rvioUnicode in item.ItemOptions) and
(item.StyleNo>=0) and
(RVData.GetRVStyle<>nil) and
not RVData.GetRVStyle.TextStyles[RVData.GetActualStyle(item)].Unicode then begin
Caption2 := RVU_UnicodeToAnsi(RVData.GetStyleCodePage(RVData.GetActualStyle(item)), Caption);
Exclude(item.ItemOptions, rvioUnicode);
RVData.RVFWarnings := RVData.RVFWarnings + [rvfwConvFromUnicode];
end;
if not (rvioUnicode in item.ItemOptions) and
(item.StyleNo>=0) and
(RVData.GetRVStyle<>nil) and
RVData.GetRVStyle.TextStyles[RVData.GetActualStyle(item)].Unicode then begin
Caption2 := RVU_AnsiToUnicode(RVData.GetStyleCodePage(RVData.GetActualStyle(item)), Caption);
Include(item.ItemOptions, rvioUnicode);
RVData.RVFWarnings := RVData.RVFWarnings + [rvfwConvToUnicode];
end;
{$ENDIF}
{$IFNDEF RVDONOTUSELISTS}
if (item.StyleNo=rvsListMarker) and not RichViewDoNotCheckRVFStyleRefs then begin
if (ListStylesMapping<>nil) and (TRVMarkerItemInfo(item).ListNo>=0) then begin
if TRVMarkerItemInfo(item).ListNo>=ListStylesMapping.Count then begin
RVData.RVFWarnings := RVData.RVFWarnings + [rvfwConvUnknownStyles];
TRVMarkerItemInfo(item).ListNo := 0;
end
else begin
OldListNo := TRVMarkerItemInfo(item).ListNo;
TRVMarkerItemInfo(item).ListNo := ListStylesMapping[OldListNo];
end;
end;
if TRVMarkerItemInfo(item).ListNo>=RVData.GetRVStyle.ListStyles.Count then begin
RVData.RVFWarnings := RVData.RVFWarnings + [rvfwConvUnknownStyles];
TRVMarkerItemInfo(item).ListNo := 0;
if TRVMarkerItemInfo(item).ListNo>=RVData.GetRVStyle.ListStyles.Count then
TRVMarkerItemInfo(item).ListNo := -1;
end;
end;
{$ENDIF}
if FirstTime then begin
if AppendMode then begin
if AParaNo=-1 then begin
item.SameAsPrev := (InsertPoint>0) and
not RVData.GetItem(InsertPoint-1).GetBoolValue(rvbpFullWidth);
if item.SameAsPrev then
item.ParaNo := RVData.GetItem(InsertPoint-1).ParaNo
else
item.ParaNo := 0;
end
else begin
item.SameAsPrev := False;
item.ParaNo := AParaNo;
end;
end;
if not RVData.InsertFirstRVFItem(InsertPoint, Caption2, item, EditFlag,
FullReformat, NewListNo) then begin
Result := False;
exit;
end;
if item<>nil then begin
inc(InsertPoint);
Index := InsertPoint-1;
FirstTime := False;
end;
{$IFNDEF RVDONOTUSELISTS}
if (OldListNo>=0) and (NewListNo>=0) then
ListStylesMapping[OldListNo] := NewListNo;
{$ENDIF}
end
else begin
item.Inserting(RVData, Caption2, False);
RVData.Items.InsertObject(InsertPoint, Caption2, item);
item.Inserted(RVData, InsertPoint);
{$IFNDEF RVDONOTUSELISTS}
RVData.AddMarkerInList(InsertPoint);
{$ENDIF}
inc(InsertPoint);
inc(NonFirstItemsAdded);
end;
if item<>nil then begin
RVData.ControlAction(rvcaAfterRVFLoad, InsertPoint-1, item);
if not (rvstLoadingAsPartOfItem in RVData.State) then
item.AfterLoading(rvlfRVF);
end
else
RVData.FreeCheckpoint(CurCP, False, False);
end
else begin
// unknown item type
if CurCP<> nil then begin
if not EditFlag then begin
inc(RVData.CPCount);
item := RichViewTextItemClass.Create(RVData);
RVData.SetCP(item, PrevCP, CurCP);
RVData.InternalFreeItem(item,False);
end
else begin
RVData.FreeCheckpoint(CurCP, False, False);
end;
end;
end;
end;
{------------------------------------------------------------------------------}
function RVFReadHeader(RVData: TCustomRVData; const CurrentLine: String;
var Header: TRVFHeader; AParaNo: Integer; var Color: TColor;
Background: TRVBackground;
TextStylesMapping, ParaStylesMapping: TRVIntegerList): Boolean;
var P: PChar;
ItemOptions: Integer;
ABackgroundStyle, AColor, Tag: Integer;
begin
P := PChar(CurrentLine);
Result := False;
Header.DataRead := 0;
if not RVFReadTextStyle(RVData.GetRVStyle,P,Header.StyleNo) then
exit; {error}
if Header.StyleNo = rvsVersionInfo then begin
Header.DataCount := 0;
Result := (RVFReadInteger(P,Header.Version) and
RVFReadInteger(P,Header.SubVersion));
exit;
end;
if not (RVFReadInteger(P,Header.DataCount) and
RVFReadParaStyle(RVData.GetRVStyle,P,Header.ParaNo)) then
exit; {error}
if (Header.StyleNo<>rvsBack) and (Header.StyleNo<>rvsCheckpoint) and
(Header.StyleNo<>rvsDocProperty) then
Header.Item := CreateRichViewItem(Header.StyleNo, RVData);
if Header.Item<>nil then
Header.Item.BeforeLoading(rvlfRVF);
if (Header.Version>=1)and(Header.SubVersion>=2) then begin
if not RVFReadInteger(P,ItemOptions) then
exit; {error}
if Header.Item<>nil then
Header.Item.ItemOptions := TRVItemOptions(Byte(ItemOptions));
end;
if not (RVFReadInteger(P,Header.ReadType) and
RVFReadTag(P, rvoTagsArePChars in RVData.Options,
(Header.Version>1) or (Header.SubVersion>2), Tag)) then
exit; {error}
if Header.StyleNo = rvsDocProperty then begin
if not RVFReadInteger(P,Header.ExtraValue) then
exit; {error}
end;
if Header.StyleNo=rvsCheckpoint then
Header.CheckpointTag := Tag
else if Header.Item<>nil then
Header.Item.Tag := Tag;
if (Header.Item<>nil) and (Header.StyleNo>=0) and
not RichViewDoNotCheckRVFStyleRefs then begin
if (TextStylesMapping<>nil) and (Header.StyleNo<>rvsDefStyle) then begin
if Header.StyleNo>=TextStylesMapping.Count then begin
RVData.RVFWarnings := RVData.RVFWarnings + [rvfwConvUnknownStyles];
if rvfoConvUnknownStylesToZero in RVData.RVFOptions then
Header.StyleNo := 0
else
exit;
end
else
Header.StyleNo := TextStylesMapping[Header.StyleNo];
end;
Header.Item.StyleNo := Header.StyleNo;
if (Header.StyleNo<>rvsDefStyle) and
(Header.StyleNo>=RVData.GetRVStyle.TextStyles.Count) then begin
RVData.RVFWarnings := RVData.RVFWarnings + [rvfwConvUnknownStyles];
if rvfoConvUnknownStylesToZero in RVData.RVFOptions then
Header.Item.StyleNo := 0
else
exit;
end;
end;
if (Header.Item<>nil) and (Header.ParaNo>=0) and
not RichViewDoNotCheckRVFStyleRefs then begin
if ParaStylesMapping<>nil then begin
if Header.ParaNo>=ParaStylesMapping.Count then begin
RVData.RVFWarnings := RVData.RVFWarnings + [rvfwConvUnknownStyles];
exit;
end;
Header.ParaNo := ParaStylesMapping[Header.ParaNo];
end;
if Header.ParaNo>=RVData.GetRVStyle.ParaStyles.Count then begin
RVData.RVFWarnings := RVData.RVFWarnings + [rvfwConvUnknownStyles];
if rvfoConvUnknownStylesToZero in RVData.RVFOptions then
Header.ParaNo := 0
else
exit;
end;
end;
case Header.StyleNo of
{*}rvsCheckpoint:
begin
if not (P^ in [#0, #10, #13]) then begin
if not RVFReadInteger(P,Header.RaiseEvent) then
exit;
end
else
Header.RaiseEvent := 0;
if not (P^ in [#0, #10, #13]) then begin
if not RVFReadInteger(P,Header.PersistentCheckpoint) then
exit;
end
else
Header.PersistentCheckpoint := 0;
end;
{*}rvsBack:
begin
if not (RVFReadInteger(P, ABackgroundStyle) and
RVFReadInteger(P, AColor)) then
exit;
if rvfoLoadBack in RVData.RVFOptions then begin
Color := AColor;
if Background<>nil then begin
Background.Style := TBackgroundStyle(ABackgroundStyle);
Background.Bitmap.Handle := 0;
end;
end;
end;
{*}else
begin
if Header.Item = nil then begin
Result := True;
exit;
end;
if not Header.Item.ReadRVFHeader(P, RVData) then
exit;
end;
end;
Result := True;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DoOnStyleReaderError(Reader: TReader;
const Message: string; var Handled: Boolean);
begin
RVFWarnings := RVFWarnings + [rvfwUnknownStyleProperties];
Handled := True;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.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;
var BufferString, CurrentLine: String;
Size: Integer;
P, EndP: PChar;
ReadState:TRVFReadState;
ReadMode: TRVFReadMode;
Header: TRVFHeader;
FirstInsert: Boolean;
PrevCP, CurCP: TRVCPInfo;
PTextStylesMapping: PRVIntegerList;
PParaStylesMapping: PRVIntegerList;
PListStylesMapping: PRVIntegerList;
InsertPoint: Integer;
{.......................................................}
procedure FreeCheckpointTag; // in-out: Header
begin
if rvoTagsArePChars in Options then StrDispose(PChar(Header.CheckpointTag));
Header.CheckpointTag := 0;
end;
{.......................................................}
{$IFDEF RICHVIEWCBDEF3}
procedure ReadStyles(Styles: TCustomRVInfos; StylesReadMode: TRVFReaderStyleMode);
var Reader: TReader;
TmpStream: TMemoryStream;
Val: TValueType;
begin
TmpStream := TMemoryStream.Create;
try
case Header.ReadType of
0: // text
RVFTextString2Stream(CurrentLine, TmpStream);
2: // binary
TmpStream.WriteBuffer(PChar(CurrentLine)^, Length(CurrentLine));
end;
if (TmpStream.Size>0) and (StylesReadMode<>rvf_sIgnore) then begin
TmpStream.Position := 0;
TmpStream.ReadBuffer(Val, sizeof(Val));
if Val<>vaCollection then
abort;
Reader := TReader.Create(TmpStream, 4096);
try
Reader.OnError := DoOnStyleReaderError;
if Styles is TRVListInfos then
TRVListInfos(Styles).FRVData := Self;
try
Reader.ReadCollection(Styles);
finally
if Styles is TRVListInfos then
TRVListInfos(Styles).FRVData := nil;
end;
finally
Reader.Free;
end;
end;
finally
TmpStream.Free;
end;
end;
{.......................................................}
procedure MergeStyles(Base, Loaded: TCustomRVInfos;
var Mapping: TRVIntegerList;
StylesReadMode: TRVFReaderStyleMode);
begin
if (Loaded.Count=0) or (StylesReadMode = rvf_sIgnore) or (Mapping<>nil) then
exit;
if AllowReplaceStyles then begin
Base.Assign(Loaded);
exit;
end;
Mapping := TRVIntegerList.Create;
case StylesReadMode of
rvf_sInsertMap:
Base.MergeWith(Loaded, rvs_merge_Map, Mapping, PTextStylesMapping^);
rvf_sInsertMerge:
Base.MergeWith(Loaded, rvs_merge_SmartMerge, Mapping, PTextStylesMapping^);
end;
end;
{.......................................................}
procedure ReadDocProperty;
var Styles, BaseStyles: TCustomRVInfos;
StylesReadMode: TRVFReaderStyleMode;
PMapping: PRVIntegerList;
{$IFNDEF RVDONOTUSELISTS}
i, ListNo: Integer;
{$ENDIF}
begin
case Header.DataRead of
0:
begin
if (Header.ExtraValue=RVF_DOCPROP_DOCPROPLIST) and AllowReplaceStyles and
(rvfoLoadDocProperties in RVFOptions) and (GetDocProperties<>nil) then
GetDocProperties.Add(RVFDecodeLineBreaks(CurrentLine));
// Header.ExtraValue<>RVF_DOCPROP_DOCPROPLIST then ignoring this line (should be name of TRVStyle)
if Header.ReadType=2 then ReadMode := rmBeforeBinary;
end;
1:
begin
case Header.ExtraValue of
RVF_DOCPROP_TEXTSTYLES:
begin
Styles := TFontInfos.Create(GetRVStyle.GetTextStyleClass, GetRVStyle);
StylesReadMode := GetRVFTextStylesReadMode;
BaseStyles := GetRVStyle.TextStyles;
PMapping := PTextStylesMapping;
end;
RVF_DOCPROP_PARASTYLES:
begin
Styles := TParaInfos.Create(GetRVStyle.GetParaStyleClass, GetRVStyle);
StylesReadMode := GetRVFParaStylesReadMode;
BaseStyles := GetRVStyle.ParaStyles;
PMapping := PParaStylesMapping;
end;
RVF_DOCPROP_LISTSTYLES:
begin
Styles := TRVListInfos.Create(GetRVStyle.GetListStyleClass, GetRVStyle);
StylesReadMode := GetRVFParaStylesReadMode;
BaseStyles := GetRVStyle.ListStyles;
PMapping := PListStylesMapping;
end;
RVF_DOCPROP_LAYOUT:
begin
if (Layout=nil) or (not AllowReplaceStyles) or
not (rvfoLoadLayout in RVFOptions) then
exit;
case Header.ReadType of
0: // text
Layout.LoadText(CurrentLine);
2: // binary
Layout.LoadBinary(CurrentLine);
end;
if (Layout.FirstParaAborted<>0) and (Layout.FirstMarkerListNo>=0) and
(PListStylesMapping^<>nil) then
Layout.FirstMarkerListNo := PListStylesMapping^[Layout.FirstMarkerListNo];
exit;
end;
RVF_DOCPROP_PREVMARKERS:
begin
{$IFNDEF RVDONOTUSELISTS}
if (GetPrevMarkers=nil) or (not AllowReplaceStyles) or
not (rvfoLoadLayout in RVFOptions) then
exit;
case Header.ReadType of
0: // text
GetPrevMarkers.LoadText(CurrentLine, Self);
2: // binary
GetPrevMarkers.LoadBinary(CurrentLine, Self);
end;
if (PListStylesMapping^<>nil) then
for i := 0 to GetPrevMarkers.Count-1 do begin
ListNo := TRVMarkerItemInfo(GetPrevMarkers.Items[i]).ListNo;
if ListNo>=0 then
TRVMarkerItemInfo(GetPrevMarkers.Items[i]).ListNo :=
PListStylesMapping^[ListNo];
end;
{$ENDIF}
exit;
end;
RVF_DOCPROP_DOCPROPLIST:
begin
if AllowReplaceStyles and (rvfoLoadDocProperties in RVFOptions) and
(GetDocProperties<>nil) then
GetDocProperties.Add(RVFDecodeLineBreaks(CurrentLine));
exit;
end;
else
exit;
end;
try
ReadStyles(Styles, StylesReadMode);
MergeStyles(BaseStyles, Styles, PMapping^, StylesReadMode);
finally
Styles.Free;
end;
end;
else
if (Header.ExtraValue=RVF_DOCPROP_DOCPROPLIST) and AllowReplaceStyles and
(rvfoLoadDocProperties in RVFOptions) and (GetDocProperties<>nil) then
GetDocProperties.Add(RVFDecodeLineBreaks(CurrentLine));
end;
end;
{$ENDIF}
{.......................................................}
// in : CurrentLine
procedure ReadBackground; // in-out: Header
// out : ReadMode, ReadState
var bmp : TBitmap;
begin
case Header.DataRead of
0:
begin
// ignoring this line (should be TBitmap)
if Header.ReadType=2 then ReadMode := rmBeforeBinary;
end;
1:
begin
if rvfoLoadBack in RVFOptions then begin
if Background<>nil then begin
if Header.ReadType=2 then
RVFLoadPictureBinary(CurrentLine, Background.Bitmap)
else
if not RVFLoadPicture(CurrentLine, Background.Bitmap) then abort; {error}
end
else begin
bmp := TBitmap.Create;
if Header.ReadType=2 then
RVFLoadPictureBinary(CurrentLine, bmp)
else
if not RVFLoadPicture(CurrentLine, bmp) then abort; {error}
bmp.Free;
end;
end;
ReadState := rstSkip;
end;
end;
end;
{.......................................................}
// in: ReadMode
// in-out: P
procedure ReadCurrentLine; // out: CurrentLine
var Start: PChar;
Size: Integer;
begin
Start := P;
case ReadMode of
rmBinary:
begin
Move(P^,Size, SizeOf(Size));
inc(Start, SizeOf(Size));
inc(P, SizeOf(Size)+Size);
end;
rmUnicode:
begin
while (PWord(P)^<>UNI_ParagraphSeparator) and
(PWord(P)^<>0) and
(P<EndP) do Inc(P,2);
end;
else
begin
while not (P^ in [#0, #10, #13]) do Inc(P);
end;
end;
SetString(CurrentLine, Start, P - Start);
end;
{.......................................................}
procedure SkipCurrentLineTail; // in-out: P, ReadMode
begin
case ReadMode of
rmText:
begin
if P^ = #13 then Inc(P);
if P^ = #10 then Inc(P);
end;
rmBeforeUnicode:
begin
if P^ = #13 then Inc(P) else abort; {error}
if P^ = #10 then Inc(P) else abort; {error}
ReadMode := rmUnicode;
end;
rmUnicode:
begin
if PWord(P)^=UNI_ParagraphSeparator then
Inc(P, 2);
end;
rmAfterUnicode:
begin
if PWord(P)^=UNI_ParagraphSeparator then
Inc(P, 2);
ReadMode := rmText;
end;
rmBeforeBinary:
begin
if P^ = #13 then Inc(P) else abort; {error}
if P^ = #10 then Inc(P) else abort; {error}
ReadMode := rmBinary;
end;
rmBinary:
begin
ReadMode := rmText;
end;
end;
end;
{.......................................................}
var StartIndex: Integer;
begin
NonFirstItemsAdded := 0;
Result := True;
Protect := True;
FirstInsert := True;
StartIndex := Index;
InsertPoint := Index;
if Index>Items.Count then
Index := Items.Count;
if Index=Items.Count then begin
PrevCP := LastCP;
if EditFlag then
CurCP := nil
else
CurCP := NotAddedCP;
end
else begin
PrevCP := FindCPBeforeItem(Index);
CurCP := nil;
end;
RVFWarnings := [];
if AllowReplaceStyles and (GetDocProperties<>nil) then
GetDocProperties.Clear;
FillChar(Header,sizeof(Header),0);
Header.Version := 1;
Header.SubVersion := 0;
InitStyleMappings(PTextStylesMapping, PParaStylesMapping, PListStylesMapping);
try
Size := Stream.Size - Stream.Position;
SetString(BufferString, nil, Size);
Stream.Read(Pointer(BufferString)^, Size);
P := Pointer(BufferString);
EndP := PChar(BufferString)+Size;
ReadState := rstHeader;
ReadMode := rmText;
if P <> nil then
while P < EndP do begin
ReadCurrentLine;
case ReadState of
rstHeader:
begin
if not RVFReadHeader(Self, CurrentLine, Header, AParaNo,
Color, Background, PTextStylesMapping^, PParaStylesMapping^) then
abort; {error}
if (Header.DataCount=0) then begin
if not InsertRVFHeaderData(Self, '', Header, PrevCP, CurCP,
Index, InsertPoint, FirstInsert, AParaNo, AppendMode, EditFlag,
NonFirstItemsAdded, FullReformat, PTextStylesMapping^,
PListStylesMapping^) then
exit;
ReadState := rstHeader;
end
else
if ((Header.Item=nil) and (Header.StyleNo<>rvsCheckpoint) and
(Header.StyleNo<>rvsBack)
{$IFDEF RICHVIEWCBDEF3}
and (Header.StyleNo<>rvsDocProperty)
{$ENDIF}
) or
((Header.Item<>nil) and
not Header.Item.GetBoolValue(rvbpRequiresRVFLines)) then
ReadState := rstSkip
else begin
ReadState := rstData;
{$IFNDEF RVDONOTUSEUNICODE}
if (Header.Item<>nil) and
(rvioUnicode in Header.Item.ItemOptions) and
(Header.ReadType<>3) then
ReadMode := rmBeforeUnicode;
{$ENDIF}
end;
end;
rstData:
begin
if Header.StyleNo<0 then begin
case Header.StyleNo of
{*} rvsBack:
ReadBackground;
{$IFDEF RICHVIEWCBDEF3}
{*} rvsDocProperty:
ReadDocProperty;
{$ENDIF}
{*} rvsCheckpoint:
begin
if CurCP = nil then begin
CurCP := TRVCPInfo.Create;
CurCP.Name := CurrentLine;
CurCP.Tag := Header.CheckpointTag;
CurCP.RaiseEvent := Boolean(Header.RaiseEvent);
CurCP.Persistent := Boolean(Header.PersistentCheckpoint);
Header.CheckpointTag := 0;
end;
end;
{*} else
begin
if Header.Item<>nil then
if not Header.Item.ReadRVFLine(CurrentLine, Self,
Header.ReadType, Header.DataRead, Header.DataCount,
Header.Name, ReadMode, ReadState) then
abort;
if Header.DataRead=Header.DataCount-1 then
if not InsertRVFHeaderData(Self, Header.Name, Header,
PrevCP, CurCP, Index, InsertPoint, FirstInsert, AParaNo,
AppendMode, EditFlag, NonFirstItemsAdded, FullReformat,
PTextStylesMapping^, PListStylesMapping^) then
exit;
end
end
end
else begin
if not InsertRVFHeaderData(Self, CurrentLine, Header, PrevCP, CurCP,
Index, InsertPoint, FirstInsert, AParaNo, AppendMode, EditFlag,
NonFirstItemsAdded, FullReformat, PTextStylesMapping^,
PListStylesMapping^) then
exit;
if Header.DataRead=Header.DataCount-1 then begin
if rvoTagsArePChars in Options then
StrDispose(PChar(Header.Item.Tag));
Header.Item.Free;
Header.Item := nil;
end;
end;
inc(Header.DataRead);
if Header.DataRead=Header.DataCount then begin
ReadState := rstHeader;
if ReadMode=rmUnicode then
ReadMode := rmAfterUnicode;
end;
end;
rstSkip:
begin
inc(Header.DataRead);
if (Header.DataRead=Header.DataCount-1) and (Header.ReadType=2) then
ReadMode := rmBeforeBinary
else if Header.DataRead=Header.DataCount then begin
if not InsertRVFHeaderData(Self, Header.Name, Header, PrevCP, CurCP,
Index, InsertPoint, FirstInsert, AParaNo, AppendMode, EditFlag,
NonFirstItemsAdded, FullReformat, PTextStylesMapping^,
PListStylesMapping^) then
exit;
ReadState := rstHeader;
end;
end;
end;
SkipCurrentLineTail;
end; // of while
Result := (ReadState = rstHeader);
{$IFNDEF RVDONOTUSELISTS}
if (InsertPoint-1>=0) and (InsertPoint-1<ItemCount) and
(GetItemStyle(InsertPoint-1)=rvsListMarker) and
((InsertPoint=ItemCount) or IsParaStart(InsertPoint)) then begin
Header.StyleNo := 0;
Header.ParaNo := -1;
Header.Item := RichViewTextItemClass.Create(Self);
InsertRVFHeaderData(Self, '', Header, PrevCP, CurCP, Index, InsertPoint,
FirstInsert, AParaNo, AppendMode, EditFlag,
NonFirstItemsAdded, FullReformat, PTextStylesMapping^, PListStylesMapping^);
Header.Item.Free;
Header.Item := nil;
end;
{$ENDIF}
if not EditFlag then
NormalizeParas(StartIndex);
Protect := False;
except
Result := False;
end;
DoneStyleMappings(PTextStylesMapping,PParaStylesMapping,PListStylesMapping);
FreeCheckpointTag;
if Result and (InsertPoint=Items.Count) and (NotAddedCP=nil) then begin
if CurCP<> nil then inc(CPCount);
NotAddedCP := CurCP
end
else
if NotAddedCP<>CurCP then
FreeCheckpoint(CurCP, False, False); // ignore cp from stream
end;
{------------------------------------------------------------------------------}
function TCustomRVData.AppendRVFFromStream(Stream: TStream; ParaNo: Integer;
var Color: TColor;
Background: TRVBackground):Boolean;
var Dummy: Integer;
Dummy2, Dummy3: Boolean;
Index: Integer;
begin
Index := Items.Count;
Result := InsertRVFFromStream_(Stream, Index, ParaNo, False, True, False,
Color, Background, nil, Dummy, Dummy2, Dummy3);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.InsertRVFFromStream(Stream: TStream; Index: Integer;
var Color: TColor; Background: TRVBackground; Layout: TRVLayoutInfo;
AllowReplaceStyles: Boolean):Boolean;
var Dummy: Integer;
Dummy2,Dummy3: Boolean;
begin
// AParaNo is used only if AppendMode=True
Result := InsertRVFFromStream_(Stream, Index, -1, AllowReplaceStyles, False, False,
Color, Background, Layout, Dummy, Dummy2,Dummy3);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.LoadRVF(const FileName: String; var Color: TColor;
Background: TRVBackground; Layout: TRVLayoutInfo):Boolean;
var Stream: TFileStream;
begin
try
Stream := TFileStream.Create(FileName,fmOpenRead);
try
Result := LoadRVFFromStream(Stream, Color, Background, Layout);
finally
Stream.Free;
end;
except
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.LoadRVFFromStream(Stream: TStream; var Color: TColor;
Background: TRVBackground; Layout: TRVLayoutInfo):Boolean;
begin
Clear;
Result := InsertRVFFromStream(Stream,0, Color, Background, Layout, True);
end;
{------------------------------------------------------------------------------}
procedure RVFWriteCheckpoint(Stream: TStream; TagsArePChars: Boolean;
cp: TRVCPInfo);
begin
if cp=nil then
exit;
RVFWriteLine(Stream, Format('%d %d %d %d %d %s %d %d',
[rvsCheckpoint, 1, 0, 0, 0, RVFSaveTag(TagsArePChars,cp.Tag),
Integer(cp.RaiseEvent), Integer(cp.Persistent)]));
RVFWriteLine(Stream, cp.Name);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SaveRVF(const FileName: String; SelectionOnly: Boolean;
Color: TColor; Background: TRVBackground; Layout: TRVLayoutInfo):Boolean;
var Stream: TFileStream;
begin
try
Stream := TFileStream.Create(FileName,fmCreate);
try
Result := SaveRVFToStream(Stream, SelectionOnly, Color, Background, Layout);
finally
Stream.Free;
end;
except
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SaveRVFToStream(Stream: TStream; SelectionOnly: Boolean;
Color: TColor; Background: TRVBackground; Layout: TRVLayoutInfo):Boolean;
begin
Result := SaveRVFToStreamEx(Stream, GetRVFSaveScope(SelectionOnly), Color,
Background, Layout);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SaveRVFToStreamEx(Stream: TStream; SaveScope: TRVFSaveScope;
Color: TColor; Background: TRVBackground; Layout: TRVLayoutInfo):Boolean;
var i: Integer;
Header: TRVFHeader;
SectionBackOffs: Integer;
StartItem, EndItem, StartOffs, EndOffs: Integer;
StartPart, EndPart: TRVMultiDrawItemPart;
MarkerItemNo: Integer;
{.......................................................}
procedure RVFSaveVersionInfo;
begin
RVFWriteLine(Stream, SysUtils.Format('%d %d %d',
[rvsVersionInfo, RVFVersion, RVFSubVersion]));
end;
{.......................................................}
{$IFDEF RICHVIEWCBDEF3}
procedure RVFSaveStyles(Id: Integer; Styles: TCollection);
var SaveType: Integer;
Writer: TWriter;
TmpStream: TMemoryStream;
Pos,Pos2: Integer;
begin
if rvfoSaveBinary in RVFOptions then
SaveType := 2 // save binary
else
SaveType := 0; // save hex dump
RVFWriteLine(Stream, Format('%d %d %d %d %d %d %d',
[rvsDocProperty, 2, 0, 0, SaveType, 0, Id]));
RVFWriteLine(Stream, GetRVStyle.Name);
if rvfoSaveBinary in RVFOptions then begin
Pos := Stream.Position;
Stream.WriteBuffer(Pos, sizeof(Pos));
Writer := TWriter.Create(Stream, 4096);
if Styles is TRVListInfos then
TRVListInfos(Styles).FRVData := Self;
try
Writer.WriteCollection(Styles)
finally
Writer.Free;
if Styles is TRVListInfos then
TRVListInfos(Styles).FRVData := nil;
end;
Pos2 := Stream.Position;
Stream.Position := Pos;
Pos := Pos2-Pos-sizeof(Pos);
Stream.WriteBuffer(Pos, sizeof(Pos));
Stream.Position := Pos2;
end
else begin
TmpStream := TMemoryStream.Create;
try
Writer := TWriter.Create(TmpStream, 4096);
if Styles is TRVListInfos then
TRVListInfos(Styles).FRVData := Self;
try
Writer.WriteCollection(Styles);
finally
Writer.Free;
if Styles is TRVListInfos then
TRVListInfos(Styles).FRVData := nil;
end;
TmpStream.Position := 0;
RVFWriteLine(Stream, RVFStream2TextString(TmpStream));
finally
TmpStream.Free;
end;
end;
end;
{$ENDIF}
{.......................................................}
procedure RVFSaveLayout;
var SaveType : Integer;
begin
if rvfoSaveBinary in RVFOptions then
SaveType := 2 // save binary
else
SaveType := 0; // save hex dump
RVFWriteLine(Stream, Format('%d %d %d %d %d %d %d',
[rvsDocProperty, 2, 0, 0, SaveType, 0, RVF_DOCPROP_LAYOUT]));
RVFWriteLine(Stream, '');
case SaveType of
2:
Layout.SaveToStream(Stream,True);
0:
Layout.SaveTextToStream(Stream);
end;
end;
{.......................................................}
{$IFNDEF RVDONOTUSELISTS}
procedure RVFSavePrevMarkers(StartItemNo: Integer);
var SaveType, MarkerIndex : Integer;
Marker: TRVMarkerItemInfo;
begin
if StartItemNo=0 then
exit;
Marker := FindPreviousMarker(StartItemNo-1);
if Marker=nil then
exit;
MarkerIndex := Marker.GetIndexInList(GetMarkers(False));
if MarkerIndex<0 then
exit;
if rvfoSaveBinary in RVFOptions then
SaveType := 2 // save binary
else
SaveType := 0; // save hex dump
RVFWriteLine(Stream, Format('%d %d %d %d %d %d %d',
[rvsDocProperty, 2, 0, 0, SaveType, 0, RVF_DOCPROP_PREVMARKERS]));
RVFWriteLine(Stream, '');
case SaveType of
2:
GetMarkers(False).SaveToStream(Stream, MarkerIndex+1, True);
0:
GetMarkers(False).SaveTextToStream(Stream, MarkerIndex+1);
end;
end;
{$ENDIF}
{.......................................................}
procedure RVFSaveDocPropertiesStringList;
var i: Integer;
dp: TStringList;
begin
dp := GetAbsoluteRootData.GetDocProperties;
if (dp=nil) or (dp.Count=0) then
exit;
RVFWriteLine(Stream, Format('%d %d %d %d %d %d %d',
[rvsDocProperty, dp.Count, 0, 0, 0, 0, RVF_DOCPROP_DOCPROPLIST]));
for i := 0 to dp.Count-1 do
RVFWriteLine(Stream, RVFEncodeLineBreaks(dp.Strings[i]));
end;
{.......................................................}
procedure RVFSaveBackground;
var SaveType, LineCount: Integer;
begin
if Background=nil then exit;
if Background.Bitmap.Empty or (Background.Style=bsNoBitmap) then
RVFWriteLine(Stream, Format('%d %d %d %d %d %d %d %d',
[rvsBack, 0, -1, 0, 0, 0, ord(Background.Style), Color]))
else begin
LineCount := 2;
if rvfoSaveBinary in RVFOptions then
SaveType := 2 // save binary
else
SaveType := 0 // save hex dump
;
RVFWriteLine(Stream, Format('%d %d %d %d %d %d %d %d',
[rvsBack, LineCount, 0, 0, SaveType, 0, ord(Background.Style), Color]));
if SaveType<>1 then begin
RVFWriteLine(Stream, Background.Bitmap.ClassName);
if rvfoSaveBinary in RVFOptions then
RVFSavePictureBinary(Stream, Background.Bitmap)
else
RVFWriteLine(Stream, RVFSavePicture(Background.Bitmap));
end;
end;
end;
{.......................................................}
{ Saves text of the ItemNo-th item in range from StartOffs to EndOffs characters.
If the ItemNo-th item is not a text item, saves an empty text line of style
GetItem(ItemNo).AssociatedTextStyleNo (it's assumed that it's >=0).
If StartOffs=GetOffsetBeforeItem(ItemNo) and the item has a checkpoint,
it's saved too.
If ForceSavingPara, item's paragraph index is saved, even if it does not
start a new paragraph. }
procedure WritePartialTextLine(ItemNo, StartOffs, EndOffs: Integer;
ForceSavingPara: Boolean); // in: Stream
var AFromStart: Boolean;
AParaNo, TextStyleNo: Integer;
SaveMode: Integer;
Tail, Text: String;
item: TCustomRVItemInfo;
{$IFNDEF RVDONOTUSEUNICODE}
Unicode: Boolean;
{$ENDIF}
ItemOptions: TRVItemOptions;
begin
AFromStart := (StartOffs <= GetOffsBeforeItem(ItemNo));
item := GetItem(ItemNo);
TextStyleNo := item.StyleNo;
if TextStyleNo<0 then
TextStyleNo := item.AssociatedTextStyleNo;
{$IFNDEF RVDONOTUSEUNICODE}
Unicode := GetRVStyle.TextStyles[TextStyleNo].Unicode;
{$ENDIF}
{$IFDEF RICHVIEWCBDEF3}
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode and not (rvfoSaveBinary in RVFOptions) then
SaveMode := 3
else
{$ENDIF}
SaveMode := 0;
{$ELSE}
SaveMode := 0;
{$ENDIF}
if (AFromStart and not item.SameAsPrev) or ForceSavingPara then
AParaNo := item.ParaNo
else
AParaNo := -1;
if AFromStart then
RVFWriteCheckpoint(Stream, rvoTagsArePChars in Options, item.Checkpoint);
Tail := '';
{$IFNDEF RVDONOTUSEITEMHINTS}
{$IFDEF RICHVIEWCBDEF3}
if item.Hint<>'' then
Tail := ' '+AnsiQuotedStr(item.Hint, '"');
{$ENDIF}
{$ENDIF}
ItemOptions := GetItemOptions(ItemNo);
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode then
Include(ItemOptions, rvioUnicode);
{$ENDIF}
RVFWriteLine(Stream, SysUtils.Format('%s %d %s %d %d %s%s',
[RVFSaveText(GetRVStyle, rvfoUseStyleNames in RVFOptions, TextStyleNo), 1,
RVFSavePara(GetRVStyle, rvfoUseStyleNames in RVFOptions, AParaNo),
Byte(ItemOptions) and RVItemOptionsMask,
SaveMode, RVFSaveTag(rvoTagsArePChars in Options, item.Tag),
Tail]));
if item.StyleNo>=0 then
Text := RVU_Copy(Items[ItemNo], StartOffs, EndOffs-StartOffs, GetItemOptions(ItemNo))
else
Text := '';
RVFWriteLineX(Stream, Text,
{$IFNDEF RVDONOTUSEUNICODE}Unicode{$ELSE}False{$ENDIF}, SaveMode=3);
MarkerItemNo := -1;
end;
{.......................................................}
function IsTheSameStyleText: Boolean; // in: i, Header
begin
with GetItem(i) do
Result := (not SameAsPrev) and (StyleNo>=0) and (StyleNo=Header.StyleNo) and
(ParaNo=Header.ParaNo) and
((Byte(ItemOptions) and RVItemOptionsMask) = (Byte(Header.Item.ItemOptions)and RVItemOptionsMask)) and
RV_CompareTags(Tag, Header.Item.Tag, rvoTagsArePChars in Options) and
{$IFNDEF RVDONOTUSEITEMHINTS}
(Hint=Header.Item.Hint) and
{$ENDIF}
(Checkpoint=nil);
end;
{.......................................................}
procedure RVFWritePrevStrings(i: Integer); // in: Header, SectionBackOffs
var j: Integer;
ItemOptions: TRVItemOptions;
SaveMode: Integer;
Tail: String;
begin
{$IFDEF RICHVIEWCBDEF3}