unit RVStyle;

{$mode Delphi}

interface
{.$R RVStyle}
uses
  {$IFDEF FPC}
  LCLType,
  {$ELSE}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes, Graphics, Controls, Forms, {LibConst,}
  IniFiles;
const
  crJump = 101;

  rvsNormal = 0;
  rvsHeading = 1;
  rvsSubheading = 2;
  rvsKeyword = 3;
  rvsJump1 = 4;
  rvsJump2 = 5;

  LAST_DEFAULT_STYLE_NO = rvsJump2;

{$I RV_Defs.inc}

type
{--------------------------------------------------------------}
  TFontInfo = class(TCollectionItem)
   private
    { Private declarations }
    FFontName: TFontName;
    FSize: Integer;
    FColor: TColor;
    FStyle: TFontStyles;
    {$IFDEF RICHVIEWDEF3}
    FCharSet: TFontCharSet;
    {$ENDIF}
  public
    { Public declarations }
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
   published
    { Published declarations }
    {$IFDEF RICHVIEWDEF3}
    property CharSet: TFontCharSet read FCharSet write FCharSet;
    {$ENDIF}
    property FontName: TFontName read FFontNAme write FFontName;
    property Size: Integer read FSize write FSize;
    property Color: TColor read FColor write FColor;
    property Style: TFontStyles read FStyle write FStyle;
  end;
{--------------------------------------------------------------}
 TFontInfos = class (TCollection)
    private
      function GetItem(Index: Integer): TFontInfo;
      procedure SetItem(Index: Integer; Value: TFontInfo);
    public
      constructor Create;
      function Add: TFontInfo;
      procedure Delete(Index: Integer);
      procedure AddFont(Name: TFontName; Size: Integer;
                        Color: TColor; Style:TFontStyles);
      {$IFDEF RICHVIEWDEF3}
      procedure AddFontEx(Name: TFontName; Size: Integer;
                        Color: TColor; Style:TFontStyles;
                        CharSet: TFontCharSet);
      {$ENDIF}
      property Items[Index: Integer]: TFontInfo
                read GetItem write SetItem; default;
  end;
{--------------------------------------------------------------}
  TRVStyle = class(TComponent)
  private
    { Private declarations }
    FColor, FHoverColor, FSelColor, FSelTextColor: TColor;
    FCursor: TCursor;
    FTextStyles: TFontInfos;
    FFullRedraw: Boolean;
    function GetTextStyle(Index: Integer): TFontInfo;
    procedure SetTextStyles(ATextStyles: TFontInfos);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function AddTextStyle: Integer; { returns index of new style }
    procedure DeleteTextStyle(Index: Integer); { removes NONSTANDARD text style}
    procedure SaveINI(filename, section: String); {WARNING: before saving all section will be removed}
    procedure LoadINI(filename, section: String);
  published
    { Published declarations }
    property TextStyles: TFontInfos read FTextStyles write SetTextStyles;
    property JumpCursor: TCursor read FCursor write FCursor;
    property Color: TColor read FColor write FColor;
    property HoverColor: TColor read FHoverColor write FHoverColor;
    property FullRedraw: Boolean read FFullRedraw write FFullRedraw;
    property SelColor: TColor read FSelColor write FSelColor;
    property SelTextColor: TColor read FSelTextColor write FSelTextColor;    
  end;

implementation
{--------------------------------------------------------------}
{ TFontInfo                                                    }
{--------------------------------------------------------------}
constructor TFontInfo.Create(Collection: TCollection);
begin
 inherited Create(Collection);
 FFontName := 'Arial';
 FSize := 10;
 FColor := clWindowText;
 FStyle := [];
 {$IFDEF RICHVIEWDEF3}
 FCharSet := DEFAULT_CHARSET;
 {$ENDIF}
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;
      FStyle := TFontInfo(Source).FStyle;
      {$IFDEF RICHVIEWDEF3}
      FCharSet := TFontInfo(Source).FCharSet;
      {$ENDIF}
    end
  else
    inherited Assign(Source);
end;
{--------------------------------------------------------------}
{ TFontInfos                                                   }
{--------------------------------------------------------------}
constructor TFontInfos.Create;
begin
  inherited Create(TFontInfo);
end;
{-------------------------------------------------------------}
function TFontInfos.Add: TFontInfo;
begin
  Result := TFontInfo(inherited Add);
end;
{-------------------------------------------------------------}
procedure TFontInfos.AddFont(Name: TFontName; Size: Integer;
                   Color: TColor; Style:TFontStyles);
var v: TFontInfo;
begin
   v := Add;
   v.FontName := Name;
   v.Size := Size;
   v.Color := Color;
   v.Style := Style;
end;
{-------------------------------------------------------------}
{$IFDEF RICHVIEWDEF3}
procedure TFontInfos.AddFontEx(Name: TFontName; Size: Integer;
                   Color: TColor; Style:TFontStyles;
                   CharSet: TFontCharSet);
var v: TFontInfo;
begin
   v := Add;
   v.FontName := Name;
   v.Size := Size;
   v.Color := Color;
   v.Style := Style;
   v.CharSet := CharSet;
end;
{$ENDIF}
{-------------------------------------------------------------}
function TFontInfos.GetItem(Index: Integer): TFontInfo;
begin
  Result := TFontInfo(inherited GetItem(Index));
end;
{-------------------------------------------------------------}
procedure TFontInfos.SetItem(Index: Integer; Value: TFontInfo);
begin
  inherited SetItem(Index, Value);
end;
{-------------------------------------------------------------}
procedure TFontInfos.Delete(Index: Integer);
begin
   if (Index<=LAST_DEFAULT_STYLE_NO) or (Index>=Count) then exit;
   Items[Index].Free;
   {
   c:=TFontInfos.Create;
   c.Assign(Self);
   Clear;
   for i:=0 to c.Count-1 do
    if i<>Index then
       AddFont(c[i].FontName, c[i].Size, c[i].Color, c[i].Style);
   c.Free;
   }
end;
{--------------------------------------------------------------}
{ TRVStyle                                                     }
{--------------------------------------------------------------}
constructor TRVStyle.Create(AOwner: TComponent);
var fi: TFontInfo;
    i : Integer;
begin
  inherited Create(AOwner);
  FFullRedraw := False;  
  {$IFDEF FPC}
  Screen.Cursors[crJump] := LoadCursorFromLazarusREsource('RV_JUMP_CURSOR');
  {$ELSE}
  Screen.Cursors[crJump] := LoadCursor(hInstance,'RV_JUMP_CURSOR');
  {$ENDIF}
  FCursor := crJump;
  FColor := clWindow;
  FHoverColor := clNone;
  FSelColor := clHighlight;
  FSelTextColor := clHighlightText;
  FTextStyles := TFontInfos.Create;
  for i := 0 to LAST_DEFAULT_STYLE_NO do begin
    fi := FTextStyles.Add;
    case i of
     rvsHeading:
        begin
           fi.Style := fi.Style + [fsBold];
           fi.Color := clBlue;
        end;
     rvsSubheading:
        begin
           fi.Style := fi.Style + [fsBold];
           fi.Color := clNavy;
        end;
     rvsKeyword:
        begin
           fi.Style := fi.Style + [fsItalic];
           fi.Color := clMaroon;
        end;
     rvsJump1, rvsJump2:
        begin
           fi.Style := fi.Style + [fsUnderline];
           fi.Color := clGreen;
        end;
    end;
  end;
end;
{--------------------------------------------------------------}
destructor TRVStyle.Destroy;
begin
  FTextStyles.Free;
  inherited Destroy;
end;
{--------------------------------------------------------------}
function TRVStyle.GetTextStyle(Index: Integer): TFontInfo;
begin
  GetTextStyle := FTextStyles[Index];
end;
{--------------------------------------------------------------}
procedure TRVStyle.SetTextStyles(ATextStyles: TFontInfos);
begin
   FTextStyles.Assign(ATextStyles);
end;
{--------------------------------------------------------------}
function TRVStyle.AddTextStyle: Integer;
begin
   FTextStyles.Add;
   AddTextStyle := FTextStyles.Count-1;
end;
{--------------------------------------------------------------}
procedure TRVStyle.DeleteTextStyle(Index: Integer);
begin
   FTextStyles.Delete(Index);
end;
{--------------------------------------------------------------}
procedure TRVStyle.SaveINI(filename, section: String);
var i: Integer;
    ini: TIniFile;
    s : String;
begin
   ini := nil;
   try
    ini := TIniFile.Create(filename);
    ini.EraseSection(section);
    ini.WriteInteger(section,'Color',FColor);
    ini.WriteInteger(section,'HoverColor',FHoverColor);
    ini.WriteInteger(section,'SelColor',FSelColor);
    ini.WriteInteger(section,'SelTextColor',FSelTextColor);
    ini.WriteInteger(section,'JumpCursor',FCursor);
    ini.WriteInteger(section,'FontsCount',FTextStyles.Count);
    for i:=0 to FTextStyles.Count-1 do
    begin
       ini.WriteString(section,'FontName'+IntToStr(i),FTextStyles[i].FontName);
       ini.WriteInteger(section,'FontSize'+IntToStr(i),FTextStyles[i].Size);
       ini.WriteInteger(section,'FontColor'+IntToStr(i),FTextStyles[i].Color);
       {$IFDEF RICHVIEWDEF3}
       ini.WriteInteger(section,'FontCharSet'+IntToStr(i),FTextStyles[i].CharSet);
       {$ENDIF}
       if fsBold in FTextStyles[i].Style then
         s := 'Yes'
       else
         s := 'No';
       ini.WriteString(section,'FontBold'+IntToStr(i),s);
       if fsUnderline in FTextStyles[i].Style then
         s := 'Yes'
       else
         s := 'No';
       ini.WriteString(section,'FontUnderline'+IntToStr(i),s);
       if fsStrikeOut in FTextStyles[i].Style then
         s := 'Yes'
       else
         s := 'No';
       ini.WriteString(section,'FontStrikeOut'+IntToStr(i),s);
       if fsItalic in FTextStyles[i].Style then
         s := 'Yes'
       else
         s := 'No';
       ini.WriteString(section,'FontItalic'+IntToStr(i),s);
    end;
    except
     on Exception do ;
   end;
   ini.Free;
end;
{--------------------------------------------------------------}
procedure TRVStyle.LoadINI(filename, section: String);
var i, fontcounts: Integer;
    ini: TIniFile;
begin
   ini := nil;
   try
    ini           := TIniFile.Create(filename);
    FColor        := ini.ReadInteger(section, 'Color',        clWindow);
    FHoverColor   := ini.ReadInteger(section, 'HoverColor',   clNone);
    FSelColor     := ini.ReadInteger(section, 'SelColor',     clHighlight);
    FSelTextColor := ini.ReadInteger(section, 'SelTextColor', clHighlightText);
    FCursor       := ini.ReadInteger(section, 'JumpCursor',   crJump);
    fontcounts    := ini.ReadInteger(section, 'FontsCount',   LAST_DEFAULT_STYLE_NO+1);
    if fontcounts<LAST_DEFAULT_STYLE_NO+1 then fontcounts := LAST_DEFAULT_STYLE_NO+1;
    while FTextStyles.Count > fontcounts do DeleteTextStyle(FTextStyles.Count-1);
    while FTextStyles.Count < fontcounts do AddTextStyle;
    for i:=0 to fontcounts-1 do
    begin
       FTextStyles[i].FontName := ini.ReadString(section,'FontName'+IntToStr(i), 'Arial');
       FTextStyles[i].Size := ini.ReadInteger(section,'FontSize'+IntToStr(i), 10);
       FTextStyles[i].Color := ini.ReadInteger(section,'FontColor'+IntToStr(i), clWindowText);
       {$IFDEF RICHVIEWDEF3}
       FTextStyles[i].CharSet := ini.ReadInteger(section,'FontCharSet'+IntToStr(i), DEFAULT_CHARSET);
       {$ENDIF}
       FTextStyles[i].Style := [];
       if ini.ReadString(section,'FontBold'+IntToStr(i),'No')='Yes' then
          FTextStyles[i].Style := FTextStyles[i].Style + [fsBold];
       if ini.ReadString(section,'FontUnderline'+IntToStr(i),'No')='Yes' then
          FTextStyles[i].Style := FTextStyles[i].Style + [fsUnderline];
       if ini.ReadString(section,'FontStrikeOut'+IntToStr(i),'No')='Yes' then
          FTextStyles[i].Style := FTextStyles[i].Style + [fsStrikeOut];
       if ini.ReadString(section,'FontItalic'+IntToStr(i),'No')='Yes' then
          FTextStyles[i].Style := FTextStyles[i].Style + [fsItalic];
    end;
    except
     on Exception do ;
   end;
   ini.Free;
end;

end.