{------------------------------------------------------------------------------
  Label Item - item class for RichView.
  Non-text item that looks like a text (but cannot be wrapped and edited)
  Does not support Unicode.

  v1.7
  compatibility with RV 1.7.6
  new properties:
    MinWidth: Integer - minimal width of item
    Alignment: TAlignment - text alignment, works if MinWidth>text width
  v1.6:
  compatibility with RV 1.7.4; ColorMode support
  v1.5:
  impr: hypertext support
  v1.4:
  fix: correct copying by AppendFrom
  v1.3:
  fix: printing
  v1.2:
  impr: correct working with DeleteUnusedStyles
  impr: ApplyText and ApplyStyleConversion affect this item
    (if ProtectTextStyleNo=False)
  impr: can be saved in text, RTF, HTML (in RTF and HTML, it is saved as a
    plain text, i.e. it has style of the preceding text)
-------------------------------------------------------------------------------}

unit LabelItem;

interface
uses SysUtils, Classes, Windows, Graphics, RVFuncs,
     RVScroll, CRVData, RVStyle, RVItem, RVFMisc, DLines, CRVFData, RichView,
     RVClasses, RVERVData, RVEdit;

const
  rvsLabel = -200;

type
  TRVLabelItemInfo = class(TRVRectItemInfo)
    private
      Width, Height, Descend: Integer;
      FMinWidth: Integer;
      FAlignment: TAlignment;
      procedure DoPaint(x,y: Integer; Canvas: TCanvas; State: TRVItemDrawStates;
        Style: TRVStyle; dli: TRVDrawLineInfo; ColorMode: TRVColorMode);
    procedure SetMinWidth(const Value: Integer);
    procedure SetAlignment(const Value: TAlignment);
    protected
      function GetDescent: Integer; override;
      function GetHeight: Integer; override;
      function GetWidth: Integer;  override;
    public
      Text: String;
      RVStyle: TRVStyle;
      TextStyleNo: Integer;
      ProtectTextStyleNo: Boolean;
      constructor CreateEx(RVData: TPersistent; TextStyleNo: Integer; const Text: String);
      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 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; ColorMode: TRVColorMode; RVData: TPersistent); override;
      procedure AfterLoading(FileFormat: TRVLoadFormat); override;
      procedure SaveRVF(Stream: TStream; RVData: TPersistent; ItemNo, ParaNo: Integer;
                        const Name: String; Part: TRVMultiDrawItemPart;
                        ForceSameAsPrev: Boolean); override;
      function ReadRVFLine(const s: String; RVData: TPersistent;
                           ReadType, LineNo, LineCount: Integer;
                           var Name: String;
                           var ReadMode: TRVFReadMode;
                           var ReadState: TRVFReadState): Boolean; override;
      procedure Assign(Source: TCustomRVItemInfo); override;
      procedure MarkStylesInUse(UsedTextStyles, UsedParaStyles, UsedListStyles: TRVIntegerList); override;
      procedure UpdateStyles(TextStylesShift, ParaStylesShift, ListStylesShift: TRVIntegerList); override;
      procedure ApplyStyleConversion(RVData: TPersistent; UserData: Integer); override;
      procedure UpdateMe;
      procedure OnDocWidthChange(DocWidth: Integer; dli: TRVDrawLineInfo; Printing: Boolean; Canvas: TCanvas;
                                 RVData: TPersistent; sad: PRVScreenAndDevice; var HShift, Desc: Integer;
                                 NoCaching: Boolean); override;
      procedure Execute(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;
      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 AsText(LineWidth: Integer;
        RVData: TPersistent; const Text, Path: String;
        TextOnly,Unicode: Boolean): String; override;
      procedure Inserted(RVData: TObject; ItemNo: Integer); override;
      property MinWidth: Integer read FMinWidth write SetMinWidth;
      property Alignment: TAlignment read FAlignment write SetAlignment;
  end;

implementation

{==============================================================================}
{ TRVLabelItemInfo }
constructor TRVLabelItemInfo.CreateEx(RVData: TPersistent;
  TextStyleNo: Integer; const Text: String);
begin
   inherited Create(RVData);
   StyleNo := rvsLabel;
   VAlign := rvvaBaseLine;
   Self.TextStyleNo := TextStyleNo;
   Self.Text    := Text;
   RVStyle := TCustomRVData(RVData).GetRVStyle;
   UpdateMe;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.AfterLoading(FileFormat: TRVLoadFormat);
begin
  inherited;
  UpdateMe;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.UpdateMe;
var DC: HDC;
    Canvas: TCanvas;
    TextMetric: TTextMetric;
begin
   DC := GetDC(0);
   Canvas := TCanvas.Create;
   Canvas.Handle := DC;
   RVStyle.ApplyStyle(Canvas, TextStyleNo, rvbdUnspecified);
   FillChar(TextMetric, sizeof(TextMetric), 0);
   GetTextMetrics(Canvas.Handle, TextMetric);
   Descend := TextMetric.tmDescent;
   Height  := TextMetric.tmHeight;
   Width := Canvas.TextWidth(Text);
   if Width<MinWidth then
     Width := MinWidth;
   Canvas.Handle := 0;
   Canvas.Free;
   ReleaseDC(0,DC);
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.Assign(Source: TCustomRVItemInfo);
begin
  if Source is TRVLabelItemInfo then begin
    StyleNo := TRVLabelItemInfo(Source).StyleNo;
    Text    := TRVLabelItemInfo(Source).Text;
    ProtectTextStyleNo := TRVLabelItemInfo(Source).ProtectTextStyleNo;
    MinWidth := TRVLabelItemInfo(Source).MinWidth;
    Alignment := TRVLabelItemInfo(Source).Alignment;
  end;
  inherited;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.DoPaint(x, y: Integer; Canvas: TCanvas;
  State: TRVItemDrawStates; Style: TRVStyle; dli: TRVDrawLineInfo;
  ColorMode: TRVColorMode);
var TextDrawState: TRVTextDrawStates;
    DTOption: Integer;
   r: TRect;
begin
  TextDrawState := [];
  if rvidsSelected in State then
    include(TextDrawState, rvtsSelected);
  if rvidsControlFocused in State then
    include(TextDrawState, rvtsControlFocused);
  if rvidsHover in State then
    include(TextDrawState, rvtsHover);
  RVStyle.ApplyStyle(Canvas,TextStyleNo,rvbdUnspecified);
  RVStyle.ApplyStyleColor(Canvas,TextStyleNo,TextDrawState, False, ColorMode);
  case Alignment of
    taRightJustify:
      DTOption := DT_RIGHT;
    taCenter:
      DTOption := DT_CENTER;
    else
      DTOption := DT_LEFT;
  end;
  r := Bounds(x,y,Width,Height);
  DrawText(Canvas.Handle, PChar(Text), Length(Text), r, DT_SINGLELINE or DTOption);
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.Paint(x, y: Integer; Canvas: TCanvas;
  State: TRVItemDrawStates; Style: TRVStyle; dli: TRVDrawLineInfo);
begin
  DoPaint(x, y, Canvas, State, Style, dli, rvcmColor);
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.Print(Canvas: TCanvas; x, y, x2: Integer;
  Preview, Correction: Boolean; const sad: TRVScreenAndDevice;
  RichView: TRVScroller; dli: TRVDrawLineInfo; Part: Integer;
  ColorMode: TRVColorMode; RVData: TPersistent);
begin
  DoPaint(x, y, Canvas, [], TCustomRichView(RichView).Style, dli, ColorMode);
end;
{------------------------------------------------------------------------------}
function TRVLabelItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx;
  RVStyle: TRVStyle): Boolean;
begin
  case Prop of
    rvbpJump, rvbpAllowsFocus,rvbpXORFocus:
      Result := RVStyle.TextStyles[TextStyleNo].Jump;
    rvbpHotColdJump:
      Result := RVStyle.TextStyles[TextStyleNo].Jump and
                RVStyle.StyleHoverSensitive(StyleNo);
   rvbpPrintToBMP:
     Result := False;
   else
     Result := inherited GetBoolValueEx(Prop, RVStyle);
  end;
end;
{------------------------------------------------------------------------------}
function TRVLabelItemInfo.GetBoolValue(Prop: TRVItemBoolProperty): Boolean;
begin
  case Prop of
    rvbpAlwaysInText:
      Result := True;
    rvbpDrawingChangesFont:
      Result := True;
    else
      Result := inherited GetBoolValue(Prop);
  end;
end;
{------------------------------------------------------------------------------}
function TRVLabelItemInfo.GetDescent: Integer;
begin
  Result := Descend;
end;
{------------------------------------------------------------------------------}
function TRVLabelItemInfo.GetHeight: Integer;
begin
  Result := Height;
end;
{------------------------------------------------------------------------------}
function TRVLabelItemInfo.GetWidth: Integer;
begin
  Result := Width;
end;
{------------------------------------------------------------------------------}
function TRVLabelItemInfo.GetMinWidth(sad: PRVScreenAndDevice; Canvas: TCanvas; RVData: TPersistent): Integer;
begin
  Result := Width;
  if MinWidth>Result then
    Result := MinWidth;
  if Sad<>nil then
    Result := MulDiv(Result, sad.ppixDevice, sad.ppixScreen);
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.SaveRVF(Stream: TStream; RVData: TPersistent;
  ItemNo, ParaNo: Integer; const Name: String; Part: TRVMultiDrawItemPart;
  ForceSameAsPrev: Boolean);
begin
   // if you want to modify saving/loading, modify
   // 1) second parameter in header - number of additional lines
   // 2) lines after header
   // Do not change other parameters in header
   RVFWriteLine(Stream,
     Format('%d %d %s %d %d %s %s',
            [StyleNo, 5 {Line count after header},
             RVFItemSavePara(ParaNo, TCustomRVData(RVData), ForceSameAsPrev),
             Byte(RVFGetItemOptions(ItemOptions, ForceSameAsPrev)) and RVItemOptionsMask,
             2 {text mode saving},
             RVFSaveTag(rvoTagsArePChars in TCustomRVData(RVData).Options,Tag),
             SaveRVFHeaderTail(RVData)]));
   // lines after header
   RVFWriteLine(Stream, Text);
   RVFWriteLine(Stream, IntToStr(TextStyleNo));
   RVFWriteLine(Stream, IntToStr(MinWidth));
   RVFWriteLine(Stream, IntToStr(ord(Alignment)));
   if ProtectTextStyleNo then
     RVFWriteLine(Stream, 'protect')
   else
     RVFWriteLine(Stream, 'no-protect')
end;
{------------------------------------------------------------------------------}
function TRVLabelItemInfo.ReadRVFLine(const s: String; RVData: TPersistent;
                           ReadType, LineNo, LineCount: Integer;
                           var Name: String;
                           var ReadMode: TRVFReadMode;
                           var ReadState: TRVFReadState): Boolean;
begin
  case LineNo of
    0:
      Text := s;
    1:
      begin
        TextStyleNo := StrToInt(s);
        RVStyle := TCustomRVData(RVData).GetRVStyle;
      end;
    2:
      MinWidth := StrToInt(s);
    3:
      Alignment := TAlignment(StrToInt(s));
    4:
      begin
        ProtectTextStyleNo := s='protect';
        ReadState := rstSkip;
      end;
  end;
  Result := True;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.MarkStylesInUse(UsedTextStyles, UsedParaStyles,
  UsedListStyles: TRVIntegerList);
begin
  inherited MarkStylesInUse(UsedTextStyles, UsedParaStyles, UsedListStyles);
  UsedTextStyles[TextStyleNo] := 1;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.UpdateStyles(TextStylesShift, ParaStylesShift,
  ListStylesShift: TRVIntegerList);
begin
  inherited UpdateStyles(TextStylesShift, ParaStylesShift, ListStylesShift);
  dec(TextStyleNo,TextStylesShift[TextStyleNo]-1);
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.ApplyStyleConversion(RVData: TPersistent;
  UserData: Integer);
var rve: TCustomRichViewEdit;
begin
  if ProtectTextStyleNo then
    exit;
  rve := TCustomRichViewEdit(TRVEditRVData(RVData).RichView);
  if not Assigned(rve.FCurStyleConversion) then
    exit;
  rve.FCurStyleConversion(rve, TextStyleNo, UserData, True, TextStyleNo);
  UpdateMe;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.SaveRTF(Stream: TStream; RVData: TPersistent;
  ItemNo: Integer; const Name: String; TwipsPerPixel: Double;
  Level: Integer; ColorList: TRVColorList; StyleToFont,
  ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
  FontTable: TRVList);
begin
  RVFWrite(Stream, RVMakeRTFStr(Text, False));
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.SaveToHTML(Stream: TStream; RVData: TPersistent;
  ItemNo: Integer; const Text, Path, imgSavePrefix: String;
  var imgSaveNo: Integer; CurrentFileColor: TColor;
  SaveOptions: TRVSaveOptions; UseCSS: Boolean; Bullets: TRVList);
begin
  RVFWrite(Stream, RV_MakeHTMLStr(Self.Text, False, False));
end;
{------------------------------------------------------------------------------}
function TRVLabelItemInfo.AsText(LineWidth: Integer; RVData: TPersistent;
  const Text, Path: String; TextOnly, Unicode: Boolean): String;
begin
  Result := Self.Text;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.Inserted(RVData: TObject; ItemNo: Integer);
begin
  if RVData<>nil then
    RVStyle := TCustomRVData(RVData).GetRVStyle;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.Execute(RVData: TPersistent);
begin
  if RVData is TCustomRVFormattedData then begin
    if GetBoolValueEx(rvbpJump, TCustomRVData(RVData).GetRVStyle) then
      TCustomRVFormattedData(RVData).DoJump(JumpID+
          TCustomRVFormattedData(RVData).FirstJumpNo)
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.SetMinWidth(const Value: Integer);
begin
  if FMinWidth<>Value then begin
    FMinWidth := Value;
    UpdateMe;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.SetAlignment(const Value: TAlignment);
begin
  FAlignment := Value;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.OnDocWidthChange(DocWidth: Integer;
  dli: TRVDrawLineInfo; Printing: Boolean; Canvas: TCanvas;
  RVData: TPersistent; sad: PRVScreenAndDevice; var HShift, Desc: Integer;
  NoCaching: Boolean);
begin
  inherited;
  Desc := GetDescent;
end;

initialization

  RegisterRichViewItemClass(rvsLabel, TRVLabelItemInfo);

end.
