labelitem.pas

与Action相结合,可以解决中文件显示乱码

{*******************************************************}
{                                                       }
{       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                  }
{       [e-mail]                               }
{       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;