rvstyle.pas

richview1.7 full.source

    property OnApplyStyleColor: TRVApplyStyleColorEvent read FOnApplyStyleColor write FOnApplyStyleColor;
    property OnDrawStyleText: TRVDrawStyleTextEvent read FOnDrawStyleText write FOnDrawStyleText;
    property OnStyleHoverSensitive: TRVStyleHoverSensitiveEvent read FOnStyleHoverSensitive write FOnStyleHoverSensitive;
    property OnDrawTextBack: TRVDrawTextBackEvent read FOnDrawTextBack write FOnDrawTextBack;
    property OnDrawCheckpoint: TRVDrawCheckpointEvent read FOnDrawCheckpoint write FOnDrawCheckpoint;
    property OnDrawPageBreak: TRVDrawPageBreakEvent read FOnDrawPageBreak write FOnDrawPageBreak;
    property OnDrawParaBack: TRVDrawParaRectEvent read FOnDrawParaBack write FOnDrawParaBack;
  end;

  procedure RVWrite(Stream: TStream; const s: String);
  procedure RVWriteLn(Stream: TStream; const s: String);

const
  rvrtfDefault: TRVRTFOptions = [rvrtfDuplicateUnicode,
                                 rvrtfSaveEMFAsWMF,
                                 rvrtfSaveJpegAsJpeg];
  RVAllFontInfoProperties: TRVFontInfoProperties = [Low(TRVFontInfoProperty)..High(TRVFontInfoProperty)];
  RVAllParaInfoProperties: TRVParaInfoProperties = [Low(TRVParaInfoProperty)..High(TRVParaInfoProperty)];
  RVAllParaBackgroundProperties: TRVParaInfoProperties = [rvpiBackground_Color..rvpiBackground_BO_Bottom];
  RVAllParaBorderProperties: TRVParaInfoProperties = [rvpiBorder_Color..rvpiBorder_Vis_Bottom];
  RichViewResetStandardFlag: Boolean = True;

implementation
uses RVUni, RVStr, CRVData, RVItem, RVFuncs, RVFMisc;
{==============================================================================}
const arrNoYes: array [False..True] of String = (RVINIFILENO,RVINIFILEYES);
procedure WriteIntToIniIfNE(ini: TRVIniFile; const Section, Key: String;
                               Value, DefValue: Integer);
begin
  if Value<>DefValue then
    ini.WriteInteger(Section, Key, Value);
end;
{------------------------------------------------------------------------------}
procedure WriteBoolToIniIfNE(ini: TRVIniFile; const Section, Key: String;
                               Value, DefValue: Boolean);
begin
  if Value<>DefValue then
    ini.WriteString(Section, Key, arrNoYes[Value]);
end;
{------------------------------------------------------------------------------}
function IniReadBool(ini: TRVIniFile; const Section, Key: String;
                        DefValue: Boolean): Boolean;
begin
  Result := UpperCase(ini.ReadString(Section, Key, arrNoYes[DefValue]))=RVINIFILEYESU;
end;
{------------------------------------------------------------------------------}
procedure WriteLongStringToINI(ini: TRVIniFile; const Section, Key, Value: String);
var l,i: Integer;
    s: String;
begin
  i := 0;
  l := 500;
  while l<Length(Value) do begin
    s := Copy(Value, l-500+1, 500);
    ini.WriteString(Section, Key+'_'+IntToStr(i), s);
    inc(i);
    inc(l,500);
  end;
  s := Copy(Value, l-500+1, Length(Value));
  if s<>'' then
    ini.WriteString(Section, Key+'_'+IntToStr(i), s);
end;
{------------------------------------------------------------------------------}
function ReadLongStringFromINI(ini: TRVIniFile; const Section, Key: String): String;
var i: Integer;
    s: String;
begin
  Result := '';
  i := 0;
  while True do begin
    s := ini.ReadString(Section, Key+'_'+IntToStr(i), '');
    if s='' then
      break;
    Result := Result+s;
    inc(i);
  end;
end;
{------------------------------------------------------------------------------}
function FontStylesToString(Styles: TFontStyles): string;
begin
  Result := '';
  if fsBold in Styles then
    Result := Result + 'B';
  if fsItalic in Styles then
    Result := Result + 'I';
  if fsUnderline in Styles then
    Result := Result + 'U';
  if fsStrikeOut in Styles then
    Result := Result + 'S';
end;
{------------------------------------------------------------------------------}
function StringToFontStyles(const Styles: string): TFontStyles;
var i: Integer;
begin
  Result := [];
  for i := 1 to Length(Styles) do
    case Styles[i] of
      'B','b':
        Include(Result, fsBold);
      'I','i':
        Include(Result, fsItalic);
      'U','u':
        Include(Result, fsUnderline);
      'S','s':
        Include(Result, fsStrikeOut);
    end;
end;
{------------------------------------------------------------------------------}
function FontToString(Font: TFont): String;
begin
  with Font do
    Result := Format('%s,%d,%s,%d,%s,%d', [Name, Height,
      FontStylesToString(Style), Ord(Pitch), ColorToString(Color),
      {$IFDEF RICHVIEWCBDEF3} Charset {$ELSE} 0 {$ENDIF}]);
end;
{------------------------------------------------------------------------------}
procedure StringToFont(const s: string; Font: TFont);
var
  i,j, State: Integer;
  s2: string;
begin
  i := 1;
  State := 1;
  while i<=Length(s) do begin
    j := i;
    while (j<=Length(s)) and (s[j]<>',') do
      inc(j);
    if (j<=Length(s)) and (s[j]=',') then begin
      s2 := Copy(s, i, j-i);
      i := j+1;
      end
    else begin
      s2 := Copy(s, i, j-i+1);
      i := j;
    end;
    case State of
      1: Font.Name := s2;
      2: Font.Height := StrToInt(s2);
      3: Font.Style := StringToFontStyles(s2);
      4: Font.Pitch := TFontPitch(StrToInt(s2));
      5: Font.Color := StringToColor(s2);
      {$IFDEF RICHVIEWCBDEF3}
      6: Font.Charset := TFontCharset(StrToInt(s2));
      {$ENDIF}
    end;
    inc(State);
  end;
end;
{------------------------------------------------------------------------------}
procedure ScaleRect(var R: TRect; sad: TRVScreenAndDevice);
begin
  exit;
  R.Left   := MulDiv(R.Left,   sad.ppixDevice, sad.ppixScreen);
  R.Right  := MulDiv(R.Right,  sad.ppixDevice, sad.ppixScreen);
  R.Top    := MulDiv(R.Top,    sad.ppiyDevice, sad.ppiyScreen);
  R.Bottom := MulDiv(R.Bottom, sad.ppiyDevice, sad.ppiyScreen);
end;
(*
{------------------------------------------------------------------------------}
procedure IniSavePen(ini: TRVIniFile; const Section,Key: String; Pen: TPen;
                     DefStyle: TPenStyle; DefColor: TColor);
begin
  WriteIntToIniIfNE(ini, Section, Key+'Style', ord(Pen.Style), ord(DefStyle));
  WriteIntToIniIfNE(ini, Section, Key+'Color', Pen.Color,      DefColor);
  WriteIntToIniIfNE(ini, Section, Key+'Width', Pen.Width,      1);
  WriteIntToIniIfNE(ini, Section, Key+'Mode',  ord(Pen.Mode),  ord(pmCopy));
end;
{------------------------------------------------------------------------------}
procedure IniLoadPen(ini: TRVIniFile; const Section,Key: String; Pen: TPen;
                     DefStyle: TPenStyle; DefColor: TColor);
begin
  Pen.Style := TPenStyle(ini.ReadInteger(Section, Key+'Style', ord(DefStyle)));
  Pen.Color := ini.ReadInteger(Section, Key+'Color', DefColor);
  Pen.Width := ini.ReadInteger(Section, Key+'Width', 1);
  Pen.Mode  := TPenMode(ini.ReadInteger(Section, Key+'Mode', ord(pmCopy)));
end;
*)
{=========================== TCustomRVInfo ====================================}
constructor TCustomRVInfo.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FBaseStyleNo  := -1;
  FStandard     := True;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVInfo.Assign(Source: TPersistent);
begin
  if Source is TCustomRVInfo then begin
    FName        := TFontInfo(Source).FName;
    FBaseStyleNo := TFontInfo(Source).FBaseStyleNo;
    FStandard    := TFontInfo(Source).FStandard;
    end
  else
    inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVInfo.LoadFromINI(ini: TRVIniFile; const Section,
  fs, DefName: String);
begin
  StyleName   := ini.ReadString (Section, Format(fs,[RVINI_STYLENAME]), DefName);
  BaseStyleNo := ini.ReadInteger(Section, Format(fs,[RVINI_BASESTYLENO]), -1);
  Standard    := Boolean(ini.ReadInteger(Section, Format(fs,[RVINI_STANDARD]), Integer(True)));
end;
{------------------------------------------------------------------------------}
procedure TCustomRVInfo.SaveToINI(ini: TRVIniFile; const Section, fs: String);
begin
  ini.WriteString(Section,  Format(fs,[RVINI_STYLENAME]), StyleName);
  WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_BASESTYLENO]),BaseStyleNo,-1);
  WriteIntToIniIfNE(ini, Section, Format(fs,[RVINI_STANDARD]), Integer(Standard), Integer(True));
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
function TCustomRVInfo.GetDisplayName: String;
begin
  Result := FName;
end;
{$ENDIF}
{============================= TCustomRVInfos =================================}
constructor TCustomRVInfos.Create(ItemClass: TCollectionItemClass;
                                  Owner: TPersistent);
begin
  inherited Create(ItemClass);
  FOwner := Owner;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVInfos.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(TCustomRVInfo(Items[i]).FName);
    end
  else
    inherited AssignTo(Dest);
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
function TCustomRVInfos.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TCustomRVInfos.MergeWith(Styles: TCustomRVInfos;
  Mode: TRVStyleMergeMode; Mapping: TRVIntegerList);
var i,j,idx,oldcount: Integer;
    Style: TCustomRVInfo;
    wht, maxwht: Integer;
    ForbiddenStyles: TRVIntegerList;
    {.............................................}
    procedure AdjustReferences;
    var i: Integer;
        Style: TCustomRVInfo;
    begin
      for i := oldcount to Count-1 do begin
        Style := TCustomRVInfo(Items[i]);
        if RichViewResetStandardFlag then
          Style.Standard := False;
        if Style.BaseStyleNo>=0 then
          Style.BaseStyleNo := Mapping[Style.BaseStyleNo];
        if (Style is TFontInfo) and (TFontInfo(Style).NextStyleNo>=0) then
          TFontInfo(Style).NextStyleNo := Mapping[TFontInfo(Style).NextStyleNo];
        if (Style is TParaInfo) and (TParaInfo(Style).NextParaNo>=0) then
          TParaInfo(Style).NextParaNo := Mapping[TParaInfo(Style).NextParaNo];
      end;
    end;
    {.............................................}
begin
  Mapping.Clear;
  Mapping.Capacity := Styles.Count;
  oldcount := Count;
  case Mode of
    rvs_merge_Append:
      for i := 0 to Styles.Count-1 do begin
        Mapping.Add(Count);
        Add.Assign(Styles.Items[i]);
      end;
    rvs_merge_Map:
      for i := 0 to Styles.Count-1 do begin
        Style := TCustomRVInfo(Styles.Items[i]);
        maxwht := 0;
        idx := -1;
        if (Style is TFontInfo) then begin
          {$IFNDEF RVDONOTUSEUNICODE}
          for j := 0 to Count-1 do
            if (TFontInfo(Items[j]).Jump=TFontInfo(Style).Jump) and
               (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}