RichEdit

开发平台：
Delphi

LabelItem.pas：源码内容
							{*******************************************************}
{                                                       }
{       RichView                                        }
{       Label Item - item class for RichView.           }
{       Non-text item that looks like a text            }
{       (but cannot be wrapped and edited)              }
{       Does not support Unicode.                       }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       svt@trichview.com                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}
unit LabelItem;
{$I RV_Defs.inc}
interface
uses SysUtils, Classes, Windows, Graphics, RVFuncs, Controls,
     RVScroll, CRVData, RVStyle, RVItem, RVFMisc, DLines, CRVFData, RichView,
     RVClasses;
const
  rvsLabel = -200;
type
  TRVLabelItemInfo = class(TRVRectItemInfo)
    private
      Width, Height, Descend: Integer;
      FMinWidth: Integer;
      FAlignment: TAlignment;
      FCanUseCustomPPI: Boolean;
      procedure SetMinWidth(const Value: Integer);
      procedure SetAlignment(const Value: TAlignment);
    protected
      procedure DoPaint(r: TRect; Canvas: TCanvas; State: TRVItemDrawStates;
        Style: TRVStyle; dli: TRVDrawLineInfo; ColorMode: TRVColorMode); virtual;
      function GetDescent: Integer; override;
      function GetHeight: Integer; override;
      function GetWidth: Integer;  override;
      function GetAssociatedTextStyleNo: Integer; override;
      procedure SetAssociatedTextStyleNo(Value: Integer); override;      
    public
      Text: String;
      RVStyle: TRVStyle;
      TextStyleNo: Integer;
      ProtectTextStyleNo: Boolean;
      Cursor: TCursor;
      constructor Create(RVData: TPersistent); override;
      constructor CreateEx(RVData: TPersistent; TextStyleNo: Integer; const Text: String);
      function MouseMove(Shift: TShiftState; X, Y, ItemNo: Integer;
        RVData: TObject): Boolean; override;
      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(Data: TRVDeleteUnusedStylesData); override;
      procedure UpdateStyles(Data: TRVDeleteUnusedStylesData); override;
      procedure ApplyStyleConversion(RVData: TPersistent;
        ItemNo, UserData: Integer); override;
      procedure UpdateMe;
      procedure OnDocWidthChange(DocWidth: Integer; dli: TRVDrawLineInfo; Printing: Boolean; Canvas: TCanvas;
        RVData: TPersistent; sad: PRVScreenAndDevice; var HShift, Desc: Integer;
        NoCaching, Reformatting: Boolean); override;
      procedure Execute(RVData:TPersistent);override;
      {$IFNDEF RVDONOTUSERTF}
      procedure SaveRTF(Stream: TStream; const Path: String;
        RVData: TPersistent; ItemNo: Integer;
        const Name: String; TwipsPerPixel: Double; Level: Integer;
        ColorList: TRVColorList;
        StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
        FontTable: TRVList); override;
      {$ENDIF}
      {$IFNDEF RVDONOTUSEHTML}
      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;
      {$ENDIF}
      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;
   FCanUseCustomPPI := rvflCanUseCustomPPI in TCustomRVData(RVData).Flags;
   Cursor := crDefault;
   UpdateMe;
end;
{------------------------------------------------------------------------------}
constructor TRVLabelItemInfo.Create(RVData: TPersistent);
begin
  inherited Create(RVData);
  StyleNo := rvsLabel;
  RVStyle := TCustomRVData(RVData).GetRVStyle;
  FCanUseCustomPPI := rvflCanUseCustomPPI in TCustomRVData(RVData).Flags;
  Cursor := crDefault;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.AfterLoading(FileFormat: TRVLoadFormat);
begin
  inherited;
  UpdateMe;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.UpdateMe;
var DC: HDC;
    Canvas: TCanvas;
    TextMetric: TTextMetric;
begin
   if RVStyle=nil then
     exit;
   DC := GetDC(0);
   Canvas := TCanvas.Create;
   Canvas.Handle := DC;
   RVStyle.ApplyStyle(Canvas, TextStyleNo, rvbdUnspecified, FCanUseCustomPPI);
   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;
    TextStyleNo := TRVLabelItemInfo(Source).TextStyleNo;
    Text    := TRVLabelItemInfo(Source).Text;
    ProtectTextStyleNo := TRVLabelItemInfo(Source).ProtectTextStyleNo;
    MinWidth := TRVLabelItemInfo(Source).MinWidth;
    Alignment := TRVLabelItemInfo(Source).Alignment;
    Cursor := TRVLabelItemInfo(Source).Cursor;
  end;
  inherited;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.DoPaint(r: TRect; Canvas: TCanvas;
  State: TRVItemDrawStates; Style: TRVStyle; dli: TRVDrawLineInfo;
  ColorMode: TRVColorMode);
var TextDrawState: TRVTextDrawStates;
    DTOption: Integer;
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, rvidsCanUseCustomPPI in State);
  RVStyle.ApplyStyleColor(Canvas,TextStyleNo,TextDrawState, False, ColorMode);
  case Alignment of
    taRightJustify:
      DTOption := DT_RIGHT;
    taCenter:
      DTOption := DT_CENTER;
    else
      DTOption := DT_LEFT;
  end;
  if Canvas.Brush.Style<>bsClear then
    Canvas.FillRect(r);
  DrawText(Canvas.Handle, PChar(Text), Length(Text), r, DT_SINGLELINE or DT_NOCLIP or DTOption);
  Canvas.Brush.Style := bsClear;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.Paint(x, y: Integer; Canvas: TCanvas;
  State: TRVItemDrawStates; Style: TRVStyle; dli: TRVDrawLineInfo);
begin
  DoPaint(Bounds(x, y, Width, Height), 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);
var r: TRect;
   DrawStates: TRVItemDrawStates;
begin
  r := Rect(x, y, Width, Height);
  r.Right  := RV_XToDevice(r.Right,  sad);
  r.Bottom := RV_YToDevice(r.Bottom, sad);
  inc(r.Right,  x);
  inc(r.Bottom, y);
  DrawStates := [];
  if rvflCanUseCustomPPI in TCustomRVData(RVData).Flags then
    Include(DrawStates, rvidsCanUseCustomPPI);
  DoPaint(r, Canvas, DrawStates, 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;
    rvbpSwitchToAssStyleNo:
      Result := not ProtectTextStyleNo;
    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, 6+GetRVFExtraPropertyCount {Line count after header},
             RVFItemSavePara(ParaNo, TCustomRVData(RVData), ForceSameAsPrev),
             Byte(RVFGetItemOptions(ItemOptions, ForceSameAsPrev)) and RVItemOptionsMask,
             0 {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');
   RVFWriteLine(Stream, Name);
   SaveRVFExtraProperties(Stream);  
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:
      ProtectTextStyleNo := s='protect';
    5:
      Name := s;
    else
      SetExtraPropertyFromRVFStr(s);
  end;
  Result := True;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.MarkStylesInUse(Data: TRVDeleteUnusedStylesData);
begin
  inherited MarkStylesInUse(Data);
  Data.UsedTextStyles[TextStyleNo] := 1;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.UpdateStyles(Data: TRVDeleteUnusedStylesData);
begin
  inherited UpdateStyles(Data);
  dec(TextStyleNo,Data.UsedTextStyles[TextStyleNo]-1);
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.ApplyStyleConversion(RVData: TPersistent;
  ItemNo, UserData: Integer);
begin
  if ProtectTextStyleNo then
    exit;
  TCustomRVFormattedData(RVData).DoCurrentTextStyleConversion(TextStyleNo, ParaNo,
    ItemNo, UserData, False);
  UpdateMe;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSERTF}
procedure TRVLabelItemInfo.SaveRTF(Stream: TStream; const Path: String;
  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, True));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEHTML}
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));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
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 begin
    RVStyle := TCustomRVData(RVData).GetRVStyle;
    FCanUseCustomPPI := rvflCanUseCustomPPI in TCustomRVData(RVData).Flags;
  end;
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, Reformatting: Boolean);
begin
  inherited;
  Desc := GetDescent;
end;
{------------------------------------------------------------------------------}
function TRVLabelItemInfo.MouseMove(Shift: TShiftState; X, Y,
  ItemNo: Integer; RVData: TObject): Boolean;
begin
  Result := inherited MouseMove(Shift, X, Y, ItemNo, RVData);
  if Cursor<>crDefault then begin
    TCustomRVFormattedData(RVData).SetCursor(Cursor);
    Result := True;
  end;
end;
{------------------------------------------------------------------------------}
function TRVLabelItemInfo.GetAssociatedTextStyleNo: Integer;
begin
  Result := TextStyleNo;
end;
{------------------------------------------------------------------------------}
procedure TRVLabelItemInfo.SetAssociatedTextStyleNo(Value: Integer);
begin
  TextStyleNo := Value;
end;
initialization
  RegisterRichViewItemClass(rvsLabel, TRVLabelItemInfo);
end.

						