rvmarker.pas

richview1.7 full.source

    rvbpActualPrintSize:
      begin
        (*
        LevelInfo := GetLevelInfo(RVStyle);
        if LevelInfo<>nil then
          Result := LevelInfo.ListType in [rvlstDecimal, rvlstLowerAlpha, rvlstUpperAlpha,
            rvlstBullet,
            rvlstLowerRoman, rvlstUpperRoman {$IFNDEF RVDONOTUSEUNICODE}, rvlstUnicodeBullet{$ENDIF}]
        else
        *)
          Result := True;
      end;
    rvbpPrintToBMP:
      begin
        LevelInfo := GetLevelInfo(RVStyle);
        if LevelInfo<>nil then
          Result := (LevelInfo.ListType in [rvlstImageList, rvlstImageListCounter]) or
                  ((LevelInfo.ListType=rvlstPicture) and LevelInfo.HasPicture and
                    not (LevelInfo.Picture.Graphic is TMetafile))
        else
          Result := False;
      end;
    else
      Result := inherited GetBoolValueEx(Prop,RVStyle);
  end;
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetHeight: Integer;
begin
  Result := FHeight;
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetWidth: Integer;
begin
  Result := FWidth;
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetLeftOverhang: Integer;
begin
  Result := FOverhang;
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetDescent: Integer;
begin
  Result := FDescent;
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetMinWidth(sad: PRVScreenAndDevice;
  Canvas: TCanvas; RVData: TPersistent): Integer;
var h,d,s,o,sb: Integer;
begin
  CalcSize(Canvas, RVData, Result, h, d, o, sad, True, s, sb);
  if not GetBoolValueEx(rvbpActualPrintSize, TCustomRVData(RVData).GetRVStyle) and
     (sad<>nil) then
    Result := MulDiv(Result, sad.ppixDevice, sad.ppixScreen);
end;
{------------------------------------------------------------------------------}
procedure TRVMarkerItemInfo.OnDocWidthChange(DocWidth: Integer;
  dli: TRVDrawLineInfo; Printing: Boolean; Canvas: TCanvas;
  RVData: TPersistent; sad: PRVScreenAndDevice;
  var HShift: Integer; NoCaching: Boolean);
var Desc, Oh: Integer;
begin
  CalcSize(Canvas, RVData, dli.Width, dli.Height, Desc, Oh, sad, False, HShift, dli.SpaceBefore);
  if not Printing then begin
    FWidth := dli.Width;
    FHeight := dli.Height;
    FDescent  := Desc;
    FOverhang := Oh;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVMarkerItemInfo.CalcDisplayString(RVStyle: TRVStyle;
   List: TRVMarkerList; Index: Integer);
var LevelInfo: TRVListLevel;
  {.......................................................}
  function IntToRoman(Value: Integer): String;
  const
    Arabics: Array[0..12] of Integer =
    (1,4,5,9,10,40,50,90,100,400,500,900,1000);
    Romans:  Array[0..12] of String =
    ('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');
  var i: Integer;
  begin
    if Value<1 then begin
      Result := '?';
      exit;
    end;
    Result := '';
    for i := 12 downto 0 do
      while (Value >= Arabics[i]) do begin
        Value := Value - Arabics[i];
        Result := Result + Romans[i];
      end;
  end;
  {.......................................................}
  function Number2Str(Value: Integer; ListType: TRVListType): String;
  const CharCount = ord('z')-ord('a')+1;
  var FirstCharCode: Integer;
  begin
    case ListType of
      rvlstDecimal, rvlstImageListCounter:
        Result := IntToStr(Value);
      rvlstLowerAlpha, rvlstUpperAlpha:
        begin
           Result := '';
           if ListType=rvlstLowerAlpha then
             FirstCharCode := ord('a')
           else
             FirstCharCode := ord('A');
           while Value>0 do begin
             Result := Chr((Value-1) mod CharCount+FirstCharCode)+Result;
             Value := (Value-1) div CharCount;
           end;
        end;
      rvlstUpperRoman:
        Result := IntToRoman(Value);
      rvlstLowerRoman:
        Result := LowerCase(IntToRoman(Value));
      else
        Result := '';
    end;
  end;

  {.......................................................}
  function MultiLevelList : String;
  var CountersVal: array [0..255] of TVarRec;
      CountersStr: array [0..255] of String;
      ParentIndex, CurIndex, i: Integer;
      ALevelInfo: TRVListLevel;
      ParentLevelNo, CurLevelNo : Integer;
      Marker: TRVMarkerItemInfo;
      LegalStyle : Boolean;
      ListType : TRVListType;
  begin
    LegalStyle := rvloLegalStyleNumbering in LevelInfo.Options;

    CurLevelNo := Level;
    Marker  := Self;
    ALevelInfo := LevelInfo;
    CurIndex := Index;

    while True do begin
      ListType := ALevelInfo.ListType;
      if (CurLevelNo<Level) and (ListType in [rvlstLowerRoman, rvlstUpperRoman, rvlstLowerAlpha, rvlstUpperAlpha]) and
         LegalStyle then
        ListType := rvlstDecimal;
      CountersStr[CurLevelNo]             := Number2Str(Marker.Counter, ListType);
      if CountersStr[CurLevelNo]<>'' then
        CountersVal[CurLevelNo].VAnsiString := PChar(CountersStr[CurLevelNo])
      else
        CountersVal[CurLevelNo].VAnsiString := nil;
      CountersVal[CurLevelNo].VType       := vtAnsiString;

      if CurLevelNo=0 then
        break;

      ParentIndex := List.FindParentMarker(CurIndex);
      if ParentIndex>=0 then begin
        Marker     := TRVMarkerItemInfo(List.Items[ParentIndex]);
        ALevelInfo := Marker.GetLevelInfo(RVStyle);
        ParentLevelNo := Marker.Level;
        end
      else begin
        Marker     := nil;
        ALevelInfo := nil;        
        ParentLevelNo := -1;
      end;
      for i := CurLevelNo-1 downto ParentLevelNo+1 do begin
        with GetLevelInfoEx(RVStyle,i) do
          CountersStr[i]  := Number2Str(StartFrom, ListType);
        if CountersStr[i]<>'' then
          CountersVal[i].VAnsiString := PChar(CountersStr[i])
        else
          CountersVal[i].VAnsiString := nil;
        CountersVal[i].VType       := vtAnsiString;
      end;
      if ParentLevelNo<0 then
        break;
      CurLevelNo := ParentLevelNo;
      CurIndex   := ParentIndex;
    end;
    Result := Format(LevelInfo.FormatString, CountersVal);
  end;
  {.......................................................}
begin
  LevelInfo := GetLevelInfo(RVStyle);
  case LevelInfo.ListType of
    rvlstBullet:
      DisplayString := LevelInfo.FormatString;
    {$IFNDEF RVDONOTUSEUNICODE}
    rvlstUnicodeBullet:
      DisplayString := ''; // RVU_UnicodeToAnsi(RVStyle.DefCodePage, PChar(Pointer(LevelInfo.FormatStringW)))
    {$ENDIF}
    rvlstPicture, rvlstImageList, rvlstImageListCounter:
      DisplayString := '';
    else
      DisplayString := MultiLevelList;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVMarkerItemInfo.Paint(x, y: Integer; Canvas: TCanvas;
  State: TRVItemDrawStates; Style: TRVStyle; dli: TRVDrawLineInfo);
var LevelInfo: TRVListLevel;
    Index: Integer;
begin
  if (ListNo<0) or (Level<0) then
    exit;
  Canvas.Pen.Color := clRed;
  if dli<>nil then
    inc(x, dli.SpaceBefore);
  LevelInfo := GetLevelInfo(TRVStyle(Style));
  case LevelInfo.ListType of
    rvlstPicture:
      begin
        if LevelInfo.HasPicture then
          Canvas.Draw(X,Y, LevelInfo.Picture.Graphic);
      end;
    rvlstImageList, rvlstImageListCounter:
      begin
        Index := LevelInfo.ImageIndex;
        if LevelInfo.ListType = rvlstImageListCounter then
          inc(Index, Counter-1);
        if (LevelInfo.ImageList<>nil) and (Index>=0) and (Index<LevelInfo.ImageList.Count) then
          LevelInfo.ImageList.Draw(Canvas, X,Y, Index);
      end;
    {$IFNDEF RVDONOTUSEUNICODE}
    {$IFDEF RICHVIEWCBDEF3}
    rvlstUnicodeBullet:
      begin
        Canvas.Font := LevelInfo.Font;
        if (Style.TextStyles.PixelsPerInch<>0) and (LevelInfo.Font.Size>0) then
          Canvas.Font.Size := - MulDiv(LevelInfo.Font.Size, Style.TextStyles.PixelsPerInch, 72);
        {$IFNDEF RVDONOTUSECHARSPACING}
        SetTextCharacterExtra(Canvas.Handle, 0);
        {$ENDIF}
        SetTextAlign(Canvas.Handle, TA_LEFT);
        Canvas.Brush.Style := bsClear;
        TextOutW(Canvas.Handle, X,Y, Pointer(LevelInfo.FormatStringW), Length(LevelInfo.FormatStringW));
      end;
    {$ENDIF}
    {$ENDIF}
    else
      begin
        Canvas.Font := LevelInfo.Font;
        if (Style.TextStyles.PixelsPerInch<>0) and (LevelInfo.Font.Size>0) then
          Canvas.Font.Size := - MulDiv(LevelInfo.Font.Size, Style.TextStyles.PixelsPerInch, 72);
        {$IFNDEF RVDONOTUSECHARSPACING}
        SetTextCharacterExtra(Canvas.Handle, 0);
        {$ENDIF}
        SetTextAlign(Canvas.Handle, TA_LEFT);
        Canvas.Brush.Style := bsClear;
        Canvas.TextOut(X,Y, DisplayString);
      end;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVMarkerItemInfo.Print(Canvas: TCanvas; x, y, x2: Integer;
  Preview, Correction: Boolean; const sad: TRVScreenAndDevice;
  RichView: TRVScroller; dli: TRVDrawLineInfo; Part: Integer);
begin
  Paint(x, y, Canvas, [], TCustomRichView(RichView).Style, dli);
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.PrintToBitmap(Bkgnd: TBitmap; Preview: Boolean; RichView: TRVScroller;
                                         dli: TRVDrawLineInfo; Part: Integer):Boolean;
begin
  Paint(0, 0, Bkgnd.Canvas, [], TCustomRichView(RichView).Style, dli);
  Result := True;
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetImageHeight(RVStyle: TRVStyle): Integer;
var LevelInfo: TRVListLevel;
begin
  Result := 0;
  LevelInfo := GetLevelInfo(RVStyle);
  case LevelInfo.ListType of
    rvlstImageList, rvlstImageListCounter:
      if LevelInfo.ImageList<>nil then
        Result := TImageList(LevelInfo.ImageList).Height;
    rvlstPicture:
      if LevelInfo.HasPicture then
        Result := LevelInfo.Picture.Graphic.Height;
  end;
end;
{------------------------------------------------------------------------------}
function TRVMarkerItemInfo.GetImageWidth(RVStyle: TRVStyle): Integer;
var LevelInfo: TRVListLevel;
begin
  Result := 0;
  LevelInfo := GetLevelInfo(RVStyle);
  case LevelInfo.ListType of

    rvlstImageList, rvlstImageListCounter:
      if LevelInfo.ImageList<>nil then
        Result := TImageList(LevelInfo.ImageList).Width;
        // Result := FWidth;
    rvlstPicture:
      if LevelInfo.HasPicture then
        Result := LevelInfo.Picture.Graphic.Width;
        //Result := FWidth;
  end;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSERTF}
procedure TRVMarkerItemInfo.FillRTFTables(ColorList: TRVColorList;
  ListOverrideCountList: TRVIntegerList; RVData: TPersistent);
var LevelInfo: TRVListLevel;
begin
  if not Reset or (ListNo<0) or (Level<0) then
    exit;
  LevelInfo := GetLevelInfo(TCustomRVData(RVData).GetRVStyle);
  if LevelInfo=nil then
    exit;
  if LevelInfo.HasNumbering and (LevelInfo.ListType<>rvlstImageListCounter) then
    ListOverrideCountList[ListNo] := ListOverrideCountList[ListNo]+1;
end;
{------------------------------------------------------------------------------}
procedure TRVMarkerItemInfo.SaveRTF(Stream: TStream; RVData: TPersistent;
  ItemNo: Integer; const Name: String; TwipsPerPixel: Double;
  Level: Integer; ColorList: TRVColorList;
  StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
  FontTable: TRVList);
var LevelInfo: TRVListLevel;
   {$IFNDEF RVDONOTUSEUNICODE}
   {$IFDEF RICHVIEWCBDEF3}
    s: String;
   {$ENDIF}
   {$ENDIF}
   ListOverrideNo: Integer;
begin
  LevelInfo := GetLevelInfo(TCustomRVData(RVData).GetRVStyle);
  if LevelInfo=nil then
    exit;
  case LevelInfo.ListType of
    rvlstPicture:
      RVSaveImageToRTF(Stream,TwipsPerPixel, LevelInfo.Picture.Graphic,
        0, 0, TCustomRVData(RVData).RTFOptions);
    rvlstImageList:
      RVSaveImageListImageToRTF(Stream, TwipsPerPixel, LevelInfo.ImageList,
        LevelInfo.ImageIndex, TCustomRVData(RVData).RTFOptions);
    rvlstImageListCounter:
      RVSaveImageListImageToRTF(Stream, TwipsPerPixel, LevelInfo.ImageList,
        LevelInfo.ImageIndex+Counter-1, TCustomRVData(RVData).RTFOptions);
    else
      begin
        RVFWrite(Stream, '{\listtext\pard\plain');
        RVSaveFontToRTF(Stream, LevelInfo.Font, ColorList, TRVRTFFontTable(FontTable),
          TCustomRVData(RVData).GetRVStyle);
        RVFWrite(Stream, ' ');
        {$IFNDEF RVDONOTUSEUNICODE}
        {$IFDEF RICHVIEWCBDEF3}
        if LevelInfo.ListType=rvlstUnicodeBullet then begin
          SetLength(s, Length(LevelInfo.FormatStringW)*2);
          Move(Pointer(LevelInfo.FormatStringW)^, Pointer(s)^, Length(s));
          RVWriteUnicodeRTFStr(Stream, s, TCustomRVData(RVData).GetRVStyle.DefCodePage,