RichEdit

开发平台：

Delphi

CRVData.pas：源码内容

if (rvfoSaveBinary in RVFOptions) or
not (rvioUnicode in GetItemOptions(i-SectionBackOffs)) then
SaveMode := 0
else
SaveMode := 3;
{$ELSE}
SaveMode := 0;
{$ENDIF}
RVFWriteCheckpoint(Stream, rvoTagsArePChars in Options, Header.Item.Checkpoint);
if MarkerItemNo>=0 then begin
ItemOptions := RVFGetItemOptions(Header.Item.ItemOptions, MarkerItemNo>=0);
RVFWriteLine(Stream, Format('%s %d %s %d %d %s',
[RVFSaveText(GetRVStyle, rvfoUseStyleNames in RVFOptions, Header.StyleNo),
1,
RVFSavePara(GetRVStyle, rvfoUseStyleNames in RVFOptions, -1),
Byte(ItemOptions) and RVItemOptionsMask,
SaveMode, RVFSaveTag(rvoTagsArePChars in Options, Header.Item.Tag)]));
RVFWriteLineX(Stream, Items[i-SectionBackOffs],
rvioUnicode in GetItemOptions(i-SectionBackOffs), SaveMode=3);
dec(SectionBackOffs);
MarkerItemNo := -1;
end;
if SectionBackOffs=0 then
exit;
Tail := '';
{$IFNDEF RVDONOTUSEITEMHINTS}
{$IFDEF RICHVIEWCBDEF3}
if GetItem(i-SectionBackOffs).Hint<>'' then
Tail := ' '+AnsiQuotedStr(GetItem(i-SectionBackOffs).Hint, '"');
{$ENDIF}
{$ENDIF}
RVFWriteLine(Stream, Format('%s %d %s %d %d %s%s',
[RVFSaveText(GetRVStyle, rvfoUseStyleNames in RVFOPtions, Header.StyleNo),
SectionBackOffs,
RVFSavePara(GetRVStyle, rvfoUseStyleNames in RVFOPtions, Header.ParaNo),
Byte(Header.Item.ItemOptions) and RVItemOptionsMask,
SaveMode, RVFSaveTag(rvoTagsArePChars in Options, Header.Item.Tag),
Tail]));
for j := i-SectionBackOffs to i-1 do
RVFWriteLineX(Stream, Items[j], rvioUnicode in GetItemOptions(j), SaveMode=3);
SectionBackOffs := 0;
end;
{.......................................................}
procedure RVFSetHeaderHeader(i: Integer); // in: Header
begin
with GetItem(i) do begin
Header.Item.Checkpoint := Checkpoint;
Header.Item.ItemOptions := ItemOptions;
Header.StyleNo := StyleNo;
Header.Item.StyleNo := StyleNo;
{$IFNDEF RVDONOTUSEITEMHINTS}
Header.Item.Hint := Hint;
{$ENDIF}
if SameAsPrev and not ((i=StartItem) and (SaveScope=rvfss_Page)) then
Header.ParaNo := -1
else
Header.ParaNo := ParaNo;
Header.Item.Tag := Tag;
end;
end;
{.......................................................}
procedure RVFWriteNonText(i: Integer; Part: TRVMultiDrawItemPart); // in: Header
{$IFNDEF RVDONOTUSELISTS}
var StartFrom: Integer;
Reset: Boolean;
marker: TRVMarkerItemInfo;
{$ENDIF}
begin
with GetItem(i) do begin
RVFWriteCheckpoint(Stream, rvoTagsArePChars in Options, Checkpoint);
{$IFNDEF RVDONOTUSELISTS}
if StyleNo=rvsListMarker then begin
marker := TRVMarkerItemInfo(GetItem(i));
StartFrom := marker.StartFrom;
Reset := marker.Reset;
if SaveScope=rvfss_Page then begin
marker.StartFrom := marker.Counter;
marker.Reset := True;
end;
end
else begin
StartFrom := 0; // avoiding warnings
Reset := False;
marker := nil;
end;
{$ENDIF}
SaveRVF(Stream, Self, i, Header.ParaNo, Items[i], Part, MarkerItemNo>=0);
{$IFNDEF RVDONOTUSELISTS}
if StyleNo=rvsListMarker then begin
marker.StartFrom := StartFrom;
marker.Reset := Reset;
end;
{$ENDIF}
MarkerItemNo := -1;
end;
end;
{.......................................................}
{ Should the first selected item be saved as an empty text line? }
function ShouldSaveEndOfNonTextItemAsEmptyText: Boolean;
begin
Result := (SaveScope=rvfss_Selection) and
(GetItem(StartItem).AssociatedTextStyleNo>=0) and
(StartOffs>=GetOffsAfterItem(StartItem)) and
GetItem(StartItem).GetBoolValue(rvbpSwitchToAssStyleNo) and
((StartItem+1=ItemCount) or IsFromNewLine(StartItem+1));
end;
{.......................................................}
{ Should the last selected item be saved as an empty text line? }
function ShouldSaveBeginningOfNonTextItemAsEmptyText: Boolean;
begin
Result := (SaveScope=rvfss_Selection) and
(GetItem(EndItem).AssociatedTextStyleNo>=0) and
(EndOffs<=GetOffsBeforeItem(EndItem)) and
GetItem(EndItem).GetBoolValue(rvbpSwitchToAssStyleNo) and
IsFromNewLine(EndItem);
end;
{.......................................................}
begin
Result := True;
if (Items.Count=0) {or (SelectionOnly and not SelectionExists)} then
exit;
FillChar(Header, sizeof(Header), 0);
Header.Item := RichViewTextItemClass.Create(Self);
try
RVFSaveVersionInfo;
if (SaveScope<>rvfss_Selection) and (rvfoSaveBack in RVFOptions) then
RVFSaveBackground;
if (rvflRoot in Flags) or (SaveScope=rvfss_Selection) then begin
{$IFDEF RICHVIEWCBDEF3}
if (rvfoSaveTextStyles in RVFOptions) then
RVFSaveStyles(RVF_DOCPROP_TEXTSTYLES, GetRVStyle.TextStyles);
if (rvfoSaveParaStyles in RVFOptions) and (Self=GetRootData) then begin
RVFSaveStyles(RVF_DOCPROP_PARASTYLES, GetRVStyle.ParaStyles);
RVFSaveStyles(RVF_DOCPROP_LISTSTYLES, GetRVStyle.ListStyles);
end;
{$ENDIF}
if (rvfoSaveDocProperties in RVFOptions) and (SaveScope<>rvfss_Page) then
RVFSaveDocPropertiesStringList;
end;
if (SaveScope=rvfss_Page) and (Layout<>nil) then begin
RVFGetLimits(SaveScope,StartItem,EndItem,StartOffs,EndOffs,StartPart,EndPart);
if (StartItem>=0) and (StartItem<=EndItem) then begin
if (StartOffs>GetOffsBeforeItem(StartItem)) or
((StartOffs<=GetOffsBeforeItem(StartItem)) and not IsParaStart(StartItem)) then begin
Layout.FirstParaAborted := 1;
{$IFNDEF RVDONOTUSELISTS}
MarkerItemNo := GetFirstParaItem(StartItem);
if (MarkerItemNo<>StartItem) and (GetItemStyle(MarkerItemNo)=rvsListMarker) then begin
Layout.FirstMarkerListNo := TRVMarkerItemInfo(GetItem(MarkerItemNo)).ListNo;
Layout.FirstMarkerLevel := TRVMarkerItemInfo(GetItem(MarkerItemNo)).Level;
end;
{$ENDIF}
end;
if (EndOffs<GetOffsAfterItem(EndItem)) or
((EndOffs>=GetOffsAfterItem(EndItem)) and not ((EndItem+1=ItemCount) or (IsParaStart(EndItem+1)))) then
Layout.LastParaAborted := 1;
{$IFNDEF RVDONOTUSELISTS}
RVFSavePrevMarkers(StartItem);
{$ENDIF}
end;
end;
if (rvfoSaveLayout in RVFOptions) and (Self=GetRootData) and (Layout<>nil) and
(SaveScope<>rvfss_Selection) then
RVFSaveLayout;
{$IFNDEF RVDONOTUSEINPLACE}
if (SaveScope=rvfss_Selection) and (GetChosenRVData<>nil) then begin
Result := GetChosenRVData.SaveRVFToStreamEx(Stream, SaveScope,
clNone, nil, nil);
Header.Item.Free;
exit;
end;
{$ENDIF}
RVFGetLimits(SaveScope,StartItem,EndItem,StartOffs,EndOffs,StartPart,EndPart);
if (StartItem=-1) or (StartItem>EndItem) then exit;
if (StartItem=EndItem) and
((StartOffs>GetOffsBeforeItem(StartItem)) or
(EndOffs <GetOffsAfterItem(EndItem))) then begin
// only part of text line is selected
WritePartialTextLine(StartItem, StartOffs, EndOffs, SaveScope=rvfss_Page);
exit;
end;
SectionBackOffs := 0;
if (StartPart<>nil) then begin
Header.ParaNo := GetItem(StartItem).ParaNo;
RVFWriteNonText(StartItem, StartPart);
inc(StartItem);
end;
MarkerItemNo := -1;
{$IFNDEF RVDONOTUSELISTS}
if (SaveScope=rvfss_Selection) and (StartPart=nil) then begin
MarkerItemNo := GetFirstParaItem(StartItem);
if (MarkerItemNo<>StartItem) and (GetItemStyle(MarkerItemNo)=rvsListMarker) then begin
RVFWriteNonText(MarkerItemNo, nil);
MarkerItemNo := GetFirstParaItem(StartItem);
end
else
MarkerItemNo := -1;
end;
{$ENDIF}
if (EndPart<>nil) then
dec(EndItem);
for i := StartItem to EndItem do begin
if (i=StartItem) then begin
if ((GetItemStyle(i)>=0) or ShouldSaveEndOfNonTextItemAsEmptyText()) and
((StartOffs>GetOffsBeforeItem(i)) or (SaveScope=rvfss_Page)) then begin
WritePartialTextLine(StartItem, StartOffs, GetOffsAfterItem(StartItem), SaveScope=rvfss_Page);
continue;
end;
if (StartOffs>GetOffsBeforeItem(i)) then
continue;
end;
if (i>StartItem) and IsTheSameStyleText then
inc(SectionBackOffs)
else begin
if SectionBackOffs>0 then
RVFWritePrevStrings(i);
RVFSetHeaderHeader(i);
if Header.StyleNo<0 then begin
if (i<EndItem) or (EndOffs=1) then
RVFWriteNonText(i, nil)
end
else
SectionBackOffs := 1;
end;
end;
if (Header.StyleNo<0) and ShouldSaveBeginningOfNonTextItemAsEmptyText() then
WritePartialTextLine(EndItem, GetOffsBeforeItem(EndItem), EndOffs, False)
else if (Header.StyleNo>=0) and (EndOffs<GetOffsAfterItem(EndItem)) then begin
dec(SectionBackOffs);
if SectionBackOffs>0 then
RVFWritePrevStrings(EndItem);
WritePartialTextLine(EndItem, GetOffsBeforeItem(EndItem), EndOffs, False);
end
else begin
if SectionBackOffs<>0 then
RVFWritePrevStrings(EndItem+1);
if (EndItem=Items.Count-1) and (EndOffs=1) then
RVFWriteCheckpoint(Stream, rvoTagsArePChars in Options, NotAddedCP);
end;
if (EndPart<>nil) then begin
RVFSetHeaderHeader(EndItem+1);
RVFWriteNonText(EndItem+1, EndPart);
end;
except;
Result := False;
end;
Header.Item.Free;
end;
{$ENDIF}{RVDONOTUSERVF}
{------------------------------------------------------------------------------}
function TCustomRVData.InsertFirstRVFItem(var Index: Integer;
var s: String; var item: TCustomRVItemInfo; EditFlag: Boolean;
var FullReformat: Boolean;
var NewListNo: Integer): Boolean;
begin
FullReformat := False;
NewListNo := -1;
item.Inserting(Self, s, False);
Items.InsertObject(Index, s, item);
item.Inserted(Self, Index);
{$IFNDEF RVDONOTUSELISTS}
AddMarkerInList(Index);
{$ENDIF}
Result := True;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.UpdateItemsPaletteInfo;
var i: Integer;
begin
if not ShareItems then
for i := 0 to Items.Count-1 do
TCustomRVItemInfo(Items.Objects[i]).
UpdatePaletteInfo(GetDoInPaletteMode, False, GetRVPalette, GetRVLogPalette);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.InsertCheckpoint(ItemNo, Tag: Integer;
const Name: String; RaiseEvent: Boolean);
var
cp: TRVCPInfo;
begin
if TCustomRVItemInfo(Items.Objects[ItemNo]).Checkpoint<>nil then
raise ERichViewError.Create(errRVCPExists);
cp := TRVCPInfo.Create;
cp.Tag := Tag;
cp.Name := Name;
cp.RaiseEvent := RaiseEvent;
cp.ItemInfo := TCustomRVItemInfo(Items.Objects[ItemNo]);
cp.Next := nil;
cp.Prev := nil;
TCustomRVItemInfo(Items.Objects[ItemNo]).Checkpoint := cp;
inc(CPCount);
UpdateCPPos(cp, ItemNo);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.UpdateCPPos(cp: TRVCPInfo; ItemNo: Integer);
var cpi: TRVCPInfo;
begin
if ItemNo=-1 then exit;
UpdateCPItemNo;
cp.Prev := nil;
cp.Next := nil;
if FirstCP = nil then begin
FirstCP := cp;
LastCP := cp;
end
else if FirstCP.ItemNo>cp.ItemNo then begin
cp.Next := FirstCP;
FirstCP.Prev := cp;
FirstCP := cp;
end
else if LastCP.ItemNo<=cp.ItemNo then begin
LastCP.Next := cp;
cp.Prev := LastCP;
LastCP := cp
end
else begin
cpi := FirstCP;
while cpi.Next<>nil do begin
if cpi.Next.ItemNo>cp.ItemNo then break;
cpi := cpi.Next;
end;
if cpi.Next<>nil then cpi.Next.Prev := cp;
cp.Next := cpi.Next;
cpi.Next := cp;
cp.Prev := cpi;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.ShareItemsFrom(Source: TCustomRVData);
begin
if ShareItems then begin
Clear;
FItems := Source.Items;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AssignItemsFrom(Source: TCustomRVData);
begin
FItems := Source.Items;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AppendFrom(Source: TCustomRVData);
var i: Integer;
item,itemcopy: TCustomRVItemInfo;
begin
if (rvoTagsArePChars in Options) <> (rvoTagsArePChars in Source.Options) then
raise ERichViewError.Create(errRVTagsTypesMismatch);
for i:=0 to Source.Items.Count-1 do begin
item := Source.GetItem(i);
itemcopy := RV_DuplicateItem(item, Self, True);
if itemcopy.GetBoolValue(rvbpValid) then begin
if itemcopy.SameAsPrev then
itemcopy.ParaNo := -1;
AddItem(Source.Items[i],itemcopy);
{$IFNDEF RVDONOTUSELISTS}
AddMarkerInList(ItemCount-1);
{$ENDIF}
end
else
InternalFreeItem(itemcopy,False);
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.UpdateCPItemNo;
var i,cnt: Integer;
begin
cnt := 0;
if cnt=CPCount then exit;
for i := 0 to Items.Count-1 do
if TCustomRVItemInfo(Items.Objects[i]).Checkpoint<>nil then begin
TCustomRVItemInfo(Items.Objects[i]).Checkpoint.ItemNo := i;
inc(cnt);
if cnt=CPCount then
exit;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.IsDelimiterA(ch: Char): Boolean;
var Del: String;
begin
Del := GetDelimiters;
Result := RV_CharPos(PChar(Del), ch, Length(Del))<>0;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.IsDelimiterW(ch: Word): Boolean;
begin
Result := (ch<256) and (Pos(Char(ch), GetDelimiters)<>0);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.IsDelimiter(const s: String; Index: Integer;
ItemOptions: TRVItemOptions): Boolean;
begin
{$IFNDEF RVDONOTUSEUNICODE}
if rvioUnicode in ItemOptions then
Result := IsDelimiterW(PWord(PChar(s)+(Index-1)*2)^)
else
{$ENDIF}
Result := IsDelimiterA(s[Index]);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemOptions(ItemNo: Integer): TRVItemOptions;
begin
Result := TCustomRVItemInfo(Items.Objects[ItemNo]).ItemOptions;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetStyleCodePage(StyleNo: Integer): TRVCodePage;
begin
{$IFDEF RICHVIEWCBDEF3}
if (GetRVStyle<>nil) then
if (StyleNo>=0) and (GetRVStyle.TextStyles[StyleNo].Charset<>DEFAULT_CHARSET) then
Result := RVU_Charset2CodePage(GetRVStyle.TextStyles[StyleNo].Charset)
else
Result := GetRVStyle.DefCodePage
else
{$ENDIF}
Result := CP_ACP;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetStyleLocale(StyleNo: Integer): Cardinal;
begin
{$IFDEF RICHVIEWCBDEF3}
if (GetRVStyle<>nil) and (StyleNo>=0) then
Result := RVMAKELCID(RVU_Charset2Language(GetRVStyle.TextStyles[StyleNo].Charset))
else
{$ENDIF}
Result := RVMAKELCID(LANG_NEUTRAL);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetDefaultCodePage: TRVCodePage;
begin
{$IFNDEF RVDONOTUSEUNICODE}
if (GetRVStyle<>nil) then
Result := GetRVStyle.DefCodePage
else
{$ENDIF}
Result := CP_ACP;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetDoInPaletteMode: TRVPaletteAction;
begin
Result := GetRootData.GetDoInPaletteMode;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetOptions: TRVOptions;
begin
Result := GetRootData.GetOptions;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetOptions(const Value: TRVOptions);
begin
GetRootData.SetOptions(Value);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetDocProperties: TStringList;
begin
Result := nil;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRVLogPalette: PLogPalette;
begin
Result := GetRootData.GetRVLogPalette;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRVPalette: HPALETTE;
begin
Result := GetRootData.GetRVPalette;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetDelimiters: String;
begin
Result := GetRootData.GetDelimiters;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRVFParaStylesReadMode: TRVFReaderStyleMode;
begin
Result := GetRootData.GetRVFParaStylesReadMode;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRVFTextStylesReadMode: TRVFReaderStyleMode;
begin
Result := GetRootData.GetRVFTextStylesReadMode;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.RVFPictureNeeded(const ItemName: String; ItemTag: Integer): TGraphic;
begin
Result := GetRootData.RVFPictureNeeded(ItemName, ItemTag);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SaveComponentToFile(const Path: String;
SaveMe: TComponent; SaveFormat: TRVSaveFormat): String;
begin
Result := GetAbsoluteRootData.SaveComponentToFile(Path, SaveMe, SaveFormat);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SaveItemToFile(const Path: String;
RVData: TCustomRVData; ItemNo: Integer; SaveFormat: TRVSaveFormat;
Unicode: Boolean; var Text: String): Boolean;
begin
Result := GetAbsoluteRootData.SaveItemToFile(Path, RVData, ItemNo, SaveFormat,
Unicode, Text);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.ImportPicture(const Location: String; Width,
Height: Integer; var Invalid: Boolean): TGraphic;
begin
Result := GetAbsoluteRootData.ImportPicture(Location, Width, Height, Invalid);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemHint(RVData: TCustomRVData; ItemNo: Integer;
const UpperRVDataHint: String): String;
begin
Result := GetAbsoluteParentData.GetItemHint(RVData, ItemNo, UpperRVDataHint);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.RVFControlNeeded(const ItemName: String; ItemTag: Integer): TControl;
begin
Result := GetRootData.RVFControlNeeded(ItemName, ItemTag);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.RVFImageListNeeded(ImageListTag: Integer): TCustomImageList;
begin
Result := GetRootData.RVFImageListNeeded(ImageListTag);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.HTMLSaveImage(RVData: TCustomRVData;
ItemNo: Integer; const Path: String; BackgroundColor: TColor;
var Location: String; var DoDefault: Boolean);
begin
GetAbsoluteRootData.HTMLSaveImage(RVData, ItemNo, Path, BackgroundColor,
Location, DoDefault);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SaveImage2(Graphic: TGraphic;
SaveFormat: TRVSaveFormat; const Path, ImagePrefix: String;
var ImageSaveNo: Integer; var Location: String; var DoDefault: Boolean);
begin
GetAbsoluteRootData.SaveImage2(Graphic, SaveFormat, Path, ImagePrefix,
ImageSaveNo, Location, DoDefault);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRVStyle: TRVStyle;
begin
Result := GetParentData.GetRVStyle;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetParentControl: TWinControl;
begin
Result := GetRootData.GetParentControl;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.ReadHyperlink(const Target, Extras: String;
DocFormat: TRVLoadFormat; var StyleNo, ItemTag: Integer;
var ItemName: String);
begin
GetRootData.ReadHyperlink(Target, Extras, DocFormat, StyleNo, ItemTag, ItemName);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.WriteHyperlink(id: Integer; RVData: TCustomRVData;
ItemNo: Integer; SaveFormat: TRVSaveFormat; var Target, Extras: String);
begin
GetAbsoluteRootData.WriteHyperlink(id, RVData, ItemNo, SaveFormat,
Target, Extras);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.ControlAction(ControlAction: TRVControlAction; ItemNo: Integer;
Item: TCustomRVItemInfo);
begin
if (item is TRVControlItemInfo) then
ControlAction2(ControlAction, ItemNo, TRVControlItemInfo(item).Control);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.ItemAction(ItemAction: TRVItemAction;
Item: TCustomRVItemInfo; var Text: String; RVData: TCustomRVData);
begin
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.Replace0(var s: String);
var p: Integer;
begin
while True do begin
p := Pos(#0,s);
if p=0 then break;
s[p] := RVDEFAULTCHARACTER;
end;
end;
{------------------------------- RTF ------------------------------------------}
procedure TCustomRVData.SetRTFOptions(const Value: TRVRTFOptions);
begin
GetRootData.SetRTFOptions(Value);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRTFOptions: TRVRTFOptions;
begin
Result := GetRootData.GetRTFOptions;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.MakeRTFTables(ColorList: TRVColorList;
ListOverrideCountList: TRVIntegerList; TopLevel: Boolean);
const ArrDefColorTable: array [0..16] of TColor =
(
clWindowText, clBlack, clBlue, clAqua,
clLime, clFuchsia, clRed, clYellow,
clWhite, clNavy, clTeal, clGreen,
clPurple, clMaroon, clOlive,
clGray, clSilver
);
var i{$IFNDEF RVDONOTUSELISTS},j{$ENDIF}: Integer;
RVStyle: TRVStyle;
begin
RVStyle := GetRVStyle;
if TopLevel then begin
ColorList.Clear;
ListOverrideCountList.Clear;
for i := Low(ArrDefColorTable) to High(ArrDefColorTable) do
ColorList.Add(ArrDefColorTable[i]);
for i := 0 to RVStyle.TextStyles.Count-1 do
with RVStyle.TextStyles[i] do begin
ColorList.AddUnique(Color);
ColorList.AddUnique(BackColor);
ColorList.AddUnique(HoverColor);
ColorList.AddUnique(HoverBackColor);
end;
for i := 0 to RVStyle.ParaStyles.Count-1 do
with RVStyle.ParaStyles[i] do begin
if (Border.Style<>rvbNone) then
ColorList.AddUnique(Border.Color);
ColorList.AddUnique(Background.Color);
end;
{$IFNDEF RVDONOTUSELISTS}
for i := 0 to RVStyle.ListStyles.Count-1 do begin
ListOverrideCountList.Add(1);
for j := 0 to RVStyle.ListStyles[i].Levels.Count-1 do
with RVStyle.ListStyles[i].Levels[j] do
if UsesFont then
ColorList.AddUnique(Font.Color);
end;
{$ENDIF}
end;
for i := 0 to Items.Count-1 do
with GetItem(i) do
if StyleNo<0 then
FillRTFTables(ColorList, ListOverrideCountList, Self);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSERTF}
function TCustomRVData.SaveRTF(const FileName: String; SelectionOnly: Boolean;
Color: TColor;
Background: TRVBackground):Boolean;
var Stream: TFileStream;
begin
try
Stream := TFileStream.Create(FileName,fmCreate);
try
Result := SaveRTFToStream(Stream, ExtractFilePath(FileName), SelectionOnly,
0, Color, Background, nil, nil, nil, nil, nil, 0.0);
finally
Stream.Free;
end;
except
Result := False;
end;
end;
{------------------------------------------------------------------------------}
procedure RVSaveFontToRTF(Stream: TStream; Font: TFont;
ColorList: TRVColorList; FontTable: TRVRTFFontTable;
RVStyle: TRVStyle);
var idx: Integer;
{$IFDEF RICHVIEWCBDEF3}
Language: Cardinal;
{$ENDIF}
begin
idx := FontTable.Find(Font.Name {$IFDEF RICHVIEWCBDEF3}, Font.Charset{$ENDIF});
if idx>=0 then
RVFWrite(Stream, Format('f%d', [idx]));
if fsBold in Font.Style then
RVFWrite(Stream, 'b');
if fsItalic in Font.Style then
RVFWrite(Stream, 'i');
if fsUnderline in Font.Style then
RVFWrite(Stream, 'ul');
if fsStrikeOut in Font.Style then
RVFWrite(Stream, 'strike');
RVFWrite(Stream, Format('fs%d', [Font.Size*2]));
{$IFDEF RICHVIEWCBDEF3}
if (Font.Charset<>DEFAULT_CHARSET) and (Font.Charset<>RVStyle.TextStyles[0].Charset) then begin
Language := RVU_Charset2Language(Font.Charset);
RVFWrite(Stream, Format('lang%d', [Language]));
end;
{$ENDIF}
if Font.Color<>clWindowText then
RVFWrite(Stream, Format('cf%d', [ColorList.IndexOf(Pointer(Font.Color))]));
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSELISTS}
procedure TCustomRVData.SaveRTFListTable97(Stream: TStream; ColorList: TRVColorList;
ListOverrideOffsetsList: TRVIntegerList;
FontTable: TRVRTFFontTable; tpp: Double);
var IDList, TemplateIDList: TRVIntegerList;
i,j, id, levelcount, idx: Integer;
s1,s2: String;
RVStyle: TRVStyle;
LevelInfo: TRVListLevel;
{...................................................}
function Getlevelnfc(LevelInfo: TRVListLevel): Integer;
begin
case LevelInfo.ListType of
rvlstBullet,
{$IFNDEF RVDONOTUSEUNICODE}
rvlstUnicodeBullet,
{$ENDIF}
rvlstPicture, rvlstImageList:
Result := 23;
rvlstDecimal,rvlstImageListCounter:
Result := 0;
rvlstLowerAlpha:
Result := 4;
rvlstUpperAlpha:
Result := 3;
rvlstLowerRoman:
Result := 2;
rvlstUpperRoman:
Result := 1;
else
Result := 255;
end;
end;
{...................................................}
function Getleveljc(LevelInfo: TRVListLevel): Integer;
begin
case LevelInfo.MarkerAlignment of
rvmaLeft:
Result := 0;
rvmaCenter:
Result := 1;
rvmaRight:
Result := 2;
else
Result := -1;
end;
end;
{...................................................}
procedure Getlevetext(LevelInfo: TRVListLevel; var LevelText, LevelNumbers: String);
var
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
Stream: TMemoryStream;
{$ENDIF}
{$ENDIF}
s: String;
i: Integer;
begin
case LevelInfo.ListType of
rvlstBullet:
begin
LevelText := RVMakeRTFStr(LevelInfo.FormatString, False, False);
LevelText := Format('''%.2x%s',[Length(LevelInfo.FormatString),LevelText]);
LevelNumbers := '';
end;
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
rvlstUnicodeBullet:
begin
SetLength(s, Length(LevelInfo.FormatStringW)*2);
if Length(s)>0 then
Move(Pointer(LevelInfo.FormatStringW)^, Pointer(s)^, Length(s));
Stream := TMemoryStream.Create;
RVWriteUnicodeRTFStr(Stream, s, RVStyle.DefCodePage, rvrtfDuplicateUnicode in RTFOptions, False);
SetLength(LevelText, Stream.Size);
Stream.Position := 0;
Stream.ReadBuffer(Pointer(LevelText)^, Stream.Size);
Stream.Free;
LevelText := Format('''%.2x%s',[Length(LevelInfo.FormatStringW),LevelText]);
LevelNumbers := '';
end;
{$ENDIF}
{$ENDIF}
rvlstDecimal,rvlstImageListCounter,
rvlstLowerAlpha,rvlstUpperAlpha,
rvlstLowerRoman,rvlstUpperRoman:
begin
LevelText := Format(LevelInfo.FormatString, ['''00','''01','''02','''03','''04','''05','''06','''07','''08']);
s := Format(LevelInfo.FormatString, [#0, #1, #2, #3, #4, #5, #6, #7, #8]);
LevelNumbers := '';
for i := 1 to Length(s) do
if s[i]<#9 then
LevelNumbers := Format('%s''%.2x',[LevelNumbers,i]);
LevelText := Format('''%.2x%s',[Length(s),LevelText]);
end;
else
begin
LevelText := '''00';
LevelNumbers := '';
end;
end;
end;
{...................................................}
procedure SaveListOverrideTable;
var i,j,k,prevcount,curcount,index: Integer;
Markers: TRVMarkerList;
Marker: TRVMarkerItemInfo;
begin
Markers := GetMarkers(False);
//if Markers=nil then
// exit;
RVFWriteLine(Stream, '{*listoverridetable');
index := 1;
for i := 0 to IDList.Count-1 do begin
RVFWriteLine(Stream,
Format('{listoverridelistid%dlistoverridecount0ls%d}', [IDList[i],index]));
inc(index);
if (Markers<>nil) and (ListOverrideOffsetsList[i]>1) then begin
for j := 0 to Markers.Count-1 do begin
Marker := Markers[j];
if (Marker.ListNo=i) and (Marker.Level>=0) and Marker.Reset then begin
RVFWrite(Stream,
Format('{listoverridelistid%dlistoverridecount%d',
[IDList[i],Marker.Level+1]));
for k := 0 to Marker.Level-1 do
RVFWrite(Stream, '{lfolevel}');
RVFWrite(Stream,
Format('{lfolevellistoverridestartatlevelstartat%d}', [Marker.StartFrom]));
RVFWriteLine(Stream, Format('ls%d}', [index]));
inc(index);
end;
end;
end;
end;
RVFWriteLine(Stream, '}');
// transforming a list of counts to a list of offsets
if RVStyle.ListStyles.Count>0 then begin
prevcount := ListOverrideOffsetsList[0];
ListOverrideOffsetsList[0] := 1; // starting from 1
for i := 1 to RVStyle.ListStyles.Count-1 do begin
curcount := ListOverrideOffsetsList[i];
ListOverrideOffsetsList[i] := ListOverrideOffsetsList[i-1]+prevcount;
prevcount := curcount;
end;
end;
end;
{...................................................}
//var listsarenotused: Boolean;
begin
RVStyle := GetRVStyle;
{
listsarenotused := True;
for i := 0 to ListOverrideOffsetsList.Count-1 do
if ListOverrideOffsetsList[i]>0 then begin
listsarenotused := False;
break;
end;
}
if (RVStyle.ListStyles.Count=0) {or listsarenotused} then begin
RVFWriteLine(Stream, '');
exit;
end;
IDList := TRVIntegerList.Create;
TemplateIDList := TRVIntegerList.Create;
try
// writing list table
RVFWrite(Stream, '{*listtable');
for i := 0 to RVStyle.ListStyles.Count-1 do begin
// if ListOverrideOffsetsList[i]>1 then begin
// writing list
repeat
id := Random(MaxInt);
until IDList.IndexOf(Pointer(id))<0;
TemplateIDList.Add(id);
RVFWrite(Stream, Format('{listlisttemplateid%d',[id]));
if RVStyle.ListStyles[i].Levels.Count=1 then
RVFWrite(Stream, 'listsimple1');
RVFWriteLine(Stream, '');
levelcount := RVStyle.ListStyles[i].Levels.Count;
if levelcount>1 then
levelcount := 9;
for j := 0 to levelcount-1 do begin
// writing list level
if j<RVStyle.ListStyles[i].Levels.Count then
idx := j
else
idx := RVStyle.ListStyles[i].Levels.Count-1;
LevelInfo := RVStyle.ListStyles[i].Levels[idx];
RVFWrite(Stream, Format('{listlevellevelnfc%dleveljc%dli%dfi%djclisttabtx%d',
[Getlevelnfc(LevelInfo), Getleveljc(LevelInfo),
Round(LevelInfo.LeftIndent*tpp),
Round((LevelInfo.MarkerIndent-LevelInfo.LeftIndent)*tpp),
Round((LevelInfo.FirstIndent+LevelInfo.LeftIndent)*tpp)]));
if Getlevelnfc(LevelInfo)<>23 then
RVFWrite(Stream, Format('levelstartat%d', [LevelInfo.StartFrom]));
if rvloLegalStyleNumbering in LevelInfo.Options then
RVFWrite(Stream, 'levellegal1');
if not (rvloLevelReset in LevelInfo.Options) then
RVFWrite(Stream, 'levelnorestart1');
Getlevetext(LevelInfo, s1, s2);
RVFWrite(Stream, Format('{leveltext%s;}{levelnumbers%s;}', [s1,s2]));
if LevelInfo.UsesFont then
RVSaveFontToRTF(Stream, LevelInfo.Font, ColorList, FontTable, RVStyle);
RVFWriteLine(Stream, '}');
end;
// writing list table (continued)
repeat
id := Random(MaxInt);
until TemplateIDList.IndexOf(Pointer(id))<0;
IDList.Add(id);
RVFWriteLine(Stream, Format('listid%d}',[id]));
{
end
else begin
IDList.Add(-1);
TemplateIDList.Add(-1);
end;
}
end;
RVFWriteLine(Stream, '}');
SaveListOverrideTable;
finally
IDList.Free;
TemplateIDList.Free;
end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TCustomRVData.ShouldSaveTextToRTF(StyleNo: Integer): Boolean;
begin
with GetRVStyle.TextStyles[StyleNo] do
Result := (rvteoRTFCode in Options) or not (rvteoHTMLCode in Options)
end;
{------------------------------------------------------------------------------}
function TCustomRVData.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;
var RVStyle: TRVStyle;
{$IFNDEF RVDONOTUSELISTS}
LastListLevel: TRVListLevel;
{$ENDIF}
LastParaNo, LastTextStyleNo, CurTextStyleNo: Integer;
function GetTwipsPerPixel: Double;
var DC: HDC;
begin
DC := CreateCompatibleDC(0);
if RichViewPixelsPerInch>0 then
Result := (72*20) / RichViewPixelsPerInch
else
Result := (72*20) / GetDeviceCaps(DC, LOGPIXELSY);
DeleteDC(DC);
end;
{.................................................}
procedure MakeFontTable(FontTable: TRVRTFFontTable;StyleToFont: TRVIntegerList);
var i {$IFNDEF RVDONOTUSELISTS},j{$ENDIF}: Integer;
Index: Integer;
begin
FontTable.Clear;
StyleToFont.Clear;
for i := 0 to RVStyle.TextStyles.Count-1 do begin
Index := FontTable.AddUnique(RVStyle.TextStyles[i].FontName
{$IFDEF RICHVIEWCBDEF3}
, RVStyle.TextStyles[i].Charset
{$ENDIF});
StyleToFont.Add(Index);
end;
{$IFNDEF RVDONOTUSELISTS}
for i := 0 to RVStyle.ListStyles.Count-1 do
for j := 0 to RVStyle.ListStyles[i].Levels.Count-1 do
if RVStyle.ListStyles[i].Levels[j].UsesFont then
with RVStyle.ListStyles[i].Levels[j].Font do
FontTable.AddUnique(Name {$IFDEF RICHVIEWCBDEF3}, Charset{$ENDIF});
{$ENDIF}
end;
{.................................................}
procedure SaveFontTable(FontTable: TRVRTFFontTable);
var i: Integer;
Charset: Integer;
begin
RVFWrite(Stream, '{fonttbl');
for i := 0 to FontTable.Count-1 do begin
{$IFDEF RICHVIEWCBDEF3}
Charset := FontTable[i].Charset;
{$ELSE}
Charset := 1;
{$ENDIF}
RVFWrite(Stream, Format('{f%dfnilfcharset%d %s;}',[i, Charset, FontTable[i].FontName]));
end;
RVFWrite(Stream, '}');
end;
{.................................................}
procedure SaveColorTable(List: TList);
var i: Integer;
Color: Integer;
begin
RVFWrite(Stream, '{colortbl;');
for i := 1 to List.Count-1 do begin
Color := ColorToRGB(Integer(List.Items[i]));
RVFWrite(Stream, Format('red%dgreen%dblue%d;',
[
Color and $0000FF,
(Color and $00FF00) shr 8,
(Color and $FF0000) shr 16
]));
end;
RVFWrite(Stream, '}');
end;
{.................................................}
procedure SaveTextStyle(StyleNo: Integer; StyleToFont, ColorTable: TList;
ToStyleSheet: Boolean);
var idx, fsscale: Integer;
{$IFDEF RICHVIEWCBDEF3}
ALanguage: Cardinal;
{$ENDIF}
begin
if not ToStyleSheet then
LastTextStyleNo := StyleNo;
if StyleNo>=RVStyle.TextStyles.Count then
StyleNo := 0;
with RVStyle.TextStyles[StyleNo] do begin
RVFWrite(Stream, Format('f%d', [Integer(StyleToFont.Items[StyleNo])]));
if fsBold in Style then
RVFWrite(Stream, 'b');
if fsItalic in Style then
RVFWrite(Stream, 'i');
if fsUnderline in Style then
RVFWrite(Stream, 'ul');
if fsStrikeOut in Style then
RVFWrite(Stream, 'strike');
// RTF-viewer will also shrink font size for s/s scripts...
fsscale := 1;
if VShift<>0 then
fsscale := 2;
if VShift<0 then
RVFWrite(Stream, 'sub');
if VShift>0 then
RVFWrite(Stream, 'super');
if CharScale<>100 then
RVFWrite(Stream, Format('charscalex%d',[CharScale]));
if CharSpacing<>0 then
RVFWrite(Stream, Format('expndtw%d',[Round(CharSpacing*tpp)]));
if rvfsAllCaps in StyleEx then
RVFWrite(Stream, 'caps');
case BiDiMode of
rvbdLeftToRight:
RVFWrite(Stream, 'ltrch');
rvbdRightToLeft:
RVFWrite(Stream, 'rtlch');
end;
{$IFDEF RICHVIEWCBDEF3}
if (Charset<>DEFAULT_CHARSET) and (Charset<>RVStyle.TextStyles[0].Charset) then begin
{$IFDEF RVLANGUAGEPROPERTY}
ALanguage := Language;
{$ELSE}
ALanguage := RVU_Charset2Language(Charset);
{$ENDIF}
if ALanguage<>0 then
RVFWrite(Stream, Format('lang%d', [ALanguage]));
end;
{$ENDIF}
RVFWrite(Stream, Format('fs%d', [Size*2*fsscale]));
if BackColor<>clNone then begin
idx := ColorTable.IndexOf(Pointer(BackColor));
//RVFWrite(Stream, Format('chshdng0chcfpat0chcbpat%d', [idx]));
RVFWrite(Stream, Format('chcbpat%d', [idx]));
end;
if Color<>clWindowText then begin
idx := ColorTable.IndexOf(Pointer(Color));
RVFWrite(Stream, Format('cf%d', [idx]));
end;
{$IFDEF RVTEXTFOOTNOTES}
if (rvfsFootnotes in StyleEx) and not ToStyleSheet then
RVFWrite(Stream, ' {chftn {footnote { chftn } { ' + FootNote + ' }}}');
{$ENDIF}
RVFWrite(Stream, GetExtraRTFCode(rv_rtfs_TextStyle, RVStyle.TextStyles[StyleNo], StyleNo, -1, ToStyleSheet));
RVFWrite(Stream, ' ');
end;
end;
{.................................................}
{$IFNDEF RVDONOTUSELISTS}
function IsListLevelNew(item: TCustomRVItemInfo): Boolean;
begin
if item.StyleNo<>rvsListMarker then begin
Result := True;
exit;
end;
Result := TRVMarkerItemInfo(item).GetLevelInfo(RVStyle)<>LastListLevel;
end;
{$ENDIF}
{.................................................}
{$IFNDEF RVDONOTUSETABS}
function GetTabAlignStr(Align: TRVTabAlign): String;
begin
case Align of
rvtaRight: Result := 'tqr';
rvtaCenter: Result := 'tqc';
else Result := '';
end;
end;
{.................................................}
function GetTabLeader(const LeaderStr: String): String;
begin
if LeaderStr='' then
Result := ''
else
case LeaderStr[1] of
'-': Result := 'tlhyph';
'_': Result := 'tlul';
#$B7: Result := 'tlmdot';
'=': Result := 'tleq';
else Result := 'tldot';
end;
end;
{.................................................}
procedure SaveTabs(ParaNo, MinAllowedPosition: Integer);
var i: Integer;
begin
with RVStyle.ParaStyles[ParaNo] do
for i := 0 to Tabs.Count-1 do
if Tabs[i].Position>MinAllowedPosition then begin
RVFWrite(Stream, GetTabAlignStr(Tabs[i].Align)+GetTabLeader(Tabs[i].Leader)+
'tx'+IntToStr(Round(Tabs[i].Position*tpp)));
end;
end;
{$ENDIF}
{.................................................}
procedure SaveParaStyle(ParaNo: Integer; ColorTable: TList; ToStyleSheet: Boolean;
item: TCustomRVItemInfo);
var s,s2,s3,s4: String;
bw: Integer;
{$IFNDEF RVDONOTUSETABS}
MinAllowedTabPos: Integer;
{$ENDIF}
begin
if not ToStyleSheet then
LastParaNo := ParaNo;
{$IFNDEF RVDONOTUSETABS}
MinAllowedTabPos := 0;
{$ENDIF}
with RVStyle.ParaStyles[ParaNo] do begin
case Alignment of
rvaLeft:
s := 'l';
rvaRight:
s := 'r';
rvaCenter:
s := 'c';
rvaJustify:
s := 'j';
end;
if (LineSpacingType=rvlsPercent) and (LineSpacing>100) then
RVFWrite(Stream, Format('sl%dslmult1', [LineSpacing*240 div 100]));
if rvpaoKeepLinesTogether in Options then
RVFWrite(Stream, 'keep');
if rvpaoKeepWithNext in Options then
RVFWrite(Stream, 'keepn');
{$IFNDEF RVDONOTUSELISTS}
LastListLevel := nil;
if (item<>nil) and (item.StyleNo = rvsListMarker) and
(TRVMarkerItemInfo(item).GetLevelInfo(RVStyle)<>nil) then begin
LastListLevel := TRVMarkerItemInfo(item).GetLevelInfo(RVStyle);
with LastListLevel do begin
{$IFNDEF RVDONOTUSETABS}
MinAllowedTabPos := FirstIndent+LeftIndent;
{$ENDIF}
RVFWrite(Stream, Format('li%dfi%djclisttabtx%d',
[Round(LeftIndent*tpp),
Round((MarkerIndent-LeftIndent)*tpp),
Round((FirstIndent+LeftIndent)*tpp)]))
end;
end
else
{$ENDIF}
RVFWrite(Stream, Format('fi%dli%d', [Round(FirstIndent*tpp), Round(LeftIndent*tpp)]));
{$IFNDEF RVDONOTUSETABS}
SaveTabs(ParaNo, MinAllowedTabPos);
{$ENDIF}
RVFWrite(Stream, Format('q%sri%dsb%dsa%d',
[s, Round(RightIndent*tpp),
Round(SpaceBefore*tpp), Round(SpaceAfter*tpp)]));
case BiDiMode of
rvbdLeftToRight:
RVFWrite(Stream, 'ltrpar');
rvbdRightToLeft:
RVFWrite(Stream, 'rtlpar');
end;
if Background.Color<>clNone then
RVFWrite(Stream, Format('cbpat%d', [ColorTable.IndexOf(Pointer(Background.Color))]));
if (Border.Style<>rvbNone) and (Border.Color<>clNone) then begin
RVFWrite(Stream, 'brdrbtw'); // <- does not work, unfortunately
s2 := 'brdr';
bw := Border.Width;
case Border.Style of
rvbSingle:
s2 := s2+'s';
rvbDouble:
s2 := s2+'db';
rvbTriple:
s2 := s2+'triple';
rvbThickInside:
begin
s2 := s2+'thtnmg';
bw := bw*2;
end;
rvbThickOutside:
begin
s2 := s2+'tnthmg';
bw := bw*2;
end;
end;
case Border.Style of
rvbThickInside:
s3 := 'brdrtnthmg';
rvbThickOutside:
s3 := 'brdrthtnmg';
else
s3 := s2;
end;
s4 := Format('brdrcf%dbrdrw%d',
[ColorTable.IndexOf(Pointer(Border.Color)),
Round(bw*tpp)
]);
s2 := s2 + s4;
s3 := s3 + s4;
s := '';
with Border.VisibleBorders do begin
if Left then s := s+Format('brdrlbrsp%d',[Round(Border.BorderOffsets.Left*tpp)])+s2;
if Top then s := s+Format('brdrtbrsp%d',[Round(Border.BorderOffsets.Top*tpp)])+s2;
if Right then s := s+Format('brdrrbrsp%d',[Round(Border.BorderOffsets.Right*tpp)])+s3;
if Bottom then s := s+Format('brdrbbrsp%d',[Round(Border.BorderOffsets.Bottom*tpp)])+s3;
end;
RVFWrite(Stream, s);
end;
if not ToStyleSheet then
RVFWrite(Stream, Format('itap%d',[Level]));
if Level=1 then
RVFWrite(Stream, 'intbl');
RVFWrite(Stream, GetExtraRTFCode(rv_rtfs_ParaStyle, RVStyle.ParaStyles[ParaNo], ParaNo, -1, ToStyleSheet));
RVFWrite(Stream, ' ');
end;
end;
{.................................................}
procedure SaveStyleSheet(StyleToFont, ColorTable: TList);
var i: Integer;
begin
RVFWrite(Stream, '{stylesheet');
for i := 0 to RVStyle.ParaStyles.Count-1 do begin
if RVStyle.ParaStyles[i].Standard then begin
RVFWrite(Stream, '{');
RVFWrite(Stream, Format('s%d',[i]));
SaveParaStyle(i, ColorTable,True,nil);
RVFWrite(Stream, MakeRTFIdentifierStr(RVStyle.ParaStyles[i].StyleName));
RVFWrite(Stream, ';}');
end;
end;
for i := 0 to RVStyle.TextStyles.Count-1 do begin
if RVStyle.TextStyles[i].Standard then begin
RVFWrite(Stream, Format('{*cs%d',[i+RVStyle.ParaStyles.Count]));
SaveTextStyle(i, StyleToFont, ColorTable,True);
RVFWrite(Stream, MakeRTFIdentifierStr(RVStyle.TextStyles[i].StyleName)+';}');
end;
end;
RVFWrite(Stream, '}');
end;
{.................................................}
procedure SaveHeader(ColorList: TRVColorList; StyleToFont: TRVIntegerList;
FontTable: TRVRTFFontTable);
var CodePage: TRVCodePage;
Language: Cardinal;
begin
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
CodePage := GetRVStyle.DefCodePage;
{$IFDEF RVLANGUAGEPROPERTY}
Language := GetRVStyle.TextStyles[0].Language;
if Language=0 then
Language := $0400;
{$ELSE}
Language := RVU_Charset2Language(GetRVStyle.TextStyles[0].CharSet);
{$ENDIF}
{$ELSE}
CodePage := 1252;
Language := $0400;
{$ENDIF}
{$ELSE}
CodePage := 1252;
Language := $0400;
{$ENDIF}
RVFWrite(Stream, Format('{rtf1ansiansicpg%duc1deff0deflang%ddeflangfe%d',
[CodePage, Language, Language]));
case GetBiDiMode of
rvbdLeftToRight:
RVFWrite(Stream, 'ltrdoc');
rvbdRightToLeft:
RVFWrite(Stream, 'rtldoc');
end;
SaveFontTable(FontTable);
SaveColorTable(ColorList);
if rvrtfSaveStyleSheet in RTFOptions then
SaveStyleSheet(StyleToFont, ColorList);
{$IFNDEF RVDONOTUSELISTS}
SaveRTFListTable97(Stream, ColorList, ListOverrideOffsetsList1, FontTable,tpp);
ListOverrideOffsetsList2.Assign(ListOverrideOffsetsList1);
{$ELSE}
RVFWriteLine(Stream, '');
{$ENDIF}
RVFWriteLine(Stream, GetExtraRTFCode(rv_rtfs_Doc, nil, -1, -1, False));
end;
{.................................................}
var i, CPIndex: Integer;
item: TCustomRVItemInfo;
s: String;
StartItem,EndItem,StartOffs,EndOffs
{$IFNDEF RVDONOTUSELISTS}
,MarkerItemNo
{$ENDIF}
: Integer;
UrlTarget, UrlExtras: String;
NotUsedPart: TRVMultiDrawItemPart;
begin
{$IFNDEF RVDONOTUSEINPLACE}
if SelectionOnly and (GetChosenRVData<>nil) then begin
Result := GetChosenRVData.SaveRTFToStream(Stream, Path, SelectionOnly, Level,
Color, Background, ColorList, StyleToFont,
ListOverrideOffsetsList1, ListOverrideOffsetsList2,
FontTable, tpp);
exit;
end;
{$ENDIF}
Result := True;
RVFGetLimits(GetRVFSaveScope(SelectionOnly),StartItem,EndItem,StartOffs,EndOffs,NotUsedPart,NotUsedPart);
if (StartItem=-1) or (StartItem>EndItem) then
exit;
LastParaNo := -1;
LastTextStyleNo := -1;
{$IFNDEF RVDONOTUSELISTS}
LastListLevel := nil;
{$ENDIF}
if Level=0 then begin
ColorList := TRVColorList.Create;
StyleToFont := TRVIntegerList.Create;
FontTable := TRVRTFFontTable.Create;
ListOverrideOffsetsList1 := TRVIntegerList.Create;
ListOverrideOffsetsList2 := TRVIntegerList.Create;
end;
RVStyle := GetRVStyle;
CPIndex := 0;
try
Include(State, rvstRTFSkipPar);
if Level=0 then begin
tpp := GetTwipsPerPixel;
MakeFontTable(FontTable, StyleToFont);
MakeRTFTables(ColorList, ListOverrideOffsetsList1, True);
if (Color<>clWindow) then
ColorList.AddUnique(Color);
SaveHeader(ColorList, StyleToFont, FontTable);
if rvrtfDuplicateUnicode in RTFOptions then
RVFWrite(Stream,'uc1')
else
RVFWrite(Stream,'uc0');
{$IFNDEF RVDONOTUSELISTS}
if SelectionOnly then begin
MarkerItemNo := GetFirstParaItem(StartItem);
if (MarkerItemNo<>StartItem) and (GetItemStyle(MarkerItemNo)=rvsListMarker) then begin
GetItem(MarkerItemNo).SaveRTF(Stream, Path, Self, MarkerItemNo,
Items[MarkerItemNo], tpp, Level, ColorList, StyleToFont,
ListOverrideOffsetsList1, ListOverrideOffsetsList2, FontTable);
Exclude(State, rvstRTFSkipPar);
end;
end;
{$ENDIF}
end;
for i := StartItem to EndItem do begin
if not ((StartItem=EndItem) and (GetItemStyle(StartItem)>=0)) then begin
if (i=StartItem) and (StartOffs>=GetOffsAfterItem(i)) and (Items[i]<>'') then
continue
else if (i=EndItem) and (EndOffs<=GetOffsBeforeItem(i)) and (Items[i]<>'') then
continue;
end;
item := GetItem(i);
if not item.SameAsPrev then begin
RVFWriteLine(Stream,'');
if item.GetBoolValue(rvbpFullWidth) and PageBreaksBeforeItems[i] then
RVFWrite(Stream,'page ');
if item.BR then
RVFWrite(Stream,'line ')
else begin
if not (rvstRTFSkipPar in State) then begin
{$IFNDEF RVDONOTUSELISTS}
if (i>0) and (GetItemStyle(GetFirstParaItem(i-1))=rvsListMarker) then begin
RVFWrite(Stream, 'plain');
LastTextStyleNo := -1;
end;
{$ENDIF}
RVFWrite(Stream, 'par ');
end;
if not item.GetBoolValue(rvbpFullWidth) and PageBreaksBeforeItems[i] then
RVFWrite(Stream,'page ');
if (item.ParaNo<>LastParaNo)
{$IFNDEF RVDONOTUSELISTS}or IsListLevelNew(item){$ENDIF} then begin
RVFWrite(Stream, 'pard');
if (rvrtfSaveStyleSheet in RTFOptions) and
RVStyle.ParaStyles[item.ParaNo].Standard then
RVFWrite(Stream, Format('s%d', [item.ParaNo]));
SaveParaStyle(item.ParaNo, ColorList,False,item);
end;
end;
end;
Exclude(State, rvstRTFSkipPar);
if item.Checkpoint<>nil then begin
// I decided to use names of checkpoints here (if assigned).
// If several checkpoints have the same name, only one of them
// will be used as a bookmark in MS Word.
s := MakeRTFBookmarkNameStr(item.Checkpoint.Name);
if s='' then
s := 'RichViewCheckpoint'+IntToStr(CPIndex);
RVFWrite(Stream, Format('{*bkmkstart %s}{*bkmkend %s}',[s,s]));
inc(CPIndex);
end;
if item.GetBoolValueEx(rvbpJump,RVStyle) then begin
WriteHyperlink(item.JumpID+FirstJumpNo, Self, i, rvsfRTF,
UrlTarget, UrlExtras);
UrlTarget := RVMakeRTFFileNameStr(UrlTarget);
UrlExtras := RVMakeRTFStr(UrlExtras,False, False);
if (UrlTarget<>'') or (UrlExtras<>'') then begin
if UrlExtras<>'' then
UrlExtras := ' '+UrlExtras;
RVFWrite(Stream,
Format('{field{*fldinst HYPERLINK "%s"%s}{fldrslt ',[UrlTarget, UrlExtras]));
LastTextStyleNo := -1;
end;
end
else begin
UrlTarget := '';
UrlExtras := '';
end;
if ((item.StyleNo>=0) or (item.AssociatedTextStyleNo>=0)) and
ShouldSaveTextToRTF(GetActualStyle(item)) then begin
if item.StyleNo>=0 then begin
if (i=StartItem) then
if (i=EndItem) then
s := RVU_Copy(Items[i], StartOffs, EndOffs-StartOffs, item.ItemOptions)
else
s := RVU_Copy(Items[i], StartOffs,
RVU_Length(Items[i],item.ItemOptions)-StartOffs+1, item.ItemOptions)
else
if i=EndItem then
s := RVU_Copy(Items[i], 1, EndOffs-1, item.ItemOptions)
else
s := Items[i];
CurTextStyleNo := GetActualStyle(item);
end
else begin
s := '';
CurTextStyleNo := item.AssociatedTextStyleNo;
end;
if LastTextStyleNo<>CurTextStyleNo then begin
RVFWrite(Stream, 'plain ');
if (rvrtfSaveStyleSheet in RTFOptions) and
RVStyle.TextStyles[CurTextStyleNo].Standard then
RVFWrite(Stream,Format('cs%d', [CurTextStyleNo+RVStyle.ParaStyles.Count]));
SaveTextStyle(CurTextStyleNo, StyleToFont, ColorList, False);
end;
if SaveItemToFile(Path, Self, i, rvsfRTF, False, s) then
RVFWrite(Stream, s)
else begin
if item.StyleNo>=0 then begin
{$IFNDEF RVDONOTUSEUNICODE}
if rvioUnicode in item.ItemOptions then
RVWriteUnicodeRTFStr(Stream, s, GetStyleCodePage(GetActualStyle(item)),
rvrtfDuplicateUnicode in RTFOptions,
rvteoRTFCode in RVStyle.TextStyles[GetActualStyle(item)].Options)
else
{$ENDIF}
RVFWrite(Stream, RVMakeRTFStr(s,rvteoRTFCode in
RVStyle.TextStyles[GetActualStyle(item)].Options, True));
end
else
item.SaveRTF(Stream, Path, Self, i, Items[i], tpp, Level, ColorList,
StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2,
FontTable);
end;
end
else begin
s := '';
if SaveItemToFile(Path, Self, i, rvsfRTF, False, s) then
RVFWrite(Stream, s)
else
item.SaveRTF(Stream, Path, Self, i, Items[i], tpp, Level, ColorList,
StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2,
FontTable);
LastTextStyleNo := -1;
end;
if (UrlTarget<>'') or (UrlExtras<>'') then begin
RVFWrite(Stream, '}}');
LastTextStyleNo := -1;
end;
end;
if NotAddedCP<>nil then begin
// I decided to use names of checkpoints here (if assigned).
// If several checkpoints have the same name, only one of them
// will be used as a bookmark in MS Word.
s := MakeRTFBookmarkNameStr(NotAddedCP.Name);
if s='' then
s := 'RichViewCheckpoint'+IntToStr(CPIndex);
RVFWrite(Stream, Format('{*bkmkstart %s}{*bkmkend %s}',[s,s]));
end;
if (Level=0) and (StartItem<>EndItem) and IsParaStart(EndItem) and (GetItemStyle(EndItem)>=0) and (Items[EndItem]='') then
RVFWrite(Stream, 'par');
if Level=0 then
RVFWrite(Stream, '}');
except
Result := False;
end;
if Level=0 then begin
ColorList.Free;
StyleToFont.Free;
FontTable.Free;
ListOverrideOffsetsList1.Free;
ListOverrideOffsetsList2.Free;
end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TCustomRVData.GetParentData: TCustomRVData;
begin
Result := nil;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRootData: TCustomRVData;
begin
Result := Self;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetAbsoluteParentData: TCustomRVData;
begin
Result := nil;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetAbsoluteRootData: TCustomRVData;
begin
Result := Self;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DrainFrom(Victim: TCustomRVData);
var i: Integer;
item: TCustomRVItemInfo;
begin
if Victim=nil then exit;
if (rvoTagsArePChars in Options) <> (rvoTagsArePChars in Victim.Options) then
raise ERichViewError.Create(errRVTagsTypesMismatch);
for i := 0 to Victim.Items.Count-1 do begin
item := Victim.GetItem(i);
if item.SameAsPrev then
item.ParaNo := -1;
AddItem(Victim.Items[i], item);
end;
if NotAddedCP<>nil then
NotAddedCP := Victim.NotAddedCP;
Victim.Items.Clear;
Victim.FirstCP := nil;
Victim.LastCP := nil;
Victim.NotAddedCP := nil;
Victim.CPCount := 0;
Victim.Clear;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemNo(Item: TCustomRVItemInfo): Integer;
begin
Result := Items.IndexOfObject(Item);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.Inserting(RVData: TCustomRVData; Safe: Boolean);
var i: Integer;
s: String;
begin
for i := 0 to Items.Count-1 do begin
s := Items[i];
GetItem(i).Inserting(RVData, s, Safe);
Items[i] := s;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.Beep;
begin
if (GetRVStyle<>nil) and (GetRVStyle.UseSound) then
MessageBeep(MB_OK);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetParagraphStyleToAll(ParaNo: Integer);
var i: Integer;
begin
for i := 0 to Items.Count-1 do
if GetItemStyle(i)<>rvsBreak then
GetItem(i).ParaNo := ParaNo;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRVData: TCustomRVData;
begin
Result := Self;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetSourceRVData: TCustomRVData;
begin
Result := Self;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItem(ItemNo: Integer): TCustomRVItemInfo;
begin
Result := TCustomRVItemInfo(Items.Objects[ItemNo]);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetRTFProperties: TPersistent;
begin
Result := GetRootData.GetRTFProperties;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.RV_CanConcateItems(FirstItemNo: Integer;
item1, item2: TCustomRVItemInfo;
IgnorePara: Boolean): Boolean;
var RVStyle: TRVStyle;
begin
RVStyle := GetRVStyle;
if (item1=nil) or (item2=nil) or (item1.StyleNo<0) or (item2.StyleNo<0) then begin
Result := False;
exit;
end;
if ((Items[FirstItemNo]='') or (Items[FirstItemNo+1]='')) and
(IgnorePara or item2.SameAsPrev) then begin
Result := True;
exit;
end;
Result := (item1.StyleNo=item2.StyleNo) and
(IgnorePara or item2.SameAsPrev) and
{$IFNDEF RVDONOTUSEUNICODE}
(RVStyle.TextStyles[GetActualStyle(item1)].Unicode=
RVStyle.TextStyles[GetActualStyle(item2)].Unicode) and
{$ENDIF}
{$IFNDEF RVDONOTUSEITEMHINTS}
(item1.Hint=item2.Hint) and
{$ENDIF}
RV_CompareTags(item1.Tag,item2.Tag, rvoTagsArePChars in Options) and
(item2.Checkpoint=nil) and
(
(Length(Items[FirstItemNo])=0) or
(Length(Items[FirstItemNo+1])=0) or
([rvprConcateProtect,rvprModifyProtect]*
RVStyle.TextStyles[GetActualStyle(item1)].Protection=[])
)
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SimpleConcate(FirstItemNo: Integer; item1,
item2: TCustomRVItemInfo);
begin
Items[FirstItemNo] := Items[FirstItemNo]+Items[FirstItemNo+1];
InternalFreeItem(item2,False);
Items.Delete(FirstItemNo+1);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.MassSimpleConcate(FirstItemNo,
LastItemNo: Integer);
var i: Integer;
item1,
item2: TCustomRVItemInfo;
begin
if FirstItemNo<0 then
FirstItemNo := 0;
if LastItemNo>=Items.Count then
LastItemNo := Items.Count-1;
for i := LastItemNo downto FirstItemNo+1 do begin
SimpleConcateSubitems(i);
item1 := TCustomRVItemInfo(Items.Objects[i-1]);
item2 := TCustomRVItemInfo(Items.Objects[i]);
if RV_CanConcateItems(i-1, item1, item2, False) then
SimpleConcate(i-1, item1, item2);
end;
if (FirstItemNo>=0) and (FirstItemNo<=LastItemNo) then
SimpleConcateSubitems(FirstItemNo);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SimpleConcateSubitems(ItemNo: Integer);
var StoreSub: TRVStoreSubRVData;
SubRVData: TCustomRVData;
item: TCustomRVItemInfo;
i: Integer;
begin
item := GetItem(ItemNo);
SubRVData := TCustomRVData(item.GetSubRVData(StoreSub,rvdFirst));
while SubRVData<>nil do begin
SubRVData.MassSimpleConcate(0, SubRVData.ItemCount-1);
for i := 0 to SubRVData.ItemCount-1 do
SubRVData.SimpleConcateSubitems(i);
SubRVData := TCustomRVData(item.GetSubRVData(StoreSub, rvdNext));
end;
StoreSub.Free;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSERTFIMPORT}
function TCustomRVData.LoadRTF(const FileName: String): TRVRTFErrorCode;
var rp: TRVRTFReaderProperties;
ItemNo: Integer;
begin
rp := TRVRTFReaderProperties(GetRTFProperties);
if rp<>nil then begin
ItemNo := Items.Count-1;
rp.BasePath := ExtractFilePath(FileName);
try
Result := rp.ReadFromFile(FileName, Self);
finally
rp.BasePath := '';
end;
MassSimpleConcate(ItemNo, Items.Count-1);
end
else
Result := rtf_ec_Assertion;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.LoadRTFFromStream(Stream: TStream): TRVRTFErrorCode;
var rp: TRVRTFReaderProperties;
ItemNo: Integer;
begin
rp := TRVRTFReaderProperties(GetRTFProperties);
if rp<>nil then begin
ItemNo := Items.Count-1;
Result := rp.ReadFromStream(Stream, Self);
MassSimpleConcate(ItemNo, Items.Count-1);
end
else
Result := rtf_ec_Assertion;
end;
{------------------------------------------------------------------------------}
{$IFDEF RVUSEWORDDOC}
function TCustomRVData.LoadWordDoc(const FileName: String):TRVRTFErrorCode;
var rp: TRVRTFReaderProperties;
ItemNo: Integer;
begin
rp := TRVRTFReaderProperties(GetRTFProperties);
if rp<>nil then begin
ItemNo := Items.Count-1;
Result := rp.ReadFromWordDocFile(FileName, Self);
MassSimpleConcate(ItemNo, Items.Count-1);
end
else
Result := rtf_ec_Assertion;
end;
{$ENDIF}
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TCustomRVData.DoMarkStylesInUse(Data: TRVDeleteUnusedStylesData);
var i: Integer;
begin
for i := 0 to Items.Count-1 do
GetItem(i).MarkStylesInUse(Data);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DoUpdateStyles(Data: TRVDeleteUnusedStylesData);
var i: Integer;
begin
for i := 0 to Items.Count-1 do
GetItem(i).UpdateStyles(Data);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.MarkStylesInUse(Data: TRVDeleteUnusedStylesData);
{............................................}
procedure ExpandStyle(Index, FirstIndex: Integer; Styles: TCustomRVInfos;
Used, Expanded: TRVIntegerList);
var Style: TCustomRVInfo;
begin
if Expanded[Index]<>0 then
exit;
Used[Index] := 1;
Expanded[Index] := 1;
Style := TCustomRVInfo(Styles.Items[Index]);
if Style.BaseStyleNo>=0 then begin
if Style.BaseStyleNo >= Styles.Count then
Style.BaseStyleNo := -1
else
ExpandStyle(Style.BaseStyleNo, FirstIndex, Styles, Used, Expanded);
end;
if (Styles is TFontInfos) and (TFontInfo(Style).NextStyleNo>=0) then begin
if TFontInfo(Style).NextStyleNo>= Styles.Count then
TFontInfo(Style).NextStyleNo := -1
else
ExpandStyle(TFontInfo(Style).NextStyleNo, FirstIndex, Styles, Used, Expanded)
end
else if (Styles is TParaInfos) and (TParaInfo(Style).NextParaNo>=0) then begin
if TParaInfo(Style).NextParaNo >= Styles.Count then
TParaInfo(Style).NextParaNo := -1
else
ExpandStyle(TParaInfo(Style).NextParaNo, FirstIndex, Styles, Used, Expanded);
end;
end;
{............................................}
procedure ExpandStyles(Styles: TCustomRVInfos; Used: TRVIntegerList);
var i: Integer;
Expanded: TRVIntegerList;
begin
Expanded := TRVIntegerList.CreateEx(Used.Count, 0);
for i := 0 to Used.Count-1 do
if (Used[i]<>0) then
ExpandStyle(i, i, Styles, Used, Expanded);
Expanded.Free;
end;
{............................................}
procedure MarkDefStyles;
var i: Integer;
RVStyle: TRVStyle;
begin
RVStyle := GetRVStyle;
for i := 0 to RVStyle.ParaStyles.Count-1 do
if (Data.UsedParaStyles[i]<>0) and
(RVStyle.ParaStyles[i].DefStyleNo>=0) then
Data.UsedTextStyles[RVStyle.ParaStyles[i].DefStyleNo] := 1;
end;
{............................................}
begin
Data.Init(GetRVStyle);
DoMarkStylesInUse(Data);
if Data.ParaStyles then
ExpandStyles(GetRVStyle.ParaStyles, Data.UsedParaStyles);
if Data.TextStyles then begin
MarkDefStyles;
{$IFNDEF RVDONOTUSEUNICODE}
if (GetRVStyle.DefUnicodeStyle>=0) then
if GetRVStyle.DefUnicodeStyle>=Data.UsedTextStyles.Count then
GetRVStyle.DefUnicodeStyle := -1
else
Data.UsedTextStyles[GetRVStyle.DefUnicodeStyle] := 1;
{$ENDIF}
ExpandStyles(GetRVStyle.TextStyles, Data.UsedTextStyles);
end;
if Data.ListStyles then
ExpandStyles(GetRVStyle.ListStyles, Data.UsedListStyles);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DeleteMarkedStyles(Data: TRVDeleteUnusedStylesData);
begin
Data.ConvertFlagsToShifts(Self.GetRVStyle);
DoUpdateStyles(Data);
AfterDeleteStyles(Data);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DeleteUnusedStyles(TextStyles, ParaStyles, ListStyles: Boolean);
var Data: TRVDeleteUnusedStylesData;
begin
Data := TRVDeleteUnusedStylesData.Create(TextStyles, ParaStyles, ListStyles);
try
MarkStylesInUse(Data);
DeleteMarkedStyles(Data);
{$IFNDEF RVDONOTUSEUNICODE}
if TextStyles and (GetRVStyle.DefUnicodeStyle>=0) then
if GetRVStyle.DefUnicodeStyle>=Data.UsedTextStyles.Count then
GetRVStyle.DefUnicodeStyle := -1
else
GetRVStyle.DefUnicodeStyle :=
GetRVStyle.DefUnicodeStyle-Data.UsedTextStyles[GetRVStyle.DefUnicodeStyle]+1;
{$ENDIF}
finally
Data.Free;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AfterDeleteStyles(Data: TRVDeleteUnusedStylesData);
begin
// nothing to do here
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.InitStyleMappings(var PTextStylesMapping,
PParaStylesMapping, PListStylesMapping: PRVIntegerList);
begin
GetRootData.InitStyleMappings(PTextStylesMapping, PParaStylesMapping, PListStylesMapping);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DoneStyleMappings(PTextStylesMapping,
PParaStylesMapping, PListStylesMapping: PRVIntegerList);
begin
// nothing to do here
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SupportsPageBreaks: Boolean;
begin
Result := True;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AdjustInItemsRange(var ItemNo: Integer);
begin
if ItemNo>=Items.Count then
ItemNo := Items.Count-1;
if ItemNo<0 then
ItemNo := 0;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.NextChar(ItemNo, Index: Integer): Integer;
begin
Result := NextCharStr(Items[ItemNo], ItemNo, Index);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.PrevChar(ItemNo, Index: Integer): Integer;
begin
Result := PrevCharStr(Items[ItemNo], ItemNo, Index);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.NextCharStr(const str: String;
ItemNo, Index: Integer): Integer;
{$IFNDEF RVDONOTUSEUNICODE}
var s: String;
p1,p2: Pointer;
{$ENDIF}
begin
{$IFNDEF RVDONOTUSEUNICODE}
if RVNT and (rvioUnicode in GetItemOptions(ItemNo)) then begin
s := str;
SetLength(s, Length(s)+1);
s[Length(s)]:=#0;
p1 := Pointer(s);
p2 := CharNextW(Pointer(PChar(p1)+(Index-1)*2));
Result := (PChar(p2)-PChar(p1)) div 2+1;
end
else
{$ENDIF}
Result := Index+1;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.PrevCharStr(const str: String;
ItemNo, Index: Integer): Integer;
{$IFNDEF RVDONOTUSEUNICODE}
var s: String;
p1,p2: Pointer;
{$ENDIF}
begin
{$IFNDEF RVDONOTUSEUNICODE}
if RVNT and (rvioUnicode in GetItemOptions(ItemNo)) then begin
s := str;
SetLength(s, Length(s)+1);
s[Length(s)]:=#0;
p1 := Pointer(s);
p2 := CharPrevW(p1, Pointer(PChar(p1)+(Index-1)*2));
if p2=PChar(p1)+(Index-1)*2 then
p2 := p1;
Result := (PChar(p2)-PChar(p1)) div 2+1;
end
else
{$ENDIF}
Result := Index-1;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetFirstParaItem(ItemNo: Integer): Integer;
begin
Result := ItemNo;
while (Result>0) and not IsParaStart(Result) do
dec(Result);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetFirstParaSectionItem(ItemNo: Integer): Integer;
begin
Result := ItemNo;
while (Result>0) and not IsFromNewLine(Result) do
dec(Result);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.GetParentInfo(var ParentItemNo: Integer;
var Location: TRVStoreSubRVData);
begin
ParentItemNo := -1;
Location := nil;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetBiDiMode: TRVBiDiMode;
begin
Result := GetRootData.GetBiDiMode;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemBiDiMode(ItemNo: Integer): TRVBiDiMode;
var item: TCustomRVItemInfo;
begin
item := GetItem(ItemNo);
if item.StyleNo>=0 then
Result := GetRVStyle.TextStyles[GetActualStyle(item)].BiDiMode
else
Result := rvbdUnspecified;
if Result=rvbdUnspecified then
Result := GetParaBiDiMode(item.ParaNo);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetParaBiDiMode(
ParaNo: Integer): TRVBiDiMode;
begin
Result := GetRVStyle.ParaStyles[ParaNo].BiDiMode;
if Result=rvbdUnspecified then
Result := GetBiDiMode;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSELISTS}
function TCustomRVData.SetListMarkerInfo(AItemNo, AListNo, AListLevel, AStartFrom, AParaNo: Integer;
AUseStartFrom: Boolean): Integer;
var Marker: TRVMarkerItemInfo;
s: String;
Markers: TRVMarkerList;
begin
if (AItemNo>=Items.Count) or (AItemNo<0) then
Result := Items.Count
else begin
Result := GetFirstParaItem(AItemNo);
if GetItem(Result).GetBoolValue(rvbpFullWidth) then begin
Result := -1;
exit;
end;
end;
if (Result<Items.Count) and (GetItemStyle(Result)=rvsListMarker) then begin
Marker := TRVMarkerItemInfo(GetItem(Result));
Marker.ListNo := AListNo;
Marker.Level := AListLevel;
Marker.StartFrom := AStartFrom;
Marker.Reset := AUseStartFrom;
Markers := GetMarkers(False);
if Markers<>nil then
Markers.RecalcCounters(Marker.GetIndexInList(Markers), GetRVStyle);
end
else begin
Marker := TRVMarkerItemInfo.CreateEx(Self, AListNo, AListLevel, AStartFrom, AUseStartFrom);
s := '';
Marker.Inserting(Self,s,False);
if Result<Items.Count then begin
GetItem(Result).SameAsPrev := True;
Marker.ParaNo := GetItemPara(Result);
end
else begin
Marker.ParaNo := AParaNo;
if AParaNo<0 then
if Items.Count=0 then
Marker.ParaNo := 0
else
Marker.ParaNo := GetItemPara(Items.Count-1);
end;
Items.InsertObject(Result, s, Marker);
Marker.Inserted(Self, Result);
AddMarkerInList(Result);
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.RecalcMarker(AItemNo: Integer; AllowCreateList: Boolean);
var Markers: TRVMarkerList;
begin
if GetItemStyle(AItemNo)<>rvsListMarker then
exit;
Markers := GetMarkers(AllowCreateList);
if Markers=nil then
exit;
Markers.RecalcCounters(TRVMarkerItemInfo(GetItem(AItemNo)).GetIndexInList(Markers), GetRVStyle);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.RemoveListMarker(ItemNo: Integer);
begin
ItemNo := GetFirstParaItem(ItemNo);
if GetItemStyle(ItemNo)=rvsListMarker then begin
DeleteItems(ItemNo,1);
if ItemNo<Items.Count then
GetItem(ItemNo).SameAsPrev := False;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetListMarkerInfo(AItemNo: Integer;
var AListNo, AListLevel, AStartFrom: Integer;
var AUseStartFrom: Boolean): Integer;
begin
Result := GetFirstParaItem(AItemNo);
if GetItemStyle(Result)<>rvsListMarker then begin
Result := -1;
exit;
end;
with TRVMarkerItemInfo(GetItem(Result)) do begin
AListNo := ListNo;
AListLevel := Level;
AStartFrom := StartFrom;
AUseStartFrom := Reset;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetMarkers(AllowCreate: Boolean): TRVMarkerList;
begin
Result := GetAbsoluteRootData.GetMarkers(AllowCreate);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetPrevMarkers: TRVMarkerList;
begin
Result := nil;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DestroyMarkers;
begin
GetAbsoluteRootData.DestroyMarkers;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddMarkerInList(ItemNo: Integer);
var List: TRVMarkerList;
PrevMarker: TRVMarkerItemInfo;
Index: Integer;
begin
if GetItemStyle(ItemNo)<>rvsListMarker then
exit;
List := GetMarkers(True);
if List=nil then
exit;
if TRVMarkerItemInfo(GetItem(ItemNo)).GetIndexInList(List)>=0 then
exit;
PrevMarker := FindPreviousMarker(ItemNo-1);
Index := List.InsertAfter(TRVMarkerItemInfo(GetItem(ItemNo)), PrevMarker);
GetMarkers(False).RecalcCounters(Index, GetRVStyle);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.DeleteMarkerFromList(Item: TCustomRVItemInfo; Clearing: Boolean);
var List: TRVMarkerList;
Index: Integer;
begin
if Item.StyleNo=rvsListMarker then begin
List := GetMarkers(False);
if List=nil then
exit;
Index := List.IndexOf(Item);
List.Delete(Index);
if List.Count=0 then
DestroyMarkers
else if not Clearing then
List.RecalcCounters(Index, GetRVStyle);
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.FindPreviousMarker(ItemNo: Integer): TRVMarkerItemInfo;
{...................................................}
function FindMarkerInRVData(RVData: TCustomRVData; LastItemNo: Integer): TRVMarkerItemInfo; forward;
{...................................................}
function FindMarkerInItem(Item: TCustomRVItemInfo; StoreSub: TRVStoreSubRVData): TRVMarkerItemInfo;
var RVData: TCustomRVData;
begin
Result := nil;
if StoreSub=nil then
RVData := TCustomRVData(item.GetSubRVData(StoreSub, rvdLast))
else
RVData := TCustomRVData(item.GetSubRVData(StoreSub, rvdPrev));
if RVData<>nil then begin
repeat
Result := FindMarkerInRVData(RVData, RVData.Items.Count-1);
if Result<>nil then
break;
RVData := TCustomRVData(item.GetSubRVData(StoreSub, rvdPrev));
until RVData=nil;
end;
StoreSub.Free;
end;
{...................................................}
function FindMarkerInRVData(RVData: TCustomRVData; LastItemNo: Integer): TRVMarkerItemInfo;
var i: Integer;
begin
for i := LastItemNo downto 0 do begin
if RVData.GetItem(i).StyleNo=rvsListMarker then
Result := TRVMarkerItemInfo(RVData.GetItem(i))
else
Result := FindMarkerInItem(RVData.GetItem(i), nil);
if Result<>nil then
exit;
end;
Result := nil;
end;
{...................................................}
var RVData: TCustomRVData;
StoreSub: TRVStoreSubRVData;
begin
Result := nil;
RVData := Self;
while RVData<>nil do begin
Result := FindMarkerInRVData(RVData, ItemNo);
if Result<>nil then
break;
RVData.GetParentInfo(ItemNo, StoreSub);
if ItemNo<0 then begin
StoreSub.Free;
break;
end;
RVData := RVData.GetAbsoluteParentData;
Result := FindMarkerInItem(RVData.GetItem(ItemNo), StoreSub);
if Result<>nil then
break;
dec(ItemNo);
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.FindMarkerLocalLocationFrom(StartItemNo: Integer;
Marker: TRVMarkerItemInfo): Integer;
{...................................................}
function FindMarkerInRVData(RVData: TCustomRVData; FirstItemNo: Integer): Integer; forward;
{...................................................}
function FindMarkerInItem(Item: TCustomRVItemInfo): Boolean;
var RVData: TCustomRVData;
StoreSub: TRVStoreSubRVData;
begin
Result := False;
RVData := TCustomRVData(item.GetSubRVData(StoreSub, rvdFirst));
if RVData<>nil then begin
repeat
Result := FindMarkerInRVData(RVData, 0)>=0;
if Result then
break;
RVData := TCustomRVData(item.GetSubRVData(StoreSub, rvdNext));
until RVData=nil;
end;
StoreSub.Free;
end;
{...................................................}
function FindMarkerInRVData(RVData: TCustomRVData; FirstItemNo: Integer): Integer;
var i: Integer;
begin
for i := FirstItemNo to RVData.Items.Count-1 do
if (RVData.GetItem(i)=Marker) or
FindMarkerInItem(RVData.GetItem(i)) then begin
Result := i;
exit;
end;
Result := -1;
end;
{...................................................}
begin;
Result := FindMarkerInRVData(Self, StartItemNo);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.FindLastMarkerIndex(StartAfterMeIndex: Integer;
ListStyles: TRVIntegerList): Integer;
var i, j, ListNo: Integer;
ok: Boolean;
Markers: TRVMarkerList;
begin
Result := -1;
Markers := GetMarkers(False);
if Markers=nil then
exit;
for i := Markers.Count-1 downto StartAfterMeIndex+1 do begin
ok := False;
ListNo := TRVMarkerItemInfo(Markers[i]).ListNo;
for j := 0 to ListStyles.Count-1 do
if ListStyles[j] = ListNo then begin
ok := True;
break;
end;
if ok then begin
Result := i;
exit;
end;
end;
end;
{$ENDIF}
function TCustomRVData.GetChosenItem: TCustomRVItemInfo;
begin
Result := nil;
end;
function TCustomRVData.GetChosenRVData: TCustomRVData;
begin
Result := nil;
end;
function TCustomRVData.GetItemText(ItemNo: Integer): String;
begin
Result := Items[ItemNo];
end;
procedure TCustomRVData.SetItemText(ItemNo: Integer; const s: String);
begin
if rvioUnicode in GetItemOptions(ItemNo) then
RVCheckUni(Length(s));
Items[ItemNo] := s;
end;
{------------------------------------------------------------------------------}
{ Returns the first and the last item of paragraph section containing
the given range of items }
procedure TCustomRVData.ExpandToParaSection(ItemNo1,ItemNo2: Integer;
var FirstItemNo, LastItemNo: Integer);
begin
FirstItemNo := ItemNo1;
while (FirstItemNo>0) and not IsFromNewLine(FirstItemNo) do
dec(FirstItemNo);
LastItemNo := ItemNo2+1;
while (LastItemNo<Items.Count) and not IsFromNewLine(LastItemNo) do
inc(LastItemNo);
dec(LastItemNo);
end;
{------------------------------------------------------------------------------}
{ Returns the first and the last item of paragraph containing
the given range of items }
procedure TCustomRVData.ExpandToPara(ItemNo1,ItemNo2: Integer;
var FirstItemNo, LastItemNo: Integer);
begin
FirstItemNo := ItemNo1;
while (FirstItemNo>0) and not IsParaStart(FirstItemNo) do
dec(FirstItemNo);
LastItemNo := ItemNo2+1;
while (LastItemNo<Items.Count) and not IsParaStart(LastItemNo) do
inc(LastItemNo);
dec(LastItemNo);
end;
{------------------------------------------------------------------------------}
{ READ method for ItemCount property }
function TCustomRVData.GetItemCount: Integer;
begin
Result := Items.Count;
end;
{------------------------------------------------------------------------------}
{ Inits editing mode and returns RVData of inplace editor. For most RVDatas,
this method does nothing and returns themselves.
Overriden in TRVTableCellData. }
function TCustomRVData.Edit: TCustomRVData;
begin
Result := Self;
end;
{------------------------------------------------------------------------------}
{ Enumerates all items from the first to the last one: calls Proc for each item.
Items in sub-documents (cells) are included. If they are edited, RVData of
inplace editor is used as a parameter. Value of UserData is passed as a
last parameter of Proc. }
function TCustomRVData.EnumItems(Proc: TRVEnumItemsProc; var UserData1: Integer;
const UserData2: String): Boolean;
var i: Integer;
RVData: TCustomRVData;
StoreSub: TRVStoreSubRVData;
item: TCustomRVItemInfo;
begin
Result := True;
for i := 0 to ItemCount-1 do begin
Proc(Self, i, UserData1, UserData2, Result);
if not Result then
exit;
item := GetItem(i);
RVData := TCustomRVData(item.GetSubRVData(StoreSub, rvdFirst));
if RVData<>nil then begin
repeat
Result := RVData.GetRVData.EnumItems(Proc, UserData1, UserData2);
if not Result then
break;
RVData := TCustomRVData(item.GetSubRVData(StoreSub, rvdNext));
until RVData=nil;
end;
StoreSub.Free;
end;
end;
{------------------------------------------------------------------------------}
{ Compares two locations in the same document:
(RVData1, ItemNo1) and (RVData2, ItemNo2).
Return value: 0 if equal, <0 if (1) before (2), >0 if (1) after (2).
Table is assumed before its cells. }
function RVCompareLocations(RVData1: TCustomRVData; ItemNo1: Integer;
RVData2: TCustomRVData; ItemNo2: Integer): Integer;
var CurItemNo2: Integer;
CurRVData2: TCustomRVData;
StoreSub1,StoreSub2: TRVStoreSubRVData;
begin
RVData1 := RVData1.GetSourceRVData;
RVData2 := RVData2.GetSourceRVData;
CurRVData2 := RVData2;
CurItemNo2 := ItemNo2;
StoreSub1 := nil;
StoreSub2 := nil;
while True do begin
while True do begin
if RVData1=CurRVData2 then begin
Result := ItemNo1-CurItemNo2; // different items?
if Result=0 then
if StoreSub1<>nil then
if StoreSub2<>nil then
Result := StoreSub1.Compare(StoreSub2) // cells in the same table?
else
Result := +1 // (1) is from table cell, (2) is a table itself
else
if StoreSub2<>nil then
Result := -1 // (2) is from table cell, (1) is a table itself
else
Result := 0; // the same item;
StoreSub1.Free;
StoreSub2.Free;
exit;
end;
StoreSub2.Free;
CurRVData2.GetParentInfo(CurItemNo2, StoreSub2);
if CurItemNo2<0 then
break;
CurRVData2 := CurRVData2.GetAbsoluteParentData.GetSourceRVData;
end;
StoreSub1.Free;
RVData1.GetParentInfo(ItemNo1, StoreSub1);
if ItemNo1<0 then
raise ERichViewError.Create(errRVCompare);
RVData1 := RVData1.GetAbsoluteParentData.GetSourceRVData;
CurRVData2 := RVData2;
end;
end;
initialization
{$IFNDEF RVDONOTUSERVF}
RegisterClasses([TBitmap, TIcon, TMetafile]);
{$IFNDEF RVDONOTUSEJPEGIMAGE}
RegisterClasses([TJpegImage]);
{$ENDIF}
{$ENDIF}
HTMLGraphicFormats := nil;
RVPngGraphiClass := nil;
finalization
HTMLGraphicFormats.Free;
HTMLGraphicFormats := nil;
end.