RichEdit

开发平台：

Delphi

RVStyle.pas：源码内容

else
Canvas.Font.Color := clWhite;
end
else if RV_GetLuminance(RV_GetPrnColor(BackColor))>RV_GetLuminance(RV_GetPrnColor(Color)) then begin
Canvas.Brush.Color := clWhite;
Canvas.Font.Color := clBlack;
end
else begin
Canvas.Brush.Color := clBlack;
Canvas.Font.Color := clWhite;
end;
end;
rvcmBlackOnWhite:
begin
Canvas.Font.Color := clBlack;
Canvas.Brush.Color := clNone;
end;
end;
end;
if Canvas.Brush.Color=clNone then
Canvas.Brush.Style := bsClear
else
Canvas.Brush.Style := bsSolid;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
const IniProtectMask = $3FF;
{ Loads properties from the ini-file, from the section Section.
fs is a format string for keys, it is like 'Font%s1', 'Font%s2', etc.
DefName is a default style name.
JumpByDefault - for backward compatibility, defines if this style should be
hypertext if this is not explicitly specified in the ini-file.
DefJumpCursor - hypertext cursor assigned to this style if, if another
cursor is not specified in the ini-file explicitly.
}
procedure TCustomRVFontInfo.LoadFromINI(ini: TRVIniFile; const Section,
fs: String; JumpByDefault: Boolean; DefJumpCursor: TCursor);
var s: String;
pr: Word;
begin
inherited LoadFromINI(ini, Section, fs, RVDEFAULTTEXTSTYLENAME);
FontName := ini.ReadString (Section, Format(fs,[RVINI_FONTNAME]), RVDEFAULTSTYLEFONT);
s := UpperCase(ini.ReadString(Section, Format(fs,[RVINI_JUMP]), RVINIUNKNOWN));
if (s=RVINIUNKNOWN) then begin // for compatibility with old saving format
Jump := JumpByDefault;
JumpCursor := DefJumpCursor;
end
else begin
Jump := (s=RVINIFILEYESU);
JumpCursor := ini.ReadInteger(Section, Format(fs,[RVINI_JUMPCURSOR]), crJump);
end;
Size := ini.ReadInteger(Section, Format(fs,[RVINI_SIZE]), 10);
Color := ini.ReadInteger(Section, Format(fs,[RVINI_COLOR]), clWindowText);
BackColor := ini.ReadInteger(Section, Format(fs,[RVINI_BACKCOLOR]), clNone);
HoverBackColor := ini.ReadInteger(Section, Format(fs,[RVINI_HOVERBACKCOLOR]), clNone);
HoverColor := ini.ReadInteger(Section, Format(fs,[RVINI_HOVERCOLOR]), clNone);
{$IFDEF RICHVIEWCBDEF3}
Charset := ini.ReadInteger(Section, Format(fs,[RVINI_CHARSET]), DEFAULT_CHARSET);
{$ENDIF}
{$IFDEF RVLANGUAGEPROPERTY}
Language := ini.ReadInteger(Section, Format(fs,[RVINI_LANGUAGE]), 0);
{$ENDIF}
CharScale := ini.ReadInteger(Section, Format(fs,[RVINI_CHARSCALE]), 100);
CharSpacing := ini.ReadInteger(Section, Format(fs,[RVINI_CHARSPACING]), 0);
BiDiMode := TRVBiDiMode(ini.ReadInteger(Section, Format(fs,[RVINI_BIDIMODE]), 0));
Style := [];
if IniReadBool(ini, Section, Format(fs,[RVINI_BOLD]), False) then
Include(FStyle, fsBold);
if IniReadBool(ini, Section, Format(fs,[RVINI_UNDERLINE]), False) then
Include(FStyle, fsUnderline);
if IniReadBool(ini, Section, Format(fs,[RVINI_STRIKEOUT]), False) then
Include(FStyle, fsStrikeOut);
if IniReadBool(ini, Section, Format(fs,[RVINI_ITALIC]), False) then
Include(FStyle, fsItalic);
StyleEx := [];
if IniReadBool(ini, Section, Format(fs,[RVINI_OVERLINE]), False) then
Include(FStyleEx, rvfsOverline);
if IniReadBool(ini, Section, Format(fs,[RVINI_ALLCAPS]), False) then
Include(FStyleEx, rvfsAllCaps);
FOptions := [];
if IniReadBool(ini, Section, Format(fs,[RVINI_RTFCODE]), False) then
Include(FOptions, rvteoRTFCode);
if IniReadBool(ini, Section, Format(fs,[RVINI_HTMLCODE]), False) then
Include(FOptions, rvteoHTMLCode);
pr := ini.ReadInteger(Section, Format(fs,[RVINI_PROTECTION]), 0) and IniProtectMask;
Protection := TRVProtectOptions(pr);
if iniReadBool(ini, Section, Format(fs,[RVINI_SINGLESYMBOLS]), False) then begin
Include(FProtection, rvprStyleProtect);
Include(FProtection, rvprDoNotAutoSwitch);
end;
VShift := ini.ReadInteger(Section, Format(fs,[RVINI_VSHIFT]), 0);
end;
{------------------------------------------------------------------------------}
{ Saves properties to the ini-file, to the section Section.
fs is a format string for keys, it is like 'Font%s1', 'Font%s2', etc. }
procedure TCustomRVFontInfo.SaveToINI(ini: TRVIniFile; const Section, fs: String);
begin
inherited SaveToINI(ini, Section, fs);
ini.WriteString(Section, Format(fs,[RVINI_FONTNAME]), FontName);
ini.WriteString(Section, Format(fs,[RVINI_JUMP]), arrNoYes[Jump]);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_SIZE]), Size, 10);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_COLOR]), Color, clWindowText);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_BACKCOLOR]), BackColor, clNone);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_HOVERBACKCOLOR]), HoverBackColor, clNone);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_HOVERCOLOR]), HoverColor, clNone);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_JUMPCURSOR]), JumpCursor, crJump);
{$IFDEF RICHVIEWCBDEF3}
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_CHARSET]), Charset, DEFAULT_CHARSET);
{$ENDIF}
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_CHARSCALE]), CharScale, 100);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_CHARSPACING]), CharSpacing, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_BiDiMode]), ord(BiDiMode), 0);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_BOLD]), fsBold in Style, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_UNDERLINE]), fsUnderline in Style, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_STRIKEOUT]), fsStrikeOut in Style, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_ITALIC]), fsItalic in Style, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_OVERLINE]), rvfsOverline in StyleEx, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_ALLCAPS]), rvfsAllCaps in StyleEx, False);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_PROTECTION]), Word(Protection) and IniProtectMask, 0);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_RTFCODE]), rvteoRTFCode in Options, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_HTMLCODE]), rvteoHTMLCode in Options, False);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_VSHIFT]), VShift, 0);
{$IFDEF RVLANGUAGEPROPERTY}
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_LANGUAGE]),Language,0);
{$ENDIF}
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Saves this text style as a part of CSS to the Stream.
if BaseStyle<>nil, only a difference between this style and BaseStyle is
saved.
If Multiline=False, all text will be written on a single line. }
procedure TCustomRVFontInfo.SaveCSSToStream(Stream: TStream; BaseStyle: TCustomRVFontInfo;
Multiline, UTF8: Boolean);
const
cssFontStyle : array[Boolean] of String = ('normal','italic');
cssFontWeight : array[Boolean] of String = ('normal','bold');
{..................................................}
function GetTextDecoration(Style: TFontStyles; StyleEx: TRVFontStyles;
Jump: Boolean): String;
{.................................}
procedure AddVal(Condition: Boolean; var s: String; const Value: String);
begin
if Condition then begin
if s<>'' then
s := s+' ';
s := s+Value;
end;
end;
{.................................}
begin
Result := '';
AddVal(fsUnderline in Style, Result, 'underline');
AddVal(fsStrikeOut in Style, Result, 'line-through');
AddVal(rvfsOverline in StyleEx, Result, 'overline');
if Result='' then
Result := 'none'
end;
{..................................................}
function GetTextVAlign(VShift: Integer): String;
begin
if VShift>0 then
Result := 'super'
else if VShift<0 then
Result := 'sub'
else
Result := '';
end;
{..................................................}
function GetHoverColor(Color: TColor): TColor;
begin
if Color=clNone then
Result := HoverColor
else
Result := Color;
end;
{..................................................}
var s: String;
begin
if (BaseStyle=nil) or (BaseStyle.Size<>Size) then
RVWriteX(Stream, Format(' font-size: %dpt;',[Size]), Multiline);
if (BaseStyle=nil) or (AnsiCompareText(BaseStyle.FontName, FontName)<>0) then begin
s := ''''+FontName+'''';
if UTF8 then
s := RVU_AnsiToUTF8(CP_ACP, s);
if AnsiCompareText(FontName, RVFONT_SYMBOL)=0 then
s := '''Arial Unicode MS'', ''Lucida Sans Unicode'', ''Arial''';
RVWriteX(Stream, Format(' font-family: %s;',[s]), Multiline);
end;
if (BaseStyle=nil) or ((fsItalic in BaseStyle.Style)<>(fsItalic in Style)) then
RVWriteX(Stream, Format(' font-style: %s;',[cssFontStyle[fsItalic in Style]]),
Multiline);
if (BaseStyle=nil) or ((fsBold in BaseStyle.Style)<>(fsBold in Style)) then
RVWriteX(Stream, Format(' font-weight: %s;',[cssFontWeight[fsBold in Style]]),
Multiline);
if (BaseStyle=nil) or (BaseStyle.Color<>Color) then
RVWriteX(Stream, Format(' color: %s;',[RV_GetHTMLRGBStr(Color, False)]), Multiline);
if ((BaseStyle=nil) and (CharSpacing<>0)) or
((BaseStyle<>nil) and (BaseStyle.CharSpacing<>CharSpacing)) then
RVWriteX(Stream, Format(' letter-spacing: %dpx;',[CharSpacing]), Multiline);
if (rvfsAllCaps in StyleEx) then begin
if (BaseStyle=nil) or not (rvfsAllCaps in BaseStyle.StyleEx) then
RVWriteX(Stream, ' text-transform: uppercase;', Multiline);
end
else if (BaseStyle<>nil) and (rvfsAllCaps in BaseStyle.StyleEx) then
RVWriteX(Stream, ' text-transform: none;', Multiline);
if ((BaseStyle=nil) and ((BackColor<>clNone) or not Multiline)) or
((BaseStyle<>nil) and (BaseStyle.BackColor<>BackColor)) then
RVWriteX(Stream, Format(' background-color: %s;',[RV_GetCSSBkColor(BackColor)]),
Multiline);
s := GetTextVAlign(VShift);
if ((BaseStyle=nil) and (s<>'')) or
((BaseStyle<>nil) and (s<>GetTextVAlign(BaseStyle.VShift))) then
RVWriteX(Stream, Format(' vertical-align: %s;',[s]), Multiline);
s := GetTextDecoration(Style,StyleEx,Jump);
if (BaseStyle=nil) or
(s<>GetTextDecoration(BaseStyle.Style,BaseStyle.StyleEx,BaseStyle.Jump))
or (Jump and (s='none')) then
RVWriteX(Stream, Format(' text-decoration: %s;',[s]), Multiline);
end;
{------------------------------------------------------------------------------}
{ Method for backward compatibility:
allows loading the deleted SingleSymbols property. }
procedure TCustomRVFontInfo.DefineProperties(Filer: TFiler);
begin
Filer.DefineProperty(RVINI_SINGLESYMBOLS, SingleSymbolsReader, nil, False);
end;
{------------------------------------------------------------------------------}
{ Method for backward compatibility:
loads the deleted SingleSymbols property as [rvprStyleProtect, rvprDoNotAutoSwitch]
Protection options. }
procedure TCustomRVFontInfo.SingleSymbolsReader(reader: TReader);
var ss: Boolean;
begin
ss := reader.ReadBoolean;
if ss then begin
Include(FProtection, rvprStyleProtect);
Include(FProtection, rvprDoNotAutoSwitch);
end;
end;
{================================= TFontInfo ==================================}
{ Constructor }
constructor TFontInfo.Create(Collection: TCollection);
begin
inherited Create(Collection);
FNextStyleNo := -1;
end;
{------------------------------------------------------------------------------}
procedure TFontInfo.Assign(Source: TPersistent);
begin
if Source is TFontInfo then begin
FNextStyleNo:= TFontInfo(Source).FNextStyleNo;
{$IFNDEF RVDONOTUSEUNICODE}
FUnicode := TFontInfo(Source).FUnicode;
{$ENDIF}
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
FModifiedProperties := TFontInfo(Source).FModifiedProperties;
{$ENDIF}
end;
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ Is this item equal to Value (all properties are equal)?
NextStyleNo property (adjusted using Mapping) is taken into account.
Mapping is from the Value's collection to this collection, see
TCustomRVInfos.MergeWith.
}
function TFontInfo.IsSimpleEqualEx(Value: TCustomRVInfo; Mapping: TRVIntegerList): Boolean;
begin
Result := IsSimpleEqual(Value, True, False);
if not Result then
exit;
if Value is TFontInfo then begin
Result := False;
if (TFontInfo(Value).NextStyleNo>=0) then begin
if (TFontInfo(Value).NextStyleNo>=Mapping.Count) then
TFontInfo(Value).NextStyleNo := -1 // fix up
else if (Mapping[TFontInfo(Value).NextStyleNo]<>NextStyleNo) then
exit;
end;
Result := True;
end;
end;
{------------------------------------------------------------------------------}
{ Is this item equal to Value (all properties are equal)?
if IgnoreReferences=True, NextStyleNo property is ignored, otherwise they
must be equal.
IgnoreID is not used (used only in TRVListInfo). }
function TFontInfo.IsSimpleEqual(Value: TCustomRVInfo; IgnoreReferences: Boolean;
IgnoreID: Boolean{$IFDEF RICHVIEWDEF4}=True{$ENDIF}): Boolean;
begin
Result := inherited IsSimpleEqual(Value, IgnoreReferences, IgnoreID);
if Result and (Value is TFontInfo) then begin
Result :=
{$IFNDEF RVDONOTUSEUNICODE}
(Unicode = TFontInfo(Value).Unicode) and
{$ENDIF}
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
(ModifiedProperties = TFontInfo(Value).ModifiedProperties) and
(StyleTemplateID = TFontInfo(Value).StyleTemplateID) and
{$ENDIF}
(IgnoreReferences or (NextStyleNo = TFontInfo(Value).NextStyleNo));
end;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
{ Checks all properties listed in PossibleProps. If they are equal in Self and
Source, exclude them in Self.ModifiedProperties }
procedure TFontInfo.ExcludeUnmodifiedProperties(
Source: TCustomRVFontInfo; PossibleProps: TRVFontInfoProperties);
{.............................................................}
procedure ChangeFontStyle(FontStyle: TFontStyle; TextPropId: TRVFontInfoProperty);
begin
if (TextPropId in PossibleProps) and
((FontStyle in Style)=(FontStyle in Source.Style)) then
Exclude(FModifiedProperties, TextPropId);
end;
{.............................................................}
procedure ChangeFontStyleEx(FontStyle: TRVFontStyle; TextPropId: TRVFontInfoProperty);
begin
if (TextPropId in PossibleProps) and
((FontStyle in StyleEx)=(FontStyle in Source.StyleEx)) then
Exclude(FModifiedProperties, TextPropId);
end;
{.............................................................}
procedure ChangeTextOption(TextOption: TRVTextOption; TextOptionId: TRVFontInfoProperty);
begin
if (TextOptionId in PossibleProps) and
((TextOption in Options)=(TextOption in Source.Options)) then
Exclude(FModifiedProperties, TextOptionId);
end;
{.............................................................}
begin
if (rvfiFontName in PossibleProps) and not (rvfiFontName in ModifiedProperties) and
(CompareText(FontName , Source.FontName)=0) then
Exclude(FModifiedProperties, rvfiFontName);
if (rvfiSize in PossibleProps) and (Size=Source.Size) then
Exclude(FModifiedProperties, rvfiSize);
{$IFDEF RICHVIEWCBDEF3}
if (rvfiCharset in PossibleProps) and (Charset=Source.Charset) then
Exclude(FModifiedProperties, rvfiCharset);
{$ENDIF}
ChangeFontStyle(fsBold, rvfiBold);
ChangeFontStyle(fsItalic, rvfiItalic);
ChangeFontStyle(fsUnderline, rvfiUnderline);
ChangeFontStyle(fsStrikeOut, rvfiStrikeOut);
ChangeFontStyleEx(rvfsOverline, rvfiOverline);
ChangeFontStyleEx(rvfsAllCaps, rvfiAllCaps);
if (rvfiVShift in PossibleProps) and (VShift = Source.VShift) then
Exclude(FModifiedProperties, rvfiVShift);
if (rvfiColor in PossibleProps) and (Color = Source.Color) then
Exclude(FModifiedProperties, rvfiColor);
if (rvfiBackColor in PossibleProps) and (BackColor = Source.BackColor) then
Exclude(FModifiedProperties, rvfiBackColor);
if (rvfiHoverColor in PossibleProps) and (HoverColor = Source.HoverColor) then
Exclude(FModifiedProperties, rvfiHoverColor);
if (rvfiHoverBackColor in PossibleProps) and (HoverBackColor = Source.HoverBackColor) then
Exclude(FModifiedProperties, rvfiHoverBackColor);
if (rvfiJump in PossibleProps) and (Jump = Source.Jump) then
Exclude(FModifiedProperties, rvfiJump);
if (rvfiJumpCursor in PossibleProps) and (JumpCursor = Source.JumpCursor) then
Exclude(FModifiedProperties, rvfiJumpCursor);
if (rvfiProtection in PossibleProps) and (Protection = Source.Protection) then
Exclude(FModifiedProperties, rvfiProtection);
if (rvfiCharScale in PossibleProps) and (CharScale = Source.CharScale) then
Exclude(FModifiedProperties, rvfiCharScale);
if (rvfiBiDiMode in PossibleProps) and (BiDiMode = Source.BiDiMode) then
Exclude(FModifiedProperties, rvfiBiDiMode);
if (rvfiCharSpacing in PossibleProps) and (CharSpacing = Source.CharSpacing) then
Exclude(FModifiedProperties, rvfiCharSpacing);
ChangeTextOption(rvteoHTMLCode, rvfiHTMLCode);
ChangeTextOption(rvteoRTFCode, rvfiRTFCode);
{$IFDEF RVLANGUAGEPROPERTY}
if (rvfiLanguage in PossibleProps) and (Language=Source.Language) then
Exclude(FModifiedProperties, rvfiLanguage);
{$ENDIF}
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Is this item equal to Value?
Equality is determined by comparing all properties NOT included in IgnoreList. }
function TFontInfo.IsEqual(Value: TCustomRVFontInfo;
IgnoreList: TRVFontInfoProperties): Boolean;
begin
Result := inherited IsEqual(Value, IgnoreList);
if Result and (Value is TFontInfo) then begin
Result :=
{$IFNDEF RVDONOTUSEUNICODE}
((rvfiUnicode in IgnoreList) or (Unicode = TFontInfo(Value).Unicode )) and
{$ENDIF}
((rvfiNextStyleNo in IgnoreList) or (NextStyleNo = TFontInfo(Value).NextStyleNo))
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
and
(StyleTemplateId=Value.StyleTemplateId) and
(ModifiedProperties=TFontInfo(Value).ModifiedProperties)
{$ENDIF}
;
end;
end;
{------------------------------------------------------------------------------}
{ Workaround for incorrect headers in D2-D6 }
type
{$IFDEF RICHVIEWDEF7}
{$IFDEF RICHVIEWDEF9}
TGetCharacterPlacementVal = LongBool;
{$ELSE}
TGetCharacterPlacementVal = Integer;
{$ENDIF}
{$ELSE}
TGetCharacterPlacementVal = LongBool;
{$ENDIF}
const
GETCHARACTERPLACEMENTFLAGS = GCP_DIACRITIC or GCP_GLYPHSHAPE or {GCP_USEKERNING or }GCP_REORDER;
{ Draws the string s onto the Canvas.
For Unicode text, s contains "raw Unicode".
Item occupies the rectangle Bounds(Left, Top, Width, Height), text is started
at the position (Left+SpaceBefore, Top). SpaceBefore can be positive in
justify-aligned paragraphs.
This item is RVStyle.TextStyles[ThisStyleNo].
DefBiDiMode is a bi-di mode of the paragraph containing this item.
Printing is True if this is printing/print preview.
PreviewCorrection is True if this is a print preview requiring correction.
ColorMode is used to adjust colors.
Notes:
- if (BiDiMode is unspecified) and Printing and PreviewCorrection, a special
procedure is used: it adjusts character positions to fit the required text
width (Width-SpaceBefore), see PrintText(..., True);
- if (BiDiMode is unspecified) and Printing and not PreviewCorrection and
(CharExtra<>0) a special procedure is used to apply CharExtra (because
some printers ignore direct setting), see PrintText(..., False)
- this procedure draws dots (#$B7/#$B0) in place of spaces/nonbreaking spaces,
if rvtsSpecialCharacters is in DrawState, see DrawDots.
}
procedure TFontInfo.Draw(const s: String; Canvas: TCanvas; ThisStyleNo: Integer;
SpaceBefore, Left, Top, Width, Height: Integer; RVStyle: TRVStyle;
DrawState: TRVTextDrawStates; Printing, PreviewCorrection: Boolean;
ColorMode: TRVColorMode; DefBiDiMode: TRVBiDiMode);
{......................................................}
function PrintText(Spacing: Integer; AutoCalcSpacing: Boolean): Boolean;
var PDx: PRVIntegerArray;
Dummy: Integer;
ItemOptions: TRVItemOptions;
i, Len, w,w2,l: Integer;
begin
Result := True;
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode then begin
ItemOptions := [rvioUnicode];
Len := Length(s) div 2;
end
else
{$ENDIF}
begin
ItemOptions := [];
Len := Length(s);
end;
if Len<2 then begin
Result := False;
exit;
end;
GetMem(PDx, (Len+1)*sizeof(Integer));
try
RVU_GetTextExtentExPoint(Canvas, s, Width*2, Dummy, PDx, ItemOptions);
for i := Len-1 downto 1 do
dec(PDx[i], PDx[i-1]);
if not AutoCalcSpacing then begin
for i := 0 to Len-1 do
inc(PDx[i], Spacing);
end
else begin
w := RVU_TextWidth(s, Canvas, ItemOptions);
if w=Width-SpaceBefore then begin
Result := False;
exit;
end;
w := Width-SpaceBefore-w;
l := Len;
for i := 0 to Len-1 do begin
if w=0 then
break;
if l=0 then
w2 := w
else
w2 := w div l;
inc(PDx[i], w2);
dec(w,w2);
dec(l);
end;
end;
{$IFDEF RVDONOTUSEUNICODE}
ExtTextOutA(Canvas.Handle, Left+SpaceBefore, Top, 0, nil, Pointer(s), Len, Pointer(PDx));
{$ELSE}
if not Unicode then
ExtTextOutA(Canvas.Handle, Left+SpaceBefore, Top, 0, nil, Pointer(s), Len, Pointer(PDx))
else
ExtTextOutW(Canvas.Handle, Left+SpaceBefore, Top, 0, nil, Pointer(s), Len, Pointer(PDx));
{$ENDIF}
finally
FreeMem(PDx);
end;
end;
{......................................................}
procedure DrawDots;
var res: TGCPResults;
i, Len, Spacing, X: Integer;
POrder,POrderRev: PRVUnsignedArray;
PDX: PRVIntegerArray;
ok: Boolean;
ItemOptions: TRVItemOptions;
wb7,wb0, spshift, nbspshift: Integer;
{. . . . . . . . . . . . . . . . . . . . . . . . . . .}
procedure DrawDot(var w, shift: Integer; sp, dot: Char);
var BrushColor: TColor;
BrushStyle: TBrushStyle;
begin
if w=0 then begin
w := Canvas.TextWidth(dot);
shift := Round((Canvas.TextWidth(sp)-w)/2);
end;
BrushColor := Canvas.Brush.Color;
BrushStyle := Canvas.Brush.Style;
Canvas.Brush.Style := bsClear;
Canvas.TextOut(Left+shift, Top, dot);
Canvas.Brush.Style := BrushStyle;
Canvas.Brush.Color := BrushColor;
end;
{. . . . . . . . . . . . . . . . . . . . . . . . . . .}
begin
if Printing then
exit;
Len := Length(s);
if Len=0 then
exit;
wb7 := 0;
wb0 := 0;
spshift := 0;
nbspshift := 0;
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode then
Len := Len div 2;
if Unicode and not RVNT then
ok := False
else {$ENDIF} begin
Spacing := GetTextCharacterExtra(Canvas.Handle);
FillChar(res, sizeof(TGCPResults), 0);
res.lStructSize := sizeof(TGCPResults);
GetMem(POrder, Len*sizeof(Cardinal));
GetMem(POrderRev, Len*sizeof(Cardinal));
GetMem(PDX, Len*sizeof(Integer));
try
FillChar(POrder^, Len*sizeof(Cardinal), 0);
res.lpOrder := @(POrder[0]);
res.lpDx := @(PDX[0]);
res.nGlyphs := Len;
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode then
ok := GetCharacterPlacementW(Canvas.Handle, Pointer(s),
TGetCharacterPlacementVal(Len), TGetCharacterPlacementVal(0), res,
GETCHARACTERPLACEMENTFLAGS)<>0
else
{$ENDIF}
ok := GetCharacterPlacementA(Canvas.Handle, PChar(s),
TGetCharacterPlacementVal(Len), TGetCharacterPlacementVal(0), res,
GETCHARACTERPLACEMENTFLAGS)<>0;
if ok then begin
for i := 0 to Len-1 do
POrderRev[POrder[i]] := i;
inc(Left, SpaceBefore);
{$IFNDEF RVDONOTUSEUNICODE}
if not Unicode then
{$ENDIF}
for i := 0 to Len-1 do begin
case s[POrderRev[i]+1] of
' ':
if rvscSpace in RVVisibleSpecialCharacters then
DrawDot(wb7, spshift, ' ', #$B7);
#$A0:
if rvscNBSP in RVVisibleSpecialCharacters then
DrawDot(wb0, nbspshift, #$A0, #$B0);
end;
inc(Left, PDX[i]+Spacing);
end
{$IFNDEF RVDONOTUSEUNICODE}
else
for i := 0 to Len-1 do begin
case PRVWordArray(PChar(s))[POrderRev[i]] of
ord(' '):
if rvscSpace in RVVisibleSpecialCharacters then
DrawDot(wb7, spshift, ' ', #$B7);
$A0:
if rvscNBSP in RVVisibleSpecialCharacters then
DrawDot(wb0, nbspshift, #$A0, #$B0);
end;
inc(Left, PDX[i]+Spacing);
end;
{$ENDIF}
end;
finally
FreeMem(POrder);
FreeMem(POrderRev);
FreeMem(PDX);
end;
end;
if ok then
exit;
GetMem(PDX, (Len+2)*sizeof(Integer));
try
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode then
ItemOptions := [rvioUnicode]
else
{$ENDIF}
ItemOptions := [];
RVU_GetTextExtentExPoint(Canvas, s, Width*2, X, PDX, ItemOptions);
inc(Left, SpaceBefore);
{$IFNDEF RVDONOTUSEUNICODE}
if not Unicode then
{$ENDIF}
for i := 0 to Len-1 do begin
if s[i+1]=' ' then begin
X := Left;
if i>0 then
inc(X, PDX[i-1]);
Canvas.TextOut(X, Top, chr($b7));
end;
end
{$IFNDEF RVDONOTUSEUNICODE}
else
for i := 0 to Len-1 do begin
if PRVWordArray(PChar(s))[i]=ord(' ') then begin
X := Left;
if i>0 then
inc(X, PDX[i-1]);
Canvas.TextOut(X, Top, chr($b7));
end;
end;
{$ENDIF}
finally
FreeMem(PDX);
end;
end;
{......................................................}
var
potm: POutlineTextMetric;
sz: Integer;
CharExtra: Integer;
TextDone: Boolean;
begin
TextDone := False;
if BiDiMode<>rvbdUnspecified then
DefBiDiMode := BiDiMode;
if Printing and (DefBiDiMode=rvbdUnspecified) then begin
if (Canvas.Brush.Style<>bsClear) then begin
Canvas.Pen.Style := psClear;
Canvas.FillRect(Bounds(Left,Top,Width,Height));
Canvas.Brush.Style := bsClear;
Canvas.Pen.Style := psSolid;
end;
if not PreviewCorrection then begin
CharExtra := GetTextCharacterExtra(Canvas.Handle);
if CharExtra<>0 then begin
SetTextCharacterExtra(Canvas.Handle, 0);
TextDone := PrintText(CharExtra, False);
SetTextCharacterExtra(Canvas.Handle, CharExtra);
end;
end
else begin
TextDone := PrintText(0, True);
end;
end;
{$IFNDEF RVDONOTUSEJUSTIFY};
if not TextDone then begin
{$IFDEF RVDONOTUSEUNICODE}
Canvas.TextOut(Left+SpaceBefore, Top, s);
{$ELSE}
if not Unicode then
TextOutA(Canvas.Handle, Left+SpaceBefore, Top, PChar(s), Length(s))
else
TextOutW(Canvas.Handle, Left+SpaceBefore, Top, Pointer(s), Length(s) div 2);
{$ENDIF}
if (rvtsSpecialCharacters in DrawState) and
(RVVisibleSpecialCharacters * [rvscSpace, rvscNBSP]<>[]) then
DrawDots;
end;
if (SpaceBefore<>0) and not Printing then begin
if (rvtsSelected in DrawState) and (Length(s)=0) then
RVStyle.ApplyStyleColor(Canvas, ThisStyleNo, DrawState-[rvtsSelected], Printing, ColorMode);
if Canvas.Brush.Style<>bsClear then
Canvas.FillRect(Bounds(Left,Top,SpaceBefore,Height));
end;
{$ELSE}
if not TextDone then begin
{$IFDEF RVDONOTUSEUNICODE}
Canvas.TextOut(Left, Top, s);
{$ELSE}
if not Unicode then
TextOutA(Canvas.Handle, Left, Top, PChar(s), Length(s))
else
TextOutW(Canvas.Handle, Left, Top, Pointer(s), Length(s) div 2);
{$ENDIF}
end;
{$ENDIF}
Canvas.Brush.Style := bsClear;
potm := nil;
try
{$IFNDEF RVDONOTUSEJUSTIFY}
if (SpaceBefore<>0) and (fsUnderline in Canvas.Font.Style) then begin
sz := GetOutlineTextMetrics(Canvas.Handle,0,nil);
if sz>0 then begin
GetMem(potm, sz);
FillChar(potm^, sz, 0);
sz := GetOutlineTextMetrics(Canvas.Handle,sz,potm);
if sz>0 then begin
Canvas.Pen.Color := Canvas.Font.Color;
Canvas.Pen.Width := potm.otmsUnderscoreSize;
Canvas.Pen.Style := psInsideFrame;
Canvas.MoveTo(Left,Top-potm.otmsUnderscorePosition+potm.otmTextMetrics.tmAscent+potm.otmsUnderscoreSize div 2);
Canvas.LineTo(Left+SpaceBefore+1,Top-potm.otmsUnderscorePosition+potm.otmTextMetrics.tmAscent+potm.otmsUnderscoreSize div 2);
Canvas.Pen.Style := psSolid;
end;
end;
end;
{$ENDIF}
if rvfsOverline in StyleEx then begin
if potm=nil then begin
sz := GetOutlineTextMetrics(Canvas.Handle,0,nil);
if sz>0 then begin
GetMem(potm, sz);
FillChar(potm^, sz, 0);
sz := GetOutlineTextMetrics(Canvas.Handle,sz,potm);
if sz>0 then
Canvas.Pen.Width := potm.otmsUnderscoreSize
else
Canvas.Pen.Width := 1;
end
else
Canvas.Pen.Width := 1;
end;
Canvas.Pen.Color := Canvas.Font.Color;
Canvas.MoveTo(Left, Top);
Canvas.LineTo(Left+Width, Top);
end;
finally
if potm<>nil then
FreeMem(potm);
end;
end;
{------------------------------------------------------------------------------}
{ You do not see this :) }
procedure TFontInfo.DrawVertical(const s: String; Canvas: TCanvas;
ThisStyleNo, SpaceBefore, Left, Top, Width, Height: Integer;
RVStyle: TRVStyle; DrawState: TRVTextDrawStates);
begin
{$IFNDEF RVDONOTUSEJUSTIFY};
{$IFDEF RVDONOTUSEUNICODE}
Canvas.TextOut(Left, Top+SpaceBefore, s);
{$ELSE}
if not Unicode then
TextOutA(Canvas.Handle, Left, Top+SpaceBefore, PChar(s), Length(s))
else
TextOutW(Canvas.Handle, Left, Top+SpaceBefore, Pointer(s), Length(s) div 2);
{$ENDIF}
if (SpaceBefore<>0) then begin
if (rvtsSelected in DrawState) and (Length(s)=0) then
RVStyle.ApplyStyleColor(Canvas, ThisStyleNo, DrawState-[rvtsSelected], False, rvcmColor);
if Canvas.Brush.Style<>bsClear then
Canvas.FillRect(Bounds(Left, Top, Height,SpaceBefore));
end;
{$ELSE}
{$IFDEF RVDONOTUSEUNICODE}
Canvas.TextOut(Left, Top, s);
{$ELSE}
if not Unicode then
TextOutA(Canvas.Handle, Left, Top, PChar(s), Length(s))
else
TextOutW(Canvas.Handle, Left, Top, Pointer(s), Length(s) div 2);
{$ENDIF}
{$ENDIF}
Canvas.Brush.Style := bsClear;
if rvfsOverline in StyleEx then begin
Canvas.Pen.Color := Canvas.Font.Color;
Canvas.MoveTo(Left, Top);
Canvas.LineTo(Left, Top+Width);
end;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads properties from the ini-file, from the section Section.
fs is a format string for keys, it is like 'Font%s1', 'Font%s2', etc. }
procedure TFontInfo.LoadFromINI(ini: TRVIniFile; const Section, fs: String;
JumpByDefault: Boolean; DefJumpCursor: TCursor);
begin
inherited;
NextStyleNo := ini.ReadInteger(Section, Format(fs,[RVINI_NEXTSTYLENO]), -1);
{$IFNDEF RVDONOTUSEUNICODE}
Unicode := iniReadBool(ini, Section, Format(fs,[RVINI_UNICODE]), False);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
{ Saves properties to the ini-file, to the section Section.
fs is a format string for keys, it is like 'Font%s1', 'Font%s2', etc. }
procedure TFontInfo.SaveToINI(ini: TRVIniFile; const Section, fs: String);
begin
inherited;
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_NEXTSTYLENO]),NextStyleNo,-1);
{$IFNDEF RVDONOTUSEUNICODE}
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_UNICODE]), Unicode, False);
{$ENDIF}
end;
{$ENDIF}
{================================== TFontInfos ================================}
{ Destructor }
destructor TFontInfos.Destroy;
begin
FInvalidItem.Free;
inherited;
end;
{------------------------------------------------------------------------------}
{ Adds new item to the end (perfotms typecasting) }
function TFontInfos.Add: TFontInfo;
begin
Result := TFontInfo(inherited Add);
end;
{------------------------------------------------------------------------------}
{ Deprecated method }
function TFontInfos.AddFont(Name: TFontName; Size: Integer;
Color,BackColor: TColor; Style:TFontStyles): TFontInfo;
begin
Result := Add;
Result.FontName := Name;
Result.Size := Size;
Result.Color := Color;
Result.BackColor := BackColor;
Result.Style := Style;
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
{ Deprecated method }
function TFontInfos.AddFontEx(Name: TFontName; Size: Integer;
Color, BackColor: TColor; Style:TFontStyles;
Charset: TFontCharset): TFontInfo;
begin
Result := AddFont(Name, Size, Color, BackColor, Style);
Result.Charset := Charset;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ 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 TFontInfos.GetItem(Index: Integer): TFontInfo;
begin
if (Index<0) or (Index>=Count) then
Result := InvalidItem
else
Result := TFontInfo(inherited GetItem(Index));
end;
{------------------------------------------------------------------------------}
{ WRITE method for the property Items[]. }
procedure TFontInfos.SetItem(Index: Integer; Value: TFontInfo);
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], but white on red. }
function TFontInfos.GetInvalidItem: TFontInfo;
begin
if FInvalidItem=nil then begin
FInvalidItem := (FOwner as TRVStyle).GetTextStyleClass.Create(nil);
if Count>0 then
FInvalidItem.Assign(Items[0]);
FInvalidItem.BackColor := clRed;
FInvalidItem.Color := clWhite;
end;
Result := FInvalidItem;
end;
{------------------------------------------------------------------------------}
{ WRITE method for the property InvalidItem. }
procedure TFontInfos.SetInvalidItem(const Value: TFontInfo);
begin
if InvalidItem<>Value then
InvalidItem.Assign(Value);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section. }
procedure TFontInfos.LoadFromINI(ini: TRVIniFile; const Section: String;
DefJumpCursor: TCursor);
var i, cnt: Integer;
begin
// for compatibility with old versions, default count of styles is
// LAST_DEFAULT_STYLE_NO+1
cnt := ini.ReadInteger(Section, RVINI_TEXTSTYLECOUNT, LAST_DEFAULT_STYLE_NO+1);
Clear;
for i := 0 to cnt-1 do begin
Add;
Items[i].LoadFromINI(ini, Section, RVINI_TEXTSTYLEPREFIX+IntToStr(i),
i in [rvsJump1, rvsJump2], DefJumpCursor);
end;
end;
{------------------------------------------------------------------------------}
{ Saves itself to the ini-file, to the section Section. }
procedure TFontInfos.SaveToINI(ini: TRVIniFile; const Section: String);
var i: Integer;
begin
ini.WriteInteger(Section, RVINI_TEXTSTYLECOUNT, Count);
for i:=0 to Count-1 do
Items[i].SaveToINI(ini, Section, RVINI_TEXTSTYLEPREFIX+IntToStr(i));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Returns the index of the style having all properties of Font.
Starts searching from Items[BaseStyle], then searches in other Items.
If not found, returns -1. }
function TFontInfos.FindStyleWithFont(BaseStyle: Integer; Font: TFont): Integer;
var i: Integer;
{........................................}
function Matched(fi: TFontInfo): Boolean;
begin
Result := (fi.Size=Font.Size) and
(fi.Style=Font.Style) and
(fi.FontName=Font.Name) and
{$IFDEF RICHVIEWCBDEF3}
(fi.Charset=Font.Charset) and
{$ENDIF}
(fi.Color=Font.Color);
end;
{........................................}
begin
if Matched(Items[BaseStyle]) then begin
Result := BaseStyle;
exit;
end;
for i := 0 to Count-1 do
if (i<>BaseStyle) and Matched(Items[i]) and
Items[BaseStyle].IsEqual(Items[i], [rvfiFontName, rvfiSize, rvfiCharset,
rvfiBold, rvfiItalic, rvfiUnderline,
rvfiStrikeout, rvfiColor]) then begin
Result := i;
exit;
end;
Result := -1;
end;
{------------------------------------------------------------------------------}
{ Returns the index of the style having the specified font Size.
Starts searching from Items[BaseStyle], then searches in other Items.
If not found, returns -1. }
function TFontInfos.FindStyleWithFontSize(BaseStyle, Size: Integer): Integer;
var i: Integer;
begin
if Items[BaseStyle].Size = Size then begin
Result := BaseStyle;
exit;
end;
for i := 0 to Count-1 do
if (i<>BaseStyle) and (Items[i].Size=Size) and
Items[BaseStyle].IsEqual(Items[i], [rvfiSize]) then begin
Result := i;
exit;
end;
Result := -1;
end;
{------------------------------------------------------------------------------}
{ Returns the index of the style having the specified values of Color and BackColor.
Starts searching from Items[BaseStyle], then searches in other Items.
If not found, returns -1. }
function TFontInfos.FindStyleWithColor(BaseStyle: Integer; Color,
BackColor: TColor): Integer;
var i: Integer;
begin
if (Items[BaseStyle].Color = Color) and
(Items[BaseStyle].BackColor = BackColor) then begin
Result := BaseStyle;
exit;
end;
for i := 0 to Count-1 do
if (i<>BaseStyle) and
(Items[i].Color = Color) and
(Items[i].BackColor = BackColor) and
Items[BaseStyle].IsEqual(Items[i], [rvfiColor, rvfiBackColor]) then begin
Result := i;
exit;
end;
Result := -1;
end;
{------------------------------------------------------------------------------}
{ Returns the index of the style having the specified value of FontName.
Starts searching from Items[BaseStyle], then searches in other Items.
If not found, returns -1. }
function TFontInfos.FindStyleWithFontName(BaseStyle: Integer;
const FontName: TFontName): Integer;
var i: Integer;
begin
if Items[BaseStyle].FontName = FontName then begin
Result := BaseStyle;
exit;
end;
for i := 0 to Count-1 do
if (i<>BaseStyle) and (Items[i].FontName=FontName) and
Items[BaseStyle].IsEqual(Items[i], [rvfiFontName]) then begin
Result := i;
exit;
end;
Result := -1;
end;
{------------------------------------------------------------------------------}
{ The most universal method for text 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 TFontInfos.FindSuchStyle(BaseStyle: Integer; Style: TFontInfo;
Mask: TRVFontInfoProperties): Integer;
var i: Integer;
begin
Mask := RVAllFontInfoProperties - 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;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
{ Returns the index of the style having the specified value of Charset.
Starts searching from Items[BaseStyle], then searches in other Items.
If not found, returns -1. }
function TFontInfos.FindStyleWithCharset(BaseStyle: Integer; Charset: TFontCharset): Integer;
var i: Integer;
begin
if (Items[BaseStyle].Charset=Charset)
{$IFNDEF RVDONOTUSEUNICODE}
and not Items[BaseStyle].Unicode
{$ENDIF}
then begin
Result := BaseStyle;
exit;
end;
for i := 0 to Count-1 do
if (i<>BaseStyle) and (Items[i].Charset=Charset) and
{$IFNDEF RVDONOTUSEUNICODE}
not Items[i].Unicode and
{$ENDIF}
Items[BaseStyle].IsEqual(Items[i], [rvfiCharset, rvfiUnicode]) then begin
Result := i;
exit;
end;
Result := -1;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Returns the index of the style having the specified font styles.
Mask defines which font styles to check. Value defines the required values
of them.
Starts searching from Items[BaseStyle], then searches in other Items.
If not found, returns -1. }
function TFontInfos.FindStyleWithFontStyle(BaseStyle: Integer; Value,
Mask: TFontStyles): Integer;
var i: Integer;
IgnoreList: TRVFontInfoProperties;
{........................................}
function Matched(fi: TFontInfo): Boolean;
var i: TFontStyle;
begin
for i := Low(TFontStyle) to High(TFontStyle) do
if (i in Mask) and ((i in fi.Style)<>(i in Value)) then begin
Result := False;
exit;
end;
Result := True;
end;
{........................................}
begin
if Matched(Items[BaseStyle]) then begin
Result := BaseStyle;
exit;
end;
IgnoreList := [];
if fsBold in Mask then
Include(IgnoreList, rvfiBold);
if fsItalic in Mask then
Include(IgnoreList, rvfiItalic);
if fsUnderline in Mask then
Include(IgnoreList, rvfiUnderline);
if fsStrikeout in Mask then
Include(IgnoreList, rvfiStrikeout);
for i := 0 to Count-1 do
if (i<>BaseStyle) and Matched(Items[i]) and
Items[BaseStyle].IsEqual(Items[i], IgnoreList) then begin
Result := i;
exit;
end;
Result := -1;
end;
{================================== TRVRect ===================================}
{ Assigns TRVRect (Source) to TRVRect (Self). }
procedure TRVRect.Assign(Source: TPersistent);
begin
if Source is TRVRect then begin
Left := TRVRect(Source).Left;
Right := TRVRect(Source).Right;
Top := TRVRect(Source).Top;
Bottom := TRVRect(Source).Bottom;
end
else
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ Assigns properties from value. Val* specify properties to assign. }
procedure TRVRect.AssignValidProperties(Source: TRVRect;
ValL, ValT, ValR, ValB: Boolean);
begin
if ValL then
Left := Source.Left;
if ValT then
Top := Source.Top;
if ValR then
Right := Source.Right;
if ValB then
Bottom := Source.Bottom;
end;
{------------------------------------------------------------------------------}
{ Assigns Value to all sides. }
procedure TRVRect.SetAll(Value: Integer);
begin
Left := Value;
Top := Value;
Right := Value;
Bottom := Value;
end;
{------------------------------------------------------------------------------}
{ Assigns itself to TRect. }
procedure TRVRect.AssignToRect(var Rect: TRect);
begin
Rect.Left := Left;
Rect.Top := Top;
Rect.Right := Right;
Rect.Bottom := Bottom;
end;
{------------------------------------------------------------------------------}
{ Assigns itself to TRect. Only sides having greater values are assigned. }
procedure TRVRect.AssignToRectIfGreater(var Rect: TRect);
begin
if Left>Rect.Left then
Rect.Left := Left;
if Top>Rect.Top then
Rect.Top := Top;
if Right>Rect.Right then
Rect.Right := Right;
if Bottom>Rect.Bottom then
Rect.Bottom := Bottom;
end;
{------------------------------------------------------------------------------}
{ Grows TRect by adding/subtracting sides. }
procedure TRVRect.InflateRect(var Rect: TRect);
begin
dec(Rect.Left, Left);
dec(Rect.Top, Top);
inc(Rect.Right, Right);
inc(Rect.Bottom, Bottom);
end;
{------------------------------------------------------------------------------}
{ Grows TRect by adding/subtracting sides adjusted to the resolution specified
in sad. }
procedure TRVRect.InflateRectSaD(var Rect: TRect;
const sad: TRVScreenAndDevice);
begin
dec(Rect.Left, RV_XToDevice(Left, sad));
dec(Rect.Top, RV_YToDevice(Top, sad));
inc(Rect.Right, RV_XToDevice(Right, sad));
inc(Rect.Bottom, RV_YToDevice(Bottom, sad));
end;
{------------------------------------------------------------------------------}
{ Is this rectangle equal to Value? }
function TRVRect.IsEqual(Value: TRVRect): Boolean;
begin
Result := (Left=Value.Left) and (Right=Value.Right) and
(Top =Value.Top) and (Bottom=Value.Bottom);
end;
{------------------------------------------------------------------------------}
{ Are the specified sides equal to the sides of Value?
Ign* specify sides to ignore when comparing. }
function TRVRect.IsEqualEx(Value: TRVRect; IgnL, IgnT, IgnR,
IgnB: Boolean): Boolean;
begin
Result := (IgnL or (Left=Value.Left)) and
(IgnR or (Right=Value.Right)) and
(IgnT or (Top =Value.Top)) and
(ignB or (Bottom=Value.Bottom));
end;
{------------------------------------------------------------------------------}
{ Returns the value of similarity between this rectangle and Value.
The larger return value - the larger similarity.
Result is proportional to Weight. }
function TRVRect.SimilarityValue(Value: TRVRect; Weight: Integer): Integer;
begin
Result := RV_CompareInts(Left, Value.Left, Weight)+
RV_CompareInts(Top, Value.Top, Weight)+
RV_CompareInts(Right, Value.Right, Weight)+
RV_CompareInts(Bottom, Value.Bottom, Weight);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys. }
procedure TRVRect.LoadFromINI(ini: TRVIniFile; const Section, fs: String);
begin
Left := ini.ReadInteger(Section, Format(fs,[RVINI_LEFT]), 0);
Right := ini.ReadInteger(Section, Format(fs,[RVINI_RIGHT]), 0);
Top := ini.ReadInteger(Section, Format(fs,[RVINI_TOP]), 0);
Bottom := ini.ReadInteger(Section, Format(fs,[RVINI_BOTTOM]), 0);
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file, in the section Section.
fs is a format string for ini keys. }
procedure TRVRect.SaveToINI(ini: TRVIniFile; const Section, fs: String);
begin
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_LEFT]), Left, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_RIGHT]), Right, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_TOP]), Top, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_BOTTOM]), Bottom, 0);
end;
{$ENDIF}
{================================ TRVBooleanRect ==============================}
{ Constructor, assigns DefValue to all sides. }
constructor TRVBooleanRect.Create(DefValue: Boolean);
begin
inherited Create;
SetAll(DefValue);
end;
{------------------------------------------------------------------------------}
{ Assigns Value to all sides. }
procedure TRVBooleanRect.SetAll(Value: Boolean);
begin
Left := Value;
Top := Value;
Right := Value;
Bottom := Value;
end;
{------------------------------------------------------------------------------}
{ Assigns parameters to sides. }
procedure TRVBooleanRect.SetValues(ALeft, ATop, ARight, ABottom: Boolean);
begin
Left := ALeft;
Top := ATop;
Right := ARight;
Bottom := ABottom;
end;
{------------------------------------------------------------------------------}
{ Assigns TRVBooleanRect (Source) to TRVBooleanRect (Self). }
procedure TRVBooleanRect.Assign(Source: TPersistent);
begin
if Source is TRVBooleanRect then begin
Left := TRVBooleanRect(Source).Left;
Right := TRVBooleanRect(Source).Right;
Top := TRVBooleanRect(Source).Top;
Bottom := TRVBooleanRect(Source).Bottom;
end
else
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ Assigns values from Source. Val* specify properties to assign. }
procedure TRVBooleanRect.AssignValidProperties(Source: TRVBooleanRect;
ValL, ValT, ValR, ValB: Boolean);
begin
if ValL then
Left := Source.Left;
if ValT then
Top := Source.Top;
if ValR then
Right := Source.Right;
if ValB then
Bottom := Source.Bottom;
end;
{------------------------------------------------------------------------------}
{ Is this boolean rectangle equal to Value? }
function TRVBooleanRect.IsEqual(Value: TRVBooleanRect): Boolean;
begin
Result := (Left=Value.Left) and (Right=Value.Right) and
(Top =Value.Top) and (Bottom=Value.Bottom);
end;
{------------------------------------------------------------------------------}
{ Are the sides equal to the parameters? }
function TRVBooleanRect.IsEqual2(ALeft, ATop, ARight, ABottom: Boolean): Boolean;
begin
Result := (Left=ALeft) and (Right=ARight) and
(Top =ATop) and (Bottom=ABottom);
end;
{------------------------------------------------------------------------------}
{ All all the sides equal to the Value? }
function TRVBooleanRect.IsAllEqual(Value: Boolean): Boolean;
begin
Result := (Left=Value) and (Right=Value) and
(Top =Value) and (Bottom=Value);
end;
{------------------------------------------------------------------------------}
{ Are the specified sides equal to the sides of Value?
Ign* specify sides to ignore when comparing. }
function TRVBooleanRect.IsEqualEx(Value: TRVBooleanRect; IgnL, IgnT, IgnR,
IgnB: Boolean): Boolean;
begin
Result := (IgnL or (Left=Value.Left)) and
(IgnR or (Right=Value.Right)) and
(IgnT or (Top =Value.Top)) and
(ignB or (Bottom=Value.Bottom));
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys. }
procedure TRVBooleanRect.LoadFromINI(ini: TRVIniFile; const Section,
fs: String);
begin
Left := IniReadBool(ini, Section, Format(fs,[RVINI_LEFT]), True);
Right := IniReadBool(ini, Section, Format(fs,[RVINI_RIGHT]), True);
Top := IniReadBool(ini, Section, Format(fs,[RVINI_TOP]), True);
Bottom := IniReadBool(ini, Section, Format(fs,[RVINI_BOTTOM]), True);
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file, in the section Section.
fs is a format string for ini keys. }
procedure TRVBooleanRect.SaveToINI(ini: TRVIniFile; const Section,
fs: String);
begin
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_LEFT]), Left, True);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_RIGHT]), Right, True);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_TOP]), Top, True);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_BOTTOM]), Bottom, True);
end;
{$ENDIF}
{============================= TRVBorder ======================================}
{ Constructor. Sets border style to "none", color to clWindowText, width to 1. }
constructor TRVBorder.Create;
begin
inherited Create;
FBorderOffsets := TRVRect.Create;
FVisibleBorders := TRVBooleanRect.Create(True);
Style := rvbNone;
Color := clWindowText;
Width := 1;
InternalWidth := 1;
end;
{------------------------------------------------------------------------------}
{ Destructor }
destructor TRVBorder.Destroy;
begin
FBorderOffsets.Free;
FVisibleBorders.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{ Assigns TRVBorder (Source) to TRVBorder (Self). }
procedure TRVBorder.Assign(Source: TPersistent);
begin
if Source is TRVBorder then begin
Width := TRVBorder(Source).Width;
Style := TRVBorder(Source).Style;
Color := TRVBorder(Source).Color;
InternalWidth := TRVBorder(Source).InternalWidth;
VisibleBorders.Assign(TRVBorder(Source).VisibleBorders);
BorderOffsets.Assign(TRVBorder(Source).BorderOffsets);
end
else
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ WRITE method for BorderOffsets property. }
procedure TRVBorder.SetBorderOffsets(const Value: TRVRect);
begin
FBorderOffsets.Assign(Value);
end;
{------------------------------------------------------------------------------}
{ WRITE method for VisibleBorders property. }
procedure TRVBorder.SetVisibleBorders(const Value: TRVBooleanRect);
begin
FVisibleBorders.Assign(Value);
end;
{------------------------------------------------------------------------------}
{ Draws border on Canvas at the rectangle Rect. Widths and offsets are adjusted
according to the device resolution specified in sad.
Colors are corrected according to ColorMode. }
procedure TRVBorder.DrawSaD(Rect: TRect; Canvas: TCanvas;
const sad: TRVScreenAndDevice; ColorMode: TRVColorMode);
begin
if Style = rvbNone then exit;
ScaleRect(Rect, sad); // does nothing
BorderOffsets.InflateRectSaD(Rect,sad);
DoDraw(Rect, Canvas, RV_YToDevice(Width, sad),
RV_YToDevice(InternalWidth, sad), RV_YToDevice(1, sad), ColorMode);
end;
{------------------------------------------------------------------------------}
{ Draws border on Canvas at the rectangle Rect. }
procedure TRVBorder.Draw(Rect: TRect; Canvas: TCanvas);
begin
if Style = rvbNone then exit;
BorderOffsets.InflateRect(Rect);
DoDraw(Rect, Canvas, Width, InternalWidth, 1, rvcmColor);
end;
{------------------------------------------------------------------------------}
{ Draws border on Canvas at the rectangle Rect. This method is called by Draw
and DrawSaD.
Colors are corrected according to ColorMode. }
procedure TRVBorder.DoDraw(Rect: TRect; Canvas: TCanvas;
Width, InternalWidth, OnePixelWidth: Integer; ColorMode: TRVColorMode);
var Count: Integer;
begin
with Canvas.Pen do begin
Width := Self.Width;
Style := psInsideFrame;
case ColorMode of
rvcmColor:
Color := Self.Color;
rvcmPrinterColor:
Color := RV_GetPrnColor(Self.Color);
rvcmGrayScale:
Color := RV_GetGray(RV_GetPrnColor(Self.Color));
rvcmBlackAndWhite, rvcmBlackOnWhite:
Color := clBlack;
end;
end;
case Style of
rvbSingle:
Count := 1;
rvbDouble, rvbThickInside, rvbThickOutside:
Count := 2;
rvbTriple:
Count := 3;
else
Count := 1;
end;
while Count>0 do begin
if ((Count=1) and (Style=rvbThickOutside)) or
((Count=2) and (Style=rvbThickInside)) then
Canvas.Pen.Width := Width*2
else
Canvas.Pen.Width := Width;
if VisibleBorders.Top then begin
Canvas.MoveTo(Rect.Left,Rect.Top);
Canvas.LineTo(Rect.Right,Rect.Top);
Canvas.MoveTo(Rect.Right,Rect.Top);
Canvas.LineTo(Rect.Left,Rect.Top);
end;
if VisibleBorders.Right then begin
Canvas.MoveTo(Rect.Right,Rect.Top);
Canvas.LineTo(Rect.Right,Rect.Bottom);
Canvas.MoveTo(Rect.Right,Rect.Bottom);
Canvas.LineTo(Rect.Right,Rect.Top);
end;
if VisibleBorders.Bottom then begin
Canvas.MoveTo(Rect.Right,Rect.Bottom);
Canvas.LineTo(Rect.Left,Rect.Bottom);
Canvas.MoveTo(Rect.Left,Rect.Bottom);
Canvas.LineTo(Rect.Right,Rect.Bottom);
end;
if VisibleBorders.Left then begin
Canvas.MoveTo(Rect.Left,Rect.Bottom);
Canvas.LineTo(Rect.Left,Rect.Top);
Canvas.MoveTo(Rect.Left,Rect.Top);
Canvas.LineTo(Rect.Left,Rect.Bottom);
end;
InflateRect(Rect, InternalWidth+OnePixelWidth, InternalWidth+OnePixelWidth);
if (Width=1) and (Style=rvbThickOutside) then begin
inc(Rect.Bottom,OnePixelWidth);
inc(Rect.Right,OnePixelWidth);
end;
if (Width=1) and (Style = rvbThickInside) then begin
dec(Rect.Top,OnePixelWidth);
dec(Rect.Left,OnePixelWidth);
end;
dec(Count);
end;
Canvas.Pen.Width := 1;
end;
{------------------------------------------------------------------------------}
{ Is this border equal to Value? }
function TRVBorder.IsEqual(Value: TRVBorder): Boolean;
begin
Result := (Style = Value.Style) and
(Color = Value.Color) and
(Width = Value.Width) and
(InternalWidth = Value.InternalWidth) and
BorderOffsets.IsEqual(Value.BorderOffsets) and
VisibleBorders.IsEqual(Value.VisibleBorders);
end;
{------------------------------------------------------------------------------}
{ Are the specified properties of this border equal to the properties of Value?
IgnoreList specifies properties that must be ignored when comparing. }
function TRVBorder.IsEqual_Para(Value: TRVBorder; IgnoreList: TRVParaInfoProperties): Boolean;
begin
Result := ((rvpiBorder_Style in IgnoreList) or (Style = Value.Style)) and
((rvpiBorder_Color in IgnoreList) or (Color = Value.Color)) and
((rvpiBorder_Width in IgnoreList) or (Width = Value.Width)) and
((rvpiBorder_InternalWidth in IgnoreList) or (InternalWidth = Value.InternalWidth)) and
BorderOffsets.IsEqualEx(Value.BorderOffsets,
rvpiBorder_BO_Left in IgnoreList,
rvpiBorder_BO_Top in IgnoreList,
rvpiBorder_BO_Right in IgnoreList,
rvpiBorder_BO_Bottom in IgnoreList) and
VisibleBorders.IsEqualEx(Value.VisibleBorders,
rvpiBorder_Vis_Left in IgnoreList,
rvpiBorder_Vis_Top in IgnoreList,
rvpiBorder_Vis_Right in IgnoreList,
rvpiBorder_Vis_Bottom in IgnoreList);
end;
{------------------------------------------------------------------------------}
{ Assign properties from Source, listed in ValidProperties. }
procedure TRVBorder.AssignValidProperties(Source: TRVBorder;
ValidProperties: TRVParaInfoProperties1);
begin
if (rvpiBorder_Style in ValidProperties) then
Style := Source.Style;
if (rvpiBorder_Color in ValidProperties) then
Color := Source.Color;
if (rvpiBorder_Width in ValidProperties) then
Width := Source.Width;
if (rvpiBorder_InternalWidth in ValidProperties) then
InternalWidth := Source.InternalWidth;
BorderOffsets.AssignValidProperties(Source.BorderOffsets,
rvpiBorder_BO_Left in ValidProperties,
rvpiBorder_BO_Top in ValidProperties,
rvpiBorder_BO_Right in ValidProperties,
rvpiBorder_BO_Bottom in ValidProperties);
VisibleBorders.AssignValidProperties(Source.VisibleBorders,
rvpiBorder_Vis_Left in ValidProperties,
rvpiBorder_Vis_Top in ValidProperties,
rvpiBorder_Vis_Right in ValidProperties,
rvpiBorder_Vis_Bottom in ValidProperties);
end;
{------------------------------------------------------------------------------}
{ Returns a value of similarity between this border and Value.
The larger value - the higher similarity. }
function TRVBorder.SimilarityValue(Value: TRVBorder): Integer;
var vis1,vis2: array[0..3] of Boolean;
sum,i: Integer;
begin
Result := 0;
vis1[0] := ((Style<>rvbNone) and VisibleBorders.Left);
vis2[0] := ((Value.Style<>rvbNone) and Value.VisibleBorders.Left);
vis1[1] := ((Style<>rvbNone) and VisibleBorders.Top);
vis2[1] := ((Value.Style<>rvbNone) and Value.VisibleBorders.Top);
vis1[2] := ((Style<>rvbNone) and VisibleBorders.Right);
vis2[2] := ((Value.Style<>rvbNone) and Value.VisibleBorders.Right);
vis1[3] := ((Style<>rvbNone) and VisibleBorders.Bottom);
vis2[3] := ((Value.Style<>rvbNone) and Value.VisibleBorders.Bottom);
sum := 0;
for i := 0 to 3 do begin
inc(sum, ord(vis1[i] and vis2[i]));
end;
if sum>0 then begin
Result := RV_CompareColors(Color, Value.Color, RVSMW_EACHRGBCOLOR, RVSMW_COLORSET)+
RV_CompareInts(Width, Value.Width, RVSMW_WIDTH)+
RV_CompareInts(InternalWidth, Value.InternalWidth, RVSMW_WIDTH);
if Style = Value.Style then
inc(Result, RVSMW_BORDERSTYLE);
Result := Result * sum;
end;
for i := 0 to 3 do begin
if not vis1[i] and not vis2[i] then
inc(Result, RVSMW_BORDERNOSIDE);
if vis1[i] <> vis2[i] then
dec(Result, RVSMW_BORDERNOSIDE);
end;
if vis1[0] and vis2[0] then
inc(Result, RV_CompareInts(BorderOffsets.Left, Value.BorderOffsets.Left, RVSMW_PADDING));
if vis1[1] and vis2[1] then
inc(Result, RV_CompareInts(BorderOffsets.Top, Value.BorderOffsets.Top, RVSMW_PADDING));
if vis1[2] and vis2[2] then
inc(Result, RV_CompareInts(BorderOffsets.Right, Value.BorderOffsets.Right, RVSMW_PADDING));
if vis1[3] and vis2[3] then
inc(Result, RV_CompareInts(BorderOffsets.Bottom, Value.BorderOffsets.Bottom, RVSMW_PADDING));
end;
{------------------------------------------------------------------------------}
{ Returns the total width of border, including all line widths and gaps. }
function TRVBorder.GetTotalWidth: Integer;
begin
case Style of
rvbSingle:
Result := Width;
rvbDouble:
Result := 2*Width+InternalWidth;
rvbTriple:
Result := 3*Width+2*InternalWidth;
rvbThickInside, rvbThickOutside:
Result := 3*Width+InternalWidth;
else
Result := 0;
end;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys. }
procedure TRVBorder.LoadFromINI(ini: TRVIniFile; const Section, fs: String);
begin
Width := ini.ReadInteger(Section, Format(fs,[RVINI_WIDTH]), 1);
Style := TRVBorderStyle(ini.ReadInteger(Section, Format(fs,[RVINI_STYLE]), ord(rvbNone)));
Color := ini.ReadInteger(Section, Format(fs,[RVINI_COLOR]), clWindowText);
InternalWidth := ini.ReadInteger(Section, Format(fs,[RVINI_INTERNALWIDTH]), 1);
BorderOffsets.LoadFromINI(ini, Section, Format(fs,[RVINI_BOFFSPREFIX]));
VisibleBorders.LoadFromINI(ini, Section, Format(fs,[RVINI_VISBPREFIX]));
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file, in the section Section.
fs is a format string for ini keys. }
procedure TRVBorder.SaveToINI(ini: TRVIniFile; const Section, fs: String);
begin
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_WIDTH]), Width, 1);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_STYLE]), ord(Style), ord(rvbNone));
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_COLOR]), Color, clWindowText);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_INTERNALWIDTH]), InternalWidth, 1);
BorderOffsets.SaveToINI(ini, Section, Format(fs,[RVINI_BOFFSPREFIX]));
VisibleBorders.SaveToINI(ini, Section, Format(fs,[RVINI_VISBPREFIX]));
end;
{$ENDIF}
{============================== TRVBackgroundRect =============================}
{ Constructor, creates a transparent border with zero padding. }
constructor TRVBackgroundRect.Create;
begin
inherited Create;
FBorderOffsets := TRVRect.Create;
Color := clNone
end;
{------------------------------------------------------------------------------}
{ Destructor. }
destructor TRVBackgroundRect.Destroy;
begin
FBorderOffsets.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{ Assigns TRVBackgroundRect (Source) to TRVBackgroundRect (Self). }
procedure TRVBackgroundRect.Assign(Source: TPersistent);
begin
if Source is TRVBackgroundRect then begin
Color := TRVBackgroundRect(Source).Color;
BorderOffsets := TRVBackgroundRect(Source).BorderOffsets;
end
else
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ Adds padding (BorderOffs) to Rect. }
procedure TRVBackgroundRect.PrepareDraw(var Rect: TRect);
begin
BorderOffsets.InflateRect(Rect);
end;
{------------------------------------------------------------------------------}
{ Adds corrected padding (BorderOffs) to Rect.
Corrections is made according to the device resolution specified in sad. }
procedure TRVBackgroundRect.PrepareDrawSaD(var Rect: TRect;
const sad: TRVScreenAndDevice);
begin
BorderOffsets.InflateRectSaD(Rect,sad);
end;
{------------------------------------------------------------------------------}
{ Draws background on the Canvas at the rectangle Rect.
If Printing, this is a printing or print preview.
Colors are corrected according to the ColorMode. }
procedure TRVBackgroundRect.Draw(Rect: TRect; Canvas: TCanvas;
Printing: Boolean; ColorMode: TRVColorMode);
begin
if (Color=clNone) or (ColorMode in [rvcmBlackAndWhite, rvcmBlackOnWhite]) then
exit;
Canvas.Brush.Style := bsSolid;
case ColorMode of
rvcmColor:
Canvas.Brush.Color := Color;
rvcmPrinterColor:
Canvas.Brush.Color := RV_GetPrnColor(Color);
rvcmGrayScale:
Canvas.Brush.Color := RV_GetGray(RV_GetPrnColor(Color));
end;
Canvas.Pen.Style := psClear;
inc(Rect.Right);
inc(Rect.Bottom);
Canvas.FillRect(Rect);
Canvas.Pen.Style := psSolid;
Canvas.Brush.Style := bsClear;
end;
{------------------------------------------------------------------------------}
{ WRITE method for BorderOffsets property. }
procedure TRVBackgroundRect.SetBorderOffsets(const Value: TRVRect);
begin
FBorderOffsets.Assign(Value);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys. }
procedure TRVBackgroundRect.LoadFromINI(ini: TRVIniFile; const Section,
fs: String);
begin
Color := ini.ReadInteger(Section, Format(fs,[RVINI_COLOR]), clNone);
BorderOffsets.LoadFromINI(ini, Section, Format(fs,[RVINI_BOFFSPREFIX]));
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file, in the section Section.
fs is a format string for ini keys. }
procedure TRVBackgroundRect.SaveToINI(ini: TRVIniFile; const Section,
fs: String);
begin
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_COLOR]), Color, clNone);
BorderOffsets.SaveToINI(ini, Section, Format(fs,[RVINI_BOFFSPREFIX]));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Is this background equal to Value? }
function TRVBackgroundRect.IsEqual(Value: TRVBackgroundRect): Boolean;
begin
Result := (Color = Value.Color) and
BorderOffsets.IsEqual(Value.BorderOffsets);
end;
{------------------------------------------------------------------------------}
{ Returns a value of similarity between this background and Value.
The larger value - the higher similarity. }
function TRVBackgroundRect.SimilarityValue(
Value: TRVBackgroundRect): Integer;
begin
Result := RV_CompareColors(Color, Value.Color, RVSMW_EACHRGBBCOLOR, RVSMW_BCOLORSET)+
BorderOffsets.SimilarityValue(Value.BorderOffsets, RVSMW_PADDING);
end;
{------------------------------------------------------------------------------}
{ Are the specified properties of this background equal to the properties of Value?
IgnoreList specifies properties that must be ignored when comparing. }
function TRVBackgroundRect.IsEqual_Para(Value: TRVBackgroundRect;
IgnoreList: TRVParaInfoProperties): Boolean;
begin
Result := ((rvpiBackground_Color in IgnoreList) or (Color = Value.Color)) and
BorderOffsets.IsEqualEx(Value.BorderOffsets,
rvpiBackground_BO_Left in IgnoreList,
rvpiBackground_BO_Top in IgnoreList,
rvpiBackground_BO_Right in IgnoreList,
rvpiBackground_BO_Bottom in IgnoreList);
end;
{------------------------------------------------------------------------------}
{ Assigns properties from Source, listed in ValidProperties }
procedure TRVBackgroundRect.AssignValidProperties(Source: TRVBackgroundRect;
ValidProperties: TRVParaInfoProperties1);
begin
if (rvpiBackground_Color in ValidProperties) then
Color := Source.Color;
BorderOffsets.AssignValidProperties(Source.BorderOffsets,
rvpiBackground_BO_Left in ValidProperties,
rvpiBackground_BO_Top in ValidProperties,
rvpiBackground_BO_Right in ValidProperties,
rvpiBackground_BO_Bottom in ValidProperties);
end;
{=========================== TRVTabInfo =======================================}
{$IFNDEF RVDONOTUSETABS}
{$IFDEF RICHVIEWCBDEF3}
{ Designtime support. Returns a string to display for the tab in the collection
editor.
This string has format "<align> at <position>".
If Leader is not empty, it's added to the end of the string. }
function TRVTabInfo.GetDisplayName: String;
begin
Result := RVAlignStr[ord(Align)]+' at '+IntToStr(Position);
if Leader<>'' then
Result := Result+' ('+Leader+Leader+Leader+Leader+Leader+Leader+')';
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Is this tabstop equal to Value? }
function TRVTabInfo.IsEqual(Value: TRVTabInfo): Boolean;
begin
Result := (Position=Value.Position) and
(Align=Value.Align) and
(Leader=Value.Leader);
end;
{------------------------------------------------------------------------------}
{ Returns a value of similarity between this tabstop and Value.
The larger value - the higher similarity. }
function TRVTabInfo.SimilarityValue(Value: TRVTabInfo): Integer;
begin
Result := RV_CompareInts(Position, Value.Position, RVSMW_TABPOS);
if Align=Value.Align then
inc(Result, RVSMW_TABALIGN);
if Leader=Value.Leader then
inc(Result, RVSMW_LEADER);
end;
{------------------------------------------------------------------------------}
{ WRITE method for Position property.
Assigns the property value and resort the collection of tabstops. }
procedure TRVTabInfo.SetPosition(const Value: Integer);
begin
if Value <> FPosition then begin
FPosition := Value;
if Collection<>nil then
with TRVTabInfos(Collection) do begin
BeginUpdate;
try
SortTabs;
finally
EndUpdate;
end;
end;
end;
end;
{------------------------------------------------------------------------------}
{ STORED method for Leader property.
Should Leader value be stored? }
function TRVTabInfo.StoreLeader: Boolean;
begin
Result := Leader<>'';
end;
{------------------------------------------------------------------------------}
{ Assigns the tabstop Source to Self. }
procedure TRVTabInfo.Assign(Source: TPersistent);
begin
if Source is TRVTabInfo then begin
Position := TRVTabInfo(Source).Position;
Align := TRVTabInfo(Source).Align;
Leader := TRVTabInfo(Source).Leader;
end
else
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ Function for comparing position of tabstops. Used to sort the collection. }
function CompareTabs(Item1, Item2: Pointer): Integer;
begin
Result := TRVTabInfo(Item1).Position-TRVTabInfo(Item2).Position;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys. }
procedure TRVTabInfo.LoadFromINI(ini: TRVIniFile; const Section,
fs: String);
begin
Position := ini.ReadInteger(Section, Format(fs,[RVINI_TABPOSITION]), 0);
Align := TRVTabAlign(ini.ReadInteger(Section, Format(fs,[RVINI_TABALIGN]), 0));
Leader := ini.ReadString(Section, Format(fs,[RVINI_TABLEADER]), '');
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file, in the section Section.
fs is a format string for ini keys. }
procedure TRVTabInfo.SaveToINI(ini: TRVIniFile; const Section, fs: String);
begin
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_TABPOSITION]), Position, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_TABALIGN]), ord(Align), 0);
if Leader<>'' then
ini.WriteString(Section, Format(fs,[RVINI_TABLEADER]), Leader);
end;
{$ENDIF}
{=============================== TRVTabInfos ==================================}
{ Constructor. Creates empty collection of TRVTabInfo. }
constructor TRVTabInfos.Create(Owner: TPersistent);
begin
inherited Create(TRVTabInfo);
FOwner := Owner;
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
{ Designtime support. Required for the collection editor. }
function TRVTabInfos.GetOwner: TPersistent;
begin
Result := FOwner;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Sorts tabs by Position in ascending order.
This method is called automatically when Items[].Position is changed }
procedure TRVTabInfos.SortTabs;
var
i: Integer;
List: TList;
begin
List := TList.Create;
try
for i := 0 to Count - 1 do
List.Add(Items[i]);
List.Sort(CompareTabs);
for i := 0 to List.Count - 1 do
TRVTabInfo(List.Items[i]).Index := i
finally
List.Free;
end;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys. }
procedure TRVTabInfos.LoadFromINI(ini: TRVIniFile; const Section,
fs: String);
var i,c: Integer;
begin
Clear;
c := ini.ReadInteger(Section, Format(fs,[RVINI_TABCOUNT]), 0);
for i := 0 to c-1 do
Add.LoadFromINI(ini, Section, Format(fs,[''])+RVINI_TABPREFIX+IntToStr(i));
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file, in the section Section.
fs is a format string for ini keys. }
procedure TRVTabInfos.SaveToINI(ini: TRVIniFile; const Section,
fs: String);
var i: Integer;
begin
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_TABCOUNT]), Count, 0);
for i := 0 to Count-1 do
Items[i].SaveToINI(ini, Section, Format(fs,[''])+RVINI_TABPREFIX+IntToStr(i));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Adds a new item (added because of typecasting). }
function TRVTabInfos.Add: TRVTabInfo;
begin
Result := TRVTabInfo(inherited Add);
end;
{------------------------------------------------------------------------------}
{ READ method for Items[] property. }
function TRVTabInfos.GetItem(Index: Integer): TRVTabInfo;
begin
Result := TRVTabInfo(inherited GetItem(Index));
end;
{------------------------------------------------------------------------------}
{ WRITE method for Items[] property. }
procedure TRVTabInfos.SetItem(Index: Integer; Value: TRVTabInfo);
begin
inherited SetItem(Index, Value);
end;
{------------------------------------------------------------------------------}
{ Is this collection of tabstops equal to Value? }
function TRVTabInfos.IsEqual(Value: TRVTabInfos): Boolean;
var i: Integer;
begin
Result := Count=Value.Count;
if not Result then
exit;
for i := 0 to Count-1 do
if not Items[i].IsEqual(Value[i]) then begin
Result := False;
exit;
end;
end;
{------------------------------------------------------------------------------}
{ Returns index of tab with the given Position (or -1 if not found).
Collection must be sorted. }
function TRVTabInfos.Find(Position: Integer): Integer;
var a,b,c: Integer;
begin
Result := -1;
if Count=0 then
exit;
a := 0;
b := Count-1;
while (b-a)>1 do begin
c := (a+b) div 2;
if Items[c].Position<Position then
a := c
else
b := c;
end;
if Items[a].Position=Position then
Result := a
else if Items[b].Position=Position then
Result := b;
end;
{------------------------------------------------------------------------------}
{ Deletes all tabs that not present in Value. Only tabs with all
common properties are not deleted. }
procedure TRVTabInfos.Intersect(Value: TRVTabInfos);
var i, Index: Integer;
begin
for i := Count-1 downto 0 do begin
Index := Value.Find(Items[i].Position);
if (Index<0) or not Items[i].IsEqual(Value[Index]) then
Items[i].Free;
end;
end;
{------------------------------------------------------------------------------}
{ Adds tabs from sources. New tabs are inserted, existing tabs are updated. }
procedure TRVTabInfos.AddFrom(Source: TRVTabInfos);
var i, Index: Integer;
begin
for i := 0 to Source.Count-1 do begin
Index := Find(Source[i].Position);
if Index<0 then begin
Add;
Index := Count-1;
end;
Items[Index].Assign(Source[i]);
end;
end;
{------------------------------------------------------------------------------}
{ Deletes tabs with the specified positions }
procedure TRVTabInfos.DeleteList(Positions: TRVIntegerList);
var i, Index: Integer;
begin
for i := 0 to Positions.Count-1 do begin
Index := Find(Positions[i]);
if Index>=0 then
Items[Index].Free;
end;
end;
{------------------------------------------------------------------------------}
{ Returns a value of similarity between this collection of tabstops and Value.
The greater value - the higher similarity. }
function TRVTabInfos.SimilarityValue(Value: TRVTabInfos): Integer;
var i, MinCount: Integer;
begin
if Count<Value.Count then
MinCount := Count
else
MinCount := Value.Count;
Result := 0;
for i := 0 to MinCount-1 do
inc(Result, Items[i].SimilarityValue(Value[i]));
dec(Result, (Count-MinCount)*RVSMW_NOTAB);
dec(Result, (Value.Count-MinCount)*RVSMW_NOTAB);
end;
{$ENDIF}
{============================= TCustomRVParaInfo ==============================}
{ Constructor. Creates left-aligned parameters with zero indents and spacing,
without background, border and tabs.
Default style name is 'Paragraph Style'. }
constructor TCustomRVParaInfo.Create(Collection: TCollection);
begin
inherited Create(Collection);
FirstIndent := 0;
LeftIndent := 0;
RightIndent := 0;
Alignment := rvaLeft;
FName := RVDEFAULTPARASTYLENAME;
FBorder := TRVBorder.Create;
FBackground := TRVBackgroundRect.Create;
{$IFNDEF RVDONOTUSETABS}
FTabs := TRVTabInfos.Create(Self);
{$ENDIF}
LineSpacingType := rvlsPercent;
LineSpacing := 100;
end;
{------------------------------------------------------------------------------}
{ Destructor. }
destructor TCustomRVParaInfo.Destroy;
begin
FBorder.Free;
FBackground.Free;
{$IFNDEF RVDONOTUSETABS}
FTabs.Free;
{$ENDIF}
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{ WRITE method for Border property. }
procedure TCustomRVParaInfo.SetBorder(const Value: TRVBorder);
begin
FBorder.Assign(Value);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSETABS}
{ WRITE method for Tabs property. }
procedure TCustomRVParaInfo.SetTabs(const Value: TRVTabInfos);
begin
FTabs.Assign(Value);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ WRITE method for Background property. }
procedure TCustomRVParaInfo.SetBackground(const Value: TRVBackgroundRect);
begin
FBackground.Assign(Value);
end;
{------------------------------------------------------------------------------}
{ Is there nondefault line spacing? }
function TCustomRVParaInfo.ExtraLineSpacing: Boolean;
begin
case LineSpacingType of
rvlsPercent:
Result := LineSpacing<>100;
rvlsSpaceBetween:
Result := LineSpacing>0;
else
Result := False;
end;
end;
{------------------------------------------------------------------------------}
{ Assigns Source to Self, if Source is TCustomRVParaInfo. }
procedure TCustomRVParaInfo.Assign(Source: TPersistent);
begin
if Source is TCustomRVParaInfo then begin
FirstIndent := TCustomRVParaInfo(Source).FirstIndent;
LeftIndent := TCustomRVParaInfo(Source).LeftIndent;
RightIndent := TCustomRVParaInfo(Source).RightIndent;
Alignment := TCustomRVParaInfo(Source).Alignment;
SpaceBefore := TCustomRVParaInfo(Source).SpaceBefore;
SpaceAfter := TCustomRVParaInfo(Source).SpaceAfter;
LineSpacing := TCustomRVParaInfo(Source).LineSpacing;
LineSpacingType := TCustomRVParaInfo(Source).LineSpacingType;
Background := TCustomRVParaInfo(Source).Background;
Border := TCustomRVParaInfo(Source).Border;
{$IFNDEF RVDONOTUSETABS}
Tabs := TCustomRVParaInfo(Source).Tabs;
{$ENDIF}
Options := TCustomRVParaInfo(Source).Options;
BiDiMode := TCustomRVParaInfo(Source).BiDiMode;
end;
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ Assigns properties listed in Props1 and Props2 from Source to Self. }
procedure TCustomRVParaInfo.AssignSelectedProperties(
Source: TCustomRVParaInfo; Props: TRVParaInfoProperties);
{.............................................................}
procedure ChangeOption(Option: TRVParaOption; OptionId: TRVParaInfoProperty2);
begin
if OptionId in Props then
if Option in Source.Options then
Options := Options+[Option]
else
Options := Options-[Option];
end;
{.............................................................}
begin
if (rvpiFirstIndent in Props) then
FirstIndent := Source.FirstIndent;
if (rvpiLeftIndent in Props) then
LeftIndent := Source.LeftIndent;
if (rvpiRightIndent in Props) then
RightIndent := Source.RightIndent;
if (rvpiSpaceBefore in Props) then
SpaceBefore := Source.SpaceBefore;
if (rvpiSpaceAfter in Props) then
SpaceAfter := Source.SpaceAfter;
if (rvpiAlignment in Props) then
Alignment := Source.Alignment;
if (rvpiLineSpacing in Props) then
LineSpacing := Source.LineSpacing;
if (rvpiLineSpacingType in Props) then
LineSpacingType := Source.LineSpacingType;
Background.AssignValidProperties(Source.Background, Props);
Border.AssignValidProperties(Source.Border, Props);
ChangeOption(rvpaoNoWrap, rvpiNoWrap);
ChangeOption(rvpaoReadOnly, rvpiReadOnly);
ChangeOption(rvpaoStyleProtect, rvpiStyleProtect);
ChangeOption(rvpaoDoNotWantReturns, rvpiDoNotWantReturns);
ChangeOption(rvpaoKeepLinesTogether, rvpiKeepLinesTogether);
ChangeOption(rvpaoKeepWithNext, rvpiKeepWithNext);
{$IFNDEF RVDONOTUSETABS}
if (rvpiTabs in Props) then
Tabs := Source.Tabs;
{$ENDIF}
if (rvpiBiDiMode in Props) then
BiDiMode := Source.BiDiMode;
{ rvpiNextParaNo, rvpiDefStyleNo - not assigned }
end;
{------------------------------------------------------------------------------}
{ Is this paragraph style equal to Value?
IgnoreID parameter is not used.
BaseStyleNo is ignored. }
function TCustomRVParaInfo.IsSimpleEqual(Value: TCustomRVInfo;
IgnoreReferences, IgnoreID: Boolean): Boolean;
begin
Result :=
(Alignment = TCustomRVParaInfo(Value).Alignment ) and
(FirstIndent = TCustomRVParaInfo(Value).FirstIndent) and
(LeftIndent = TCustomRVParaInfo(Value).LeftIndent ) and
(RightIndent = TCustomRVParaInfo(Value).RightIndent) and
(SpaceBefore = TCustomRVParaInfo(Value).SpaceBefore) and
(SpaceAfter = TCustomRVParaInfo(Value).SpaceAfter) and
(LineSpacing = TCustomRVParaInfo(Value).LineSpacing) and
(LineSpacingType = TCustomRVParaInfo(Value).LineSpacingType) and
(Options = TCustomRVParaInfo(Value).Options) and
(BiDiMode = TCustomRVParaInfo(Value).BiDiMode) and
Background.IsEqual(TCustomRVParaInfo(Value).Background) and
{$IFNDEF RVDONOTUSETABS}
Tabs.IsEqual(TParaInfo(Value).Tabs) and
{$ENDIF}
Border.IsEqual(TParaInfo(Value).Border) and
(not RichViewCompareStyleNames or (StyleName=TCustomRVParaInfo(Value).StyleName));
end;
{------------------------------------------------------------------------------}
{ Returns a value of similarity between this paragraph style and Value.
The greater value - the higher similarity.
BaseStyleNo, NextParaNo, DefStyleNo are ignored. }
function TCustomRVParaInfo.SimilarityValue(Value: TCustomRVInfo): Integer;
begin
Result :=
RV_CompareInts(FirstIndent, TParaInfo(Value).FirstIndent, RVSMW_INDENT)+
RV_CompareInts(LeftIndent, TParaInfo(Value).LeftIndent, RVSMW_INDENT)+
RV_CompareInts(RightIndent, TParaInfo(Value).RightIndent, RVSMW_INDENT)+
RV_CompareInts(SpaceBefore, TParaInfo(Value).SpaceBefore, RVSMW_INDENT)+
RV_CompareInts(SpaceAfter, TParaInfo(Value).SpaceAfter, RVSMW_INDENT)+
Background.SimilarityValue(TParaInfo(Value).Background)+
{$IFNDEF RVDONOTUSETABS}
Tabs.SimilarityValue(TParaInfo(Value).Tabs)+
{$ENDIF}
Border.SimilarityValue(TParaInfo(Value).Border);
if (Alignment = TParaInfo(Value).Alignment) then
inc(Result, RVSMW_ALIGNMENT);
if (BiDiMode = TParaInfo(Value).BiDiMode) then
inc(Result, RVSMW_BIDIMODE);
if ((rvpaoNoWrap in Options) = (rvpaoNoWrap in TParaInfo(Value).Options)) then
inc(Result, RVSMW_NOWRAP);
if ((rvpaoReadOnly in Options) = (rvpaoReadOnly in TParaInfo(Value).Options)) then
inc(Result, RVSMW_READONLY);
if ((rvpaoStyleProtect in Options) = (rvpaoStyleProtect in TParaInfo(Value).Options)) then
inc(Result, RVSMW_STYLEPROTECT);
if ((rvpaoDoNotWantReturns in Options) = (rvpaoDoNotWantReturns in TParaInfo(Value).Options)) then
inc(Result, RVSMW_DONOTWANTRETURNS);
if ((rvpaoKeepLinesTogether in Options) = (rvpaoKeepLinesTogether in TParaInfo(Value).Options)) then
inc(Result, RVSMW_KEEPLINESTOGETHER);
if ((rvpaoKeepWithNext in Options) = (rvpaoKeepWithNext in TParaInfo(Value).Options)) then
inc(Result, RVSMW_KEEPWITHNEXT);
if (LineSpacingType=TParaInfo(Value).LineSpacingType) then
inc(Result, RV_CompareInts(LineSpacing, TParaInfo(Value).LineSpacing, RVSMW_LINESPACING))
else if ExtraLineSpacing<>TParaInfo(Value).ExtraLineSpacing then
dec(Result, RVSMW_LINESPACING*4);
end;
{------------------------------------------------------------------------------}
{ Is the specified properties of this paragraph style equal to the properties of
Value. IgnoreList lists properties which will be ignored when comparing.
BaseStyleNo is always ignored. }
function TCustomRVParaInfo.IsEqual(Value: TCustomRVParaInfo;
IgnoreList: TRVParaInfoProperties): Boolean;
begin
Result :=
((rvpiAlignment in IgnoreList) or (Alignment = Value.Alignment)) and
((rvpiFirstIndent in IgnoreList) or (FirstIndent = Value.FirstIndent)) and
((rvpiLeftIndent in IgnoreList) or (LeftIndent = Value.LeftIndent)) and
((rvpiRightIndent in IgnoreList) or (RightIndent = Value.RightIndent)) and
((rvpiSpaceBefore in IgnoreList) or (SpaceBefore = Value.SpaceBefore)) and
((rvpiSpaceAfter in IgnoreList) or (SpaceAfter = Value.SpaceAfter)) and
((rvpiLineSpacing in IgnoreList) or (LineSpacing = Value.LineSpacing)) and
((rvpiLineSpacingType in IgnoreList) or (LineSpacingType = Value.LineSpacingType)) and
((rvpiNoWrap in IgnoreList) or ((rvpaoNoWrap in Options) = (rvpaoNoWrap in TParaInfo(Value).Options))) and
((rvpiReadOnly in IgnoreList) or ((rvpaoReadOnly in Options) = (rvpaoReadOnly in TParaInfo(Value).Options))) and
((rvpiStyleProtect in IgnoreList) or ((rvpaoStyleProtect in Options) = (rvpaoStyleProtect in TParaInfo(Value).Options))) and
((rvpiDoNotWantReturns in IgnoreList) or ((rvpaoDoNotWantReturns in Options) = (rvpaoDoNotWantReturns in TParaInfo(Value).Options))) and
((rvpiKeepLinesTogether in IgnoreList) or ((rvpaoKeepLinesTogether in Options) = (rvpaoKeepLinesTogether in TParaInfo(Value).Options))) and
((rvpiKeepWithNext in IgnoreList) or ((rvpaoKeepWithNext in Options) = (rvpaoKeepWithNext in TParaInfo(Value).Options))) and
((rvpiBiDiMode in IgnoreList) or (BiDiMode = Value.BiDiMode)) and
{$IFNDEF RVDONOTUSETABS}
((rvpiTabs in IgnoreList) or Tabs.IsEqual(Value.Tabs)) and
{$ENDIF}
Background.IsEqual_Para(Value.Background, IgnoreList) and
Border.IsEqual_Para(Value.Border, IgnoreList);
if Result and RichViewCompareStyleNames then
Result := StyleName=Value.StyleName;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys. }
procedure TCustomRVParaInfo.LoadFromINI(ini: TRVIniFile; const Section, fs: String);
begin
inherited LoadFromINI(ini, Section, fs, RVDEFAULTPARASTYLENAME);
SpaceBefore := ini.ReadInteger(Section, Format(fs,[RVINI_SPACEBEFORE]), 0);
SpaceAfter := ini.ReadInteger(Section, Format(fs,[RVINI_SPACEAFTER]), 0);
LeftIndent := ini.ReadInteger(Section, Format(fs,[RVINI_LEFTINDENT]), 0);
RightIndent := ini.ReadInteger(Section, Format(fs,[RVINI_RIGHTIDENT]), 0);
FirstIndent := ini.ReadInteger(Section, Format(fs,[RVINI_FIRSTINDENT]), 0);
LineSpacing := ini.ReadInteger(Section, Format(fs,[RVINI_LINESPACING]), 100);
LineSpacingType := TRVLineSpacingType(ini.ReadInteger(Section, Format(fs,[RVINI_LINESPACINGTYPE]), ord(rvlsPercent)));
Alignment := TRVAlignment(ini.ReadInteger(Section, Format(fs,[RVINI_ALIGNMENT]), ord(rvaLeft)));
BiDiMode := TRVBiDiMode(ini.ReadInteger(Section, Format(fs,[RVINI_BIDIMODE]), 0));
Options := [];
if IniReadBool(ini, Section, Format(fs,[RVINI_NOWRAP]), False) then
Include(FOptions, rvpaoNoWrap);
if IniReadBool(ini, Section, Format(fs,[RVINI_READONLY]), False) then
Include(FOptions, rvpaoReadOnly);
if IniReadBool(ini, Section, Format(fs,[RVINI_STYLEPROTECT]), False) then
Include(FOptions, rvpaoStyleProtect);
if IniReadBool(ini, Section, Format(fs,[RVINI_DONOTWANTRETURNS]), False) then
Include(FOptions, rvpaoDoNotWantReturns);
if IniReadBool(ini, Section, Format(fs,[RVINI_KEEPLINESTOGETHER]), False) then
Include(FOptions, rvpaoKeepLinesTogether);
if IniReadBool(ini, Section, Format(fs,[RVINI_KEEPWITHNEXT]), False) then
Include(FOptions, rvpaoKeepWithNext);
Border.LoadFromINI(ini, Section, Format(fs,[RVINI_BORDERPREFIX]));
Background.LoadFromINI(ini, Section, Format(fs,[RVINI_BACKGROUNDPREFIX]));
{$IFNDEF RVDONOTUSETABS}
Tabs.LoadFromINI(ini, Section, Format(fs, [RVINI_TABPREFIX]));
{$ENDIF}
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file, in the section Section.
fs is a format string for ini keys. }
procedure TCustomRVParaInfo.SaveToINI(ini: TRVIniFile; const Section, fs: String);
begin
inherited SaveToINI(ini, Section, fs);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_SPACEBEFORE]), SpaceBefore, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_SPACEAFTER]), SpaceAfter, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_LEFTINDENT]), LeftIndent, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_RIGHTIDENT]), RightIndent, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_FIRSTINDENT]), FirstIndent, 0);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_LINESPACING]), LineSpacing, 100);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_LINESPACINGTYPE]), ord(LineSpacingType), ord(rvlsPercent));
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_ALIGNMENT]), ord(Alignment), ord(rvaLeft));
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_BIDIMODE]), ord(BiDiMode), 0);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_NOWRAP]), rvpaoNoWrap in Options, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_READONLY]), rvpaoReadOnly in Options, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_STYLEPROTECT]), rvpaoStyleProtect in Options, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_DONOTWANTRETURNS]), rvpaoDoNotWantReturns in Options, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_KEEPLINESTOGETHER]), rvpaoKeepLinesTogether in Options, False);
WriteBoolToIniIfNE(ini, Section, Format(fs,[RVINI_KEEPWITHNEXT]), rvpaoKeepWithNext in Options, False);
Border.SaveToINI(ini, Section, Format(fs,[RVINI_BORDERPREFIX]));
Background.SaveToINI(ini, Section, Format(fs,[RVINI_BACKGROUNDPREFIX]));
{$IFNDEF RVDONOTUSETABS}
Tabs.SaveToINI(ini, Section, Format(fs, [RVINI_TABPREFIX]));
{$ENDIF}
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Saves this paragraph style as a part of CSS to the Stream.
if BaseStyle<>nil, only a difference between this style and BaseStyle is
saved.
If Multiline=False, all text will be written on a single line.
If IgnoreLeftAlignment, left value of alignment is not saved.
If IgnoreLeftIndents, left and first line indents are not saved. }
procedure TCustomRVParaInfo.SaveCSSToStream(Stream: TStream; BaseStyle: TParaInfo;
Multiline, IgnoreLeftAlignment, IgnoreLeftIndents: Boolean);
const cssTextAlign : array[TRVAlignment] of String =
('left', 'right', 'center', 'justify');
{..................................................}
function GetBorderStyle(bs: TRVBorderStyle): String;
begin
Result := '';
case bs of
rvbNone:
Result := 'none';
rvbSingle:
Result := 'solid';
rvbDouble, rvbTriple, rvbThickInside, rvbThickOutside:
Result := 'double';
end;
end;
{..................................................}
function GetBorderWidth(Border: TRVBorder): Integer;
begin
Result := 0;
case Border.Style of
rvbSingle:
Result := Border.Width;
rvbDouble:
Result := Border.Width+Border.InternalWidth;
rvbThickInside, rvbThickOutside:
Result := Border.Width*3 div 2+Border.InternalWidth;
rvbTriple:
Result := Border.Width+Border.InternalWidth*2;
end;
end;
{..................................................}
var r, baser: TRect;
begin
if ((BaseStyle=nil) and (not IgnoreLeftAlignment or (Alignment<>rvaLeft))) or
((BaseStyle<>nil) and (BaseStyle.Alignment<>Alignment)) then
RVWriteX(Stream, ' text-align: '+cssTextAlign[Alignment]+';', Multiline);
if not IgnoreLeftIndents and ((BaseStyle=nil) or (BaseStyle.FirstIndent<>FirstIndent)) then
RVWriteX(Stream, Format(' text-indent: %dpx;', [FirstIndent]), Multiline);
if ((BaseStyle=nil) and (LineSpacingType=rvlsPercent) and (LineSpacing<>100)) or
((BaseStyle<>nil) and (LineSpacingType=rvlsPercent) and
(BaseStyle.LineSpacingType=rvlsPercent) and
(LineSpacing<>BaseStyle.LineSpacing)) then
RVWriteX(Stream, Format(' line-height: %d.%d;',[LineSpacing div 100, LineSpacing mod 100]), Multiline)
else if (BaseStyle<>nil) and (BaseStyle.LineSpacingType=rvlsPercent) and
(BaseStyle.LineSpacing<>100) and (LineSpacingType<>rvlsPercent) then
RVWriteX(Stream, ' line-height: normal;', Multiline);
if rvpaoNoWrap in Options then
RVWriteX(Stream, ' white-space: nowrap;', Multiline)
else if (BaseStyle<>nil) and (rvpaoNoWrap in BaseStyle.Options) then
RVWriteX(Stream, ' white-space: normal;', Multiline);
if rvpaoKeepLinesTogether in Options then
RVWriteX(Stream, ' page-break-inside: avoid;', Multiline)
else if (BaseStyle<>nil) and (rvpaoKeepLinesTogether in BaseStyle.Options) then
RVWriteX(Stream, ' page-break-inside: auto;', Multiline);
if rvpaoKeepWithNext in Options then
RVWriteX(Stream, ' page-break-after: avoid;', Multiline)
else if (BaseStyle<>nil) and (rvpaoKeepWithNext in BaseStyle.Options) then
RVWriteX(Stream, ' page-break-after: auto;', Multiline);
if (Border.Style <> rvbNone) and (Border.Color<>clNone) then begin
RVWriteX(Stream, Format(' border-color: %s;', [RV_GetHTMLRGBStr(Border.Color, False)]),
Multiline);
RVWriteX(Stream, Format(' border-style: %s;', [GetBorderStyle(Border.Style)]),
Multiline);
RVWriteX(Stream, Format(' border-width: %dpx;', [GetBorderWidth(Border)]),
Multiline);
if not Border.VisibleBorders.Top then
RVWriteX(Stream, ' border-top: none;', Multiline);
if not Border.VisibleBorders.Right then
RVWriteX(Stream, ' border-right: none;', Multiline);
if not Border.VisibleBorders.Bottom then
RVWriteX(Stream, ' border-bottom: none;', Multiline);
if not Border.VisibleBorders.Left then
RVWriteX(Stream, ' border-left: none;', Multiline);
Border.BorderOffsets.AssignToRect(r);
end
else begin
if (BaseStyle<>nil) and (BaseStyle.Border.Style <> rvbNone) and
(BaseStyle.Border.Color<>clNone) then
RVWriteX(Stream, ' border: none;', Multiline);
r := Rect(0,0,0,0);
//RVWriteX(Stream, ' border: none;', Multiline);
end;
if (BaseStyle<>nil) and (BaseStyle.Border.Style <> rvbNone) and
(BaseStyle.Border.Color<>clNone) then
BaseStyle.Border.BorderOffsets.AssignToRect(baser)
else
baser := Rect(0,0,0,0);
if ((BaseStyle=nil) and (Background.Color<>clNone)) or
((BaseStyle<>nil) and (Background.Color<>BaseStyle.Background.Color)) then
RVWriteX(Stream,
Format(' background: %s;', [RV_GetCSSBkColor(Background.Color)]), Multiline);
if Background.Color<>clNone then
Background.BorderOffsets.AssignToRectIfGreater(r);
if (BaseStyle=nil) or not AreRectsEqual(baser,r) then
with r do
RVWriteX(Stream, Format(' padding: %dpx %dpx %dpx %dpx;',
[Top, Right, Bottom, Left]), Multiline);
if (BaseStyle<>nil) then begin
baser.Left := BaseStyle.LeftIndent-baser.Left;
baser.Right := BaseStyle.RightIndent-baser.Right;
baser.Top := BaseStyle.SpaceBefore-baser.Top;
baser.Bottom := BaseStyle.SpaceAfter-baser.Bottom;
end;
r.Left := LeftIndent-r.Left;
r.Right := RightIndent-r.Right;
r.Top := SpaceBefore-r.Top;
r.Bottom := SpaceAfter-r.Bottom;
if (BaseStyle=nil) or not AreRectsEqual(baser,r) then
with r do
if not IgnoreLeftIndents then
RVWriteX(Stream, Format(' margin: %dpx %dpx %dpx %dpx;',
[Top, Right, Bottom, Left]), Multiline)
else begin
RVWriteX(Stream, Format(' margin-top: %dpx;', [Top]), Multiline);
RVWriteX(Stream, Format(' margin-right: %dpx;', [Right]), Multiline);
RVWriteX(Stream, Format(' margin-bottom: %dpx;', [Bottom]), Multiline);
end;
end;
{=================================== TParaInfo ================================}
{ Constructor }
constructor TParaInfo.Create(Collection: TCollection);
begin
inherited Create(Collection);
NextParaNo := -1;
DefStyleNo := -1;
end;
{------------------------------------------------------------------------------}
{ Assigns Source to Self, if Source is TCustomRVParaInfo }
procedure TParaInfo.Assign(Source: TPersistent);
begin
if Source is TParaInfo then begin
NextParaNo := TParaInfo(Source).NextParaNo;
DefStyleNo := TParaInfo(Source).DefStyleNo;
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
ModifiedProperties1 := TParaInfo(Source).ModifiedProperties1;
ModifiedProperties2 := TParaInfo(Source).ModifiedProperties2;
{$ENDIF}
end;
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
procedure TParaInfo.ExcludeUnmodifiedProperties(Source: TCustomRVParaInfo;
PossibleProps: TRVParaInfoProperties);
{.............................................................}
procedure ChangeOption(Option: TRVParaOption; OptionId: TRVParaInfoProperty2);
begin
if (OptionId in PossibleProps) and
((Option in Options)=(Option in Source.Options)) then
Exclude(FModifiedProperties2, OptionId);
end;
{.............................................................}
begin
if (rvpiFirstIndent in PossibleProps) and (FirstIndent=Source.FirstIndent) then
Exclude(FModifiedProperties1, rvpiFirstIndent);
if (rvpiLeftIndent in PossibleProps) and (LeftIndent=Source.LeftIndent) then
Exclude(FModifiedProperties1, rvpiLeftIndent);
if (rvpiRightIndent in PossibleProps) and (RightIndent=Source.RightIndent) then
Exclude(FModifiedProperties1, rvpiRightIndent);
if (rvpiSpaceBefore in PossibleProps) and (SpaceBefore=Source.SpaceBefore) then
Exclude(FModifiedProperties1, rvpiSpaceBefore);
if (rvpiSpaceAfter in PossibleProps) and (SpaceAfter=Source.SpaceAfter) then
Exclude(FModifiedProperties1, rvpiSpaceAfter);
if (rvpiAlignment in PossibleProps) and (Alignment=Source.Alignment) then
Exclude(FModifiedProperties1, rvpiAlignment);
if (rvpiLineSpacing in PossibleProps) and (LineSpacing=Source.LineSpacing) then
Exclude(FModifiedProperties1, rvpiLineSpacing);
if (rvpiLineSpacingType in PossibleProps) and (LineSpacingType=Source.LineSpacingType) then
Exclude(FModifiedProperties1, rvpiLineSpacingType);
if (rvpiBackground_Color in PossibleProps) and (Background.Color=Source.Background.Color) then
Exclude(FModifiedProperties1, rvpiBackground_Color);
if (rvpiBackground_BO_Left in PossibleProps) and
(Background.BorderOffsets.Left=Source.Background.BorderOffsets.Left) then
Exclude(FModifiedProperties1, rvpiBackground_BO_Left);
if (rvpiBackground_BO_Top in PossibleProps) and
(Background.BorderOffsets.Top=Source.Background.BorderOffsets.Top) then
Exclude(FModifiedProperties1, rvpiBackground_BO_Top);
if (rvpiBackground_BO_Right in PossibleProps) and
(Background.BorderOffsets.Right=Source.Background.BorderOffsets.Right) then
Exclude(FModifiedProperties1, rvpiBackground_BO_Right);
if (rvpiBackground_BO_Bottom in PossibleProps) and
(Background.BorderOffsets.Bottom=Source.Background.BorderOffsets.Bottom) then
Exclude(FModifiedProperties1, rvpiBackground_BO_Bottom);
if (rvpiBorder_Style in PossibleProps) and (Border.Style=Source.Border.Style) then
Exclude(FModifiedProperties1, rvpiBorder_Style);
if (rvpiBorder_Color in PossibleProps) and (Border.Color=Source.Border.Color) then
Exclude(FModifiedProperties1, rvpiBorder_Color);
if (rvpiBorder_Width in PossibleProps) and (Border.Width=Source.Border.Width) then
Exclude(FModifiedProperties1, rvpiBorder_Width);
if (rvpiBorder_InternalWidth in PossibleProps) and (Border.Width=Source.Border.InternalWidth) then
Exclude(FModifiedProperties1, rvpiBorder_InternalWidth);
if (rvpiBorder_BO_Left in PossibleProps) and
(Border.BorderOffsets.Left=Source.Border.BorderOffsets.Left) then
Exclude(FModifiedProperties1, rvpiBorder_BO_Left);
if (rvpiBorder_BO_Top in PossibleProps) and
(Border.BorderOffsets.Top=Source.Border.BorderOffsets.Top) then
Exclude(FModifiedProperties1, rvpiBorder_BO_Top);
if (rvpiBorder_BO_Right in PossibleProps) and
(Border.BorderOffsets.Right=Source.Border.BorderOffsets.Right) then
Exclude(FModifiedProperties1, rvpiBorder_BO_Right);
if (rvpiBorder_BO_Bottom in PossibleProps) and
(Border.BorderOffsets.Bottom=Source.Border.BorderOffsets.Bottom) then
Exclude(FModifiedProperties1, rvpiBorder_BO_Bottom);
if (rvpiBorder_Vis_Left in PossibleProps) and
(Border.VisibleBorders.Left=Source.Border.VisibleBorders.Left) then
Exclude(FModifiedProperties1, rvpiBorder_Vis_Left);
if (rvpiBorder_Vis_Top in PossibleProps) and
(Border.VisibleBorders.Top=Source.Border.VisibleBorders.Top) then
Exclude(FModifiedProperties1, rvpiBorder_Vis_Top);
if (rvpiBorder_Vis_Right in PossibleProps) and
(Border.VisibleBorders.Right=Source.Border.VisibleBorders.Right) then
Exclude(FModifiedProperties1, rvpiBorder_Vis_Right);
if (rvpiBorder_Vis_Bottom in PossibleProps) and
(Border.VisibleBorders.Bottom=Source.Border.VisibleBorders.Bottom) then
Exclude(FModifiedProperties1, rvpiBorder_Vis_Bottom);
ChangeOption(rvpaoNoWrap, rvpiNoWrap);
ChangeOption(rvpaoReadOnly, rvpiReadOnly);
ChangeOption(rvpaoStyleProtect, rvpiStyleProtect);
ChangeOption(rvpaoDoNotWantReturns, rvpiDoNotWantReturns);
ChangeOption(rvpaoKeepLinesTogether, rvpiKeepLinesTogether);
ChangeOption(rvpaoKeepWithNext, rvpiKeepWithNext);
if (rvpiTabs in PossibleProps) and Tabs.IsEqual(Source.Tabs) then
Exclude(FModifiedProperties2, rvpiTabs);
if (rvpiBiDiMode in PossibleProps) and (BiDiMode=Source.BiDiMode) then
Exclude(FModifiedProperties2, rvpiBiDiMode);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEINI}
{ Loads itself from the ini-file, from the section Section.
fs is a format string for ini keys. }
procedure TParaInfo.LoadFromINI(ini: TRVIniFile; const Section,
fs: String);
begin
inherited LoadFromINI(ini, Section, fs);
NextParaNo := ini.ReadInteger(Section, Format(fs,[RVINI_NEXTPARANO]), -1);
DefStyleNo := ini.ReadInteger(Section, Format(fs,[RVINI_DEFSTYLENO]), -1);
end;
{------------------------------------------------------------------------------}
{ Stores itself in the ini-file, in the section Section.
fs is a format string for ini keys. }
procedure TParaInfo.SaveToINI(ini: TRVIniFile; const Section, fs: String);
begin
inherited SaveToINI(ini, Section, fs);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_NEXTPARANO]), NextParaNo, -1);
WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_DEFSTYLENO]), DefStyleNo, -1);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{ Is this paragraph style equal to Value?
Mapping is used to compare NextParaNo.
Mapping is from the Value's collection to this collection, see
TCustomRVInfos.MergeWith.
}
function TParaInfo.IsSimpleEqualEx(Value: TCustomRVInfo;
Mapping: TRVIntegerList): Boolean;
begin
Result := IsSimpleEqual(Value, True, False);
if not Result then
exit;
if Value is TParaInfo then begin
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;
}
if (TParaInfo(Value).NextParaNo>=0) then begin
if (TParaInfo(Value).NextParaNo>=Mapping.Count) then
TParaInfo(Value).NextParaNo := -1 // fix up
else if (Mapping[TParaInfo(Value).NextParaNo]<>NextParaNo) then
exit;
end;
Result := True;
end;
end;
{------------------------------------------------------------------------------}
{ Is this paragraph style equal to Value?
If IgnoreReferences, NextParaNo and DefStyleNo are ignored.
IgnoreID parameter is not used.
BaseStyleNo is ignored. }
function TParaInfo.IsSimpleEqual(Value: TCustomRVInfo; IgnoreReferences,
IgnoreID: Boolean): Boolean;
begin
Result := inherited IsSimpleEqual(Value, IgnoreReferences, IgnoreID);
if not Result then
exit;
if Value is TParaInfo then
Result :=
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
(ModifiedProperties1 = TParaInfo(Value).ModifiedProperties1) and
(ModifiedProperties2 = TParaInfo(Value).ModifiedProperties2) and
(StyleTemplateID = TParaInfo(Value).StyleTemplateID) and
{$ENDIF}
(IgnoreReferences or (NextParaNo = TParaInfo(Value).NextParaNo)) and
(IgnoreReferences or (DefStyleNo = TParaInfo(Value).DefStyleNo));
end;
{------------------------------------------------------------------------------}
{ Is the specified properties of this paragraph style equal to the properties of
Value. IgnoreList lists properties which will be ignored when comparing.
BaseStyleNo is always ignored. }
function TParaInfo.IsEqual(Value: TCustomRVParaInfo;
IgnoreList: TRVParaInfoProperties): Boolean;
begin
Result := inherited IsEqual(Value, IgnoreList);
if Result and (Value is TParaInfo) then begin
Result := ((rvpiNextParaNo in IgnoreList) or (NextParaNo = TParaInfo(Value).NextParaNo)) and
((rvpiDefStyleNo in IgnoreList) or (DefStyleNo = TParaInfo(Value).DefStyleNo))
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
and
(StyleTemplateId=Value.StyleTemplateId) and
(ModifiedProperties1=TParaInfo(Value).ModifiedProperties1) and
(ModifiedProperties2=TParaInfo(Value).ModifiedProperties2)
{$ENDIF}
;
end
end;
{============================== TParaInfos ====================================}
destructor TParaInfos.Destroy;
begin
FInvalidItem.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{ Assigns style names to TStrings. Called from TStrings.Assign. }
procedure TParaInfos.AssignTo(Dest: TPersistent);
var i: Integer;
begin
if Dest is TStrings then begin
TStrings(Dest).Clear;
for i:=0 to Count-1 do
TStrings(Dest).Add(Items[i].FName);
end