rvmarker.pas

richview1.7 full.source

unit RVMarker;

interface
{$I RV_Defs.inc}
uses SysUtils, Windows, Classes, Controls, Graphics, Forms,
     RVFuncs, RVItem, RVStyle, DLines, RVFMisc, RVScroll, RVUni, RVClasses;

{$IFNDEF RVDONOTUSELISTS}

type

  TRVMarkerList = class;

  TRVMarkerItemInfo = class (TRVRectItemInfo)
    private
      FWidth, FHeight, FDescent, FOverhang: Integer;
      FCachedIndexInList: Integer;
    protected
      function SaveRVFHeaderTail(RVData: TPersistent): String; override;
      procedure CalcSize(Canvas: TCanvas; RVData: TPersistent; var Width, Height, Desc, Overhang: Integer;
        sad: PRVScreenAndDevice; ForMinWidth: Boolean;
        var HShift, SpaceBefore: Integer);
      procedure CalcDisplayString(RVStyle: TRVStyle; List: TRVMarkerList; Index: Integer);
      function GetHeight: Integer; override;
      function GetWidth: Integer; override;
      function GetLevelInfoEx(RVStyle: TRVStyle; LevelNo: Integer): TRVListLevel;
      function GetDescent: Integer; override;
    public
      ListNo, Level: Integer;
      Counter: Integer;
      Reset: Boolean;
      StartFrom: Integer;
      DisplayString: String;
      constructor CreateEx(RVData: TPersistent; AListNo, ALevel, AStartFrom: Integer; AReset: Boolean);
      constructor Create(RVData: TPersistent); override;
      procedure Assign(Source: TCustomRVItemInfo); override;
      function GetLevelInfo(RVStyle: TRVStyle): TRVListLevel;
      function GetMinWidth(sad: PRVScreenAndDevice; Canvas: TCanvas; RVData: TPersistent): Integer; override;
      function GetBoolValue(Prop: TRVItemBoolProperty): Boolean; override;
      function GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean; override;
      procedure OnDocWidthChange(DocWidth: Integer; dli: TRVDrawLineInfo; Printing: Boolean;
          Canvas: TCanvas; RVData: TPersistent;
          sad: PRVScreenAndDevice;
          var HShift: Integer; NoCaching: Boolean); override;
      procedure Paint(x,y: Integer; Canvas: TCanvas; State: TRVItemDrawStates;
                      Style: TRVStyle; dli: TRVDrawLineInfo); override;
      procedure Print(Canvas: TCanvas; x,y,x2: Integer; Preview, Correction: Boolean;
          const sad: TRVScreenAndDevice; RichView: TRVScroller;
          dli: TRVDrawLineInfo;
          Part: Integer); override;
      function PrintToBitmap(Bkgnd: TBitmap; Preview: Boolean; RichView: TRVScroller;
          dli: TRVDrawLineInfo; Part: Integer):Boolean; override;
      function ReadRVFHeader(var P: PChar; RVData: TPersistent): Boolean; override;
      procedure SaveRVF(Stream: TStream; RVData: TPersistent; ItemNo, ParaNo: Integer;
          const Name: String; Part: TRVMultiDrawItemPart;
          ForceSameAsPrev: Boolean); override;
      procedure MovingToUndoList(ItemNo: Integer; RVData, AContainerUndoItem: TObject); override;
      procedure MovingFromUndoList(ItemNo: Integer; RVData: TObject); override;
      function GetImageWidth(RVStyle: TRVStyle): Integer; override;
      function GetImageHeight(RVStyle: TRVStyle): Integer; override;
      function GetLeftOverhang: Integer; override;
      procedure HTMLOpenOrCloseTags(Stream: TStream; OldLevelNo, NewLevelNo: Integer;
          RVStyle: TRVStyle; UseCSS: Boolean);
      procedure SaveHTMLSpecial(Stream: TStream; Prev: TRVMarkerItemInfo; RVStyle: TRVStyle; UseCSS: Boolean);
      procedure SaveToHTML(Stream: TStream; RVData: TPersistent;
          ItemNo: Integer; const Text, Path: String;
          const imgSavePrefix: String; var imgSaveNo: Integer;
          CurrentFileColor: TColor; SaveOptions: TRVSaveOptions;
          UseCSS: Boolean; Bullets: TRVList); override;
      function GetLICSS(RVData: TPersistent; ItemNo: Integer; const Path,
          imgSavePrefix: String; var imgSaveNo: Integer; CurrentFileColor: TColor;
          SaveOptions: TRVSaveOptions; Bullets: TRVList): String;
      {$IFNDEF RVDONOTUSERTF}
      procedure FillRTFTables(ColorList: TRVColorList; ListOverrideCountList: TRVIntegerList;
        RVData: TPersistent); override;
      procedure SaveRTF(Stream: TStream; RVData: TPersistent; ItemNo: Integer;
        const Name: String; TwipsPerPixel: Double; Level: Integer;
        ColorList: TRVColorList; StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
        FontTable: TRVList); override;
      {$ENDIF}
      procedure MarkStylesInUse(UsedTextStyles, UsedParaStyles, UsedListStyles: TRVIntegerList); override;
      procedure UpdateStyles(TextStylesShift, ParaStylesShift, ListStylesShift: TRVIntegerList); override;
      function AsText(LineWidth: Integer;
          RVData: TPersistent; const Text, Path: String;
          TextOnly,Unicode: Boolean): String; override;
      function GetIndexInList(List: TList): Integer;
  end;

  TRVMarkerList = class (TList)
    function InsertAfter(InsertMe, AfterMe: TRVMarkerItemInfo): Integer;
    procedure RecalcCounters(StartFrom: Integer; RVStyle: TRVStyle);
    function FindParentMarker(Index: Integer): Integer;
  end;

{.$ENDIF}

implementation
uses CRVData, CRVFData, RichView;
{.$IFNDEF RVDONOTUSELISTS}
{============================= TRVMarkerItemInfo ==============================}
constructor TRVMarkerItemInfo.CreateEx(RVData: TPersistent; AListNo,
  ALevel, AStartFrom: Integer; AReset: Boolean);
begin
  inherited Create(RVData);
  StyleNo   := rvsListMarker;
  ListNo    := AListNo;
  Level     := ALevel;
  StartFrom := AStartFrom;
  Reset     := AReset;
  SameAsPrev := False;
  Counter   := 1;
  FCachedIndexInList := -1;
end;
{------------------------------------------------------------------------------}
constructor TRVMarkerItemInfo.Create(RVData: TPersistent);
begin
  inherited Create(RVData);
  SameAsPrev := False;
  Counter   := 1;
  FCachedIndexInList := -1;  
end;
{------------------------------------------------------------------------------}
procedure TRVMarkerItemInfo.Assign(Source: TCustomRVItemInfo);
begin
  if Source is TRVMarkerItemInfo then begin
    ListNo    := TRVMarkerItemInfo(Source).ListNo;
    Level     := TRVMarkerItemInfo(Source).Level;
    StartFrom := TRVMarkerItemInfo(Source).StartFrom;
    Reset     := TRVMarkerItemInfo(Source).Reset;
  end;
  inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
procedure TRVMarkerItemInfo.MovingToUndoList(ItemNo: Integer; RVData,
  AContainerUndoItem: TObject);
begin
  inherited;
  TCustomRVData(RVData).DeleteMarkerFromList(TCustomRVData(RVData).GetItem(ItemNo), False);
end;
{------------------------------------------------------------------------------}
procedure TRVMarkerItemInfo.MovingFromUndoList(ItemNo: Integer; RVData: TObject);
begin
  inherited;
  TCustomRVData(RVData).AddMarkerInList(ItemNo);
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.ReadRVFHeader(var P: PChar;
  RVData: TPersistent): Boolean;
var v: Integer;
begin
  Result :=  RVFReadInteger(P,ListNo) and
             RVFReadInteger(P,Level) and
             RVFReadInteger(P,StartFrom) and
             RVFReadInteger(P,v);
  Reset := v<>0;
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.SaveRVFHeaderTail(RVData: TPersistent): String;
begin
  Result := Format('%d %d %d %d', [ListNo, Level, StartFrom, ord(Reset)]);
end;
{------------------------------------------------------------------------------}
procedure TRVMarkerItemInfo.SaveRVF(Stream: TStream; RVData: TPersistent;
  ItemNo, ParaNo: Integer; const Name: String; Part: TRVMultiDrawItemPart;
  ForceSameAsPrev: Boolean);
begin
  RVFWriteLine(Stream,
               Format('%d %d %s %d %d %s %s',
                     [StyleNo, 0,
                      RVFItemSavePara(ParaNo, TCustomRVData(RVData), False),
                      Byte(ItemOptions) and RVItemOptionsMask,
                      0, RVFSaveTag(rvoTagsArePChars in TCustomRVData(RVData).Options,Tag),
                      SaveRVFHeaderTail(RVData)]));
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetLevelInfoEx(RVStyle: TRVStyle; LevelNo: Integer): TRVListLevel;
begin
  if LevelNo>=RVStyle.ListStyles[ListNo].Levels.Count then
    LevelNo :=RVStyle.ListStyles[ListNo].Levels.Count-1;
  Result := RVStyle.ListStyles[ListNo].Levels[LevelNo];
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetLevelInfo(RVStyle: TRVStyle): TRVListLevel;
var LevelNo: Integer;
begin
  Result := nil;
  if ListNo<0 then
    exit;
  LevelNo := Level;
  if LevelNo>=RVStyle.ListStyles[ListNo].Levels.Count then
    LevelNo :=RVStyle.ListStyles[ListNo].Levels.Count-1;
  if LevelNo<RVStyle.ListStyles[ListNo].Levels.Count then
    Result := RVStyle.ListStyles[ListNo].Levels[LevelNo];
end;
{------------------------------------------------------------------------------}
procedure TRVMarkerItemInfo.CalcSize(Canvas: TCanvas; RVData: TPersistent;
                                     var Width, Height, Desc, Overhang: Integer;
                                     sad: PRVScreenAndDevice;
                                     ForMinWidth: Boolean;
                                     var HShift, SpaceBefore: Integer);
var sz: TSize;
    LevelInfo: TRVListLevel;
    TextMetric: TTextMetric;
    RVStyle: TRVStyle;
    {.........................................................}
    procedure CountLR(var LeftWidth, RightWidth: Integer);
    begin
      case LevelInfo.MarkerAlignment of
        rvmaLeft:
          begin
            LeftWidth := 0;
            RightWidth := Width;
          end;
        rvmaRight:
          begin
            LeftWidth := Width;
            RightWidth := 0;
          end;
        rvmaCenter:
          begin
            RightWidth := Width div 2;
            LeftWidth := Width - RightWidth;
          end;
      end;
    end;
    {.........................................................}
    procedure CountWidth(UseSad: Boolean);
    var  LeftWidth, RightWidth, w: Integer;
    begin
      CountLR(LeftWidth, RightWidth);
      if UseSaD and (sad<>nil) then
        w := MulDiv(LevelInfo.FirstIndent+LevelInfo.LeftIndent-LevelInfo.MarkerIndent, sad.ppixDevice, sad.ppixScreen)
      else
        w := LevelInfo.FirstIndent+LevelInfo.LeftIndent-LevelInfo.MarkerIndent;
      if ForMinWidth then begin
        Width := RightWidth;
        if Width<w then
          Width := w;
        end
      else begin
        if RightWidth<w then
          RightWidth := w;
        if TCustomRVData(RVData).GetParaBiDiMode(ParaNo)=rvbdRightToLeft then begin
          HShift :=  LeftWidth;
          SpaceBefore := LeftWidth+RightWidth-Width;
          end
        else begin
          HShift := - LeftWidth;
          SpaceBefore := 0;
        end;
        Width := LeftWidth+RightWidth;
        Overhang := HShift;
      end;
    end;
    {.........................................................}
begin
  if (ListNo<0) or (Level<0) then begin
    Width := 0;
    Height := 0;
    HShift := 0;
    Desc := 0;
    Overhang := 0;
    SpaceBefore := 0;
    exit;
  end;
  RVStyle := TCustomRVData(RVData).GetRVStyle;
  LevelInfo := GetLevelInfo(RVStyle);
  Desc := 0;
  case LevelInfo.ListType of
    rvlstPicture:
      begin
        if LevelInfo.HasPicture then begin
          Width := LevelInfo.Picture.Graphic.Width;
          Height := LevelInfo.Picture.Graphic.Height;
          if sad<>nil then begin
            Width := MulDiv(Width, sad.ppixDevice, sad.ppixScreen);
            Height := MulDiv(Height, sad.ppiyDevice, sad.ppiyScreen);
          end;
          end
        else begin
          Width := 0;
          Height := 0;
        end;
        CountWidth(True);
      end;
    rvlstImageList, rvlstImageListCounter:
      begin
        if LevelInfo.ImageList<>nil then begin
          Width := TImageList(LevelInfo.ImageList).Width;
          Height := TImageList(LevelInfo.ImageList).Height;
          if sad<>nil then begin
            Width := MulDiv(Width, sad.ppixDevice, sad.ppixScreen);
            Height := MulDiv(Height, sad.ppiyDevice, sad.ppiyScreen);
          end;
          end
        else begin
          Width := 0;
          Height := 0;
        end;
        CountWidth(True);
      end;
    {$IFNDEF RVDONOTUSEUNICODE}
    {$IFDEF RICHVIEWCBDEF3}
    rvlstUnicodeBullet:
      begin
        Canvas.Font := LevelInfo.Font;
        if (RVStyle.TextStyles.PixelsPerInch<>0) and (LevelInfo.Font.Size>0) then
          Canvas.Font.Size := - MulDiv(LevelInfo.Font.Size, RVStyle.TextStyles.PixelsPerInch, 72);
        {$IFNDEF RVDONOTUSECHARSPACING}
        SetTextCharacterExtra(Canvas.Handle, 0);
        {$ENDIF}
        SetTextAlign(Canvas.Handle, TA_LEFT);
        GetTextExtentPoint32W(Canvas.Handle, Pointer(LevelInfo.FormatStringW),
           Length(LevelInfo.FormatStringW), sz);
        GetTextMetrics(Canvas.Handle, TextMetric);
        Desc := TextMetric.tmDescent;
        Width := sz.cx;
        Height := sz.cy;
        CountWidth(True);
      end;
    {$ENDIF}
    {$ENDIF}
    else
      begin
        Canvas.Font := LevelInfo.Font;
        if (RVStyle.TextStyles.PixelsPerInch<>0) and (LevelInfo.Font.Size>0) then
          Canvas.Font.Size := - MulDiv(LevelInfo.Font.Size, RVStyle.TextStyles.PixelsPerInch, 72);
        {$IFNDEF RVDONOTUSECHARSPACING}
        SetTextCharacterExtra(Canvas.Handle, 0);
        {$ENDIF}
        SetTextAlign(Canvas.Handle, TA_LEFT);
        GetTextExtentPoint32(Canvas.Handle, PChar(DisplayString),
           Length(DisplayString), sz);
        GetTextMetrics(Canvas.Handle, TextMetric);
        Desc := TextMetric.tmDescent;
        Width := sz.cx;
        Height := sz.cy;
        CountWidth(True);
      end;
  end;
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetBoolValue(Prop: TRVItemBoolProperty): Boolean;
begin
  case Prop of
    rvbpDrawingChangesFont, rvbpCanSaveUnicode {, rvbpAlwaysInText}:
      Result := True;
    else
      Result := inherited GetBoolValue(Prop);
  end;
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean;
var LevelInfo: TRVListLevel;
begin
  case Prop of