rvstyle.pas

richview1.7 full.source

          if idx=-1 then
            for j := 0 to Count-1 do
              if (TFontInfo(Items[j]).Jump=TFontInfo(Style).Jump) then begin
                wht := Style.SimilarityValue(TCustomRVInfo(Styles.Items[j]));
                if (idx=-1) or (wht>maxwht) then begin
                  maxwht := wht;
                  idx := j;
                end;
              end;
          {$IFNDEF RVDONOTUSEUNICODE}
          if idx=-1 then
            for j := 0 to Count-1 do
              if (TFontInfo(Items[j]).Unicode=TFontInfo(Style).Unicode) then begin
                wht := Style.SimilarityValue(TCustomRVInfo(Styles.Items[j]));
                if (idx=-1) or (wht>maxwht) then begin
                  maxwht := wht;
                  idx := j;
                end;
              end;
          {$ENDIF}
        end;
        if idx=-1 then
          for j := 0 to Count-1 do begin
            wht := Style.SimilarityValue(TCustomRVInfo(Styles.Items[j]));
            if (idx=-1) or (wht>maxwht) then begin
              maxwht := wht;
              idx := j;
            end;
          end;
        Mapping.Add(idx);
      end;
    rvs_merge_SmartMerge:
      begin
        if Self is TRVListInfos then
          ForbiddenStyles := TRVIntegerList.Create
        else
          ForbiddenStyles := nil;
        for i := 0 to Styles.Count-1 do begin
          idx := -1;
          Style := TCustomRVInfo(Styles.Items[i]);
          if (i<Count) and Style.IsSimpleEqualEx(TCustomRVInfo(Items[i]), Mapping) and
             ((ForbiddenStyles=nil) or (ForbiddenStyles.IndexOf(Pointer(i))<0)) then
            idx := i;
          if idx<0 then
            for j := 0 to Count-1 do
              if Style.IsSimpleEqualEx(TCustomRVInfo(Items[j]), Mapping) and
                ((ForbiddenStyles=nil) or (ForbiddenStyles.IndexOf(Pointer(j))<0)) then begin
                idx := j;
                break;
              end;
          if idx<0 then begin
            idx := Count;
            Add.Assign(Styles.Items[i]);
          end;
          Mapping.Add(idx);
          if ForbiddenStyles<>nil then begin
            if TRVListInfo(Style).HasNumbering then
              ForbiddenStyles.Add(idx);
          end;
        end;
        ForbiddenStyles.Free;
      end;
  end;
  AdjustReferences;
end;
{================================ TFontInfo ===================================}
constructor TFontInfo.Create(Collection: TCollection);
begin
 inherited Create(Collection);
 FFontName  := RVDEFAULTSTYLEFONT;
 FSize      := 10;
 FColor     := clWindowText;
 FBackColor := clNone;
 FHoverBackColor := clNone;
 FHoverColor := clNone;
 FStyle     := [];
 FStyleEx   := [];
 {$IFDEF RICHVIEWCBDEF3}
 FCharset   := DEFAULT_CHARSET;
 {$ENDIF}
 Jump       := False;
 JumpCursor := crJump;
 FName      := RVDEFAULTTEXTSTYLENAME;
 FVShift    := 0;
 FNextStyleNo  := -1;
 FCharScale    := 100;
end;
{------------------------------------------------------------------------------}
procedure TFontInfo.Assign(Source: TPersistent);
begin
  if Source is TFontInfo then begin
      FFontName   := TFontInfo(Source).FFontName;
      FSize       := TFontInfo(Source).FSize;
      FColor      := TFontInfo(Source).FColor;
      FBackColor  := TFontInfo(Source).FBackColor;
      FHoverBackColor  := TFontInfo(Source).FHoverBackColor;
      FHoverColor  := TFontInfo(Source).FHoverColor;
      FStyle      := TFontInfo(Source).FStyle;
      FStyleEx    := TFontInfo(Source).FStyleEx;
      {$IFDEF RICHVIEWCBDEF3}
      FCharset    := TFontInfo(Source).FCharset;
      {$ENDIF}
      {$IFDEF RVLANGUAGEPROPERTY}
      FLanguage   := TFontInfo(Source).FLanguage;
      {$ENDIF}
      FJump       := TFontInfo(Source).FJump;
      FJumpCursor := TFontInfo(Source).FJumpCursor;
      FProtection := TFontInfo(Source).FProtection;
      FOptions    := TFontInfo(Source).FOptions;
      FVShift     := TFontInfo(Source).FVShift;
      FNextStyleNo:= TFontInfo(Source).FNextStyleNo;
      FCharScale  := TFontInfo(Source).FCharScale;
      FCharSpacing := TFontInfo(Source).FCharSpacing;
      FBiDiMode   := TFontInfo(Source).FBiDiMode;
      {$IFNDEF RVDONOTUSEUNICODE}
      FUnicode    := TFontInfo(Source).FUnicode;
      {$ENDIF}
      inherited Assign(Source);
    end
  else if Source is TFont then begin
      FFontName := TFont(Source).Name;
      FSize     := TFont(Source).Size;
      FColor    := TFont(Source).Color;
      FStyle    := TFont(Source).Style;
      {$IFDEF RICHVIEWCBDEF3}
      FCharset  := TFont(Source).Charset;
      {$ENDIF}
    end
  else
    inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
procedure TFontInfo.AssignTo(Dest: TPersistent);
begin
  if Dest is TFont then begin
      TFont(Dest).Name    := FFontName;
      TFont(Dest).Size    := FSize;
      TFont(Dest).Color   := FColor;
      TFont(Dest).Style   := FStyle;
      {$IFDEF RICHVIEWCBDEF3}
      {$IFNDEF RVDONOTUSEUNICODE}
      if not Unicode then
      {$ENDIF}
        TFont(Dest).Charset := FCharset;
      {$ENDIF}
    end
  else
    inherited AssignTo(Dest);
end;
{------------------------------------------------------------------------------}
procedure TFontInfo.AssignToLogFont(var LogFont: TLogFont; Canvas: TCanvas);
var ppi: Integer;
begin
  FillChar(LogFont, sizeof(LogFont), 0);
  with LogFont do begin
    ppi := 0;
    if Collection<>nil then
      ppi := TFontInfos(Collection).PixelsPerInch;
    if ppi=0 then
      ppi := Canvas.Font.PixelsPerInch;
    lfHeight := -MulDiv(Size, ppi, 72);
    if fsBold in Style then
      lfWeight := FW_BOLD
    else
      lfWeight := FW_NORMAL;
    lfItalic := Byte(fsItalic in Style);
    lfUnderline := Byte(fsUnderline in Style);
    lfStrikeOut := Byte(fsStrikeOut in Style);
    {$IFDEF RICHVIEWCBDEF3}
    lfCharSet := Byte(Charset);
    {$ENDIF}
    StrPCopy(lfFaceName, FontName);
    lfQuality := DEFAULT_QUALITY;
    lfOutPrecision := OUT_DEFAULT_PRECIS;
    lfClipPrecision := CLIP_DEFAULT_PRECIS;
    lfPitchAndFamily := DEFAULT_PITCH;
  end;
end;
{------------------------------------------------------------------------------}
// mapping is from the value's collection to this collection
function TFontInfo.IsSimpleEqualEx(Value: TCustomRVInfo; Mapping: TRVIntegerList): Boolean;
begin
  Result := IsSimpleEqual(Value, True);
  if not Result then
    exit;
  Result := False;
  {
  if (Value.BaseStyleNo>=0) then begin
    if (Value.BaseStyleNo>=Mapping.Count) then
      Value.BaseStyleNo := -1 // fix up
    else if (Mapping[Value.BaseStyleNo]<>BaseStyleNo) then
      exit;
  end;
  }
  if (TFontInfo(Value).NextStyleNo>=0) then begin
    if (TFontInfo(Value).NextStyleNo>=Mapping.Count) then
      Value.BaseStyleNo := -1 // fix up
    else if (Mapping[TFontInfo(Value).NextStyleNo]<>NextStyleNo) then
      exit;
  end;
  Result := True;
end;
{------------------------------------------------------------------------------}
function TFontInfo.IsSimpleEqual(Value: TCustomRVInfo; IgnoreReferences: Boolean): Boolean;
begin
   Result := (Size        = TFontInfo(Value).Size   ) and
             {$IFDEF RICHVIEWCBDEF3}
             (Charset     = TFontInfo(Value).Charset) and
             {$ENDIF}
             {$IFNDEF RVDONOTUSEUNICODE}
             (Unicode     = TFontInfo(Value).Unicode) and
             {$ENDIF}
             (Style       = TFontInfo(Value).Style  ) and
             (StyleEx     = TFontInfo(Value).StyleEx) and
             (AnsiCompareText(FontName, TFontInfo(Value).FontName)=0) and
             (VShift      = TFontInfo(Value).VShift ) and
             (Color       = TFontInfo(Value).Color  ) and
             (BackColor   = TFontInfo(Value).BackColor) and
             (Jump        = TFontInfo(Value).Jump   ) and
             {$IFDEF RVLANGUAGEPROPERTY}
             (Language     = TFontInfo(Value).Language) and
             {$ENDIF}
             (not Jump or
              ((HoverColor     = TFontInfo(Value).HoverColor    ) and
               (HoverBackColor = TFontInfo(Value).HoverBackColor) and
               (JumpCursor    = TFontInfo(Value).JumpCursor     ))
             ) and
             (IgnoreReferences or (NextStyleNo = TFontInfo(Value).NextStyleNo)) and
             (Protection  = TFontInfo(Value).Protection ) and
             (Options     = TFontInfo(Value).Options )    and
             (CharScale   = TFontInfo(Value).CharScale  ) and
             (CharSpacing = TFontInfo(Value).CharSpacing) and
             (BiDiMode    = TFontInfo(Value).BiDiMode  );
end;
{------------------------------------------------------------------------------}
function TFontInfo.SimilarityValue(Value: TCustomRVInfo): Integer;
var fs: TFontStyle;
begin
   Result :=
     RV_CompareInts(TFontInfo(Value).Size, Size, RVSMW_FONTSIZE)+
     RV_CompareInts(TFontInfo(Value).VShift, VShift, RVSMW_VSHIFTRATIO)+
     RV_CompareInts(TFontInfo(Value).CharScale, CharScale, RVSMW_CHARSCALE)+
     RV_CompareInts(TFontInfo(Value).CharSpacing, CharSpacing, RVSMW_CHARSPACING)+
     RV_CompareColors(TFontInfo(Value).Color, Color, RVSMW_EACHRGBCOLOR, RVSMW_COLORSET)+
     RV_CompareColors(TFontInfo(Value).BackColor, BackColor, RVSMW_EACHRGBBCOLOR, RVSMW_BCOLORSET);
   if TFontInfo(Value).BiDiMode=BiDiMode then
     inc(Result, RVSMW_BIDIMODE);
   if AnsiCompareText(TFontInfo(Value).FontName, FontName)=0 then
     inc(Result, RVSMW_FONTNAME);
   for fs := Low(TFontStyle) to High(TFontStyle) do
     if (fs in TFontInfo(Value).Style) = (fs in Style) then
       inc(Result, RVSMW_FONTEACHSTYLE);
   if (rvfsOverline in TFontInfo(Value).StyleEx)=(rvfsOverline in StyleEx) then
     inc(Result, RVSMW_OVERLINE);
   if (rvfsAllCaps in TFontInfo(Value).StyleEx)=(rvfsAllCaps in StyleEx) then
     inc(Result, RVSMW_OVERLINE);
   if ((TFontInfo(Value).Style=[]) and (TFontInfo(Value).StyleEx=[]))
      =
      ((Style=[]) and (StyleEx=[])) then
     inc(Result, RVSMW_FONTSTYLESET);

   {$IFDEF RVLANGUAGEPROPERTY}
   if TFontInfo(Value).Language = Language then
     inc(Result, RVSMW_LANGUAGE);
   {$ENDIF}

   if Jump and TFontInfo(Value).Jump then begin
     if TFontInfo(Value).JumpCursor=JumpCursor then
       inc(Result, RVSMW_CURSOR);
     inc(Result,
         RV_CompareColors(TFontInfo(Value).HoverColor,HoverColor, RVSMW_EACHRGBCOLOR, RVSMW_COLORSET) div 2+
         RV_CompareColors(TFontInfo(Value).HoverBackColor,HoverBackColor, RVSMW_EACHRGBBCOLOR, RVSMW_BCOLORSET) div 2);
   end;
   if TFontInfo(Value).Protection<>Protection then
     dec(Result, RVSMW_PROTECTION);
   if (rvteoHTMLCode in TFontInfo(Value).Options)=(rvteoHTMLCode in Options) then
     inc(Result, RVSMW_SPECIALCODE);
   if (rvteoRTFCode in TFontInfo(Value).Options)=(rvteoRTFCode in Options) then
     inc(Result, RVSMW_SPECIALCODE);
  {$IFDEF RICHVIEWCBDEF3}
  if Charset=TFontInfo(Value).Charset then
    inc(Result, RVSMW_FONTCHARSET)
  else
    if (Charset=DEFAULT_CHARSET) or
       (TFontInfo(Value).Charset=DEFAULT_CHARSET) then
      inc(Result, RVSMW_FONTCHARSET div 4);
  {$ENDIF}
end;
{------------------------------------------------------------------------------}
function TFontInfo.IsEqual(Value: TFontInfo; IgnoreList: TRVFontInfoProperties): Boolean;
begin
   Result := ((rvfiSize        in IgnoreList) or (Size        = Value.Size       )) and