richview.pas

richview1.7 full.source

{=================================} unit RichView; {===========================}
{ unit RichView:                                                               }
{ components:                                                                  }
{   TRichView (registered in "RichView" palette page)                          }
{------------------------------------------------------------------------------}
{ Copyright (C) S.Tkachenko                                                    }
{==============================================================================}
interface
{$I RV_Defs.inc}
{$IFDEF RICHVIEWDEF6}
{$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  DLines, RVItem, RVStyle, RVScroll, RVFMisc, RVFuncs, CRVData, CRVFData, RVRVData,
  RVBack, RVUni, Registry,
  {$IFDEF RICHVIEWDEF4}
  ImgList,
  {$ENDIF}
  ClipBrd,
  RVRTFProps, RVRTFErr, StdCtrls;
{------------------------------------------------------------------------------}

const
  WM_RVEVENT = WM_USER + 15;

type

  TRVEventType = (rvetRVDblClick, rvetJump, rvetRVMouseUp, rvetRVMouseDown,
                  rvetClick, rvetDblClick, rvetMouseMove, rvetDragDrop, rvetEndDrag);

  TRVMessageData = class
    public
      Event: TRVEventType;
  end;

  TRVClickMessageData = class (TRVMessageData)
  end;

  TRVStdDblClickMessageData = class (TRVMessageData)
  end;

  TRVDblClickMessageData = class (TRVMessageData)
    public
      ClickedWord: String;
      StyleNo: Integer;
  end;

  TRVJumpMessageData = class (TRVMessageData)
    public
      id: Integer;
  end;

  TRVMouseMoveMessageData = class (TRVMessageData)
    public
      X,Y,ItemNo: Integer;
      Shift: TShiftState;
  end;

  TRVMouseUpDownMessageData = class (TRVMouseMoveMessageData)
    public
      Button: TMouseButton;
  end;

  TRVDNDMessageData = class (TRVMessageData)
    public
      X, Y: Integer;
      Obj: TObject;
  end;

  TCustomRichView = class;
{------------------------------------------------------------------------------}
  TRVPrintingStep = (rvpsStarting, rvpsProceeding, rvpsFinished);
{------------------------------------------------------------------------------}
  TJumpEvent           = procedure (Sender: TObject; id: Integer) of object;
  TRVMouseMoveEvent    = procedure (Sender: TObject; id: Integer) of object;
  TRVMouseEvent = procedure (Sender: TCustomRichView; Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer) of object;
  TRVSaveComponentToFileEvent = procedure (Sender: TCustomRichView; Path: String; SaveMe: TPersistent; SaveFormat: TRVSaveFormat; var OutStr:String) of object;
  TRVURLNeededEvent    = procedure (Sender: TCustomRichView; id: Integer; var url:String) of object;
  TRVDblClickEvent     = procedure (Sender: TCustomRichView; ClickedWord: String; Style: Integer) of object;
  TRVRightClickEvent   = procedure (Sender: TCustomRichView; ClickedWord: String; Style, X, Y: Integer) of object;
  TRVFPictureNeededEvent  = procedure  (Sender: TCustomRichView; Name: String; Tag: Integer; var gr: TGraphic) of object;
  TRVFControlNeededEvent  = procedure  (Sender: TCustomRichView; Name: String; Tag: Integer; var ctrl: TControl) of object;
  TRVCheckpointVisibleEvent = procedure (Sender: TCustomRichView; CheckpointData: TCheckpointData) of object;
  TRVControlActionEvent = procedure (Sender: TCustomRichView; ControlAction: TRVControlAction; ItemNo: Integer;
                                     var ctrl: TControl) of object;
  TRVItemActionEvent = procedure (Sender: TCustomRichView; ItemAction: TRVItemAction;
                                  Item: TCustomRVItemInfo; var Text: String;
                                  RVData: TCustomRVData) of object;
  TRVFImageListNeededEvent = procedure (Sender: TCustomRichView; ImageListTag: Integer; var il: TCustomImageList) of object;
  TRVHTMLSaveImageEvent = procedure (Sender: TCustomRichView; RVData: TCustomRVData; ItemNo: Integer;
                                const Path: String; BackgroundColor: TColor;
                                var Location: String; var DoDefault: Boolean)  of object;
  TRVReadHyperlink = procedure (Sender: TCustomRichView; const Target, Extras: String; DocFormat: TRVLoadFormat;
                                var StyleNo, ItemTag: Integer; var ItemName: String) of object;
  TRVSaveRTFExtraEvent = procedure (Sender: TCustomRichView; Area: TRVRTFSaveArea;
                                    Obj: TObject;
                                    Index1, Index2: Integer;
                                    InStyleSheet: Boolean; var RTFCode: String) of object;
  TRVSaveHTMLExtraEvent = procedure (Sender: TCustomRichView; Area: TRVHTMLSaveArea; CSSVersion: Boolean;
                                     var HTMLCode: String) of object;
  TRVPaintEvent = procedure (Sender: TCustomRichView; Canvas: TCanvas; Prepaint: Boolean) of object;
{------------------------------------------------------------------------------}
  TCustomRichView = class(TRVScroller)
  private
    { Private declarations }
    FCursor: TCursor;
    FOptions: TRVOptions;
    FRTFOptions: TRVRTFOptions;
    VScrollDelta, HScrollDelta: Integer;
    ScrollTimerActive: Boolean;
    FDelimiters: String;
    FOnJump: TJumpEvent;
    FOnRVMouseMove: TRVMouseMoveEvent;
    FOnSaveComponentToFile: TRVSaveComponentToFileEvent;
    FOnURLNeeded: TRVURLNeededEvent;
    FOnRVDblClick: TRVDblClickEvent;
    FOnRVRightClick: TRVRightClickEvent;
    FOnRVMouseUp,FOnRVMouseDown: TRVMouseEvent;
    FOnControlAction: TRVControlActionEvent;
    FOnItemAction: TRVItemActionEvent;
    FCPEventKind: TCPEventKind;
    FOnRVFPictureNeeded: TRVFPictureNeededEvent;
    FOnRVFControlNeeded: TRVFControlNeededEvent;
    FOnRVFImageListNeeded: TRVFImageListNeededEvent;
    FOnCheckpointVisible: TRVCheckpointVisibleEvent;
    FMaxTextWidth, FMinTextWidth, FLeftMargin, FRightMargin, FTopMargin, FBottomMargin: Integer;
    FRVFOptions: TRVFOptions;
    FRVFWarnings: TRVFWarnings;
    {$IFDEF RV_ODHC}
    FOnDocumentHeightChange: TNotifyEvent;
    {$ENDIF}
    FOnCopy: TNotifyEvent;
    FOnHTMLSaveImage: TRVHTMLSaveImageEvent;
    FRTFReadProperties: TRVRTFReaderProperties;
    FRVFTextStylesReadMode: TRVFReaderStyleMode;
    FRVFParaStylesReadMode: TRVFReaderStyleMode;
    FOnTReadHyperlink: TRVReadHyperlink;
    FOnSaveRTFExtra: TRVSaveRTFExtraEvent;
    FOnSaveHTMLExtra: TRVSaveHTMLExtraEvent;    
    FOnPaint: TRVPaintEvent;
    {$IFDEF RICHVIEWDEF5}
    procedure WMContextMenu(var Message: TMessage); message WM_CONTEXTMENU;
    {$ENDIF}
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMCopy(var Message: TWMCopy); message WM_COPY;
    procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
    procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMRVEvent(var Message: TMessage); message WM_RVEVENT;

    function GetLineCount: Integer;

    function GetAllowSelection: Boolean;
    function GetSingleClick: Boolean;
    procedure SetAllowSelection(const Value: Boolean);
    procedure SetSingleClick(const Value: Boolean);
    procedure DoOnBackBitmapChange(Sender: TObject);
    function GetPageBreaksBeforeItems(Index: Integer): Boolean;
    procedure SetPageBreaksBeforeItems(Index: Integer;  Value: Boolean);
    function GetDocumentHeight: Integer;
    function GetFirstJumpNo: Integer;
    procedure SetFirstJumpNo(Value: Integer);
    procedure SetTabNavigation(const Value: TRVTabNavigationType);
    procedure SetRTFReadProperties(const Value: TRVRTFReaderProperties);
    function StoreDelimiters: Boolean;
    {$IFDEF RVDEBUG}{$I Debug\DebPropDef.inc}{$ENDIF}
  protected
    { Protected declarations }
    FOnSelect: TNotifyEvent;
    FStyle: TRVStyle;

    imgSavePrefix: String;
    SaveOptions: TRVSaveOptions;
    CurrentFileColor: TColor;

    procedure SetBiDiModeRV(const Value: TRVBiDiMode); override;

    procedure SetVSmallStep(Value: Integer); override;
    procedure Paint; override;

    function GetColor: TColor;
    function GetHoverColor(Color: TColor):TColor;

    function IsCopyShortcut(Shift: TShiftState; Key: Word): Boolean;
    function IsCutShortcut(Shift: TShiftState; Key: Word): Boolean;
    function IsPasteShortcut(Shift: TShiftState; Key: Word): Boolean;

    procedure DblClick; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure ClearTemporal; virtual;
    function GetFirstItemVisible: Integer;
    function GetLastItemVisible: Integer;
    function GetBackBitmap: TBitmap;
    procedure SetBackBitmap(Value: TBitmap);
    procedure SetBackgroundStyle(Value: TBackgroundStyle);
    function GetBackgroundStyle: TBackgroundStyle;
    procedure Notification(AComponent: TComponent; Operation: TOperation);override;

    procedure Loaded; override;
    function CompareTags(Tag1, Tag2: Integer): Boolean;
    procedure SetStyle(Value: TRVStyle);
    procedure AfterVScroll; override;
    procedure AfterHScroll; override;
    procedure GenerateMouseMove;
    procedure Format_(OnlyResized,ForceFormat:Boolean; Canvas: TCanvas;
          OnlyTail, NoCaching: Boolean);
    function GetDataClass: TRichViewRVDataClass; virtual;
    function GetTabNavigation:TRVTabNavigationType;
    function GetRTFReadProperties: TRVRTFReaderProperties; virtual;
    procedure AfterCreateWnd1; override;
    procedure AfterCreateWnd2; override;
    procedure SetName(const NewName: TComponentName); override;
    { obsolete properties }
    property AllowSelection: Boolean read GetAllowSelection write SetAllowSelection stored False;
    property SingleClick   : Boolean read GetSingleClick    write SetSingleClick    stored False;
    property OnPaint: TRVPaintEvent  read FOnPaint          write FOnPaint;
  public
    { Should be protected. Do not use! }
    RVData: TRichViewRVData;
    Flags : TRVFlags;
    Background: TRVBackground;
    imgSaveNo: Integer;    
    property Canvas;
    procedure SelectNext_(GoForward: Boolean);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
    procedure ActivateScrollTimer;
    function RTFReaderAssigned: Boolean; dynamic;
    procedure AssignEvents(Source: TCustomRichView);
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetTabOrderList(List: TList); override;
    procedure AssignSoftPageBreaks(RVPrint: TComponent);
    procedure ClearSoftPageBreaks;

    { add... methods: }
    procedure AddItem(const Text: String; Item: TCustomRVItemInfo);
    procedure AddNL(const s: String; StyleNo, ParaNo: Integer);
    procedure AddFmt(const FormatStr: String; const Args: array of const;
                     StyleNo, ParaNo: Integer);
    procedure Add(const s: String; StyleNo:Integer);
    procedure AddTextNL(const s: String; StyleNo, FirstParaNo, OtherParaNo: Integer);
    procedure AddTextBlockNL(s: String; StyleNo, ParaNo: Integer);
    procedure AddBreak;
    function AddCheckpoint: Integer; { returns cp # }
    function AddNamedCheckpoint(CpName: String): Integer; { returns cp # }
    function AddNamedCheckpointEx(const CpName: String; RaiseEvent: Boolean): Integer; { returns cp # }
    procedure AddPictureEx(const Name: String; gr: TGraphic; ParaNo: Integer;
                           VAlign: TRVVAlign);
    procedure AddHotPicture(const Name: String; gr: TGraphic; ParaNo: Integer;
                           VAlign: TRVVAlign);
    procedure AddHotspotEx(const Name: String; ImageIndex, HotImageIndex: Integer;
                           ImageList: TCustomImageList; ParaNo: Integer);
    procedure AddBulletEx (const Name: String; ImageIndex: Integer;
                           ImageList: TCustomImageList; ParaNo: Integer);
    procedure AddControlEx(const Name: String; ctrl: TControl;
                           ParaNo: Integer; VAlign: TRVVAlign);
    procedure AddBreakEx(Width: Byte; Style: TRVBreakStyle; Color: TColor);
    {$IFDEF RVDEBUG}{$I Debug\DebPropDef2.inc}{$ENDIF}
    { add...tag methods: }
    procedure AddNLTag(const s: String; StyleNo, ParaNo, Tag: Integer);
    procedure AddTag(const s: String;StyleNo,Tag:Integer);
    procedure AddBreakTag(Tag:Integer);
    function AddCheckpointTag(Tag: Integer): Integer; { returns cp # }
//    function AddNamedCheckpointTag(const CpName: String; Tag: Integer): Integer; { returns cp # }
    function AddNamedCheckpointExTag(const CpName: String; RaiseEvent: Boolean;
                                    Tag: Integer): Integer; { returns cp # }
    procedure AddPictureExTag(const Name: String; gr: TGraphic; ParaNo: Integer;
                              VAlign: TRVVAlign; Tag: Integer);
    procedure AddHotPictureTag(const Name: String; gr: TGraphic; ParaNo: Integer;
                              VAlign: TRVVAlign; Tag: Integer);
    procedure AddHotspotExTag(const Name: String; ImageIndex, HotImageIndex: Integer;
                              ImageList: TCustomImageList; ParaNo,Tag: Integer);
    procedure AddBulletExTag (const Name: String; ImageIndex: Integer;
                              ImageList: TCustomImageList; ParaNo,Tag: Integer);
    procedure AddControlExTag(const Name: String; ctrl: TControl;
                              ParaNo: Integer; VAlign: TRVVAlign; Tag: Integer);
    procedure AddBreakExTag(Width: Byte; Style: TRVBreakStyle;
                            Color: TColor; Tag: Integer);
    { add... methods for backward compatibility: }
    procedure AddFromNewLine(const s: String;StyleNo:Integer);  {$IFDEF RICHVIEWDEF6}deprecated;{$ENDIF}
    procedure AddCenterLine(const s: String;StyleNo:Integer);  {$IFDEF RICHVIEWDEF6}deprecated;{$ENDIF}
    procedure AddText(const s: String;StyleNo:Integer);  {$IFDEF RICHVIEWDEF6}deprecated;{$ENDIF}
    procedure AddTextFromNewLine(const s: String;StyleNo:Integer);  {$IFDEF RICHVIEWDEF6}deprecated;{$ENDIF}
    procedure AddPicture(gr: TGraphic);  {$IFDEF RICHVIEWDEF6}deprecated;{$ENDIF}
    procedure AddHotspot(ImageIndex: Integer; ImageList: TCustomImageList;
                         fromnewline: Boolean);  {$IFDEF RICHVIEWDEF6}deprecated;{$ENDIF}
    procedure AddBullet (ImageIndex: Integer; ImageList: TCustomImageList;
                         fromnewline: Boolean);  {$IFDEF RICHVIEWDEF6}deprecated;{$ENDIF}
    procedure AddControl(ctrl: TControl; center: Boolean);  {$IFDEF RICHVIEWDEF6}deprecated;{$ENDIF}

    // checkpoint methods:
    function GetCheckpointY(no: Integer): Integer;