RichEdit

开发平台：

Delphi

RVStyle.pas：源码内容

else
inherited AssignTo(Dest);
end;
{------------------------------------------------------------------------------}
{ Adds a new item. }
function TParaInfos.Add: TParaInfo;
begin
Result := TParaInfo(inherited Add);
end;
{------------------------------------------------------------------------------}
{ READ method for the property Items[].
Returns the Index-th item. If the index is out of range (0..Count-1), returns
InvalidItem instead. This method never generates exceptions. }
function TParaInfos.GetItem(Index: Integer): TParaInfo;
begin
if (Index<0) or (Index>=Count) then
Result := InvalidItem
else
Result := TParaInfo(inherited GetItem(Index));
end;
{------------------------------------------------------------------------------}
{ WRITE method for the property Items[]. }
procedure TParaInfos.SetItem(Index: Integer; Value: TParaInfo);
begin
inherited SetItem(Index, Value);
end;
{------------------------------------------------------------------------------}
{ READ method for the property InvalidItem.
It's returned when accessing Items[] with invalid index.
By default it has all properties of Items[0] and red border. }
function TParaInfos.GetInvalidItem: TParaInfo;
begin
if FInvalidItem=nil then begin
FInvalidItem := (FOwner as TRVStyle).GetParaStyleClass.Create(nil);
if Count>0 then
FInvalidItem.Assign(Items[0]);
FInvalidItem.SpaceBefore :=1;
FInvalidItem.SpaceAfter :=1;
FInvalidItem.LeftIndent :=1;
FInvalidItem.RightIndent :=1;
FInvalidItem.Border.Color := clRed;
FInvalidItem.Border.Style := rvbSingle;
FInvalidItem.Border.Width := 2;
FInvalidItem.Border.BorderOffsets.SetAll(1);
end;
Result := FInvalidItem;
end;
{------------------------------------------------------------------------------}
{ WRITE method for the property InvalidItem. }
procedure TParaInfos.SetInvalidItem(const Value: TParaInfo);
begin
if InvalidItem<>Value then
InvalidItem.Assign(Value);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys. }
procedure TParaInfos.LoadFromINI(ini: TRVIniFile; const Section: String);
var i, cnt: Integer;
begin
cnt := ini.ReadInteger(Section, RVINI_PARASTYLECOUNT, 2);
Clear;
for i:=0 to cnt-1 do begin
Add;
Items[i].LoadFromINI(ini, Section, RVINI_PARASTYLEPREFIX+IntToStr(i));
end;
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file, in the section Section.
fs is a format string for ini keys. }
procedure TParaInfos.SaveToINI(ini: TRVIniFile; const Section: String);
var i: Integer;
begin
ini.WriteInteger(Section,RVINI_PARASTYLECOUNT, Count);
for i:=0 to Count-1 do
Items[i].SaveToINI(ini, Section, RVINI_PARASTYLEPREFIX+IntToStr(i));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Returns the index of the style having the specified Alignment.
Starts searching from Items[BaseStyle], then searches in other Items.
If not found, returns -1. }
function TParaInfos.FindStyleWithAlignment(BaseStyle: Integer;
Alignment: TRVAlignment): Integer;
var i: Integer;
begin
if Items[BaseStyle].Alignment = Alignment then begin
Result := BaseStyle;
exit;
end;
for i := 0 to Count-1 do
if (i<>BaseStyle) and (Items[i].Alignment=Alignment) and
Items[BaseStyle].IsEqual(Items[i], [rvpiAlignment]) then begin
Result := i;
exit;
end;
Result := -1;
end;
{------------------------------------------------------------------------------}
{ The most universal method for paragraph style searching.
Returns the index of the style having all properties of Style listed in Mask.
Starts searching from Items[BaseStyle], then searches in other Items.
If not found, returns -1. }
function TParaInfos.FindSuchStyle(BaseStyle: Integer; Style: TParaInfo;
Mask: TRVParaInfoProperties): Integer;
var i: Integer;
begin
Mask := RVAllParaInfoProperties - Mask;
if Style.IsEqual(Items[BaseStyle], Mask) then begin
Result := BaseStyle;
exit;
end;
for i := 0 to Count-1 do
if (i<>BaseStyle) and Style.IsEqual(Items[i], Mask) then begin
Result := i;
exit;
end;
Result := -1;
end;
{============================== TRVMarkerFont =================================}
{ Constructor. Sets values default for ListLevel.Font. }
constructor TRVMarkerFont.Create;
begin
inherited Create;
Name := RVDEFAULTSTYLEFONT;
Size := 8;
end;
{------------------------------------------------------------------------------}
{ Is this font equal to Font? }
function TRVMarkerFont.IsEqual(Font: TFont): Boolean;
begin
Result :=
(Height=Font.Height) and
(Style=Font.Style) and
(Color=Font.Color) and
{$IFDEF RICHVIEWCBDEF3}
(Charset=Font.Charset) and
{$ENDIF}
(AnsiCompareText(Name, Font.Name)=0);
end;
{------------------------------------------------------------------------------}
{ Do all properties of this font have default values? }
function TRVMarkerFont.IsDefault: Boolean;
begin
Result :=
(Size=8) and
(Color=clWindowText) and
{$IFDEF RICHVIEWCBDEF3}
(Charset=DEFAULT_CHARSET) and
{$ENDIF}
(Style=[]) and
(AnsiCompareText(Name,RVDEFAULTSTYLEFONT)=0);
end;
{------------------------------------------------------------------------------}
{ STORED method for Name property. }
function TRVMarkerFont.StoreName: Boolean;
begin
Result := Name<>RVDEFAULTSTYLEFONT;
end;
{------------------------------------------------------------------------------}
{ STORED method for Height property. }
function TRVMarkerFont.StoreHeight: Boolean;
begin
Result := Size<>8;
end;
{============================== TRVListLevel ==================================}
{ Constructor. Creates a dot bullet with FirstIndent=10. }
constructor TRVListLevel.Create(Collection: TCollection);
begin
inherited Create(Collection);
FFirstIndent := 10;
FStartFrom := 1;
FFormatString := #$B7;
FOptions := [rvloContinuous, rvloLevelReset];
end;
{------------------------------------------------------------------------------}
{ Destructor. }
destructor TRVListLevel.Destroy;
begin
FPicture.Free;
FFont.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{ Assigns Source to Self, if Source is TRVListLevel. }
procedure TRVListLevel.Assign(Source: TPersistent);
begin
if Source is TRVListLevel then begin
ListType := TRVListLevel(Source).ListType;
StartFrom := TRVListLevel(Source).StartFrom;
ImageList := TRVListLevel(Source).ImageList;
ImageIndex := TRVListLevel(Source).ImageIndex;
FormatString := TRVListLevel(Source).FormatString;
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
FormatStringW := TRVListLevel(Source).FormatStringW;
{$ENDIF}
{$ENDIF}
LeftIndent := TRVListLevel(Source).LeftIndent;
FirstIndent := TRVListLevel(Source).FirstIndent;
MarkerIndent := TRVListLevel(Source).MarkerIndent;
MarkerAlignment := TRVListLevel(Source).MarkerAlignment;
Picture := TRVListLevel(Source).FPicture;
Font := TRVListLevel(Source).FFont;
Options := TRVListLevel(Source).Options;
end
else
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RICHVIEWDEF3}
{ Are the Length bytes referenced by P1 and P2 the same? }
function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler;
asm
PUSH ESI
PUSH EDI
MOV ESI,P1
MOV EDI,P2
MOV EDX,ECX
XOR EAX,EAX
AND EDX,3
SHR ECX,1
SHR ECX,1
REPE CMPSD
JNE @@2
MOV ECX,EDX
REPE CMPSB
JNE @@2
INC EAX
@@2: POP EDI
POP ESI
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Do Picture1 and Picture2 contain the same picture? }
function ArePicturesEqual(FPicture1, FPicture2: TPicture): Boolean;
var Stream1, Stream2: TMemoryStream;
begin
Result := ((FPicture1=nil) or (FPicture1.Graphic=nil)) =
((FPicture2=nil) or (FPicture2.Graphic=nil));
if not Result then
exit;
if (FPicture1=nil) or (FPicture2.Graphic=nil) then
exit;
Result := FPicture1.ClassType=FPicture2.ClassType;
if not Result then
exit;
Result := (FPicture1.Width=FPicture2.Width) and
(FPicture1.Height=FPicture2.Height);
if not Result then
exit;
Stream1 := TMemoryStream.Create;
Stream2 := TMemoryStream.Create;
try
FPicture1.Graphic.SaveToStream(Stream1);
FPicture2.Graphic.SaveToStream(Stream2);
Result := (Stream1.Size=Stream2.Size) and
CompareMem(Stream1.Memory,Stream2.Memory,Stream1.Size);
finally
Stream1.Free;
Stream2.Free;
end;
end;
{------------------------------------------------------------------------------}
{ Is this list level equal to Value? }
function TRVListLevel.IsSimpleEqual(Value: TRVListLevel): Boolean;
begin
Result :=
(ListType = Value.ListType) and
(StartFrom = Value.StartFrom) and
(ImageList = Value.ImageList) and
(ImageIndex = Value.ImageIndex) and
(FormatString = Value.FormatString) and
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
(FormatStringW = Value.FormatStringW) and
{$ENDIF}
{$ENDIF}
(LeftIndent = Value.LeftIndent) and
(FirstIndent = Value.FirstIndent) and
(MarkerIndent = Value.MarkerIndent) and
(MarkerAlignment = Value.MarkerAlignment) and
(
((FFont=nil) or (FFont.IsDefault)) and ((Value.FFont=nil) or (Value.FFont.IsDefault)) or
((FFont<>nil) and (Value.FFont<>nil) and FFont.IsEqual(Value.FFont))
) and
(Options = Value.Options) and
ArePicturesEqual(FPicture, Value.FPicture);
end;
{------------------------------------------------------------------------------}
{ Returns a value of similarity between this list level and Value.
The greater value - the higher similarity. }
function TRVListLevel.SimilarityValue(Value: TRVListLevel): Integer;
begin
Result := 0;
if ListType=Value.ListType then
inc(Result, RVMW_LISTTYPE);
if StartFrom=Value.StartFrom then
inc(Result, RVMW_LISTMISC);
if ImageList=Value.ImageList then
inc(Result, RVMW_LISTMISC);
if ImageIndex=Value.ImageIndex then
inc(Result, RVMW_LISTMISC);
if FormatString=Value.FormatString then
inc(Result, RVMW_LISTMISC);
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
if FormatStringW=Value.FormatStringW then
inc(Result, RVMW_LISTMISC);
{$ENDIF}
{$ENDIF}
if LeftIndent=Value.LeftIndent then
inc(Result, RVMW_LISTMISC);
if FirstIndent=Value.FirstIndent then
inc(Result, RVMW_LISTMISC);
if FirstIndent=Value.FirstIndent then
inc(Result, RVMW_LISTMISC);
if MarkerIndent=Value.MarkerIndent then
inc(Result, RVMW_LISTMISC);
if MarkerAlignment=Value.MarkerAlignment then
inc(Result, RVMW_LISTMISC);
if Options=Value.Options then
inc(Result, RVMW_LISTMISC);
if ((FFont=nil) or (FFont.IsDefault)) and ((Value.FFont=nil) or (Value.FFont.IsDefault)) or
((FFont<>nil) and (Value.FFont<>nil) and FFont.IsEqual(Value.FFont)) then
inc(Result, RVMW_LISTMISC);
if ArePicturesEqual(FPicture, Value.FPicture) then
inc(Result, RVMW_LISTMISC);
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
{ Designtime support. Returns a string which will be displayed for this item
in the collection editor.
It has a format
"<list type> <left indent>/<marker indent>/<first line indent>". }
function TRVListLevel.GetDisplayName: String;
begin
Result := Format(RVLISTLEVELDISPLAYNAME, [RVListTypeStr[ord(ListType)],
LeftIndent, MarkerIndent, FirstIndent]);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ READ method for Picture property. }
function TRVListLevel.GetPicture: TPicture;
begin
if FPicture=nil then
FPicture := TPicture.Create;
Result := FPicture;
end;
{------------------------------------------------------------------------------}
{ WRITE method for Picture property. }
procedure TRVListLevel.SetPicture(const Value: TPicture);
begin
if Value<>FPicture then begin
if (Value=nil) or (Value.Graphic=nil) then begin
FPicture.Free;
FPicture := nil;
end
else begin
GetPicture.Assign(Value);
{$IFDEF RICHVIEWDEF3}
FPicture.Graphic.Transparent := True;
{$ENDIF}
end;
end;
end;
{------------------------------------------------------------------------------}
{ STORED method for Picture property. }
function TRVListLevel.StorePicture: Boolean;
begin
Result := FPicture<>nil;
end;
{------------------------------------------------------------------------------}
{ Is value of Picture property nonempty? }
function TRVListLevel.HasPicture: Boolean;
begin
Result := (FPicture<>nil) and (FPicture.Graphic<>nil);
end;
{------------------------------------------------------------------------------}
{ Does this list level uses Font? (it depends on ListType). }
function TRVListLevel.UsesFont: Boolean;
begin
Result := ListType in [rvlstBullet,
rvlstDecimal, rvlstLowerAlpha, rvlstUpperAlpha,
rvlstLowerRoman, rvlstUpperRoman
{$IFNDEF RVDONOTUSEUNICODE}, rvlstUnicodeBullet{$ENDIF} ];
end;
{------------------------------------------------------------------------------}
{ Does this list level uses numbering? (it depends on ListType). }
function TRVListLevel.HasNumbering: Boolean;
begin
Result := ListType in [rvlstDecimal, rvlstLowerAlpha, rvlstUpperAlpha,
rvlstLowerRoman, rvlstUpperRoman, rvlstImageListCounter];
end;
{------------------------------------------------------------------------------}
{ Is width of marker of this list level variable? (it depends on ListType). }
function TRVListLevel.HasVariableWidth: Boolean;
begin
Result := ListType in [rvlstDecimal, rvlstLowerAlpha, rvlstUpperAlpha,
rvlstLowerRoman, rvlstUpperRoman];
end;
{------------------------------------------------------------------------------}
{ (reserved) }
function TRVListLevel.GetHTMLOpenTagForCSS: String;
begin
if HasNumbering then
Result := 'ol'
else
Result := 'ul';
end;
{------------------------------------------------------------------------------}
{ Returns CSS to insert in <P> tag when SaveHTMLEx is called with
rvsoMarkersAsText option. }
function TRVListLevel.GetIndentCSSForTextVersion: String;
begin
if MarkerIndent-LeftIndent>=0 then
Result := Format('text-indent: %dpx; margin-left: %dpx;',
[MarkerIndent-LeftIndent, LeftIndent])
else
Result := Format('text-indent: %dpx; padding-left: %dpx; margin-left: %dpx;',
[MarkerIndent-LeftIndent, LeftIndent-MarkerIndent, MarkerIndent]);
end;
{------------------------------------------------------------------------------}
{ Writes opening HTML tag for this list level in Stream.
Used TRVMarkerItemInfo.HTMLOpenOrCloseTags. }
procedure TRVListLevel.HTMLOpenTag(Stream: TStream; UseCSS: Boolean);
{..............................................}
function GetListType: String;
begin
case ListType of
rvlstLowerAlpha:
Result := 'a';
rvlstUpperAlpha:
Result := 'A';
rvlstLowerRoman:
Result := 'i';
rvlstUpperRoman:
Result := 'I';
else
Result := '';
end;
if Result<>'' then
Result := ' type='+Result;
end;
{..............................................}
var CSS: String;
PrevIndent: Integer;
begin
if UseCSS then begin
PrevIndent := 0;
if Index>0 then
PrevIndent := TRVListLevelCollection(Collection).Items[Index-1].LeftIndent;
if MarkerIndent>=LeftIndent then
CSS := Format('text-indent: %dpx; margin-left: %dpx; list-style-position: inside;',
[MarkerIndent-LeftIndent, LeftIndent-PrevIndent])
else
CSS := Format('text-indent: %dpx; margin-left: %dpx; list-style-position: outside;',
[FirstIndent, LeftIndent-PrevIndent]);
CSS := ' style="'+CSS+'"';
end
else
CSS := '';
if HasNumbering then
RVWrite(Stream,Format('<ol%s%s>',[GetListType,CSS]))
else
RVWrite(Stream,Format('<ul%s>',[CSS]));
end;
{------------------------------------------------------------------------------}
{ Writes closing HTML tag for this list level in Stream.
Used TRVMarkerItemInfo.HTMLOpenOrCloseTags. }
procedure TRVListLevel.HTMLCloseTag(Stream: TStream; UseCSS: Boolean);
begin
if HasNumbering then
RVWrite(Stream,'</ol>')
else
RVWrite(Stream,'</ul>');
end;
{------------------------------------------------------------------------------}
{ READ method for Font property. }
function TRVListLevel.GetFont: TRVMarkerFont;
begin
if FFont=nil then
FFont := TRVMarkerFont.Create;
Result := FFont;
end;
{------------------------------------------------------------------------------}
{ WRITE method for Font property. }
procedure TRVListLevel.SetFont(const Value: TRVMarkerFont);
begin
if Value<>FFont then begin
if (Value=nil) then begin
FFont.Free;
FFont := nil;
end
else
GetFont.Assign(Value);
end;
end;
{------------------------------------------------------------------------------}
{ STORED method for Font property. }
function TRVListLevel.StoreFont: Boolean;
begin
Result := FFont<>nil;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys.
ImageList is not loaded (to-do) }
procedure TRVListLevel.SaveToINI(ini: TRVIniFile; const Section, fs: String);
var Stream: TMemoryStream;
begin
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_LISTTYPE]), ord(ListType), ord(rvlstBullet));
// ImageList ?
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_IMAGEINDEX]), ImageIndex, 0);
ini.WriteString(Section, Format(fs,[RVINI_FORMATSTRING]), FormatString);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_LEFTINDENT]), LeftIndent, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_FIRSTINDENT]), FirstIndent, 10);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_MARKERINDENT]), MarkerIndent, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_MARKERALIGNMENT]), ord(FMarkerAlignment), ord(rvmaLeft));
if (FPicture<>nil) and (FPicture.Graphic<>nil) then begin
ini.WriteString(Section, Format(fs,[RVINI_GRAPHICCLASS]), FPicture.Graphic.ClassName);
Stream := TMemoryStream.Create;
FPicture.Graphic.SaveToStream(Stream);
Stream.Position := 0;
WriteLongStringToINI(ini, Section, Format(fs,[RVINI_PICTURE]), RVFStream2TextString(Stream));
Stream.Free;
end;
if FFont<>nil then
ini.WriteString(Section, Format(fs,[RVINI_FONT]), FontToString(FFont));
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_LOCONTINUOUS]), rvloContinuous in Options, True);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_LOLEVELRESET]), rvloLevelReset in Options, True);
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
if FFormatStringW<>'' then begin
Stream := TMemoryStream.Create;
Stream.WriteBuffer(Pointer(FFormatStringW)^, Length(FFormatStringW)*2);
Stream.Position := 0;
ini.WriteString(Section, Format(fs,[RVINI_FORMATSTRINGW]), RVFStream2TextString(Stream));
Stream.Free;
end;
{$ENDIF}
{$ENDIF}
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file, in the section Section.
fs is a format string for ini keys.
ImageList is not stored (to-do). }
procedure TRVListLevel.LoadFromINI(ini: TRVIniFile; const Section, fs: String);
var s: String;
Stream: TMemoryStream;
GraphicClass: TGraphicClass;
Graphic: TGraphic;
begin
ListType := TRVListType(ini.ReadInteger(Section, Format(fs,[RVINI_LISTTYPE]), ord(rvlstBullet)));
// ImageList ?
ImageIndex := ini.ReadInteger(Section, Format(fs,[RVINI_IMAGEINDEX]), 0);
FormatString := ini.ReadString(Section, Format(fs,[RVINI_FORMATSTRING]), '');
LeftIndent := ini.ReadInteger(Section, Format(fs,[RVINI_LEFTINDENT]), 0);
FirstIndent := ini.ReadInteger(Section, Format(fs,[RVINI_FIRSTINDENT]), 10);
MarkerIndent := ini.ReadInteger(Section, Format(fs,[RVINI_MARKERINDENT]), 0);
FMarkerAlignment := TRVMarkerAlignment(ini.ReadInteger(Section, Format(fs,[RVINI_MARKERALIGNMENT]), ord(rvmaLeft)));
s := ini.ReadString(Section, Format(fs,[RVINI_GRAPHICCLASS]), '');
GraphicClass := nil;
if s<>'' then
GraphicClass := TGraphicClass(GetClass(s));
if GraphicClass=nil then
Picture := nil
else begin
Graphic := RV_CreateGraphics(GraphicClass);
Picture.Graphic := Graphic;
Graphic.Free;
Stream := TMemoryStream.Create;
s := ReadLongStringFromINI(ini, Section, Format(fs,[RVINI_PICTURE]));
RVFTextString2Stream(s, Stream);
Stream.Position := 0;
try
Picture.Graphic.LoadFromStream(Stream);
except
Picture := nil;
end;
Stream.Free;
end;
s := ini.ReadString(Section, Format(fs,[RVINI_FONT]), '');
if s='' then
Font := nil
else
StringToFont(s, Font);
FOptions := [];
if IniReadBool(ini, Section, Format(fs,[RVINI_LOCONTINUOUS]), True) then
Include(FOptions,rvloContinuous);
if IniReadBool(ini, Section, Format(fs,[RVINI_LOLEVELRESET]), True) then
Include(FOptions,rvloLevelReset);
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
s := ini.ReadString(Section, Format(fs,[RVINI_FORMATSTRINGW]), '');
Stream := TMemoryStream.Create;
RVFTextString2Stream(s, Stream);
SetLength(FFormatStringW, Stream.Size div 2);
Stream.Position := 0;
Stream.ReadBuffer(Pointer(FFormatStringW)^, Stream.Size);
Stream.Free;
{$ENDIF}
{$ENDIF}
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Writes ImageList.Tag as ILTag pseudo-property. }
procedure TRVListLevel.ImageListTagWriter(Writer: TWriter);
begin
Writer.WriteInteger(FImageList.Tag);
end;
{ Returns RVData used to store this list level.
There are two possibilities
- storing in DFM: no RVData (nil)
- storing in RVF: returns RVData assigned to RVStyle.ListStyles.FRVData. }
{------------------------------------------------------------------------------}
function TRVListLevel.GetRVFRVData: TPersistent;
begin
if (Collection<>nil) and (TRVListLevelCollection(Collection).FOwner<>nil) and
(TRVListInfo(TRVListLevelCollection(Collection).FOwner).Collection<>nil) then
Result := TRVListInfos(TRVListInfo(TRVListLevelCollection(Collection).FOwner).Collection).FRVData
else
Result := nil;
end;
{------------------------------------------------------------------------------}
{ Reads ILTag pseudo-property. When loading from RVF file, it contains a Tag
property of ImageList. It's used to call RVData.RVFImageListNeeded, which
calls RichView.OnRVFImageListNeeded event.
There must be no this property when loading from DFM. }
procedure TRVListLevel.ImageListTagReader(Reader: TReader);
var RVData: TCustomRVData;
Tag: Integer;
begin
RVData := TCustomRVData(GetRVFRVData);
Tag := Reader.ReadInteger;
if RVData<>nil then
FImageList := RVData.RVFImageListNeeded(Tag)
else
FImageList := nil;
end;
{------------------------------------------------------------------------------}
{ STORED method for ILTag pseudo-property. It should be stored only if RVData is
assigned, i.e. when saving to RVF file. }
function TRVListLevel.StoreImageList: Boolean;
begin
Result := GetRVFRVData=nil;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
{ READ method for FormatStringWCode pseudo-property. This pseudo-property is
used for storing FormatStringW property.
This trick is used because new and old version of Delphi save strings
differently. If we will use standard Delphi streaming method for these
properties, programs compiled with older version of Delphi will not be able to
open RVF files saved with newer versions of Delphi. }
procedure TRVListLevel.FormatStringWCodeReader(Reader: TReader);
begin
FFormatStringW := RVDecodeWideString(Reader.ReadString);
end;
{------------------------------------------------------------------------------}
{ WRITE method for FormatStringWCode pseudo-property }
procedure TRVListLevel.FormatStringWCodeWriter(Writer: TWriter);
begin
Writer.WriteString(RVEncodeWideString(FFormatStringW));
end;
{$ENDIF}
{$ENDIF}
{------------------------------------------------------------------------------}
{ READ method for FormatStringCode pseudo-property. This pseudo-property is
used for storing FormatString property. }
procedure TRVListLevel.FormatStringCodeReader(Reader: TReader);
begin
FFormatString := RVDecodeString(Reader.ReadString);
end;
{------------------------------------------------------------------------------}
{ WRITE method for FormatStringCode pseudo-property. This pseudo-property is
used for storing FormatString property. }
procedure TRVListLevel.FormatStringCodeWriter(Writer: TWriter);
begin
Writer.WriteString(RVEncodeString(FFormatString));
end;
{------------------------------------------------------------------------------}
{ Defines additional properties (pseudo-properties): ILTag, FormatStringWCode,
FormatStringCode. }
procedure TRVListLevel.DefineProperties(Filer: TFiler);
begin
inherited;
if GetRVFRVData<>nil then
Filer.DefineProperty('ILTag', ImageListTagReader, ImageListTagWriter, FImageList<>nil);
{$IFNDEF RVDONOTUSEUNICODE}
{$IFDEF RICHVIEWCBDEF3}
Filer.DefineProperty('FormatStringWCode', FormatStringWCodeReader, FormatStringWCodeWriter, FFormatStringW<>'');
{$ENDIF}
{$ENDIF}
Filer.DefineProperty('FormatStringCode', FormatStringCodeReader, FormatStringCodeWriter, FFormatString<>#$B7);
end;
{========================= TRVListLevelCollection =============================}
{ Constructor. Creates empty collection of list levels. }
constructor TRVListLevelCollection.Create(Owner: TPersistent);
begin
inherited Create(TRVListLevel);
FOwner := Owner;
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
{ Designtime support, for the IDE collection editor. }
function TRVListLevelCollection.GetOwner: TPersistent;
begin
Result := FOwner;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ READ method for Items[] property. }
function TRVListLevelCollection.GetItem(Index: Integer): TRVListLevel;
begin
Result := TRVListLevel(inherited GetItem(Index));
end;
{------------------------------------------------------------------------------}
{ WRITE method for Items[] property. }
procedure TRVListLevelCollection.SetItem(Index: Integer;
const Value: TRVListLevel);
begin
inherited SetItem(Index, Value);
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWDEF4}
{ Inserts a new list level in the collection. This method is added for typecasting. }
function TRVListLevelCollection.Insert(Index: Integer): TRVListLevel;
begin
Result := TRVListLevel(inherited Insert(Index));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Is this collection of list levels equal to Value? }
function TRVListLevelCollection.IsSimpleEqual(Value: TRVListLevelCollection): Boolean;
var i: Integer;
begin
Result := False;
if Count<>Value.Count then
exit;
for i := 0 to Count-1 do
if not Items[i].IsSimpleEqual(Value[i]) then
exit;
Result := True;
end;
{------------------------------------------------------------------------------}
{ Adds new list level to the end of the collection. This method is added for
typecasting. }
function TRVListLevelCollection.Add: TRVListLevel;
begin
Result := TRVListLevel(inherited Add);
end;
{=========================== TRVListInfo ======================================}
{ Constructor. Creates a list style with 0 levels. }
constructor TRVListInfo.Create(Collection: TCollection);
begin
inherited Create(Collection);
FLevels := TRVListLevelCollection.Create(Self);
StyleName := RVDEFAULTLISTSTYLENAME;
end;
{------------------------------------------------------------------------------}
{ Destructor. }
destructor TRVListInfo.Destroy;
begin
FLevels.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{ Assigns Source to Self, if Source is TRVListInfo. }
procedure TRVListInfo.Assign(Source: TPersistent);
begin
if Source is TRVListInfo then begin
Levels := TRVListInfo(Source).Levels;
OneLevelPreview := TRVListInfo(Source).OneLevelPreview;
end;
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ Is this list style equal to Value?
Mapping is not used. }
function TRVListInfo.IsSimpleEqualEx(Value: TCustomRVInfo;
Mapping: TRVIntegerList): Boolean;
begin
Result := IsSimpleEqual(Value, True, False);
{
if not Result then
exit;
Result := False;
if (Value.BaseStyleNo>=0) then begin
if (Value.BaseStyleNo>=Mapping.Count) then
Value.BaseStyleNo := -1 // fix up
else if (Mapping[Value.BaseStyleNo]<>BaseStyleNo) then
exit;
end;
Result := True;
}
end;
{------------------------------------------------------------------------------}
{ Is this list style equal to Value?
If IgnoreID, ListID properties are ignored. }
function TRVListInfo.IsSimpleEqual(Value: TCustomRVInfo;
IgnoreReferences, IgnoreID: Boolean): Boolean;
begin
Result := (OneLevelPreview=TRVListInfo(Value).OneLevelPreview) and
(Levels.Count = TRVListInfo(Value).Levels.Count) and
(IgnoreID or (ListID = TRVListInfo(Value).ListID));
if not Result then
exit;
Result := Levels.IsSimpleEqual(TRVListInfo(Value).Levels);
if Result and RichViewCompareStyleNames then
Result := StyleName=Value.StyleName;
end;
{------------------------------------------------------------------------------}
{ Returns the value of similarity between this paragraph list and Value.
The larger return value - the larger similarity. }
function TRVListInfo.SimilarityValue(Value: TCustomRVInfo): Integer;
var i,min,max: Integer;
begin
Result := 0;
if OneLevelPreview=TRVListInfo(Value).OneLevelPreview then
inc(Result, RVMW_LISTMISC);
if ListID=TRVListInfo(Value).ListID then
inc(Result, RVMW_LISTMISC div 2);
min := Levels.Count;
max := min;
if TRVListInfo(Value).Levels.Count<min then
min := TRVListInfo(Value).Levels.Count;
if TRVListInfo(Value).Levels.Count>max then
max := TRVListInfo(Value).Levels.Count;
for i := 0 to min-1 do
inc(Result, Levels[i].SimilarityValue(TRVListInfo(Value).Levels[i]));
dec(Result, RVMW_LISTMISC*(max-min));
end;
{------------------------------------------------------------------------------}
{ READ method for LstID pseudo-property.
This pseudo-property is used to store ListID property (which cannot be stored
by itself, because it's readonly. }
procedure TRVListInfo.ReadListID(Reader: TReader);
begin
FListID := Reader.ReadInteger;
end;
{------------------------------------------------------------------------------}
{ WRITE method for LstID pseudo-property. }
procedure TRVListInfo.WriteListID(Writer: TWriter);
begin
Writer.WriteInteger(ListID);
end;
{------------------------------------------------------------------------------}
{ Defines additional property: LstID.
See also comments to RVNoLstIDProperty. }
procedure TRVListInfo.DefineProperties(Filer: TFiler);
begin
inherited;
if not RVNoLstIDProperty then
Filer.DefineProperty('LstID', ReadListID, WriteListID, True);
end;
{------------------------------------------------------------------------------}
{ WRITE method for Levels[] property. }
procedure TRVListInfo.SetLevels(const Value: TRVListLevelCollection);
begin
if FLevels<>Value then
FLevels.Assign(Value);
end;
{------------------------------------------------------------------------------}
{ READ method for ListID property. }
function TRVListInfo.GetListID: Integer;
begin
while FListID=0 do
FListID := Random(MaxInt);
Result := FListID;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Stores itself to the ini-file, to the section Section.
fs is a format string for ini keys. }
procedure TRVListInfo.SaveToINI(ini: TRVIniFile; const Section, fs: String);
var i: Integer;
begin
inherited SaveToINI(ini, Section, fs);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_LEVELSCOUNT]),Levels.Count,0);
WriteBoolToIniIfNE(ini,Section, RVINI_ONELEVELPREVIEW, OneLevelPreview, False);
for i := 0 to Levels.Count-1 do
Levels[i].SaveToINI(ini, Section, Format(fs,[''])+RVINI_LEVELPREFIX+IntToStr(i));
end;
{------------------------------------------------------------------------------}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys. }
procedure TRVListInfo.LoadFromINI(ini: TRVIniFile; const Section, fs: String);
var cnt,i: Integer;
begin
inherited LoadFromINI(ini, Section, fs, RVDEFAULTLISTSTYLENAME);
OneLevelPreview := IniReadBool(ini, Section, RVINI_ONELEVELPREVIEW, False);
cnt := ini.ReadInteger(Section, Format(fs,[RVINI_LEVELSCOUNT]), 0);
for i := 0 to cnt-1 do
Levels.Add.LoadFromINI(ini, Section, Format(fs,[''])+RVINI_LEVELPREFIX+IntToStr(i));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Is at least one of list levels a numbered list? }
function TRVListInfo.HasNumbering: Boolean;
var i: Integer;
begin
Result := False;
for i := 0 to Levels.Count-1 do
if Levels[i].HasNumbering then begin
Result := True;
exit;
end;
end;
{------------------------------------------------------------------------------}
{ Are all list levels numbered lists? }
function TRVListInfo.AllNumbered: Boolean;
var i: Integer;
begin
Result := True;
for i := 0 to Levels.Count-1 do
if not Levels[i].HasNumbering then begin
Result := False;
exit;
end;
end;
{------------------------------------------------------------------------------}
{ Does at least one of list levels have markers of variable width? }
function TRVListInfo.HasVariableWidth: Boolean;
var i: Integer;
begin
Result := False;
for i := 0 to Levels.Count-1 do
if Levels[i].HasVariableWidth then begin
Result := True;
exit;
end;
end;
{============================== TRVListInfos ==================================}
{ READ method for Items[] property.
TODO: to implement InvalidItem, like for other styles. }
function TRVListInfos.GetItem(Index: Integer): TRVListInfo;
begin
Result := TRVListInfo(inherited GetItem(Index));
end;
{------------------------------------------------------------------------------}
{ WRITE method for Items[] property. }
procedure TRVListInfos.SetItem(Index: Integer; const Value: TRVListInfo);
begin
inherited SetItem(Index, Value);
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWDEF4}
{ Inserts a new list style in the collection. This method is added for typecasting. }
function TRVListInfos.Insert(Index: Integer): TRVListInfo;
begin
Result := TRVListInfo(inherited Insert(Index));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Adds a new list style to the collection. This method is added for typecasting. }
function TRVListInfos.Add: TRVListInfo;
begin
Result := TRVListInfo(inherited Add);
end;
{------------------------------------------------------------------------------}
{ Removes all references from list levels to ImageList.
Called from TRVStyle.Notification, when removing ImageList. }
procedure TRVListInfos.RemoveImageList(ImageList: TCustomImageList);
var i, j: Integer;
begin
for i := 0 to Count-1 do
for j := 0 to Items[i].Levels.Count-1 do
if Items[i].Levels[j].FImageList=ImageList then
Items[i].Levels[j].FImageList := nil;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section. }
procedure TRVListInfos.LoadFromINI(ini: TRVIniFile; const Section: String);
var i, cnt: Integer;
begin
cnt := ini.ReadInteger(Section, RVINI_LISTSTYLECOUNT, 0);
Clear;
for i:=0 to cnt-1 do
Add.LoadFromINI(ini, Section, RVINI_LISTSTYLEPREFIX+IntToStr(i));
end;
{------------------------------------------------------------------------------}
{ Stores itself to the ini-file, to the section Section. }
procedure TRVListInfos.SaveToINI(ini: TRVIniFile; const Section: String);
var i: Integer;
begin
ini.WriteInteger(Section,RVINI_LISTSTYLECOUNT, Count);
for i:=0 to Count-1 do
Items[i].SaveToINI(ini, Section, RVINI_LISTSTYLEPREFIX+IntToStr(i));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Searches for the list style equal to Style.
If AddIfNotFound, adds such style (with Standard property = False) to the end
of collection.
ListID properties of list styles are ignored when comparing.
Returns index of the found style (or -1 if not found and not added). }
function TRVListInfos.FindSuchStyle(Style: TRVListInfo; AddIfNotFound: Boolean): Integer;
var i: Integer;
begin
for i:=0 to Count-1 do
if Items[i].IsSimpleEqual(Style, False, True) then begin
Result := i;
exit;
end;
if AddIfNotFound then begin
Add.Assign(Style);
Result := Count-1;
if RichViewResetStandardFlag then
Items[Result].Standard := False;
end
else
Result := -1;
end;
{------------------------------------------------------------------------------}
{ Searches for the list style having levels equal to Levels.
If AddIfNotFound, adds such style (with properties Standard=False;
OneLevelPreview=True; StyleNo=StyleNameForAdding) to the end
of collection.
Returns index of the found style (or -1 if not found and not added). }
function TRVListInfos.FindStyleWithLevels(Levels: TRVListLevelCollection;
const StyleNameForAdding: String; AddIfNotFound: Boolean): Integer;
var i: Integer;
begin
for i:=0 to Count-1 do
if Items[i].Levels.IsSimpleEqual(Levels) then begin
Result := i;
exit;
end;
if AddIfNotFound then begin
Add;
Result := Count-1;
if RichViewResetStandardFlag then
Items[Result].Standard := False;
Items[Result].StyleName := StyleNameForAdding;
Items[Result].OneLevelPreview := True;
Items[Result].Levels := Levels;
end
else
Result := -1;
end;
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
{=============== TRVSTFontInfo, TRVSTParaInfo, TRVSTListInfo ==================}
{ Hiding properties }
procedure TRVSTFontInfo.SetNoProp(const Value: Integer);
begin
raise ERichViewError.Create(errRVInvProp);
end;
{------------------------------------------------------------------------------}
procedure TRVSTParaInfo.SetNoProp(const Value: Integer);
begin
raise ERichViewError.Create(errRVInvProp);
end;
{------------------------------------------------------------------------------}
procedure TRVSTListInfo.SetNoProp(const Value: Integer);
begin
raise ERichViewError.Create(errRVInvProp);
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
{ Allowing designtime editing of subcollections }
function TRVSTFontInfo.GetOwner: TPersistent;
begin
Result := FOwner;
end;
{------------------------------------------------------------------------------}
function TRVSTParaInfo.GetOwner: TPersistent;
begin
Result := FOwner;
end;
{------------------------------------------------------------------------------}
function TRVSTListInfo.GetOwner: TPersistent;
begin
Result := FOwner;
end;
{$ENDIF}
{============================= TRVStyleTemplate ===============================}
{ Constructor }
constructor TRVStyleTemplate.Create(Collection: TCollection);
begin
inherited Create(Collection);
FTextStyle := TRVSTFontInfo.Create(nil);
FParaStyle := TRVSTParaInfo.Create(nil);
FListStyle := TRVSTListInfo.Create(nil);
{$IFDEF RICHVIEWCBDEF3}
FParaStyle.FOwner := Self;
FTextStyle.FOwner := Self;
FListStyle.FOwner := Self;
{$ENDIF}
FParentId := -1;
if (Collection<>nil) and
not ((TRVStyleTemplateCollection(Collection).FOwner<>nil) and
(csLoading in TRVStyle(TRVStyleTemplateCollection(Collection).FOwner).ComponentState)) then
TRVStyleTemplateCollection(Collection).AssignUniqueNameTo(Self);
end;
{------------------------------------------------------------------------------}
{ Destructor }
destructor TRVStyleTemplate.Destroy;
var i: Integer;
begin
if FParent<>nil then
FParent.RemoveChild(Self);
if FChildren<>nil then
for i := 0 to FChildren.Count-1 do
TRVStyleTemplate(FChildren.Items[i]).ParentId := -1;
if (Collection<>nil) and
(TRVStyleTemplateCollection(Collection).FNormalStyleTemplate=Self) then
TRVStyleTemplateCollection(Collection).FNormalStyleTemplate := nil;
FChildren.Free;
FTextStyle.Free;
FParaStyle.Free;
FListStyle.Free;
inherited;
end;
{------------------------------------------------------------------------------}
{ Assigns Source to Self, if Source is TRVStyleTemplate }
procedure TRVStyleTemplate.Assign(Source: TPersistent);
begin
if Source is TRVStyleTemplate then begin
TextStyle := TRVStyleTemplate(Source).TextStyle;
ParaStyle := TRVStyleTemplate(Source).ParaStyle;
// ListStyle := TRVStyleTemplate(Source).ListStyle;
if (Collection<>nil) and (Collection=TRVStyleTemplate(Source).Collection) then
FParentId := TRVStyleTemplate(Source).ParentId;
Name := TRVStyleTemplate(Source).Name;
ValidTextProperties := TRVStyleTemplate(Source).ValidTextProperties;
ValidParaProperties1 := TRVStyleTemplate(Source).ValidParaProperties1;
ValidParaProperties2 := TRVStyleTemplate(Source).ValidParaProperties2;
end
else
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ Allows applying style template to text and paragraph styles using their
Assign method. }
procedure TRVStyleTemplate.AssignTo(Dest: TPersistent);
begin
inherited;
if Dest is TCustomRVFontInfo then
ApplyToTextStyle(TCustomRVFontInfo(Dest), nil, True)
else if Dest is TCustomRVParaInfo then
ApplyToParaStyle(TCustomRVParaInfo(Dest), True);
end;
{------------------------------------------------------------------------------}
{ Assigns valid properties of this style template (and its parents) to ATextStyle.
Only propeties listed in AllowedProps can be changed.
Return value: list of assigned properties. }
function TRVStyleTemplate.AssignToTextStyle(ATextStyle: TCustomRVFontInfo;
AllowedProps: TRVFontInfoProperties): TRVFontInfoProperties;
var Props: TRVFontInfoProperties;
Template: TRVStyleTemplate;
begin
Props := ValidTextProperties;
Result := [];
Template := Self;
while True do begin
Props := Props * AllowedProps;
if Props<>[] then begin
ATextStyle.AssignSelectedProperties(Template.TextStyle, Props);
Result := Result+Props;
end;
Template := Template.FParent;
if Template=nil then
break;
Props := Template.ValidTextProperties-Result;
end;
end;
{------------------------------------------------------------------------------}
{ Applies this style template (and its parents) to ATextStyle.
1) Assigns properties listed in ValidTextProperies of this style template
(and its parents).
if ATextStyle is TFontInfo, then properties listed in
ATextStyle.ModifiedProperties are assigned only if
OverrideModifiedProperties = True.
2) If AParaStyle<>nil and has StyleTemplate, does the
same with the paragraph's style template (but without overriding properties
assigned on the step 1.)
3) If ATextStyle is TFontInfo then
4) If OverrideModifiedProperties = True, excludes the applied properties from
ATextStyle.ModifiedProperties.
5) Reverts other (not applied and not listed in ModifiedProperties)
properties to their default values.
Default values are taken from the style template having name 'Normal'.
If this style template does not exist, RVStyle.TextStyles[0] is used instead.
}
procedure TRVStyleTemplate.ApplyToTextStyle(ATextStyle: TCustomRVFontInfo;
AParaStyle: TCustomRVParaInfo; OverrideModifiedProperties: Boolean);
var AppliedProps, AppliedProps2, DefProps: TRVFontInfoProperties;
Template: TRVStyleTemplate;
Index: Integer;
begin
AppliedProps := RVAllFontInfoProperties;
if not OverrideModifiedProperties and (ATextStyle is TFontInfo) then
AppliedProps := AppliedProps-TFontInfo(ATextStyle).ModifiedProperties;
AppliedProps := AssignToTextStyle(ATextStyle, AppliedProps);
if (AParaStyle<>nil) and (AParaStyle.StyleTemplateId>0) and (Collection<>nil) then begin
Index := TRVStyleTemplateCollection(Collection).FindById(AParaStyle.StyleTemplateId);
if Index>=0 then begin
Template := TRVStyleTemplateCollection(Collection).Items[Index];
AppliedProps2 := RVAllFontInfoProperties-AppliedProps;
if (ATextStyle is TFontInfo) and (TFontInfo(ATextStyle).StyleTemplateId<>Template.Id) then
AppliedProps2 := AppliedProps2-TFontInfo(ATextStyle).ModifiedProperties;
AppliedProps := AppliedProps+Template.AssignToTextStyle(ATextStyle, AppliedProps2);
end;
end;
if ATextStyle is TFontInfo then begin
if OverrideModifiedProperties then begin
TFontInfo(ATextStyle).ModifiedProperties := TFontInfo(ATextStyle).ModifiedProperties-AppliedProps;
TFontInfo(ATextStyle).StyleTemplateId := Id;
end;
DefProps := RVAllFontInfoProperties - AppliedProps - TFontInfo(ATextStyle).ModifiedProperties;
if DefProps=[] then
exit;
if Collection<>nil then
Template := TRVStyleTemplateCollection(Collection).FNormalStyleTemplate
else
Template := nil;
if Template<>nil then
Template.AssignToTextStyle(ATextStyle, DefProps)
else if (Collection<>nil) and
(TRVStyleTemplateCollection(Collection).FOwner<>nil) then
ATextStyle.AssignSelectedProperties(
(TRVStyleTemplateCollection(Collection).FOwner as TRVStyle).TextStyles[0],
DefProps);
end;
end;
{------------------------------------------------------------------------------}
{ Assigns valid properties of this style template (and its parents) to AParaStyle.
Only propeties listed in AllowedProps can be changed.
Return value: list of assigned properties. }
function TRVStyleTemplate.AssignToParaStyle(AParaStyle: TCustomRVParaInfo;
AllowedProps: TRVParaInfoProperties): TRVParaInfoProperties;
var Props: TRVParaInfoProperties;
Template: TRVStyleTemplate;
begin
Props := ValidParaProperties1+ValidParaProperties2;
Result := [];
Template := Self;
while True do begin
Props := Props * AllowedProps;
if (Props<>[]) then begin
AParaStyle.AssignSelectedProperties(Template.ParaStyle, Props);
Result := Result+Props;
end;
Template := Template.FParent;
if Template=nil then
break;
Props := Template.ValidParaProperties1+Template.ValidParaProperties2-Result;
end;
end;
{------------------------------------------------------------------------------}
{ Applies this style template (and its parents) to AParaStyle.
1) Assigns properties listed in ValidParaProperies (1 and 2) of this style template
(and its parents). if AParaStyle is TParaInfo, then properties listed in
AParaStyle.ModifiedProperties (1 and 2) are assigned only if
OverrideModifiedProperties = True.
2) If AParaStyle is TParaInfo then
3) If OverrideModifiedProperties = True, excludes the applied properties from
AParaStyle.ModifiedProperties (1 and 2).
4) Reverts other (not applied and not listed in ModifiedProperties (1 and 2))
properties to their default values.
Default values are taken from the style template having name 'Normal'.
If this style template does not exist, RVStyle.ParaStyles[0] is used instead.
}
procedure TRVStyleTemplate.ApplyToParaStyle(AParaStyle: TCustomRVParaInfo;
OverrideModifiedProperties: Boolean);
var AppliedProps, DefProps: TRVParaInfoProperties;
Template: TRVStyleTemplate;
begin
AppliedProps := RVAllParaInfoProperties;
if not OverrideModifiedProperties and (AParaStyle is TParaInfo) then
AppliedProps := AppliedProps - TParaInfo(AParaStyle).ModifiedProperties1 -
TParaInfo(AParaStyle).ModifiedProperties2;
AppliedProps := AssignToParaStyle(AParaStyle, AppliedProps);
if AParaStyle is TParaInfo then begin
if OverrideModifiedProperties then begin
TParaInfo(AParaStyle).ModifiedProperties1 :=
TParaInfo(AParaStyle).ModifiedProperties1 - (AppliedProps * RVAllParaInfoProperties1);
TParaInfo(AParaStyle).ModifiedProperties2 :=
TParaInfo(AParaStyle).ModifiedProperties2 - (AppliedProps * RVAllParaInfoProperties2);
AParaStyle.StyleTemplateId := Id;
end;
DefProps := RVAllParaInfoProperties - AppliedProps
- TParaInfo(AParaStyle).ModifiedProperties1
- TParaInfo(AParaStyle).ModifiedProperties1;
if DefProps=[] then
exit;
if Collection<>nil then
Template := TRVStyleTemplateCollection(Collection).FNormalStyleTemplate
else
Template := nil;
if Template<>nil then
Template.AssignToParaStyle(AParaStyle, DefProps)
else if (Collection<>nil) and
(TRVStyleTemplateCollection(Collection).FOwner<>nil) then
AParaStyle.AssignSelectedProperties(
(TRVStyleTemplateCollection(Collection).FOwner as TRVStyle).ParaStyles[0],
DefProps);
end;
end;
{------------------------------------------------------------------------------}
{ Checks properties listed in PossibleProps.
If they are in ValidTextProperties of this style template (or its parents),
and their values are equal in ATextStyle and TextStyle property, they are excluded
from ATextStyle.ModifiedProperties. }
procedure TRVStyleTemplate.ExcludeUnmodifiedTextStyleProperties(ATextStyle: TFontInfo;
PossibleProps: TRVFontInfoProperties);
var Template: TRVStyleTemplate;
Props: TRVFontInfoProperties;
begin
Template := Self;
while (PossibleProps<>[]) and (Template<>nil) do begin
Props := PossibleProps * Template.ValidTextProperties;
ATextStyle.ExcludeUnmodifiedProperties(TextStyle, Props);
PossibleProps := PossibleProps - Props;
Template := Template.FParent;
end;
end;
{------------------------------------------------------------------------------}
{ Checks properties listed in PossibleProps.
If they are in ValidParaProperties (-1 or -2) of this style
template (or its parents), and their values are equal in AParaStyle and
ParaStyle property, they are excluded from AParaStyle.ModifiedProperties
(-1 or -2). }
procedure TRVStyleTemplate.ExcludeUnmodifiedParaStyleProperties(AParaStyle: TParaInfo;
PossibleProps: TRVParaInfoProperties);
var Template: TRVStyleTemplate;
Props: TRVParaInfoProperties;
begin
Template := Self;
while (PossibleProps<>[]) and (Template<>nil) do begin
Props := PossibleProps * (Template.ValidParaProperties1+Template.ValidParaProperties2);
AParaStyle.ExcludeUnmodifiedProperties(ParaStyle, Props);
PossibleProps := PossibleProps - Props;
Template := Template.FParent;
end;
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
{ Returns a name of the collection item, for design-time collection editor. }
function TRVStyleTemplate.GetDisplayName: String;
begin
Result := Name;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ READ method for Id property. Value of this property is stored in FId field.
If it's <= 0, it's undefined, and this method generates random value for it.
If this item is inserted in the collection, the generated value is unique. }
function TRVStyleTemplate.GetId: TRVStyleTemplateId;
var i: Integer;
found: Boolean;
begin
if FId<=0 then
repeat
FId := Random(MaxInt);
found := False;
if Collection<>nil then
for i := 0 to Collection.Count-1 do
if (Collection.Items[i]<>Self) and
(FId = TRVStyleTemplate(Collection.Items[i]).Id) then begin
found := True;
break;
end;
until not found;
Result := FId;
end;
{------------------------------------------------------------------------------}
{ WRITE method for ListStyle property }
{
procedure TRVStyleTemplate.SetListStyle(const Value: TRVSTListInfo);
begin
FListStyle.Assign(Value);
end;
}
{------------------------------------------------------------------------------}
{ WRITE method for ParaStyle property }
procedure TRVStyleTemplate.SetParaStyle(const Value: TRVSTParaInfo);
begin
FParaStyle.Assign(Value);
end;
{------------------------------------------------------------------------------}
{ WRITE method for TextStyle property }
procedure TRVStyleTemplate.SetTextStyle(const Value: TRVSTFontInfo);
begin
FTextStyle.Assign(Value);
end;
{------------------------------------------------------------------------------}
{ Overriden to add IDProp pseudo-property }
procedure TRVStyleTemplate.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('IDProp', ReadID, WriteID, True);
end;
{------------------------------------------------------------------------------}
{ READ method for IDProp pseudo-property.
This pseudo-property is used to store Id property (which cannot be stored
by itself, because it's readonly. }
procedure TRVStyleTemplate.ReadID(Reader: TReader);
begin
FId := Reader.ReadInteger;
end;
{------------------------------------------------------------------------------}
{ WRITE method for IDProp pseudo-property. }
procedure TRVStyleTemplate.WriteID(Writer: TWriter);
begin
Writer.WriteInteger(Id);
end;
{------------------------------------------------------------------------------}
{ Adds Child to the FChildren collection. }
procedure TRVStyleTemplate.AddChild(Child: TRVStyleTemplate);
begin
if FChildren=nil then
FChildren := TList.Create;
FChildren.Add(Child);
end;
{------------------------------------------------------------------------------}
{ Removes Child from the FChildren collection. }
procedure TRVStyleTemplate.RemoveChild(Child: TRVStyleTemplate);
begin
if FChildren<>nil then begin
FChildren.Remove(Child);
if FChildren.Count=0 then begin
FChildren.Free;
FChildren := nil;
end;
end;
end;
{------------------------------------------------------------------------------}
{ WRITE method for ParentId property.
If possible, references to parent and children are updated. }
procedure TRVStyleTemplate.SetParentId(const Value: TRVStyleTemplateId);
var CanUpdateReferences: Boolean;
Index: Integer;
begin
if Value=FParentId then
exit;
CanUpdateReferences := (Collection<>nil) and
(TRVStyleTemplateCollection(Collection).FOwner<>nil) and
not (csLoading in (TRVStyleTemplateCollection(Collection).FOwner as TComponent).ComponentState);
if CanUpdateReferences and (ParentId>0) then begin
Index := TRVStyleTemplateCollection(Collection).FindById(ParentId);
if Index>=0 then
TRVStyleTemplateCollection(Collection).Items[Index].RemoveChild(Self);
end;
FParentId := Value;
FParent := nil;
if CanUpdateReferences and (ParentId>0) then begin
Index := TRVStyleTemplateCollection(Collection).FindById(ParentId);
if Index>=0 then begin
FParent := TRVStyleTemplateCollection(Collection).Items[Index];
if IsAncestorFor(FParent) then begin
FParentId := -1;
FParent := nil;
raise ERichViewError.Create(errRVBadStyleTemplateParent);
end;
FParent.AddChild(Self);
end;
end;
end;
{------------------------------------------------------------------------------}
{ WRITE method for Name property.
Maintains TRVStyle.StyleTemplates.FNormalStyleTemplate property. }
procedure TRVStyleTemplate.SetName(const Value: TRVStyleTemplateName);
begin
if Value<>FName then begin
if FName=RVNORMALSTYLETEMPLATENAME then
if (Collection<>nil) and
(TRVStyleTemplateCollection(Collection).FNormalStyleTemplate=Self) then
TRVStyleTemplateCollection(Collection).FNormalStyleTemplate := nil;
FName := Value;
if FName=RVNORMALSTYLETEMPLATENAME then
if (Collection<>nil) then
TRVStyleTemplateCollection(Collection).FNormalStyleTemplate := Self;
end;
end;
{------------------------------------------------------------------------------}
{ Updates references to parent and children. Called from
TRVStyleTemplateCollection.UpdateParentReferences. }
procedure TRVStyleTemplate.UpdateParentReference;
var Index: Integer;
begin
FParent := nil;
if ParentId>0 then begin
Index := TRVStyleTemplateCollection(Collection).FindById(ParentId);
if Index>=0 then begin
FParent := TRVStyleTemplateCollection(Collection).Items[Index];
FParent.AddChild(Self);
end;
end;
end;
{------------------------------------------------------------------------------}
{ Is Self an ancestor for StyleTemplate?
I.e., of Self=StyleTemplate, or Self=StyleTemplate.FParent, or
Self=StyleTemplate.FParent.FParent, etc. }
function TRVStyleTemplate.IsAncestorFor(StyleTemplate: TRVStyleTemplate): Boolean;
var Ancestors: TList;
begin
Result := False;
Ancestors := TList.Create;
try
while StyleTemplate<>nil do begin
if StyleTemplate=Self then begin
Result := True;
break;
end;
Ancestors.Add(StyleTemplate);
StyleTemplate := StyleTemplate.FParent;
if (StyleTemplate<>nil) and (Ancestors.IndexOf(StyleTemplate)>=0) then
StyleTemplate := nil; // exiting circular reference (bad)
end;
finally
Ancestors.Free;
end;
end;
{========================== TRVStyleTemplateCollection ========================}
{ Constructor }
constructor TRVStyleTemplateCollection.Create(Owner: TPersistent);
begin
inherited Create(TRVStyleTemplate);
FOwner := Owner;
FDefStyleName := RVDEFAULTSTYLETEMPLATENAME;
end;
{------------------------------------------------------------------------------}
{ Resets counter used to generate unique item names }
procedure TRVStyleTemplateCollection.ResetNameCounter;
begin
FNameCounter := 0;
end;
{------------------------------------------------------------------------------}
{ Function for comparing names of style templates. Used to sort the collection.
Case sensitive.}
function CompareStyleTemplateNames(Item1, Item2: Pointer): Integer;
begin
Result := AnsiCompareStr(TRVStyleTemplate(Item1).Name,TRVStyleTemplate(Item2).Name);
end;
{------------------------------------------------------------------------------}
{ Sorts items by Name in ascending order, case sensitive }
procedure TRVStyleTemplateCollection.Sort;
var
i: Integer;
List: TList;
begin
List := TList.Create;
try
for i := 0 to Count - 1 do
List.Add(Items[i]);
List.Sort(CompareStyleTemplateNames);
for i := 0 to List.Count - 1 do
TRVStyleTemplate(List.Items[i]).Index := i
finally
List.Free;
end;
end;
{------------------------------------------------------------------------------}
{ Returns the index of the item having the given Id.
If not found, returns -1. }
function TRVStyleTemplateCollection.FindById(Id: TRVStyleTemplateId): Integer;
var i: Integer;
begin
for i := 0 to Count-1 do
if Items[i].Id=Id then begin
Result := i;
exit;
end;
Result := -1;
end;
{------------------------------------------------------------------------------}
{ Returns the index of the item having the given Name (case sensitive)
If not found, returns -1. }
function TRVStyleTemplateCollection.FindByName(const Name: TRVStyleTemplateName): Integer;
var i: Integer;
begin
for i := 0 to Count-1 do
if Items[i].Name=Name then begin
Result := i;
exit;
end;
Result := -1;
end;
{------------------------------------------------------------------------------}
{ The the style template named 'Normal'), or nil if not found. Fast. }
function TRVStyleTemplateCollection.GetNormalStyleTemplate: TRVStyleTemplate;
begin
Result := FNormalStyleTemplate;
end;
{------------------------------------------------------------------------------}
{ Assigns item names to Strings. If AssignObjects=True, then items are assigned
to Strings.Objects. }
procedure TRVStyleTemplateCollection.AssignToStrings(Strings: TStrings;
AssignObjects: Boolean);
var i: Integer;
begin
Strings.BeginUpdate;
try
Strings.Clear;
{$IFDEF RICHVIEWCBDEF3}
Strings.Capacity := Count;
{$ENDIF}
for i := 0 to Count-1 do
if AssignObjects then
Strings.AddObject(Items[i].Name, Items[i])
else
Strings.Add(Items[i].Name);
finally
Strings.EndUpdate;
end;
end;
{------------------------------------------------------------------------------}
{ Assigns Source to Self, if Source is a TRVStyleTemplateCollection. }
procedure TRVStyleTemplateCollection.Assign(Source: TPersistent);
begin
if Source is TRVStyleTemplateCollection then
AssignStyleTemplates(TRVStyleTemplateCollection(Source), False)
else
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ Assigns Source to Self. Two possible modes are possible:
1. CopyIds=True : Id and ParentId properties are copied. Self becomes
the exact copy of Source.
2. CopyIds=False: Id properties are not copied, but ParentId properties
point to items with the same indices as in the Source. }
procedure TRVStyleTemplateCollection.AssignStyleTemplates(
Source: TRVStyleTemplateCollection; CopyIds: Boolean);
var i: Integer;
begin
if Source=Self then
exit;
inherited Assign(Source);
if CopyIDs then begin
for i := 0 to Count-1 do
Items[i].FId := Source.Items[i].Id;
for i := 0 to Count-1 do
Items[i].ParentId := Source.Items[i].ParentId;
end
else begin
for i := 0 to Count-1 do
if Source.Items[i].FParent<>nil then
Items[i].ParentId := Items[Source.Items[i].FParent.Index].Id;
end;
end;
{------------------------------------------------------------------------------}
{ Clears format from ATextStyle:
- if 'Normal' StyleTemplate exists, applies it;
- otherwise assigns the ParaStyle[0] and clears references.
AParaStyle is a style of paragraph where this text is located }
procedure TRVStyleTemplateCollection.ClearTextFormat(ATextStyle: TCustomRVFontInfo;
AParaStyle: TCustomRVParaInfo);
begin
if FNormalStyleTemplate<>nil then
FNormalStyleTemplate.ApplyToTextStyle(ATextStyle, AParaStyle, True)
else if (FOwner<>nil) then begin
ATextStyle.Assign((FOwner as TRVStyle).TextStyles[0]);
if ATextStyle is TFontInfo then begin
TFontInfo(ATextStyle).ModifiedProperties := [];
TFontInfo(ATextStyle).StyleTemplateId := -1;
end;
end;
end;
{------------------------------------------------------------------------------}
{ Clears format from AParaStyle:
- if 'Normal' StyleTemplate exists, applies it;
- otherwise assigns the ParaStyle[0] and clears references. }
procedure TRVStyleTemplateCollection.ClearParaFormat(AParaStyle: TCustomRVParaInfo);
begin
if FNormalStyleTemplate<>nil then
FNormalStyleTemplate.ApplyToParaStyle(AParaStyle, True)
else if (FOwner<>nil) then begin
AParaStyle.Assign((FOwner as TRVStyle).ParaStyles[0]);
if AParaStyle is TParaInfo then begin
TParaInfo(AParaStyle).ModifiedProperties1 := [];
TParaInfo(AParaStyle).ModifiedProperties2 := [];
TParaInfo(AParaStyle).StyleTemplateId := -1;
end;
end;
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
{ Designtime support. Required for the collection editor. }
function TRVStyleTemplateCollection.GetOwner: TPersistent;
begin
Result := FOwner;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ READ method for the property Items[]. }
function TRVStyleTemplateCollection.GetItem(Index: Integer): TRVStyleTemplate;
begin
Result := TRVStyleTemplate(inherited GetItem(Index));
end;
{------------------------------------------------------------------------------}
{ WRITE method for the property Items[]. }
procedure TRVStyleTemplateCollection.SetItem(Index: Integer;
const Value: TRVStyleTemplate);
begin
inherited SetItem(Index, Value);
end;
{------------------------------------------------------------------------------}
{ STORE method for DefStyleName property }
function TRVStyleTemplateCollection.StoreDefStyleName: Boolean;
begin
Result := FDefStyleName<>RVDEFAULTSTYLETEMPLATENAME;
end;
{------------------------------------------------------------------------------}
{ Generates unique style name }
procedure TRVStyleTemplateCollection.AssignUniqueNameTo(Item: TRVStyleTemplate);
var i: Integer;
found: Boolean;
Name: String;
begin
if (Count=1) and (Items[0]=Item) then
FNameCounter := 0;
if FNameCounter=MaxInt then
FNameCounter := 0;
repeat
inc(FNameCounter);
Name := Format(FDefStyleName, [FNameCounter]);
found := False;
for i := 0 to Count-1 do
if (Items[i]<>Item) and (Items[i].Name=Name) then begin
found := True;
break;
end;
until not found;
Item.Name := Name;
end;
{------------------------------------------------------------------------------}
{ Updates references to parent and children of each item.
Normally, references are updated automatically. Updates are deferred only
when loading the collection from stream. }
procedure TRVStyleTemplateCollection.UpdateParentReferences;
var i: Integer;
begin
for i := 0 to Count-1 do
Items[i].UpdateParentReference;
end;
{$ENDIF}
{============================== TRVStyle ======================================}
{ Constructor. Assigns default values to properties. Adds some default items
to TextStyles and ParaStyles.
Loads crJump and crRVFlipArrow cursors. }
constructor TRVStyle.Create(AOwner: TComponent);
var jumpcur : HCURSOR;
const IDC_HAND = MakeIntResource(32649);
begin
inherited Create(AOwner);
jumpcur := LoadCursor(0, IDC_HAND);
if jumpcur=0 then
jumpcur := LoadCursor(hInstance,RVRC_JUMP_CURSOR);
Screen.Cursors[crJump] := jumpcur;
Screen.Cursors[crRVFlipArrow] := LoadCursor(hInstance,RVRC_FLIPARROW_CURSOR);
FSpacesInTab := 0;
FDefTabWidth := 48;
FFullRedraw := False;
FJumpCursor := crJump;
FLineSelectCursor := crRVFlipArrow;
FColor := clWindow;
FHoverColor := clNone;
FCurrentItemColor := clNone;
FSelColor := clHighlight;
FSelTextColor := clHighlightText;
FInactiveSelColor := clHighlight;
FInactiveSelTextColor := clHighlightText;
FCheckpointColor := clGreen;
FCheckpointEvColor := clLime;
FPageBreakColor := clBtnShadow;
FSoftPageBreakColor := clBtnFace;
FLiveSpellingColor := clRed;
FUseSound := True;
FSelectionMode := rvsmWord;
FSelectionStyle := rvssItems;
{$IFNDEF RVDONOTUSEUNICODE}
FDefUnicodeStyle := -1;
FDefCodePage := CP_ACP;
{$ENDIF}
FTextStyles := TFontInfos.Create(GetTextStyleClass, Self);
FParaStyles := TParaInfos.Create(GetParaStyleClass, Self);
FListStyles := TRVListInfos.Create(GetListStyleClass, Self);
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
FStyleTemplates := TRVStyleTemplateCollection.Create(Self);
{$ENDIF}
ResetParaStyles;
ResetTextStyles;
end;
{------------------------------------------------------------------------------}
{ Returns class of item of ParaStyles collection. You can override this method
to add new properties to paragraph style. }
function TRVStyle.GetParaStyleClass: TRVParaInfoClass;
begin
Result := TParaInfo;
end;
{------------------------------------------------------------------------------}
{ Returns class of item of TextStyles collection. You can override this method
to add new properties to text style. }
function TRVStyle.GetTextStyleClass: TRVFontInfoClass;
begin
Result := TFontInfo;
end;
{------------------------------------------------------------------------------}
{ Returns class of item of ListStyles collection. You can override this method
to add new properties to list style. }
function TRVStyle.GetListStyleClass: TRVListInfoClass;
begin
Result := TRVListInfo;
end;
{------------------------------------------------------------------------------}
{ Delphi streaming support (required for D2) }
procedure TRVStyle.ReadState(Reader: TReader);
begin
{$IFNDEF RICHVIEWDEF3}
ParaStyles.Clear;
TextStyles.Clear;
{$ENDIF}
inherited ReadState(Reader);
end;
{------------------------------------------------------------------------------}
{ Destructor. }
destructor TRVStyle.Destroy;
begin
FTextStyles.Free;
FParaStyles.Free;
FListStyles.Free;
FInvalidPicture.Free;
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
FStyleTemplates.Free;
{$ENDIF}
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{ Applies TextStyle[StyleNo] to the Canvas (all properties except for colors).
DefBiDiMode - bi-di mode of paragraph.
CanUseCustomPPI allows using TextStyles.PixelsPerInch property.
This method calls OnApplyStyle event, then (if allowed) TextStyles[StyleNo].Apply
method. }
procedure TRVStyle.ApplyStyle(Canvas: TCanvas; StyleNo: Integer;
DefBiDiMode: TRVBiDiMode; CanUseCustomPPI: Boolean);
var DoDefault: Boolean;
begin
if Assigned(FOnApplyStyle) then begin
DoDefault := True;
FOnApplyStyle(Self, Canvas, StyleNo, DoDefault);
if DoDefault then
FTextStyles[StyleNo].Apply(Canvas, DefBiDiMode, CanUseCustomPPI);
end
else
FTextStyles[StyleNo].Apply(Canvas, DefBiDiMode, CanUseCustomPPI);
end;
{------------------------------------------------------------------------------}
{ Applies colors of TextStyle[StyleNo] to the Canvas.
DrawState defines a state of text (selected, hot, etc.).
This method calls OnApplyStyleColor event, then (if allowed)
TextStyles[StyleNo].ApplyColor method.
Colors are corrected according to the ColorMode.
If Printing, this is a printing or print preview. }
procedure TRVStyle.ApplyStyleColor(Canvas: TCanvas; StyleNo: Integer;
DrawState: TRVTextDrawStates; Printing: Boolean; ColorMode: TRVColorMode);
var DoDefault: Boolean;
begin
if Assigned(FOnApplyStyleColor) then begin
DoDefault := True;
FOnApplyStyleColor(Self, Canvas, StyleNo, DrawState, DoDefault);
if DoDefault then
FTextStyles[StyleNo].ApplyColor(Canvas, Self, DrawState, Printing, ColorMode);
end
else
FTextStyles[StyleNo].ApplyColor(Canvas, Self, DrawState, Printing, ColorMode);
end;
{------------------------------------------------------------------------------}
{ Draws string s on Canvas using TextStyles[StyleNo].
It's assumed that ApplyStyleColor and ApplyStyle were already called.
(RVData, ItemNo, OffsetInItem) specify a location of this string in document.
These properties will be assigned to the corresponding fields of Self (for using
in events).
If TextStyles[StyleNo].Unicode, s must contain a "raw unicode".
Drawing item rectangle is Bounds(Left, Top, Width, Height).
Text position is (Left+SpaceBefore, Top).
DrawState defines a state of text (selected, hot, etc.).
Colors are corrected according to the ColorMode.
If Printing, this is a printing or print preview.
If PreviewCorrection and Printing, this is a print preview that allows correction.
DefBiDiMode - bi-di mode of paragraph.
}
procedure TRVStyle.DrawStyleText(const s: String; Canvas: TCanvas;
ItemNo, OffsetInItem, StyleNo: Integer; RVData: TPersistent;
SpaceBefore, Left, Top, Width, Height: Integer; DrawState: TRVTextDrawStates;
Printing, PreviewCorrection: Boolean; ColorMode: TRVColorMode;
DefBiDiMode: TRVBidiMode);
var DoDefault: Boolean;
begin
if Assigned(FOnDrawStyleText) then begin
DoDefault := True;
Self.ItemNo := ItemNo;
Self.RVData := RVData;
Self.OffsetInItem := OffsetInItem;
FOnDrawStyleText(Self, s, Canvas, StyleNo,
SpaceBefore, Left, Top, Width, Height, DrawState, DoDefault);
if DoDefault then
FTextStyles[StyleNo].Draw(s, Canvas, StyleNo, SpaceBefore, Left, Top, Width, Height,
Self, DrawState, Printing, PreviewCorrection, ColorMode, DefBiDiMode);
end
else
FTextStyles[StyleNo].Draw(s, Canvas, StyleNo, SpaceBefore, Left, Top, Width, Height,
Self, DrawState, Printing, PreviewCorrection, ColorMode, DefBiDiMode);
end;
{------------------------------------------------------------------------------}
{ Does text of TextStyles[StyleNo] require redrawing when mouse moves in/out?
This function checks HoverColors (fore- and background) and calls
OnStyleHoverSensitive event. }
function TRVStyle.StyleHoverSensitive(StyleNo: Integer): Boolean;
begin
Result := (GetHoverColor(StyleNo)<>clNone) or
(FTextStyles[StyleNo].HoverBackColor<>FTextStyles[StyleNo].BackColor);
if Assigned(FOnStyleHoverSensitive) then
FOnStyleHoverSensitive(Self, StyleNo, Result);
end;
{------------------------------------------------------------------------------}
{ Draws text background at Bounds(Left,Top,Width,Height) on Canvas.
This method calls OnDrawTextBackground event. If this event is not processed,
it does nothing (because background is drawn in DrawStyleText).
(RVData, ItemNo) specify position of text item in document.
These properties will be assigned to the corresponding fields of Self
(for using in event).
DrawState defines a state of text (selected, hot, etc.) }
procedure TRVStyle.DrawTextBack(Canvas: TCanvas; ItemNo, StyleNo: Integer;
RVData: TPersistent; Left, Top, Width, Height: Integer;
DrawState: TRVTextDrawStates);
var DoDefault: Boolean;
begin
if Assigned(FOnDrawTextBack) then begin
DoDefault := True;
Self.ItemNo := ItemNo;
Self.RVData := RVData;
FOnDrawTextBack(Self, Canvas, StyleNo, Left, Top, Width, Height, DrawState, DoDefault);
end;
end;
{------------------------------------------------------------------------------}
{ Draw checkpoint on Canvas.
(X,Y) - top left corner of item owning the checkpoint.
XShift specifies a horizontal scrolling position (useful if you want to draw
something on margin rather than relative to the item's X coordinate).
RaiseEvent - property of checkpoint.
Control - TRichView where to draw.
ItemNo - index of item owning this checkpoint.
NOTE: this is old method. When it was created, it was possible to get additional
checkpoint info using Control and ItemNo. TODO: to add RVData parameter.
This method calls OnDrawCheckpoint event. Then (if allowed) draws checkpoint
as a horizontal dotted line with a small circle at (X,Y).
If RaiseEvent, CheckpointEvColor color is used, otherwise CheckpointColor.
}
procedure TRVStyle.DrawCheckpoint(Canvas: TCanvas; X,Y, AreaLeft, Width: Integer;
RVData: TPersistent; ItemNo, XShift: Integer;
RaiseEvent: Boolean; Control: TControl);
var DoDefault: Boolean;
begin
DoDefault := True;
if Assigned(FOnDrawCheckpoint) then begin
Self.RVData := RVData;
Self.ItemNo := ItemNo;
FOnDrawCheckpoint(Self, Canvas, X, Y, ItemNo, XShift, RaiseEvent, Control,
DoDefault);
end;
if DoDefault then begin
Canvas.Pen.Width := 1;
if RaiseEvent then
Canvas.Pen.Color := CheckpointEvColor
else
Canvas.Pen.Color := CheckpointColor;
Canvas.Brush.Style := bsClear;
if ItemNo<>-1 then begin
Canvas.Pen.Style := psSolid;
Canvas.Ellipse(X-2,Y-2, X+2, Y+2);
end;
Canvas.Pen.Style := psDot;
Canvas.MoveTo(AreaLeft-XShift, Y);
Canvas.LineTo(AreaLeft+Width-XShift, Y);
end;
Canvas.Pen.Style := psSolid;
Canvas.Brush.Style := bsClear;
end;
{------------------------------------------------------------------------------}
{ Draws page break on Canvas. Y - vertical coordinate. XShift specifies
a horizontal scrolling. Control is TRichView where to draw.
PageBreakType - type of pagebreak (hard (explicit) or soft (automatic)).
This method calls OnDrawPageBreak event. Then (if allowed) - draws a line
with "dog ear" effect, using PageBreakColor or SoftPageBreakColor. }
procedure TRVStyle.DrawPageBreak(Canvas: TCanvas; Y, XShift: Integer;
PageBreakType: TRVPageBreakType; Control: TControl);
var DoDefault: Boolean;
x: Integer;
const CORNERSIZE=8;
begin
DoDefault := True;
if Assigned(FOnDrawPageBreak) then
FOnDrawPageBreak(Self, Canvas, Y, XShift, PageBreakType, Control, DoDefault);
if DoDefault then begin
if PageBreakType = rvpbPageBreak then
Canvas.Pen.Color := PageBreakColor
else
Canvas.Pen.Color := SoftPageBreakColor;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
x := Control.ClientWidth-XShift-CORNERSIZE;
Canvas.Brush.Color := clWindow;
Canvas.Brush.Style := bsSolid;
Canvas.MoveTo(-XShift,Y);
Canvas.LineTo(X,Y);
Canvas.Polygon([Point(X,Y), Point(X+CORNERSIZE,Y+CORNERSIZE),
Point(X,Y+CORNERSIZE)]);
end;
Canvas.Pen.Style := psSolid;
Canvas.Brush.Style := bsClear;
end;
{------------------------------------------------------------------------------}
{ Draw background of ParaStyles[ParaNo] on Canvas at Rect.
If Printing, this is printing or print preview.
Colors are corrected according to ColorMode.
This method calls OnDrawParaBack event, then (if allowed)
ParaStyles[ParaNo].Background.Draw method.
Note: when calling this method, Self.RVData and Self.ItemNo
(index of the last item of the paragraph) are assigned. }
procedure TRVStyle.DrawParaBack(Canvas: TCanvas; ParaNo: Integer; const Rect: TRect;
Printing: Boolean; ColorMode: TRVColorMode);
var DoDefault: Boolean;
begin
DoDefault := True;
if Assigned(FOnDrawParaBack) then
FOnDrawParaBack(Self, Canvas, ParaNo, Rect, DoDefault);
if DoDefault then
FParaStyles[ParaNo].Background.Draw(Rect, Canvas, Printing, ColorMode);
end;
{------------------------------------------------------------------------------}
{ Clears TextStyles and fills it with default items. }
procedure TRVStyle.ResetTextStyles;
var fi: TFontInfo;
i : Integer;
begin
FTextStyles.Clear;
for i := 0 to LAST_DEFAULT_STYLE_NO do begin
fi := FTextStyles.Add;
case i of
rvsNormal:
begin
fi.StyleName := RVDEFSTYLENAME0;
end;
rvsHeading:
begin
fi.Style := fi.Style + [fsBold];
fi.Color := clBlue;
fi.StyleName := RVDEFSTYLENAME1;
end;
rvsSubheading:
begin
fi.Style := fi.Style + [fsBold];
fi.Color := clNavy;
fi.StyleName := RVDEFSTYLENAME2;
end;
rvsKeyword:
begin
fi.Style := fi.Style + [fsItalic];
fi.Color := clMaroon;
fi.StyleName := RVDEFSTYLENAME3;
end;
rvsJump1, rvsJump2:
begin
fi.Style := fi.Style + [fsUnderline];
fi.Color := clGreen;
fi.Jump := True;
fi.JumpCursor := JumpCursor;
if i=rvsJump1 then
fi.StyleName := RVDEFSTYLENAME4
else
fi.StyleName := RVDEFSTYLENAME5;
end;
end;
end;
end;
{------------------------------------------------------------------------------}
{ Clears ParaStyles and fills it with default items. }
procedure TRVStyle.ResetParaStyles;
begin
FParaStyles.Clear;
FParaStyles.Add;
with FParaStyles.Add as TParaInfo do begin
StyleName := RVDEFPARASTYLENAME1;
Alignment := rvaCenter;
end;
end;
{------------------------------------------------------------------------------}
{ WRITE method for TextStyles property. }
procedure TRVStyle.SetTextStyles(Value: TFontInfos);
begin
if FTextStyles<>Value then
FTextStyles.Assign(Value);
end;
{------------------------------------------------------------------------------}
{ WRITE method for ParaStyles property. }
procedure TRVStyle.SetParaStyles(Value: TParaInfos);
begin
if FParaStyles<>Value then
FParaStyles.Assign(Value);
end;
{------------------------------------------------------------------------------}
{ WRITE method for ListStyles property. }
procedure TRVStyle.SetListStyles(Value: TRVListInfos);
begin
if FListStyles<>Value then
FListStyles.Assign(Value);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
{ WRITE method for StyleTemplates property }
procedure TRVStyle.SetStyleTemplates(const Value: TRVStyleTemplateCollection);
begin
if FStyleTemplates<>Value then
FStyleTemplates.Assign(Value);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Returns "hot" (under mouse) color for the specified Color. }
function TRVStyle.GetHoverColorByColor(Color: TColor): TColor;
begin
if Color<>clNone then
Result := Color
else
Result := HoverColor;
end;
{------------------------------------------------------------------------------}
{ Returns "hot" (under mouse) text color for TextStyle[StyleNo]. }
function TRVStyle.GetHoverColor(StyleNo: Integer): TColor;
begin
if FTextStyles[StyleNo].HoverColor<>clNone then
Result := FTextStyles[StyleNo].HoverColor
else
Result := HoverColor;
end;
{------------------------------------------------------------------------------}
{ (Deprecated) }
function TRVStyle.AddTextStyle: Integer;
begin
FTextStyles.Add;
AddTextStyle := FTextStyles.Count-1;
end;
{------------------------------------------------------------------------------}
{ (Deprecated) }
procedure TRVStyle.DeleteTextStyle(Index: Integer);
begin
FTextStyles[Index].Free;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section. }
procedure TRVStyle.LoadFromINI(ini: TRVIniFile; Section: String);
begin
Color := ini.ReadInteger(Section, RVINI_COLOR, clWindow);
HoverColor := ini.ReadInteger(Section, RVINI_HOVERCOLOR, clNone);
CurrentItemColor := ini.ReadInteger(Section, RVINI_CURRENTITEMCOLOR, clNone);
SelColor := ini.ReadInteger(Section, RVINI_SELCOLOR, clHighlight);
SelTextColor := ini.ReadInteger(Section, RVINI_SELTEXTCOLOR, clHighlightText);
InactiveSelColor := ini.ReadInteger(Section, RVINI_ISELCOLOR, clHighlight);
InactiveSelTextColor := ini.ReadInteger(Section, RVINI_ISELTEXTCOLOR, clHighlightText);
CheckpointColor := ini.ReadInteger(Section, RVINI_CPCOLOR, clGreen);
CheckpointEvColor := ini.ReadInteger(Section, RVINI_CPEVCOLOR, clLime);
PageBreakColor := ini.ReadInteger(Section, RVINI_PAGEBREAKCOLOR, clBtnShadow);
SoftPageBreakColor := ini.ReadInteger(Section, RVINI_SOFTPAGEBREAKCOLOR, clBtnFace);
LiveSpellingColor := ini.ReadInteger(Section, RVINI_LIVESPELLINGCOLOR, clRed);
JumpCursor := ini.ReadInteger(Section, RVINI_JUMPCURSOR, crJump);
UseSound := Boolean(ini.ReadInteger(Section, RVINI_USESOUND, Integer(True)));
SelectionMode := TRVSelectionMode(ini.ReadInteger(Section, RVINI_SELECTIONMODE, ord(rvsmWord)));
SelectionStyle := TRVSelectionStyle(ini.ReadInteger(Section, RVINI_SELECTIONSTYLE, ord(rvssItems)));
SpacesInTab := ini.ReadInteger(Section, RVINI_SPACESINTAB, 0);
DefTabWidth := ini.ReadInteger(Section, RVINI_DEFTABWIDTH, 48);
{$IFNDEF RVDONOTUSEUNICODE}
DefUnicodeStyle := ini.ReadInteger(Section, RVINI_DEFUNICODESTYLE, -1);
DefCodePage := ini.ReadInteger(Section, RVINI_DEFCODEPAGE, CP_ACP);
{$ENDIF}
ParaStyles.LoadFromINI(ini, Section);
TextStyles.LoadFromINI(ini, Section, JumpCursor);
ListStyles.LoadFromINI(ini, Section);
end;
{------------------------------------------------------------------------------}
{ Stores itself to the ini-file, to the section Section.
WARNING: this Section is erased before writing! }
procedure TRVStyle.SaveToINI(ini: TRVIniFile; Section: String);
begin
ini.EraseSection(Section);
WriteIntToIniIfNE(ini, Section, RVINI_COLOR, Color, clWindow);
WriteIntToIniIfNE(ini, Section, RVINI_HOVERCOLOR, HoverColor, clNone);
WriteIntToIniIfNE(ini, Section, RVINI_CURRENTITEMCOLOR, CurrentItemColor, clNone);
WriteIntToIniIfNE(ini, Section, RVINI_SELCOLOR, SelColor, clHighlight);
WriteIntToIniIfNE(ini, Section, RVINI_SELTEXTCOLOR, SelTextColor, clHighlightText);
WriteIntToIniIfNE(ini, Section, RVINI_ISELCOLOR, InactiveSelColor, clHighlight);
WriteIntToIniIfNE(ini, Section, RVINI_ISELTEXTCOLOR, InactiveSelTextColor, clHighlightText);
WriteIntToIniIfNE(ini, Section, RVINI_CPCOLOR, CheckpointColor, clGreen);
WriteIntToIniIfNE(ini, Section, RVINI_CPEVCOLOR, CheckpointEvColor, clLime);
WriteIntToIniIfNE(ini, Section, RVINI_PAGEBREAKCOLOR, PageBreakColor, clBtnShadow);
WriteIntToIniIfNE(ini, Section, RVINI_SOFTPAGEBREAKCOLOR, SoftPageBreakColor, clBtnFace);
WriteIntToIniIfNE(ini, Section, RVINI_LIVESPELLINGCOLOR, LiveSpellingColor, clRed);
WriteIntToIniIfNE(ini, Section, RVINI_JUMPCURSOR, JumpCursor, crJump);
WriteBoolToIniIfNE(ini, Section, RVINI_USESOUND, UseSound, True);
WriteIntToIniIfNE(ini, Section, RVINI_SELECTIONMODE, ord(SelectionMode), ord(rvsmWord));
WriteIntToIniIfNE(ini, Section, RVINI_SELECTIONSTYLE, ord(SelectionStyle), ord(rvssItems));
WriteIntToIniIfNE(ini, Section, RVINI_SPACESINTAB, SpacesInTab, 0);
WriteIntToIniIfNE(ini, Section, RVINI_DEFTABWIDTH, DefTabWidth, 48);
WriteIntToIniIfNE(ini, Section, RVINI_SELECTIONSTYLE, ord(SelectionStyle), ord(rvssItems));
{$IFNDEF RVDONOTUSEUNICODE}
WriteIntToIniIfNE(ini, Section, RVINI_DEFUNICODESTYLE, DefUnicodeStyle, -1);
WriteIntToIniIfNE(ini, Section, RVINI_DEFCODEPAGE, DefCodePage, CP_ACP);
{$ENDIF}
ParaStyles.SaveToINI(ini, Section);
TextStyles.SaveToINI(ini, Section);
ListStyles.SaveToINI(ini, Section);
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file FileName, in the section Section. }
procedure TRVStyle.SaveINI(const FileName, Section: String);
var ini: TIniFile;
begin
ini := TIniFile.Create(FileName);
try
SaveToINI(ini, Section);
finally
ini.Free;
end;
end;
{------------------------------------------------------------------------------}
{ Loads itself from the ini-file FileName, from the section Section. }
procedure TRVStyle.LoadINI(const FileName, Section: String);
var ini: TIniFile;
begin
ini := TIniFile.Create(filename);
try
LoadFromINI(ini, Section);
finally
ini.Free;
end;
end;
{$IFDEF RICHVIEWDEF4}
{------------------------------------------------------------------------------}
{ Loads itself from the Registry, from the key BaseKey"RVStyle". }
procedure TRVStyle.LoadReg(const BaseKey: String);
var ini: TRegistryIniFile;
begin
ini := TRegistryIniFile.Create(BaseKey);
try
LoadFromINI(ini, RVSTYLE_REG);
finally
ini.Free;
end;
end;
{------------------------------------------------------------------------------}
{ Stores itself to the Registry, to the key BaseKey"RVStyle". }
procedure TRVStyle.SaveReg(const BaseKey: String);
var ini: TRegistryIniFile;
begin
ini := TRegistryIniFile.Create(BaseKey);
try
SaveToINI(ini, RVSTYLE_REG);
finally
ini.Free;
end;
end;
{$ENDIF}
{$ENDIF}
{-----------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEHTML}
{-----------------------------------------------------------------------}
{ Exports as CSS (Cascading Style Sheet) file. }
function TRVStyle.SaveCSS(const FileName: String;
AOptions: TRVSaveCSSOptions): Boolean;
var Stream: TFileStream;
begin
Result := True;
try
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveCSSToStream(Stream, AOptions);
finally
Stream.Free;
end;
except
Result := False;
end;
end;
{-----------------------------------------------------------------------}
{ Exports as CSS (Cascading Style Sheet) to the Stream. }
procedure TRVStyle.SaveCSSToStream(Stream: TStream; AOptions: TRVSaveCSSOptions);
var i: Integer;
comments: String;
BaseStyle: TFontInfo;
BaseParaStyle: TParaInfo;
{..................................................}
{$IFNDEF RVDONOTUSELISTS}
(* Reserved for future - when browser will be CSS2 compatible
function GetListTagSequence(ListNo, Level: Integer): String;
var i: Integer;
begin
Result := Format('%s.RVLS%d',
[ListStyles[ListNo].Levels[0].GetHTMLOpenTagForCSS, ListNo]);
with ListStyles[ListNo] do
for i := 1 to Level do
Result := Result+' '+Levels[i].GetHTMLOpenTagForCSS;
end;
{..................................................}
function GetListTypeStr(ListType: TRVListType; Legal: Boolean): String;
begin
case ListType of
rvlstBullet, rvlstPicture, rvlstUnicodeBullet, rvlstImageList:
Result := '';
rvlstLowerAlpha:
Result := 'lower-alpha';
rvlstUpperAlpha:
Result := 'upper-alpha';
rvlstLowerRoman:
Result := 'lower-roman';
rvlstUpperRoman:
Result := 'upper-roman';
else
Result := 'decimal';
end;
if Legal and (Result<>'') then
Result := 'decimal';
end;
{..................................................}
function GetListContentStr(ListNo, Level: Integer): String;
var CountersVal: array [0..255] of TVarRec;
CountersStr: array [0..255] of String;
s: String;
i: Integer;
Legal: Boolean;
begin
for i := 0 to 255 do begin
CountersVal[i].VAnsiString := nil;
CountersVal[i].VType := vtAnsiString;
end;
Legal := rvloLegalStyleNumbering in ListStyles[ListNo].Levels[Level].Options;
for i := 0 to Level do begin
s := GetListTypeStr(ListStyles[ListNo].Levels[i].ListType, Legal and (i<>Level));
if s<>'' then begin
CountersStr[i] := Format(#1' counter(c%dl%d,%s) '#1,[ListNo,i,s]);
CountersVal[i].VAnsiString := PChar(CountersStr[i]);
end
end;
s := Format(ListStyles[ListNo].Levels[Level].FormatString, CountersVal);
repeat
i := Pos(#1#1, s);
if i>0 then
Delete(s, i, 2);
until i = 0;
if Length(s)>0 then begin
if s[1]=#1 then
Delete(s,1,1)
else
s := '"'+s;
if s[Length(s)]=#1 then
Delete(s,Length(s),1)
else
s := s+'"';
end;
for i := 1 to Length(s) do
if s[i]=#1 then
s[i] := '"';
Result := s;
end;
{..................................................}
function GetListContent(ListNo, Level: Integer): String;
var LevelInfo: TRVListLevel;
begin
LevelInfo := ListStyles[ListNo].Levels[Level];
case LevelInfo.ListType of
rvlstUnicodeBullet:
{$IFDEF RICHVIEWCBDEF3}
Result := RVU_GetHTMLEncodedUnicode(RVU_GetRawUnicode(LevelInfo.FFormatStringW), False,False);
{$ELSE}
Result := LevelInfo.FFormatStringW;
{$ENDIF}
rvlstBullet:
Result := LevelInfo.FFormatString;
else
Result := GetListContentStr(ListNo,Level);
end;
end;
*)
{$ENDIF}
{..................................................}
begin
RVWriteLn(Stream, '/* ========== Text Styles ========== */');
RVWriteLn(Stream, 'hr { color: '+RV_GetHTMLRGBStr(FTextStyles[0].Color, False)+'}');
for i:=0 to FTextStyles.Count-1 do
with FTextStyles[i] do begin
if Standard then begin
Comments := Format(' /* %s */', [StyleName]);
if rvcssUTF8 in AOptions then
Comments := RVU_AnsiToUTF8(DefCodePage, Comments);
end
else
Comments := '';
if (i=0) and not Jump and (BackColor=clNone) and
not (rvcssNoDefCSSStyle in AOptions) then
RVWriteLn(Stream, Format('body, table%s', [Comments]))
else if Jump then
RVWriteLn(Stream, Format('a.rvts%d, span.rvts%d%s',[i,i, Comments]))
else
RVWriteLn(Stream, Format('span.rvts%d%s', [i, Comments]));
if (rvcssOnlyDifference in AOptions) and
(BaseStyleNo>=0) and (BaseStyleNo<TextStyles.Count) then
BaseStyle := TextStyles[BaseStyleNo]
else begin
BaseStyle := nil;
if (i>0) and not TextStyles[0].Jump and
(TextStyles[0].BackColor=clNone) and
not (rvcssNoDefCSSStyle in AOptions) then
BaseStyle := TextStyles[0];
end;
RVWriteLn(Stream, '{');
SaveCSSToStream(Stream, BaseStyle, True, rvcssUTF8 in AOptions);
RVWriteLn(Stream, '}');
if Jump and ((GetHoverColorByColor(HoverColor)<>clNone) or (HoverBackColor<>clNone)) then begin
RVWrite(Stream, Format('a.rvts%d:hover {', [i]));
if (((BaseStyle=nil) or not BaseStyle.Jump) and (GetHoverColorByColor(HoverColor)<>clNone)) or
((BaseStyle<>nil) and (GetHoverColorByColor(HoverColor)<>GetHoverColorByColor(BaseStyle.HoverColor))) then
RVWrite(Stream, Format(' color: %s;', [RV_GetHTMLRGBStr(GetHoverColorByColor(HoverColor), False)]));
if (((BaseStyle=nil) or not BaseStyle.Jump) and (HoverBackColor<>clNone)) or
((BaseStyle<>nil) and (HoverBackColor<>BaseStyle.HoverBackColor)) then
RVWrite(Stream, Format(' background-color: %s;', [RV_GetHTMLRGBStr(HoverBackColor, False)]));
RVWriteLn(Stream, ' }');
end;
end;
RVWriteLn(Stream, '/* ========== Para Styles ========== */');
for i:=0 to FParaStyles.Count-1 do
with FParaStyles[i] do begin
if Standard then begin
Comments := Format(' /* %s */', [StyleName]);
if rvcssUTF8 in AOptions then
Comments := RVU_AnsiToUTF8(DefCodePage, Comments);
end
else
Comments := '';
if (i=0) and not (rvcssNoDefCSSStyle in AOptions) then
RVWriteLn(Stream, Format('p,ul,ol%s',[Comments]))
else
RVWriteLn(Stream, Format('.rvps%d%s',[i,Comments]));
if (rvcssOnlyDifference in AOptions) and
(BaseStyleNo>=0) and (BaseStyleNo<ParaStyles.Count) then
BaseParaStyle := ParaStyles[BaseStyleNo]
else begin
if (i>0) and not (rvcssNoDefCSSStyle in AOptions) then
BaseParaStyle := ParaStyles[0]
else
BaseParaStyle := nil;
end;
RVWriteLn(Stream, '{');
SaveCSSToStream(Stream, BaseParaStyle, True,
rvcssIgnoreLeftAlignment in AOptions, False);
RVWriteLn(Stream, '}');
end;
{$IFNDEF RVDONOTUSELISTS}
(*
RVWriteLn(Stream, '/*----------List Styles----------*/');
for i:=0 to FListStyles.Count-1 do
for j:=0 to FListStyles[i].Levels.Count-1 do
with FListStyles[i].Levels[j] do begin
s := GetListTagSequence(i,j);
if j=0 then
descr := Format('/* %s */ ',[FListStyles[i].StyleName])
else
descr := '';
if MarkerIndent>=LeftIndent then
s2 := Format('text-indent: %dpx !important; margin-left !important: %d; list-style:inside;',
[MarkerIndent-LeftIndent, LeftIndent])
else
s2 := Format('text-indent: %dpx !important; margin-left: %d !important; list-style:outside;',
[FirstIndent, LeftIndent]);
RVWriteLn(Stream, Format('%s %s{ %s }', [s, descr, s2]));
end;
*)
(*
RVWriteLn(Stream, '/*----------List Styles----------*/');
for i:=0 to FListStyles.Count-1 do
for j:=0 to FListStyles[i].Levels.Count-1 do
with FListStyles[i].Levels[j] do begin
s := GetListTagSequence(i,j);
if j=0 then
descr := Format('/* %s */ ',[FListStyles[i].StyleName])
else
descr := '';
if HasNumbering then begin
if (rvloLevelReset in Options) then begin
RVWriteLn(Stream, Format('%s %s{ counter-reset: c%dl%d; }', [s, descr, i,j]));
descr := '';
end;
RVWriteLn(Stream, Format('%s > LI %s{ counter-increment: c%dl%d; }', [s, descr, i,j]));
descr := '';
end;
RVWriteLn(Stream, Format('%s > LI:before %s{ content:%s }', [s, descr, GetListContent(i,j)]));
end;
*)
{$ENDIF}
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Adjusting link when removing linked components. }
procedure TRVStyle.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation=opRemove) and (AComponent is TCustomImageList) then
FListStyles.RemoveImageList(TCustomImageList(AComponent));
end;
{------------------------------------------------------------------------------}
procedure TRVStyle.Loaded;
begin
inherited Loaded;
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
StyleTemplates.UpdateParentReferences;
{$ENDIF}
end;
{------------------------------------------------------------------------------}
{ READ method for InvalidPicture property. }
function TRVStyle.GetInvalidPicture: TPicture;
begin
if FInvalidPicture=nil then begin
FInvalidPicture := TPicture.Create;
FInvalidPicture.Bitmap.Handle := LoadBitmap(hInstance, 'RV_BAD_PICTURE');
end;
Result := FInvalidPicture;
end;
{------------------------------------------------------------------------------}
{ Write method for InvalidPicture property. }
procedure TRVStyle.SetInvalidPicture(const Value: TPicture);
begin
if Value=nil then begin
FInvalidPicture.Free;
FInvalidPicture := nil;
exit;
end;
if FInvalidPicture=Value then
exit;
if FInvalidPicture=nil then
FInvalidPicture := TPicture.Create;
FInvalidPicture.Assign(Value);
end;
{------------------------------------------------------------------------------}
{ Returns the next tabstop after X. X is measured from the very left
of document, including the left margin.
The following values are returned: Position (from the very left), Align, Leader.
LeftIndent and RightIndent are values of LeftIndent and RightIndent. They are
in the target device resolution. sad specifies the resolution of target device.
DefBiDiMode - bi-di mode of document (some corrections are done for RTL paragraphs).
How it works:
- first it searches in ParaStyles[ParaNo].Tabs[].Positions; LeftIndent is also
treated as a tabstop (RightIndent for RTL paragraphs).
- if not found, it calculates position using DefTabWidth property.
}
procedure TRVStyle.GetNextTab(ParaNo, X: Integer; sad: TRVScreenAndDevice;
var Position: Integer; var Leader: String; var Align: TRVTabAlign;
DefBiDiMode: TRVBiDiMode; LeftIndent, RightIndent: Integer);
var
{$IFNDEF RVDONOTUSETABS}
Tabs: TRVTabInfos;
Pos, Indent, i: Integer;
Found: Boolean;
{$ENDIF}
dtw: Integer;
begin
if DefBiDiMode=rvbdUnspecified then
DefBiDiMode := ParaStyles[ParaNo].BiDiMode;
dec(X, sad.LeftMargin);
if (DefBiDiMode=rvbdRightToLeft) then begin
inc(X,RightIndent);
dec(X,LeftIndent);
{$IFNDEF RVDONOTUSETABS}
Indent := RightIndent;
{$ENDIF}
end
{$IFNDEF RVDONOTUSETABS}
else
Indent := LeftIndent
{$ENDIF};
{$IFNDEF RVDONOTUSETABS}
Tabs := ParaStyles[ParaNo].Tabs;
for i := 0 to Tabs.Count-1 do begin
Found := False;
Pos := RV_XToDevice(Tabs[i].Position, sad);
if (Indent>X) and (Indent<Pos) then begin
Found := True;
Position := Indent+sad.LeftMargin;
Leader := '';
Align := rvtaLeft;
end
else if Pos>X then begin
Found := True;
Position := Pos+sad.LeftMargin;
Leader := Tabs[i].Leader;
Align := Tabs[i].Align;
end;
if Found then begin
if DefBiDiMode=rvbdRightToLeft then begin
dec(Position,RightIndent);
inc(Position,LeftIndent);
end;
exit;
end;
end;
if (Indent>X) and
((Tabs.Count=0) or (Indent>RV_XToDevice(Tabs[Tabs.Count-1].Position, sad))) then begin
Position := Indent+sad.LeftMargin;
Leader := '';
Align := rvtaLeft;
if (DefBiDiMode=rvbdRightToLeft) then begin
dec(Position,RightIndent);
inc(Position,LeftIndent);
end;
exit;
end;
{$ENDIF}
dtw := DefTabWidth;
if dtw<=0 then
dtw := 1;
dtw := RV_XToDevice(dtw, sad);
Position := ((X+dtw) div dtw)*dtw+sad.LeftMargin;
if (DefBiDiMode=rvbdRightToLeft) then begin
dec(Position,RightIndent);
inc(Position,LeftIndent);
end;
Align := rvtaLeft;
Leader := '';
end;
{==============================================================================}
{ Writes s to Stream. }
procedure RVWrite(Stream: TStream; const s: String);
begin
Stream.WriteBuffer(PChar(s)^, Length(s));
end;
{-----------------------------------------------------------------------}
{ Writes s+line break to Stream }
procedure RVWriteLn(Stream: TStream; const s: String);
var crlf: String;
begin
Stream.WriteBuffer(PChar(s)^, Length(s));
crlf := #13#10;
Stream.WriteBuffer(PChar(crlf)^, 2);
end;
{-----------------------------------------------------------------------}
{ Writes s to Stream. If Multiline, writes line break after it. }
procedure RVWriteX(Stream: TStream; const s: String; Multiline: Boolean);
var crlf: String;
begin
Stream.WriteBuffer(PChar(s)^, Length(s));
if Multiline then begin
crlf := #13#10;
Stream.WriteBuffer(PChar(crlf)^, 2);
end;
end;
end.