RichEdit

开发平台：

Delphi

CRVFData.pas：源码内容

{*******************************************************}
{ }
{ RichView }
{ TCustomRVFormattedData is a basic class }
{ representing RichView document with }
{ formatting. }
{ }
{ Copyright (c) Sergey Tkachenko }
{ svt@trichview.com }
{ http://www.trichview.com }
{ }
{*******************************************************}
unit CRVFData;
interface
{$I RV_Defs.inc}
uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Clipbrd,
Forms,
RVFuncs, RVStyle, RVItem, CRVData, DLines, RVScroll, RVBack, RVUni,
{$IFNDEF RVDONOTUSEDRAGDROP}
ActiveX, RVDragDrop,
{$ENDIF}
RVClasses;
type
TCustomRVFormattedData = class;
{-----------------------------------------------------------------------}
TRVJumpInfo = class
public
RVData: TCustomRVFormattedData;
l,t,w,h: Integer;
id, DrawItemNo: Integer;
Cursor: TCursor;
end;
TRVSoftPageBreakInfo = class
ItemNo, Offset, ExtraData: Integer;
end;
TRVSoftPageBreakList = class (TRVList)
public
function FindItem(ItemNo: Integer): Integer;
end;
TRVSelectingState = (rvsesInWord, rvsesOutsideWord, rvsesFreeMode,
rvsesParaMode);
{ TRVSelectingInfo: information about the selection process (with mouse).
For internal use (used as FSelectingInfo field of TCustomRVFormattedData.
This field is allocated while user is making selection.
Contains two set of fields: for starting and for ending parts of selection
(bounds of word containing selection end, actual selection position). }
TRVSelectingInfo = class
public
DrawItemSOffs, DrawItemEOffs, DrawItemSWordOffs1, DrawItemSWordOffs2,
DrawItemEWordOffs1, DrawItemEWordOffs2: Integer;
DrawItemSNo, DrawItemENo: Integer;
SWordState, EWordState: TRVSelectingState;
procedure InitE(ASWordState: TRVSelectingState);
function IsAboveSWord(ADrawItemNo, ADrawItemOffs: Integer): Boolean;
function IsBelowSWord(ADrawItemNo, ADrawItemOffs: Integer): Boolean;
function IsInSWord(ADrawItemNo, ADrawItemOffs: Integer): Boolean;
function AreWordsEqual: Boolean;
function IsEWord(ADrawItemNo,
ADrawItemWordOffs1, ADrawItemWordOffs2: Integer): Boolean;
function IsEFreeStateNeeded(ADrawItemNo, ADrawItemOffs: Integer): Boolean;
end;
{--------------------------------------------------------------------------- }
{$IFNDEF RVDONOTUSEDRAGDROP}
{ TCustomRVFormattedData: information about drag&drop caret location.
See: TCustomRVFormattedData.GetDragDropCaretInfo }
TRVDragDropCaretInfo = class
public
X,Y, // coordinates relative to RVData top-left
Height, // caret height
ItemNo, ItemOffs: Integer; // item index and offset in item, in RVData
RVData: TCustomRVData; // RVData containing d&d caret
RefCount: Integer;
end;
{$ENDIF}
TRVFontInfoCacheItem = class
public
LastBiDiMode: TRVBiDiMode;
Canvas: TCanvas;
TextMetric: TTextMetric;
FontInfo: TFontInfo;
VerticalOffset: Integer;
EmptyLineHeight: Integer;
HyphenWidth: Integer;
end;
PRVFontInfoCacheItem = ^TRVFontInfoCacheItem;
TRVFontInfoCache = class (TRVList)
protected
FCanvas: TCanvas;
FRVStyle: TRVStyle;
FCanUseCustomPPI: Boolean;
FOwner: TObject;
function GetItems(Index: Integer): TRVFontInfoCacheItem; virtual; abstract;
public
CurParaBiDiMode: TRVBiDiMode;
IgnoreParaBiDiMode: Boolean;
LastTextStyle: Integer;
constructor Create(const AData: TCustomRVFormattedData;
const ARVStyle: TRVStyle; const ACanvas: TCanvas; ACanUseCustomPPI: Boolean); virtual;
property Items[Index: Integer]: TRVFontInfoCacheItem read GetItems; default;
end;
TRVFormatParams = record
x, baseline, prevdesc, prevabove:Integer;
IsParaStart: Boolean;
LineWidth, FirstIndent, LastDrawItem, VerticalOffs, LeftIndent, RightIndent: Integer;
LastTextStyle: Integer;
FirstParaItemNo: Integer;
NoCaching, Reformatting: Boolean;
DontFSL: Boolean;
LastTabDrawItemNo: Integer;
LastTabAlign: TRVTabAlign;
LastTabPosition: Integer;
SpaceEaten: Boolean;
FontInfoCache: TRVFontInfoCache;
FormatCanvas: TCanvas;
FormatCanvasHandle: HDC;
TextMetric: TTextMetric;
end;
{--------------------------------------------------------------------------- }
{ TCustomRVFormattedData: RichView document with formatting. }
TCustomRVFormattedData = class (TCustomRVData)
private
LastRaisedCP: TRVCPInfo;
FXORDrawing: TMouseMoveEvent;
FCaptureMouseItem: TCustomRVItemInfo;
FSelectingInfo: TRVSelectingInfo;
//FZoomPercent: Integer;
//LastSelectionRect: TRect;
function FindDrawItemAtPos(X, Y: Integer): Integer;
procedure CopyText_;
procedure CopyTextW_;
procedure CopyImage_;
{$IFNDEF RVDONOTUSERVF}
procedure CopyRVF_(Color: TColor; Background: TRVBackground);
{$ENDIF}
{$IFNDEF RVDONOTUSERTF}
procedure CopyRTF_(Color: TColor; Background: TRVBackground);
{$ENDIF}
procedure StartFormatting;
procedure EndFormatting;
procedure SearchHotItem(X, Y, HOffs, VOffs: Integer);
procedure AdjustSelection;
//procedure SetZoomPercent(const Value: Integer);
protected
{ Protected declarations }
XorImageDrawn: Boolean;
MouseX, MouseY: Integer;
Jumps: TList;
nJmps: Integer;
LastItemFormatted: Integer;
LastJumpMovedAbove, LastDIMovedAbove: Integer;
LastRVDataMovedAbove: TCustomRVFormattedData;
LastJumpDowned: Integer;
FPartialSelectedItem: TCustomRVItemInfo;
AlreadyFormatted: Boolean;
FSoftPageBreaks: TRVSoftPageBreakList;
FClickedDrawItemNo: Integer;
{ Inplace }
function GetInplaceEditor: TControl; dynamic;
procedure DestroyInplaceEditor; dynamic;
{ Clearing }
procedure ClearLastJump;
{ Drawing item info }
function IsDrawItemParaStart(DrawItemNo: Integer): Boolean;
function IsDrawItemItemStart(DrawItemNo: Integer): Boolean;
function IsDrawItemParaSectionStart(DrawItemNo: Integer): Boolean;
function IsDrawItemParaEnd(DrawItemNo: Integer): Boolean;
function IsDrawItemFromNewLine(DrawItemNo: Integer): Boolean;
function IsDrawItemLastOnWrappedLine(DrawItemNo: Integer): Boolean;
function GetDrawItemStyle(DrawItemNo: Integer): Integer;
function IsSpaceBetweenDrawItems(DrawItemNo: Integer): Boolean;
{ Drawing }
procedure PostPaintTo(Canvas: TCanvas;
HOffs, VOffs, FirstDrawItemNo, LastDrawItemNo: Integer); virtual;
{ Selecting }
procedure FindDrawItemForSel(X, Y: Integer; var No, Offs: Integer; Strict: Boolean);
function AdjustSelectionByMode(X,Y: Integer): Boolean;
function AdjustLineSelection(X,Y: Integer): Boolean;
function ExpandSelectionToParagraph(OnlyIfMultiple: Boolean): Boolean;
procedure ExpandSelectionToLines(OneLine: Boolean);
procedure DeselectPartiallySelectedItem(NewPartiallySelected: TCustomRVItemInfo); dynamic;
procedure SetPartialSelectedItem(Item: TCustomRVItemInfo); virtual;
{ Selection info }
function IsSelectionTopDown: Boolean;
function DItem_InsideSelection(DItemNo, DItemOffs: Integer): Boolean;
function GetClientSelectionRect: TRect;
{$IFNDEF RVDONOTUSEDRAGDROP}
{ Drag & drop: drop to }
procedure DrawDragDropCaret(Canvas: TCanvas; OnlyForSelf: Boolean);
{ Drag & drop: drop from }
function CanStartDragging: Boolean; dynamic;
function InitDragging(var DropSource: TRVDropSource; var OKEffect: Integer): Boolean; dynamic;
procedure DoneDragging(FDeleteSelection: Boolean); dynamic;
{$ENDIF}
{ Formatting }
procedure FinishScreenLine(const sad: TRVScreenAndDevice;
LineWidth, LastDrawItem: Integer; parafinished: Boolean;
var ExtraSpace: Integer; var dontdoit: Boolean; Canvas: TCanvas);
procedure UpdateLastTab(var Params: TRVFormatParams);
procedure FormatLine(const Text, OrigText: String; StartOffs, Len, ItemNo: Integer;
Canvas: TCanvas; var sad: TRVScreenAndDevice;
var Params: TRVFormatParams);
procedure FormatWords(ItemNo: Integer; Canvas: TCanvas;
var sad: TRVScreenAndDevice; var Params: TRVFormatParams);
procedure GetSADForFormatting(Canvas: TCanvas; var sad: TRVScreenAndDevice); virtual;
procedure Formatted(FirstItemNo, LastItemNo: Integer; Partial: Boolean); dynamic;
procedure CreateFontInfoCache(ACanvas: TCanvas); dynamic;
procedure DestroyFontInfoCache(var Cache: TRVFontInfoCache); dynamic;
function GetFontInfoCache(ACanvas: TCanvas;
RVData: TCustomRVFormattedData): TRVFontInfoCache; dynamic;
{ Misc. }
procedure ConcateItems(FirstItemNo: Integer);
function InsideWord(DrawItemNo, DrawItemOffs: Integer): Boolean;
procedure GetWordBounds(DrawItemNo, DrawItemOffs: Integer;
var DrawItemWordOffs1, DrawItemWordOffs2: Integer);
procedure GetScreenLineBounds(DrawItemNo: Integer; var First, Last: Integer);
procedure AfterDeleteStyles(Data: TRVDeleteUnusedStylesData); override;
procedure InternalFreeItem(item: TCustomRVItemInfo; Clearing: Boolean); override;
procedure ApplyZoom(Canvas: TCanvas);
procedure ZoomRectDown(var r: TRect);
procedure ZoomInt(var v: Integer);
procedure RestoreZoom(Canvas: TCanvas);
function GetFirstItemMarker(var ListNo, Level: Integer): Boolean; virtual;
procedure GetIndents(ItemNo: Integer; IsParaStart: Boolean;
var FirstParaItemNo: Integer; var LeftIndent, RightIndent,
PureLeftIndent: Integer);
function GetRVDataExtraVOffs: Integer; virtual;
function GetMaxIndent(ItemNo: Integer; var FirstParaItemNo: Integer): Integer;
{$IFNDEF RVDONOTUSERVF}
procedure RVFGetLimits(SaveScope: TRVFSaveScope;
var StartItem, EndItem, StartOffs, EndOffs: Integer;
var StartPart, EndPart: TRVMultiDrawItemPart); override;
{$ENDIF}
{ Live spelling }
{$IFNDEF RVDONOTUSELIVESPELL}
procedure LiveSpellingCheckCurrentItem; dynamic;
{$ENDIF}
public
FActiveItem: TCustomRVItemInfo;
DocumentWidth: Integer;
DocumentHeight, TextWidth,FocusedItemNo: Integer;
DrawItems: TRVDrawLines;
FSelStartNo, FSelEndNo, FSelStartOffs, FSelEndOffs: Integer;
{ Create & Destroy }
constructor Create;
destructor Destroy; override;
{ Clearing }
procedure ClearTemporal;virtual;
procedure Clear; override;
{ Soft page breaks }
procedure AssignSoftPageBreaks(RVPrint: TComponent);
function ClearSoftPageBreaks: Boolean;
{ Focused items }
function GetNextFocusedItem(ItemNo: Integer; GoForward: Boolean;
var TopLevelRVData: TCustomRVFormattedData;
var TopLevelItemNo: Integer): Integer;
procedure ClearFocus;
procedure AdjustFocus(NewFocusedItemNo: Integer;
TopLevelRVData: TPersistent; TopLevelItemNo: Integer); dynamic;
{ Animation }
{$IFNDEF RVDONOTUSEANIMATION}
function AllowAnimation: Boolean; dynamic;
procedure InsertAnimator(var Animator: TObject); dynamic;
procedure ResetAniBackground; dynamic;
{$ENDIF}
{ Size and position of document }
procedure GetOrigin(var ALeft, ATop: Integer); virtual;
procedure GetOriginEx(var ALeft, ATop: Integer); dynamic;
function GetAreaWidth: Integer; virtual; abstract;
function GetAreaHeight: Integer; virtual; abstract;
function GetLeftMargin: Integer; virtual; abstract;
function GetRightMargin: Integer; virtual; abstract;
function GetTopMargin: Integer; virtual; abstract;
function GetBottomMargin: Integer; virtual; abstract;
function GetMinTextWidth: Integer; virtual; abstract;
function GetMaxTextWidth: Integer; virtual; abstract;
function GetWidth: Integer; virtual; abstract;
function GetHeight: Integer; virtual; abstract;
procedure SetDocumentAreaSize(Width,Height: Integer;
UpdateH: Boolean); virtual; abstract;
function CalculatePureParaSectionWidth(ItemNo: Integer;
var FirstParaItemNo: Integer; sad: PRVScreenAndDevice; Canvas: TCanvas): Integer;
function CalculateParaSectionMinWidth(StartItemNo: Integer;
var FirstParaItemNo: Integer; sad: PRVScreenAndDevice;
Canvas: TCanvas): Integer;
function CalculateParaSectionMinWidthDef(StartItemNo: Integer): Integer;
function CalculateParaSectionsMinWidth(StartItemNo, EndItemNo: Integer;
var FirstParaItemNo: Integer; sad: PRVScreenAndDevice;
Canvas: TCanvas): Integer;
function CalculateParaSectionsMinWidthDef(StartItemNo, EndItemNo: Integer): Integer;
function CalculateMinItemWidthPlus_WithoutPSWidth(ItemNo: Integer;
sad: PRVScreenAndDevice; Canvas: TCanvas): Integer;
function CalculateMinItemsWidthPlus(StartItemNo, EndItemNo: Integer;
var FirstParaItemNo: Integer; sad: PRVScreenAndDevice;
Canvas: TCanvas): Integer;
function CalculateMinItemWidthPlusEx(ItemNo: Integer): Integer;
function CalculateMinItemsWidthPlusEx(StartItemNo, EndItemNo: Integer): Integer;
function CalculateMinDocWidthPlus(sad: PRVScreenAndDevice; Canvas: TCanvas): Integer;
function CalculateMinWidthAfterInsert(item:TCustomRVItemInfo; InsertItemNo: Integer): Integer;
{ Coordinates }
procedure ResetSubCoords; dynamic;
function GetDrawItemNo(BoundLine: Integer; Option: Integer): Integer;
function GetItemCoords(ItemNo: Integer;var Left,Top: Integer): Boolean;
function GetItemClientCoords(ItemNo: Integer;var Left,Top: Integer): Boolean;
function ClientToScreen(const p: TPoint): TPoint; dynamic;
function ScreenToClient(const p: TPoint): TPoint; dynamic;
{$IFNDEF RVDONOTUSESMARTPOPUP}
procedure AdjustSpecialControlsCoords(RVData: TCustomRVFormattedData); dynamic;
{$ENDIF}
procedure AdjustChildrenCoords;
{ Get ... at (X,Y) }
procedure GetWordAt(X, Y: Integer; var RVData: TCustomRVFormattedData;
var ItemNo: Integer; var Word: String);
function FindWordAt(var Word: String; X, Y: Integer; var StyleNo,
ItemNo, Offs: Integer; var RVData: TCustomRVFormattedData): Boolean;
procedure GetItemAt(X,Y: Integer; var ItemNo, OffsetInItem: Integer);
procedure GetItemAtEx(X,Y: Integer; var RVData: TCustomRVFormattedData;
var ItemNo, OffsetInItem: Integer; Strict: Boolean;
var InSubRVDataOwnerItem: Boolean);
{ Scrolling }
procedure ShowRectangle(Left, Top, Width, Height: Integer); dynamic;
procedure AdjustVScrollUnits; virtual; abstract;
function GetHOffs: Integer; virtual;
function GetVOffs: Integer; virtual;
function GetZHOffs: Integer;
function GetZVOffs: Integer;
procedure ScrollTo(Y: Integer; Redraw: Boolean); virtual; abstract;
procedure HScrollTo(X: Integer); virtual; abstract;
function GetVSmallStep: Integer; virtual; abstract;
procedure AfterVScroll;
procedure OnTimerScroll;
{ Calling events }
procedure DoCopy; dynamic;
function IsAssignedCopy: Boolean; dynamic;
function IsAssignedRVMouseUp: Boolean; dynamic; abstract;
function IsAssignedRVMouseDown: Boolean; dynamic; abstract;
function IsAssignedRVRightClick: Boolean; dynamic;
function IsAssignedJump: Boolean; dynamic; abstract;
function IsAssignedRVDblClick: Boolean; dynamic;
function IsAssignedCheckpointVisible: Boolean; dynamic; abstract;
procedure DoRVMouseUp(Button: TMouseButton; Shift: TShiftState;
ItemNo, X, Y: Integer); dynamic; abstract;
procedure DoRVMouseDown(Button: TMouseButton; Shift: TShiftState;
ItemNo, X, Y: Integer); dynamic; abstract;
procedure DoRVRightClick(const ClickedWord: String; StyleNo, X, Y: Integer);dynamic;
procedure DoJump(id: Integer); dynamic; abstract;
procedure DoRVMouseMove(id: Integer); dynamic; abstract;
procedure DoRVDblClick(const ClickedWord: String; StyleNo: Integer); dynamic;
procedure DoSelect; dynamic;
procedure DoCheckpointVisible(CheckpointData: TCheckpointData); dynamic; abstract;
procedure DoCurrentTextStyleConversion(var StyleNo: Integer;
ParaStyleNo, ItemNo, UserData: Integer; ToWholeParagraphs: Boolean); dynamic;
{ Properties }
function GetNormalCursor: TCursor; dynamic; abstract;
function GetCPEventKind: TCPEventKind; dynamic;
function GetBackground: TRVBackground; virtual; abstract;
function GetCanvas: TCanvas; virtual;
function GetColor: TColor; virtual; abstract;
procedure SetCursor(Cursor: TCursor); dynamic;
function GetEditor: TWinControl; dynamic;
{ Mouse }
procedure MouseLeave;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);dynamic;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);dynamic;
procedure DblClick;
procedure AdjustMouseUpSelection; dynamic;
{ Mouse capture }
procedure SetMouseCapture(Item: TCustomRVItemInfo; var Left,Top: Integer);
procedure ReleaseMouseCapture(Item: TCustomRVItemInfo);
{$IFNDEF RVDONOTUSEDRAGDROP}
{ Drag & drop: drop to }
function GetDragDropCaretInfo: TRVDragDropCaretInfo; dynamic;
procedure SetDragDropCaretTo(X,Y: Integer);
procedure RemoveDragDropCaret;
procedure SetDragDropCaret(ItemNo, Offs: Integer);
{ Drag & drop: drop from }
procedure DoDrag;
function IsDragging: Boolean; dynamic;
{$ENDIF}
{ Insertion and protection (used in editor or by drag&drop) }
function CanInsertHere(ItemNo, Offs: Integer): Boolean;
function IsProtected(ItemNo: Integer; Option: TRVProtectOption): Boolean;
function IsParaProtected(ParaNo: Integer; Option: TRVParaOption): Boolean;
function IsItemParaProtected(ItemNo: Integer): Boolean;
function IsSticking(FirstItemNo: Integer; NoSound: Boolean): Boolean;
{ Drawing }
procedure DrawBackground(Canvas: TCanvas; r: TRect); virtual;
procedure PaintTo(Canvas: TCanvas; AClipRect: TRect);
procedure GetItemBackground(ItemNo: Integer; r: TRect; MakeImageRect: Boolean;
var Color: TColor; var bmp: TBitmap;
var UseBitmap: Boolean); virtual;
{ Redrawing }
procedure InvalidateJumpRect(id: Integer);
procedure Refresh;
procedure UpdateView;
procedure Invalidate;
procedure InvalidateRect(const r: TRect);
{ Palette }
procedure UpdateBackgroundPaletteInfo(Background: TRVBackground);
function UpdatingBackgroundPalette: Boolean;
{ Drawing XOR }
procedure XorDrawing; virtual;
procedure XorDrawingEx(X,Y: Integer);
function ClearXorDrawing: Boolean;
procedure AssignXorDrawing(P: TMouseMoveEvent);
function UsingThisXorDrawing(P: TMouseMoveEvent): Boolean;
procedure UnAssignXorDrawing(P: TMouseMoveEvent);
{ Formatting }
procedure FormatParas(StartDrawItemNo, EndDrawItemNo, ItemsInserted: Integer);
procedure FormatParasExact(StartDrawItemNo, EndDrawItemNo,
ItemsInserted: Integer; NoCaching: Boolean);
procedure Format_(OnlyResized, ForceFormat, NoScroll: Boolean;
depth: Integer; Canvas: TCanvas; OnlyTail, NoCaching, Reformatting: Boolean); virtual;
procedure Format(NoCaching: Boolean);
{ Selecting }
procedure DoSetSelectionBounds(StartItemNo, StartItemOffs, EndItemNo,
EndItemOffs: Integer);
procedure SetSelectionBounds(StartItemNo, StartItemOffs, EndItemNo,
EndItemOffs: Integer);
function SearchText(Down, MatchCase, WholeWord: Boolean; s: String): Boolean;
procedure SelectWordAt(X, Y: Integer);
function SelectControl(AControl: TControl): Boolean;
procedure Deselect(NewPartiallySelected: TCustomRVItemInfo;
MakeEvent: Boolean); dynamic;
procedure SelectAll;
procedure SelectLine(ItemNo, Offs: Integer);
procedure RestoreSelBounds(StartNo, EndNo, StartOffs, EndOffs: Integer);
procedure SrchSelectIt(strt, offs, len: Integer; Invert: Boolean); dynamic;
procedure SrchStart(Down: Boolean; var strt, offs: Integer);dynamic;
{ Chosen RVData & Item }
procedure AssignChosenRVData(RVData: TCustomRVFormattedData;
Item: TCustomRVItemInfo); dynamic;
procedure SilentReplaceChosenRVData(RVData: TCustomRVFormattedData); dynamic;
procedure UnassignChosenRVData(RVData: TCustomRVData); dynamic;
{ Get selection }
function SelectionExists(AllowReset: Boolean;
UsePartialSelected: Boolean): Boolean;
procedure GetSelectionBounds(var StartItemNo, StartItemOffs, EndItemNo,
EndItemOffs: Integer; Normalize: Boolean);
procedure GetSelBounds(var StartNo, EndNo, StartOffs, EndOffs: Integer;
Normalize: Boolean); dynamic;
procedure StoreSelBounds(var StartNo, EndNo, StartOffs, EndOffs: Integer;
Normalize: Boolean);
procedure GetSelectionBoundsEx(var StartItemNo, StartItemOffs, EndItemNo,
EndItemOffs: Integer; Normalize: Boolean); dynamic;
procedure GetSelStart(var DINo, DIOffs: Integer);dynamic;
function GetSelText(Unicode: Boolean): String;
function GetSelectedImage: TGraphic;
function GetSelectionRect: TRect;
{ Selection misc. }
procedure DoOnSelection(AllowScrolling: Boolean); dynamic;
function Item_InsideSelection(ItemNo, ItemOffs: Integer): Boolean;
{ Checkpoints }
procedure GetCheckpointXY(CheckpointData: TCheckpointData; var X, Y: Integer);
function GetCheckpointYEx(CheckpointData: TCheckpointData): Integer;
{ Hypertext }
procedure BuildJumpsCoords(var StartJumpNo: Integer; jumps: TList);
procedure ClearJumps;
procedure AdjustJumpsCoords;
function GetJumpPointY(id: Integer): Integer;
function GetJumpPointItemNo(id: Integer): Integer;
procedure GetJumpPointLocation(id: Integer; var RVData: TCustomRVFormattedData; var ItemNo: Integer);
{ Copying to the Clipboard }
{$IFNDEF RVDONOTUSERVF}
procedure CopyRVF(Color: TColor; Background: TRVBackground);
{$ENDIF}
{$IFNDEF RVDONOTUSERTF}
procedure CopyRTF(Color: TColor; Background: TRVBackground);
{$ENDIF}
procedure CopyText;
procedure CopyTextW;
procedure CopyImage;
procedure Copy(Color: TColor; Background: TRVBackground);
function CopyDef(Color: TColor; Background: TRVBackground): Boolean;
{ Items and drawitems indices, line numbers }
function GetLineNo(ItemNo, ItemOffs: Integer): Integer;
procedure GetParaBounds(DINo1, DINo2: Integer; var ParaStart, ParaEnd: Integer);
function GetFirstVisible(TopLine: Integer): Integer;
function GetFirstItemVisible: Integer; dynamic;
function GetLastItemVisible: Integer; dynamic;
function GetOffsBeforeDrawItem(DrawItemNo: Integer): Integer;
function GetOffsAfterDrawItem(DrawItemNo: Integer): Integer;
procedure DrawItem2Item(DrawItemNo, DrawItemOffs: Integer; var ItemNo, ItemOffs: Integer);
procedure Item2DrawItem(ItemNo, ItemOffs: Integer; var DrawItemNo, DrawItemOffs: Integer);
procedure Item2FirstDrawItem(ItemNo: Integer; var DrawItemNo: Integer);
procedure Item2LastDrawItem(ItemNo: Integer; var DrawItemNo: Integer);
function FindDrawItemByItem(ItemNo: Integer): Integer;
procedure InvalidateDrawItem(DrawItemNo, Spacing: Integer);
{ Deleting }
procedure DeleteItems(FirstItemNo, Count: Integer); override;
procedure DeleteParas(FirstItemNo, LastItemNo: Integer);
{ Others }
procedure Normalize;
{ Properties }
property PartialSelectedItem: TCustomRVItemInfo
read FPartialSelectedItem write SetPartialSelectedItem;
property CaptureMouseItem: TCustomRVItemInfo read FCaptureMouseItem;
property SoftPageBreaks: TRVSoftPageBreakList read FSoftPageBreaks;
//property ZoomPercent:Integer read FZoomPercent write SetZoomPercent;
{ Selection Info }
function IsMultiParagraphSelection: Boolean;
end;
const
RichViewSafeFormatting:Boolean = False;
RichViewShowGhostSpaces: Boolean = False;
implementation
uses RichView,
{$IFNDEF RVDONOTUSELIVESPELL}
RVWordPaint,
{$ENDIF}
{$IFNDEF RVDONOTUSELISTS}
RVMarker,
{$ENDIF}
RVCtrlData, RVStr, PtblRV, PtRVData
;
{==============================================================================}
const gdinFirstVisible = 1;
const gdinLastCompleteVisible = 2;
const gdinLastVisible = 3;
const MAXLINELENGTH = 1000;
{------------------------------------------------------------------------------}
function MyStrRScanA(Str: PChar; Chr: Char; Length: Integer): PChar;
begin
Result := Str+Length-1;
while Result>=Str do begin
if Result^=Chr then
exit;
dec(Result);
end;
Result := nil;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEUNICODE}
{
function MyStrRScanW(Str: PChar; Chr: Char; Length: Integer): PChar;
begin
Result := Str+(Length-1)*2;
while Result>=Str do begin
if (Result^=Chr) and ((Result+1)^=#0) then
exit;
dec(Result, 2);
end;
Result := nil;
end;
}
{$ENDIF}
{------------------------------------------------------------------------------}
function max(a,b: Integer): Integer;
begin
if a>b then
max := a
else
max := b;
end;
{================================ TRVSelectingInfo ============================}
{ Initializing ending values with the starting values }
procedure TRVSelectingInfo.InitE(ASWordState: TRVSelectingState);
begin
DrawItemEOffs := DrawItemSOffs;
DrawItemENo := DrawItemSNo;
DrawItemEWordOffs1 := DrawItemSWordOffs1;
DrawItemEWordOffs2 := DrawItemSWordOffs2;
if ASWordState=rvsesParaMode then begin
SWordState := rvsesParaMode;
EWordState := rvsesParaMode;
end
else begin
SWordState := ASWordState;
EWordState := rvsesInWord;
end;
end;
{------------------------------------------------------------------------------}
{ Is (ADrawItemNo, ADrawItemOffs) in inside the starting word? }
function TRVSelectingInfo.IsInSWord(ADrawItemNo, ADrawItemOffs: Integer): Boolean;
begin
Result := (ADrawItemNo=DrawItemSNo) and
(ADrawItemOffs>=DrawItemSWordOffs1) and
(ADrawItemOffs<=DrawItemSWordOffs2)
end;
{------------------------------------------------------------------------------}
{ Is (ADrawItemNo, ADrawItemOffs) below the starting word? }
function TRVSelectingInfo.IsBelowSWord(ADrawItemNo, ADrawItemOffs: Integer): Boolean;
begin
Result := (ADrawItemNo>DrawItemSNo) or
((ADrawItemNo=DrawItemSNo) and (ADrawItemOffs>DrawItemSWordOffs2));
end;
{------------------------------------------------------------------------------}
{ Is (ADrawItemNo, ADrawItemOffs) above the starting word? }
function TRVSelectingInfo.IsAboveSWord(ADrawItemNo, ADrawItemOffs: Integer): Boolean;
begin
Result := (ADrawItemNo<DrawItemSNo) or
((ADrawItemNo=DrawItemSNo) and (ADrawItemOffs<DrawItemSWordOffs1));
end;
{------------------------------------------------------------------------------}
{ Are the positions of the ending and the starting words equal? }
function TRVSelectingInfo.AreWordsEqual: Boolean;
begin
Result := (DrawItemENo=DrawItemSNo) and
(DrawItemEWordOffs1=DrawItemSWordOffs1) and
(DrawItemEWordOffs2=DrawItemSWordOffs2);
end;
{------------------------------------------------------------------------------}
{ Are the parameters equal to the ending word? }
function TRVSelectingInfo.IsEWord(ADrawItemNo,
ADrawItemWordOffs1, ADrawItemWordOffs2: Integer): Boolean;
begin
Result := (DrawItemENo=DrawItemENo) and
(DrawItemEWordOffs1=ADrawItemWordOffs1) and
(DrawItemEWordOffs2=ADrawItemWordOffs2);
end;
{------------------------------------------------------------------------------}
{ Should we change EWordState to rvsesFreeMode?
This function assumes that the ending point of the selection
(ADrawItemNo, ADrawItemOffs) is inside the ending word }
function TRVSelectingInfo.IsEFreeStateNeeded(ADrawItemNo,
ADrawItemOffs: Integer): Boolean;
begin
Result :=
(IsAboveSWord(ADrawItemNo,ADrawItemOffs) and (ADrawItemOffs>DrawItemEOffs))
or
(IsBelowSWord(ADrawItemNo,ADrawItemOffs) and (ADrawItemOffs<DrawItemEOffs));
end;
{=========================== TRVSoftPageBreakList =============================}
function TRVSoftPageBreakList.FindItem(ItemNo: Integer): Integer;
var a,b,no: Integer;
{....................................}
procedure AdjustResult(var R: Integer);
begin
while (R>0) and (TRVSoftPageBreakInfo(Items[R-1]).ItemNo=ItemNo) do
dec(R);
end;
{....................................}
begin
a := 0;
b := Count-1;
while b-a>1 do begin
Result := (a+b) div 2;
no := TRVSoftPageBreakInfo(Items[Result]).ItemNo;
if no=ItemNo then begin
AdjustResult(Result);
exit;
end;
if no<ItemNo then
a := Result
else
b := Result;
end;
if TRVSoftPageBreakInfo(Items[a]).ItemNo=ItemNo then
Result := a
else if TRVSoftPageBreakInfo(Items[b]).ItemNo=ItemNo then
Result := b
else
Result := -1;
AdjustResult(Result);
end;
{============================ TCustomRVFormattedData ==========================}
constructor TCustomRVFormattedData.Create;
begin
inherited Create;
DrawItems := TRVDrawLines.Create;
Jumps := TList.Create;
FSelStartNo := -1;
FSelEndNo := -1;
FSelStartOffs := 0;
FSelEndOffs := 0;
TextWidth := -1;
DocumentWidth := -1;
DocumentHeight := 0;//GetTopMargin;
LastItemFormatted := -1;
LastJumpMovedAbove := -1;
LastDIMovedAbove := -1;
LastJumpDowned := -1;
FocusedItemNo := -1;
FActiveItem := nil;
FPartialSelectedItem := nil;
//FZoomPercent := 100;
end;
{------------------------------------------------------------------------------}
destructor TCustomRVFormattedData.Destroy;
begin
ClearTemporal;
DrawItems.Free;
DrawItems := nil;
Jumps.Free;
Jumps := nil;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.ClearLastJump;
begin
if LastRVDataMovedAbove<>nil then begin
LastRVDataMovedAbove.State := LastRVDataMovedAbove.State - [rvstDrawHover];
LastRVDataMovedAbove.LastJumpMovedAbove := -1;
LastRVDataMovedAbove.LastJumpDowned := -1;
DoRVMouseMove(-1);
end;
State := State - [rvstDrawHover];
LastJumpMovedAbove := -1;
LastJumpDowned := -1;
LastRVDataMovedAbove := nil;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.ClearJumps;
var i: Integer;
begin
if Jumps<>nil then begin
for i:=0 to Jumps.Count-1 do
TObject(Jumps[i]).Free;
Jumps.Clear;
ClearLastJump;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.ClearTemporal;
var i: Integer;
begin
if DrawItems<>nil then begin
for i:=0 to DrawItems.Count-1 do
DrawItems[i].Free;
DrawItems.Clear;
ClearJumps;
nJmps := 0;
FActiveItem := nil;
//FPartialSelectedItem := nil;
FCaptureMouseItem := nil;
LastDIMovedAbove := -1;
LastRVDataMovedAbove := nil;
State := State - [ rvstMakingSelection, rvstLineSelection, rvstDrawHover];
LastRaisedCP := nil;
FClickedDrawItemNo := -1;
FSelectingInfo.Free;
FSelectingInfo := nil;
LastItemFormatted := -1;
DocumentHeight := GetTopMargin+GetBottomMargin;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.Clear;
var Clearing: Boolean;
begin
Clearing := rvstClearing in State;
Include(State, rvstClearing);
try
ClearSoftPageBreaks;
Deselect(nil, True);
ClearTemporal;
inherited Clear;
finally
if not Clearing then
Exclude(State, rvstClearing);
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.Deselect(NewPartiallySelected: TCustomRVItemInfo;
MakeEvent: Boolean);
begin
if rvstDeselecting in State then
exit;
State := State + [rvstDeselecting];
try
State := State - [rvstMakingSelection, rvstLineSelection];
FSelStartNo := -1;
FSelEndNo := -1;
FSelStartOffs := 0;
FSelEndOffs := 0;
if (FocusedItemNo>=0) and (FocusedItemNo<ItemCount) then
GetItem(FocusedItemNo).ClearFocus;
FocusedItemNo := -1;
DeselectPartiallySelectedItem(NewPartiallySelected);
if MakeEvent then
DoSelect;
finally
State := State - [rvstDeselecting];
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.SelectAll;
begin
if Items.Count=0 then
exit;
{$IFNDEF RVDONOTUSELIVESPELL}
LiveSpellingCheckCurrentItem;
{$ENDIF}
DestroyInplaceEditor;
DeselectPartiallySelectedItem(nil);
FSelStartNo := 0;
FSelEndNo := DrawItems.Count-1;
FSelStartOffs := GetOffsBeforeDrawItem(0);
FSelEndOffs := GetOffsAfterDrawItem(FSelEndNo);
DoOnSelection(False);
DoSelect;
end;
procedure TCustomRVFormattedData.ConcateItems(FirstItemNo: Integer);
var item1,item2: TCustomRVItemInfo;
begin
item1 := TCustomRVItemInfo(Items.Objects[FirstItemNo]);
item2 := TCustomRVItemInfo(Items.Objects[FirstItemNo+1]);
if ((rvioUnicode in item1.ItemOptions)<>
(rvioUnicode in item2.ItemOptions)) and
(Items[FirstItemNo+1]<>'') then begin
item2.SameAsPrev := item1.SameAsPrev;
item2.BR := item1.BR;
FreeItem(FirstItemNo, False);
Items.Delete(FirstItemNo);
end
else begin
Items[FirstItemNo] := Items[FirstItemNo]+Items[FirstItemNo+1];
FreeItem(FirstItemNo+1, False);
Items.Delete(FirstItemNo+1);
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.Normalize;
var li, li2: TCustomRVItemInfo;
i: Integer;
begin
for i := Items.Count-1 downto 1 do begin
li := TCustomRVItemInfo(Items.Objects[i-1]);
li2 := TCustomRVItemInfo(Items.Objects[i]);
if RV_CanConcateItems(i-1, li,li2,False) then
ConcateItems(i-1);
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVFormattedData.GetOffsBeforeDrawItem(DrawItemNo: Integer): Integer;
begin
if GetDrawItemStyle(DrawItemNo)<0 then
Result := 0
else
Result := 1;
end;
{------------------------------------------------------------------------------}
function TCustomRVFormattedData.GetOffsAfterDrawItem(DrawItemNo: Integer): Integer;
begin
if GetDrawItemStyle(DrawItemNo)<0 then
Result := 1
else
Result := DrawItems[DrawItemNo].Length+1;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.FinishScreenLine(const sad: TRVScreenAndDevice;
LineWidth, LastDrawItem: Integer; parafinished: Boolean;
var ExtraSpace: Integer; var dontdoit: Boolean; Canvas: TCanvas);
var pi: TParaInfo;
BiDiMode: TRVBiDiMode;
Alignment: TRVAlignment;
{.......................................................}
function GetDevY(ScreenY: Integer): Integer;
begin
Result := MulDiv(ScreenY, sad.ppiyDevice, sad.ppiyScreen);
end;
{.......................................................}
function GetDevX(ScreenX: Integer): Integer;
begin
Result := MulDiv(ScreenX, sad.ppixDevice, sad.ppixScreen);
end;
{.......................................................}
procedure RearrangeMarker(FirstDrawItem, LastDrawItem: Integer);
var extrax, i: Integer;
begin
if not GetItem(DrawItems[FirstDrawItem].ItemNo).SameAsPrev and
(DrawItems[FirstDrawItem].Offs<=GetOffsBeforeItem(DrawItems[FirstDrawItem].ItemNo)) then begin
{$IFNDEF RVDONOTUSELISTS}
if (GetItemStyle(DrawItems[FirstDrawItem].ItemNo)=rvsListMarker) then begin
extrax := GetDevX(-TRVMarkerItemInfo(GetItem(DrawItems[FirstDrawItem].ItemNo)).GetLeftOverhang);
end
else
{$ENDIF}
begin
extrax := GetDevX(pi.FirstIndent);
end;
if extrax<>0 then
for i := FirstDrawItem to LastDrawItem do
dec(DrawItems[i].Left, extrax);
end;
end;
{.......................................................}
function GetDrawItemBiDi(DrawItemNo: Integer; var Start, Ending: TRVBiDiMode): Boolean;
var item: TCustomRVItemInfo;
Locale: Cardinal;
Len: Integer;
s: String;
CharTypes: PWordArray;
begin
Start := BiDiMode;
Ending := BiDiMode;
Result := True;
item := GetItem(DrawItems[DrawItemNo].ItemNo);
if item.StyleNo<0 then
exit;
s := DrawItems.GetString(DrawItemNo, Items);
if s='' then
exit;
{$IFNDEF RVDONOTUSEUNICODE}
if GetRVStyle.TextStyles[GetActualStyle(item)].Unicode then
Len := Length(s) div 2
else
{$ENDIF}
Len := Length(s);
Locale := GetStyleLocale(GetActualStyle(item));
if GetRVStyle.TextStyles[GetActualStyle(item)].BiDiMode<>rvbdUnspecified then begin
Start := GetRVStyle.TextStyles[GetActualStyle(item)].BiDiMode;
Ending := GetRVStyle.TextStyles[GetActualStyle(item)].BiDiMode;
end;
GetMem(CharTypes, Len*sizeof(Word));
try
{$IFNDEF RVDONOTUSEUNICODE}
if GetRVStyle.TextStyles[GetActualStyle(item)].Unicode then
GetStringTypeExW(Locale, CT_CTYPE2, Pointer(s), Len, CharTypes^)
else
{$ENDIF}
GetStringTypeExA(Locale, CT_CTYPE2, Pointer(s), Len, CharTypes^);
case CharTypes[0] of
C2_LEFTTORIGHT:
Start := rvbdLeftToRight;
C2_RIGHTTOLEFT:
Start := rvbdRightToLeft;
end;
case CharTypes[Len-1] of
C2_LEFTTORIGHT:
Ending := rvbdLeftToRight;
C2_RIGHTTOLEFT:
Ending := rvbdRightToLeft;
end;
finally
FreeMem(CharTypes);
end;
end;
{.......................................................}
function RearrangeLineEx(LastDrawItem: Integer): Boolean;
var FirstDrawItem, i,insertpoint: Integer;
extrax, curx: Integer;
diorder: TRVIntegerList;
CurBiDi, PrevBiDi, StartBiDi, EndBiDi: TRVBiDiMode;
begin
Result := True;
if BiDiMode=rvbdUnspecified then
exit;
FirstDrawItem := LastDrawItem;
while (FirstDrawItem>0) and not DrawItems[FirstDrawItem].FromNewLine do
dec(FirstDrawItem);
if BiDiMode=rvbdRightToLeft then
RearrangeMarker(FirstDrawItem, LastDrawItem);
if FirstDrawItem=LastDrawItem then
exit;
insertpoint := 0;
diorder := TRVIntegerList.Create;
try
PrevBiDi := BiDiMode;
for i := FirstDrawItem to LastDrawItem do begin
if not GetDrawItemBiDi(i, StartBiDi, EndBiDi) then begin
diorder.Free;
Result := False;
exit;
end;
CurBiDi := BiDiMode;
if PrevBiDi=StartBiDi then
CurBiDi := PrevBiDi;
PrevBiDi := EndBiDi;
if CurBiDi=rvbdLeftToRight then begin
if insertpoint<diorder.Count then
inc(insertpoint);
end;
diorder.Insert(insertpoint, i);
end;
curx := DrawItems[FirstDrawItem].Left;
for i := 0 to diorder.Count-1 do begin
if diorder[i]>FirstDrawItem then
extrax := DrawItems[diorder[i]].Left-(DrawItems[diorder[i]-1].Left+DrawItems[diorder[i]-1].Width)
else
extrax := 0;
DrawItems[diorder[i]].Left := curx;
inc(curx, DrawItems[diorder[i]].Width+extrax);
end;
finally
diorder.Free;
end;
end;
{.......................................................}
procedure RearrangeLine(LastDrawItem: Integer);
var FirstDrawItem, i: Integer;
curx, extrax: Integer;
begin
if BiDiMode<>rvbdRightToLeft then
exit;
FirstDrawItem := LastDrawItem;
while (FirstDrawItem>0) and
not DrawItems[FirstDrawItem].FromNewLine do
dec(FirstDrawItem);
RearrangeMarker(FirstDrawItem, LastDrawItem);
if FirstDrawItem=LastDrawItem then
exit;
curx := DrawItems[FirstDrawItem].Left;
for i := LastDrawItem downto FirstDrawItem do begin
if i>FirstDrawItem then
extrax := DrawItems[i].Left-(DrawItems[i-1].Left+DrawItems[i-1].Width)
else
extrax := 0;
DrawItems[i].Left := curx;
inc(curx, DrawItems[i].Width+extrax);
end;
end;
{.......................................................}
var i, j, dx, min,max: Integer;
fl: Boolean;
dli: TRVDrawLineInfo;
item: TCustomRVItemInfo;
{$IFNDEF RVDONOTUSEJUSTIFY}
SpaceCount, strt: Integer;
s: String;
{$ENDIF}
begin
ExtraSpace := 0;
if dontdoit then begin
dontdoit := False;
exit;
end;
i := LastDrawItem-1;
if i=-1 then
exit;
dli := DrawItems[i];
item := GetItem(dli.ItemNo);
if item.GetBoolValue(rvbpFullWidth) then
exit;
pi := GetRVStyle.ParaStyles[item.ParaNo];
BiDiMode := GetParaBiDiMode(item.ParaNo);
Alignment := pi.Alignment;
if (Alignment=rvaJustify)
{$IFNDEF RVDONOTUSEJUSTIFY}
and (BiDiMode<>rvbdUnspecified)
{$ENDIF}
then
Alignment := rvaLeft;
if (Alignment = rvaLeft) or ((Alignment = rvaJustify) and ParaFinished) then
dx := 0
else begin
dx := LineWidth - (dli.Left+dli.Width);
if Alignment = rvaCenter then begin
dx := dx div 2;
if dx<0 then
dx := 0;
end;
end;
case pi.LineSpacingType of
rvlsSpaceBetween:
if pi.LineSpacing>=0 then
ExtraSpace := GetDevY(pi.LineSpacing);
rvlsPercent:
begin
if pi.LineSpacing>=50 then begin
j := i;
min := 0;
max := 0;
fl := True;
repeat
if GetDrawItemStyle(j)>=0 then begin
if fl or (DrawItems[j].Top<min) then
min := DrawItems[j].Top;
if fl or (DrawItems[j].Top+DrawItems[j].Height>max) then
max := DrawItems[j].Top+DrawItems[j].Height;
fl := False;
end;
dec(j);
until (j<0) or DrawItems[j+1].FromNewLine;
if not fl then
ExtraSpace := (max-min)*(pi.LineSpacing-100) div 100;
end;
end;
end;
if ExtraSpace<>0 then begin
j := i;
repeat
DrawItems[j].ExtraSpaceBelow := ExtraSpace;
dec(j);
until (j<0) or DrawItems[j+1].FromNewLine;
end;
{$IFNDEF RVDONOTUSEJUSTIFY}
if (Alignment = rvaJustify) and not ParaFinished then begin
if DrawItems[i].FromNewLine then
exit;
SpaceCount := 0;
while (i>=0) and not DrawItems[i].FromNewLine and (GetDrawItemStyle(i)<>rvsTab) do
with DrawItems[i] do begin
if (GetItemStyle(ItemNo)>=0) then begin
s := DrawItems.GetString(i,Items);
if (System.Length(s)>0) and RVU_IsSpace(s, 1, GetItemOptions(ItemNo)) then
inc(SpaceCount)
end;
dec(i);
end;
strt := i+1;
for i := strt to LastDrawItem-1 do
with DrawItems[i] do begin
if (GetItemStyle(ItemNo)>=0) then begin
s := DrawItems.GetString(i,Items);
if (System.Length(s)>0) and RVU_IsSpace(s, 1, GetItemOptions(ItemNo)) then begin
SpaceBefore := dx div SpaceCount;
inc(Width,SpaceBefore);
dec(dx,SpaceBefore);
dec(SpaceCount);
end;
end;
if not FromNewLine then
Left := DrawItems[i-1].Left+DrawItems[i-1].Width;
end;
RearrangeLineEx(LastDrawItem-1);
exit;
end;
{$ENDIF}
while (i>=0) do begin
with DrawItems[i] do begin
inc(Left,dx);
if FromNewLine then begin
RearrangeLineEx(LastDrawItem-1);
exit;
end;
end;
dec(i);
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVFormattedData.GetFirstItemMarker(var ListNo, Level: Integer): Boolean;
begin
ListNo := -1;
Level := -1;
Result := False;
end;
{------------------------------------------------------------------------------}
function TCustomRVFormattedData.GetRVDataExtraVOffs: Integer;
begin
Result := 0;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.GetIndents(ItemNo: Integer; IsParaStart: Boolean;
var FirstParaItemNo: Integer; var LeftIndent, RightIndent,
PureLeftIndent: Integer);
var RVStyle: TRVStyle;
item : TCustomRVItemInfo;
{$IFNDEF RVDONOTUSELISTS}
item2 : TCustomRVItemInfo;
bidimode: TRVBiDiMode;
ListNo, Level: Integer;
{$ENDIF}
pi : TParaInfo;
begin
RVStyle := GetRVStyle;
item := GetItem(ItemNo);
{$IFNDEF RVDONOTUSELISTS}
bidimode := GetParaBiDiMode(item.ParaNo);
{$ENDIF}
pi := RVStyle.ParaStyles[item.ParaNo];
if (rvstFirstParaAborted in State) then begin
if FirstParaItemNo<0 then
FirstParaItemNo := GetFirstParaItem(ItemNo);
if FirstParaItemNo=0 then
IsParaStart := False;
end;
if IsParaStart then begin
{$IFNDEF RVDONOTUSELISTS}
if (item.StyleNo=rvsListMarker) and (TRVMarkerItemInfo(item).GetLevelInfo(RVStyle)<>nil) then
if bidimode=rvbdRightToLeft then begin
RightIndent := TRVMarkerItemInfo(item).GetLevelInfo(RVStyle).MarkerIndent;
LeftIndent := pi.LeftIndent;
PureLeftIndent := LeftIndent;
end
else begin
LeftIndent := TRVMarkerItemInfo(item).GetLevelInfo(RVStyle).MarkerIndent;
RightIndent := pi.RightIndent;
PureLeftIndent := LeftIndent;
end
else begin
if FirstParaItemNo<0 then
FirstParaItemNo := GetFirstParaItem(ItemNo);
item2 := GetItem(FirstParaItemNo);
if (item2.StyleNo=rvsListMarker) and (TRVMarkerItemInfo(item2).GetLevelInfo(RVStyle)<>nil) then
if bidimode=rvbdRightToLeft then begin
RightIndent := TRVMarkerItemInfo(item2).GetLevelInfo(RVStyle).LeftIndent;
LeftIndent := pi.LeftIndent;
PureLeftIndent := LeftIndent;
end
else begin
LeftIndent := TRVMarkerItemInfo(item2).GetLevelInfo(RVStyle).LeftIndent;
RightIndent := pi.RightIndent;
PureLeftIndent := LeftIndent;
end
else
{$ENDIF}
begin
LeftIndent := pi.LeftIndent;
PureLeftIndent := LeftIndent;
if not item.BR and not item.GetBoolValue(rvbpFullWidth) then
inc(LeftIndent, pi.FirstIndent);
RightIndent := pi.RightIndent;
end;
{$IFNDEF RVDONOTUSELISTS}
end;
{$ENDIF}
end
else begin
{$IFNDEF RVDONOTUSELISTS}
if FirstParaItemNo<0 then
FirstParaItemNo := GetFirstParaItem(ItemNo);
item2 := GetItem(FirstParaItemNo);
if (item2.StyleNo=rvsListMarker) and (TRVMarkerItemInfo(item2).GetLevelInfo(RVStyle)<>nil) then begin
if bidimode=rvbdRightToLeft then begin
RightIndent := TRVMarkerItemInfo(item2).GetLevelInfo(RVStyle).LeftIndent;
LeftIndent := pi.LeftIndent;
PureLeftIndent := LeftIndent;
end
else begin
LeftIndent := TRVMarkerItemInfo(item2).GetLevelInfo(RVStyle).LeftIndent;
RightIndent := pi.RightIndent;
PureLeftIndent := LeftIndent;
end
end
else if (FirstParaItemNo=0) and (rvstFirstParaAborted in State) and
GetFirstItemMarker(ListNo, Level) then begin
if bidimode=rvbdRightToLeft then begin
RightIndent := RVGetLevelInfo(RVStyle, ListNo, Level).LeftIndent;
LeftIndent := pi.LeftIndent;
PureLeftIndent := LeftIndent;
end
else begin
LeftIndent := RVGetLevelInfo(RVStyle, ListNo, Level).LeftIndent;
RightIndent := pi.RightIndent;
PureLeftIndent := LeftIndent;
end
end
else
{$ENDIF}
begin
LeftIndent := pi.LeftIndent;
RightIndent := pi.RightIndent;
PureLeftIndent := LeftIndent;
end;
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVFormattedData.GetMaxIndent(ItemNo: Integer; var FirstParaItemNo: Integer): Integer;
var RVStyle: TRVStyle;
item: TCustomRVItemInfo;
pi : TParaInfo;
{$IFNDEF RVDONOTUSELISTS}
levelinfo: TRVListLevel;
item2 : TCustomRVItemInfo;
bidimode: TRVBiDiMode;
ListNo, Level: Integer;
{$ENDIF}
begin
RVStyle := GetRVStyle;
item := GetItem(ItemNo);
{$IFNDEF RVDONOTUSELISTS}
bidimode := GetParaBiDiMode(item.ParaNo);
{$ENDIF}
pi := RVStyle.ParaStyles[item.ParaNo];
{$IFNDEF RVDONOTUSELISTS}
if FirstParaItemNo<0 then
FirstParaItemNo := GetFirstParaItem(ItemNo);
item2 := GetItem(FirstParaItemNo);
if (item2.StyleNo=rvsListMarker) and (TRVMarkerItemInfo(item2).GetLevelInfo(RVStyle)<>nil) then
levelinfo := TRVMarkerItemInfo(item2).GetLevelInfo(RVStyle)
else if (FirstParaItemNo=0) and (rvstFirstParaAborted in State) and GetFirstItemMarker(ListNo, Level) then
levelinfo := RVGetLevelInfo(RVStyle, ListNo, Level)
else
levelinfo := nil;
if levelinfo<>nil then begin
Result := levelinfo.LeftIndent;
if levelinfo.FirstIndent>0 then
inc(Result,levelinfo.FirstIndent);
if bidimode=rvbdRightToLeft then
inc(Result, pi.LeftIndent)
else
inc(Result, pi.RightIndent);
end
else
{$ENDIF}
begin
Result := pi.LeftIndent+pi.RightIndent;
if (pi.FirstIndent>0) and not item.GetBoolValue(rvbpFullWidth) then
inc(Result,pi.FirstIndent);
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.UpdateLastTab(var Params: TRVFormatParams);
var FreeSpace, i, XShift: Integer;
LastDrawItem, TabDrawItem: TRVDrawLineInfo;
begin
if Params.LastTabDrawItemNo<0 then
exit;
LastDrawItem := DrawItems[Params.LastDrawItem-1];
TabDrawItem := DrawItems[Params.LastTabDrawItemNo];
XShift := Params.x - (LastDrawItem.Left+LastDrawItem.Width);
if Params.LastTabPosition>Params.LineWidth+Params.FirstIndent then
Params.LastTabPosition := Params.LineWidth+Params.FirstIndent;
case Params.LastTabAlign of
rvtaRight:
begin
FreeSpace := Params.LastTabPosition-(LastDrawItem.Left+LastDrawItem.Width);
end;
rvtaCenter:
begin
FreeSpace := Params.LastTabPosition+
(Params.LastTabPosition-TabDrawItem.Left-TabDrawItem.Width)-
(LastDrawItem.Left+LastDrawItem.Width);
FreeSpace := FreeSpace div 2;
end;
else
FreeSpace := 0;
end;
if FreeSpace<0 then
FreeSpace := 0;
if FreeSpace>=0 then
inc(TabDrawItem.Width, FreeSpace);
if FreeSpace>=0 then begin
for i := Params.LastTabDrawItemNo+1 to Params.LastDrawItem-1 do
inc(DrawItems[i].Left, FreeSpace);
Params.x := LastDrawItem.Left+LastDrawItem.Width+XShift;
end;
Params.LastTabDrawItemNo := -1;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.FormatLine(const Text, OrigText: String;
StartOffs, Len, ItemNo: Integer; Canvas: TCanvas; var sad: TRVScreenAndDevice;
var Params: TRVFormatParams);
var sourceStrPtr,OrigSourceStrPtr, sourceStrPtr2, strForAdd, strSpacePos: PChar;
sourceStrPtrLen: Integer;
sz: TSIZE;
max,max2,j, y: Integer;
dli: TRVDrawLineInfo;
newline, AtStart:Boolean;
jmpinfo: TRVJumpInfo;
y5, Offs, ActualStyleNo: Integer;
pi: TParaInfo;
SpaceAfter, ExternalLeading, ExtraSpaceBelowLine: Integer;
li: TCustomRVItemInfo;
RVStyle: TRVStyle;
{$IFNDEF RVDONOTUSEUNICODE}
IsUnicodeItem: Boolean;
{$ENDIF}
{.......................................................}
function GetDevX(ScreenX: Integer): Integer;
begin
Result := MulDiv(ScreenX, sad.ppixDevice, sad.ppixScreen);
end;
{.......................................................}
function GetDevY(ScreenY: Integer): Integer;
begin
Result := MulDiv(ScreenY, sad.ppiyDevice, sad.ppiyScreen);
end;
{.......................................................}
{$IFNDEF RVDONOTUSEUNICODE}
function AdjustMaxFitR(value: Integer): Integer;
var PStart, PCur, PCur2: PChar;
begin
Result := value;
PStart := sourceStrPtr;
// we cannot use CharNextW() because string does not have WideChar(0) at the end
while True do begin
if (Result=0) or (Result=sourceStrPtrLen) then
exit;
PCur := PStart + (Result+1)*2;
PCur2 := PChar(CharPrevW(Pointer(PStart), Pointer(PCur)));
if PCur2=PStart+(Result)*2 then
exit;
inc(Result);
end;
end;
{.......................................................}
function AdjustMaxFitL(value: Integer): Integer;
var PStart, PCur, PCur2: PChar;
begin
Result := value;
RVU_GetTextExtentPoint32W(Params.FormatCanvas, Pointer(sourceStrPtr), Result, sz);
if sz.cx<=SpaceAfter then
exit;
PStart := sourceStrPtr;
PCur := PStart + (Result-1)*2;
PCur2 := PChar(CharPrevW(Pointer(PStart), Pointer(PCur)));
Result := (PCur2-PStart) div 2;
end;
{$ENDIF}
function MaxFitSafe: Integer; // out: sz
{$IFNDEF RVDONOTUSEUNICODE}
var r: Integer;
{$ENDIF}
begin
if (rvpaoNoWrap in pi.Options) then
Result := sourceStrPtrLen
else begin
{$IFDEF RVDONOTUSEUNICODE}
RVU_GetTextExtentExPointPC(Params.FormatCanvas, OrigSourceStrPtr, sourceStrPtrLen,
SpaceAfter, Result, nil, li.ItemOptions, sz);
{$ELSE}
RVU_GetTextExtentExPointPC(Params.FormatCanvas, OrigSourceStrPtr, sourceStrPtrLen,
SpaceAfter, Result, nil, li.ItemOptions, sz);
if IsUnicodeItem then begin
{$IFNDEF RVDONOTUSESOFTHYPHENS}
if (Result>0) and
(PRVWordArray(OrigSourceStrPtr)[Result-1]=UNI_SOFT_HYPHEN) and
(PRVWordArray(SourceStrPtr)[Result-1]=UNI_ZERO_WIDTH_SPACE) then begin
inc(sz.cx, Params.FontInfoCache[ActualStyleNo].HyphenWidth);
if sz.cx>SpaceAfter then
dec(Result);
end;
// we do not allow to break just before the soft hyphen
if (Result>0) and (Result<sourceStrPtrLen) and
(PRVWordArray(OrigSourceStrPtr)[Result]=UNI_SOFT_HYPHEN) then
dec(Result);
{$ENDIF}
end;
if IsUnicodeItem and RVNT then begin
r := Result;
Result := AdjustMaxFitR(r);
end;
{$ENDIF}
end;
end;
{.......................................................}
function MaxFitA: Integer; // out: sz
var maxlo, maxhi, cxlo, cxhi : Integer;
begin
if RichViewSafeFormatting or (not RVNT and (rvflPrinting in Flags)) then begin
Result := MaxFitSafe;
exit;
end;
{ First, find the length of the whole string }
GetTextExtentPoint32(Params.FormatCanvasHandle, sourceStrPtr, sourceStrPtrLen, sz);
if (rvpaoNoWrap in pi.Options) or ((sz.cx <= SpaceAfter) and (sz.cx>=0)) then
{ it will fit on the line }
Result := sourceStrPtrLen
else begin
maxlo := 0;
maxhi := sourceStrPtrLen;
cxlo := 0;
cxhi := sz.cx;
while maxhi > (maxlo + 1) do begin
{ make the best estimate of where max should be }
if cxhi=cxlo then
inc(cxhi);
Result := maxlo + (maxhi - maxlo) * (SpaceAfter - cxlo) div (cxhi - cxlo);
if Result <= maxlo then
Result := maxlo + 1;
if Result >= maxhi then
Result := maxhi - 1;
GetTextExtentPoint32(Params.FormatCanvasHandle,sourceStrPtr,Result,sz);
{ if sz.cx = SpaceAfter then max is correct }
if sz.cx = SpaceAfter then begin
maxlo := Result;
maxhi := Result;
end
else if (sz.cx < SpaceAfter) and (sz.cx>0) then begin
maxlo := Result;
cxlo := sz.cx;
end
else { sz.cx > SpaceAfter } begin
maxhi := Result;
cxhi := sz.cx;
end;
end;
Result := maxlo;
end
end;
{.......................................................}
{$IFNDEF RVDONOTUSEUNICODE}
function MaxFitW: Integer; // out: sz
var maxlo, maxhi, cxlo, cxhi : Integer;
{$IFNDEF RVDONOTUSESOFTHYPHENS}
HyphenWidth: Integer;
{$ENDIF}
begin
if RichViewSafeFormatting or ({not RVNT and }(rvflPrinting in Flags)) then begin
Result := MaxFitSafe;
exit;
end;
{$IFNDEF RVDONOTUSESOFTHYPHENS}
HyphenWidth := 0;
{$ENDIF}
{ First, find the length of the whole string }
RVU_GetTextExtentPoint32W(Params.FormatCanvas, Pointer(sourceStrPtr), sourceStrPtrLen, sz);
if (rvpaoNoWrap in pi.Options) or ((sz.cx <= SpaceAfter) and (sz.cx>=0)) then
{ it will fit on the line }
Result := sourceStrPtrLen
else begin
maxlo := 0;
maxhi := sourceStrPtrLen;
cxlo := 0;
cxhi := sz.cx;
while maxhi > (maxlo + 1) do begin
{ make the best estimate of where max should be }
if cxhi=cxlo then
inc(cxhi);
Result := maxlo + (maxhi - maxlo) * (SpaceAfter - cxlo) div (cxhi - cxlo);
if Result <= maxlo then
Result := maxlo + 1;
if Result >= maxhi then
Result := maxhi - 1;
RVU_GetTextExtentPoint32W(Params.FormatCanvas, Pointer(sourceStrPtr), Result, sz);
{$IFNDEF RVDONOTUSESOFTHYPHENS}
if (PRVWordArray(OrigSourceStrPtr)[Result-1]=UNI_SOFT_HYPHEN) and
(PRVWordArray(SourceStrPtr)[Result-1]=UNI_ZERO_WIDTH_SPACE) then begin
if HyphenWidth=0 then
HyphenWidth := Params.FontInfoCache[ActualStyleNo].HyphenWidth;
inc(sz.cx,HyphenWidth);
end;
{$ENDIF}
{ if sz.cx = SpaceAfter then max is correct }
if sz.cx = SpaceAfter then begin
maxlo := Result;
maxhi := Result;
end
else if (sz.cx < SpaceAfter) and (sz.cx>0) then begin
maxlo := Result;
cxlo := sz.cx;
end
else { sz.cx > SpaceAfter } begin
maxhi := Result;
cxhi := sz.cx;
end;
end;
{$IFNDEF RVDONOTUSESOFTHYPHENS}
// we do not allow to break just before the soft hyphen
if (maxlo>0) and (maxlo<sourceStrPtrLen) and
(PRVWordArray(OrigSourceStrPtr)[maxlo]=UNI_SOFT_HYPHEN) then
dec(maxlo);
{$ENDIF}
// Adjusting combined characters
if RVNT then begin
Result := AdjustMaxFitR(maxlo);
if Result<>maxlo then
Result := AdjustMaxFitL(Result);
end
else
Result := maxlo;
end
end;
{$ENDIF}
{.......................................................}
procedure OnStartNewLine(li: TCustomRVItemInfo; wrapping: Boolean);
var dli: TRVDrawLineInfo;
SpaceAtEnd: Boolean;
StyleNo: Integer;
LeftIndent: Integer;
begin
if not Params.SpaceEaten and wrapping and (Params.LastDrawItem>0) then begin
dli := DrawItems[Params.LastDrawItem-1];
StyleNo := GetItemStyle(dli.ItemNo);
if StyleNo>=0 then begin
{$IFNDEF RVDONOTUSEUNICODE}
if rvioUnicode in GetItemOptions(dli.ItemNo) then
SpaceAtEnd := (dli.Length>0) and
(PWord(PChar(Items[dli.ItemNo])+(dli.Offs+dli.Length-2)*2)^=ord(' '))
else
{$ENDIF}
SpaceAtEnd := (dli.Length>0) and
(Items[dli.ItemNo][dli.Offs+dli.Length-1]=' ');
if SpaceAtEnd and not IsDrawItemFromNewLine(Params.LastDrawItem-1) then begin
if (dli.Length=1) and (Params.LastDrawItem-2>=0) and
(dli.ItemNo=DrawItems[Params.LastDrawItem-2].ItemNo) and
not dli.FromNewLine then begin
DrawItems.Delete(Params.LastDrawItem-1);
dec(Params.LastDrawItem);
end
else begin
dec(dli.Length);
RVStyle.ApplyStyle(Params.FormatCanvas, StyleNo, GetItemBiDiMode(dli.ItemNo),
rvflCanUseCustomPPI in Flags);
dli.Width := RVU_TextWidth(DrawItems.GetString(Params.LastDrawItem-1, Items),
Params.FormatCanvas, GetItemOptions(dli.ItemNo));
if (GetItemStyle(ItemNo)>=0) and (GetItemStyle(ItemNo)<>StyleNo) then
RVStyle.ApplyStyle(Params.FormatCanvas, GetItemStyle(ItemNo), GetItemBiDiMode(ItemNo),
rvflCanUseCustomPPI in Flags);
end;
Params.SpaceEaten := True;
end;
end;
end;
{$IFNDEF RVDONOTUSESOFTHYPHENS}
// if the last draw item on the previous (just formed) line is finihed with
// the soft hyphen, increasing its Width on the hyphen width
if wrapping and (Params.LastDrawItem-1>=0) and (Params.LastDrawItem-1<DrawItems.Count) and
(not (rvoShowSpecialCharacters in Options) or not (rvscSoftHyphen in RVVisibleSpecialCharacters)) then begin
dli := DrawItems[Params.LastDrawItem-1];
if (rvioUnicode in GetItemOptions(dli.ItemNo)) and (dli.Length>0) and
(PRVWordArray(PChar(DrawItems.GetString(Params.LastDrawItem-1, Items)))[dli.Length-1]=UNI_SOFT_HYPHEN) then begin
Params.FontInfoCache.IgnoreParaBiDiMode := True;
inc(dli.Width, Params.FontInfoCache[GetActualStyle(GetItem(dli.ItemNo))].HyphenWidth);
Params.FontInfoCache.IgnoreParaBiDiMode := False;
end;
end;
{$ENDIF}
UpdateLastTab(Params);
FinishScreenLine(sad, Params.LineWidth+Params.FirstIndent,
Params.LastDrawItem, Params.IsParaStart, ExtraSpaceBelowLine,
Params.DontFSL, Params.FormatCanvas);
pi := RVStyle.ParaStyles[TCustomRVItemInfo(Items.Objects[ItemNo]).ParaNo];
GetIndents(ItemNo, Params.IsParaStart, Params.FirstParaItemNo,
LeftIndent, Params.RightIndent, Params.LeftIndent);
Params.LeftIndent := GetDevX(Params.LeftIndent);
LeftIndent := GetDevX(LeftIndent);
Params.RightIndent := GetDevX(Params.RightIndent);
if Params.IsParaStart and not li.BR then begin
if ItemNo>0 then
inc(Params.prevdesc,
GetDevY(RVStyle.ParaStyles[GetItemPara(ItemNo-1)].SpaceAfter));
inc(Params.prevdesc,GetDevY(pi.SpaceBefore));
end;
if rvpaoNoWrap in pi.Options then
Params.LineWidth := DocumentWidth - (LeftIndent+Params.RightIndent)
else
Params.LineWidth := TextWidth - (LeftIndent+Params.RightIndent);
Params.FirstIndent := sad.LeftMargin+LeftIndent;
end;
{.......................................................}
procedure AdjustLineHeight(h: Integer);
begin
if Params.prevabove < h then begin
j := Params.LastDrawItem-1;
if j>=0 then
repeat
inc(DrawItems[j].Top,h-Params.prevabove);
dec(j);
until DrawItems[j+1].FromNewLine;
inc(Params.baseline,h-Params.prevabove);
Params.prevabove := h;
end;
end;
{.......................................................}
procedure OnNonText(li: TRVRectItemInfo; dli: TRVDrawLineInfo);
var above, VerticalOffs: Integer;
w,h,desc,hshift: Integer;
TabLeader: String;
TabAlign: TRVTabAlign;
TabPos: Integer;
begin
hshift := 0;
li.OnDocWidthChange(TextWidth - GetDevX(pi.LeftIndent+pi.RightIndent+pi.FirstIndent),
dli, rvflPrinting in Flags, Canvas, Self, @sad, hshift, desc, Params.NoCaching,
Params.Reformatting);
if li.GetBoolValue(rvbpDrawingChangesFont) then
Params.LastTextStyle := -1;
if li.GetBoolValueEx(rvbpActualPrintSize, RVStyle) then begin
w := dli.Width;
h := dli.Height;
end
else begin
w := GetDevX(li.Width);
h := GetDevY(li.Height);
desc := GetDevY(desc);
end;
if li.StyleNo=rvsTab then begin
UpdateLastTab(Params);
RVStyle.GetNextTab(li.ParaNo, Params.x+Params.FirstIndent, sad, TabPos,
TabLeader, TabAlign, GetBiDiMode, Params.LeftIndent, Params.RightIndent);
w := TabPos-(Params.x+Params.FirstIndent);
if Params.x+w<=Params.LineWidth then
case TabAlign of
rvtaRight:
w := 0;
rvtaCenter:
begin
w := w-(Params.LineWidth+Params.FirstIndent-TabPos);
if w<0 then
w := 0;
end;
end;
dli.Width := w;
end;
if li.AssociatedTextStyleNo>=0 then
VerticalOffs := MulDiv(h, RVStyle.TextStyles[li.AssociatedTextStyleNo].VShift, 100)
else
if li.VShiftAbs then
VerticalOffs := GetDevY(li.VShift)
else
VerticalOffs := MulDiv(h,li.VShift,100);
dli.SetSize(w, h);
if not li.SameAsPrev or
((dli is TRVMultiDrawItemInfo)
)
or
(
(Params.x+w > Params.LineWidth) and
not (rvpaoNoWrap in pi.Options)
{$IFNDEF RVDONOTUSELISTS}
and not ((ItemNo>0) and (GetItemStyle(ItemNo-1)=rvsListMarker))
{$ENDIF}
) then begin
if li.SameAsPrev then
Params.IsParaStart := False;
OnStartNewLine(li, li.SameAsPrev);
dli.FromNewLine := True;
Params.x :=0;
inc(Params.baseline, ExtraSpaceBelowLine);
y := Params.baseline + Params.prevdesc;
case li.VAlign of
rvvaBaseline:
Params.prevabove := h-desc;
else {rvvaMiddle:}
Params.prevabove := h div 2;
end;
inc(Params.prevabove, VerticalOffs);
inc (Params.baseline,Params.prevdesc+Params.prevabove);
Params.prevdesc :=h-Params.prevabove;
end
else begin
pi := RVStyle.ParaStyles[li.ParaNo];
case li.VAlign of
rvvaBaseline:
above := h-desc;
else {rvvaMiddle:}
above := h div 2;
end;
AdjustLineHeight(above+VerticalOffs);
y := Params.baseline - above-VerticalOffs;
if Params.prevdesc < (h-above-VerticalOffs) then
Params.prevdesc := (h-above-VerticalOffs);
dli.FromNewLine := False;
end;
dli.Left := Params.x+Params.FirstIndent+hshift;
if li.StyleNo=rvsTab then begin
RVStyle.GetNextTab(li.ParaNo, dli.Left, sad, TabPos, TabLeader, TabAlign,
GetBiDiMode, Params.LeftIndent, Params.RightIndent);
TRVTabItemInfo(li).Leader := TabLeader;
w := TabPos-dli.Left;
case TabAlign of
rvtaRight:
begin
w := 0;
Params.LastTabDrawItemNo := Params.LastDrawItem;
Params.LastTabAlign := TabAlign;
Params.LastTabPosition := TabPos;
end;
rvtaCenter:
begin
w := w-(Params.LineWidth+Params.FirstIndent-TabPos);
if w<0 then
w := 0;
Params.LastTabDrawItemNo := Params.LastDrawItem;
Params.LastTabAlign := TabAlign;
Params.LastTabPosition := TabPos;
end;
end;
dli.Width := w;
end;
inc(Params.x, w+hshift);
dli.Top := y;
dli.ItemNo := ItemNo;
dli.SetSize(w, h);
dli.Offs := 0;
dli.Length := 0;
if not ShareItems then
li.DrawItemNo := Params.LastDrawItem;
DrawItems.Insert(Params.LastDrawItem, dli);
if rvflUseJumps in Flags then
li.BuildJumps(dli.Left, dli.Top, nJmps, jumps);
//AdjustCP(li);
inc(Params.LastDrawItem);
end;
{.......................................................}
var HShift, Desc: Integer;
begin
HShift := 0;
Desc := 0;
RVStyle := GetRVStyle;
li := GetItem(ItemNo);
pi := RVStyle.ParaStyles[li.ParaNo];
if (not li.SameAsPrev) and (StartOffs=0) then begin
Params.IsParaStart := True;
Params.SpaceEaten := False;
end;
{
if LineWidth<0 then
OnStartNewLine(not li.BR, li);
}
if li.StyleNo<0 then begin
if li is TRVRectItemInfo then begin
// rvsComponent, rvsHotspot, rvsBullet, rvsPicture:
if rvflAllowCustomDrawItems in Flags then
dli := li.CreatePrintingDrawItem(Self,sad)
else
dli := TRVDrawLineInfo.Create;
OnNonText(TRVRectItemInfo(li), dli);
if li.GetBoolValue(rvbpDrawingChangesFont) then
Params.LastTextStyle := -1;
if li.GetBoolValueEx(rvbpJump, RVStyle) then begin
if rvflUseJumps in Flags then begin
jmpinfo := TRVJumpInfo.Create;
jmpinfo.w := dli.Width;
jmpinfo.h := dli.Height;
jmpinfo.id := nJmps;
jmpinfo.DrawItemNo := Params.LastDrawItem-1;
jmpinfo.Cursor := li.GetHypertextCursor(RVStyle);
jmpinfo.RVData := Self;
jumps.Add(jmpinfo);
end;
TCustomRVItemInfo(Items.Objects[ItemNo]).JumpID := nJmps;
inc(nJmps);
end;
end
else begin
UpdateLastTab(Params);
FinishScreenLine(sad, Params.LineWidth+Params.FirstIndent,Params.LastDrawItem,
True, ExtraSpaceBelowLine, Params.DontFSL, Params.FormatCanvas);
if ItemNo>0 then
inc(Params.prevdesc,GetDevY(RVStyle.ParaStyles[GetItemPara(ItemNo-1)].SpaceAfter));
inc(Params.prevdesc, GetDevY(RVStyle.ParaStyles[GetItemPara(ItemNo)].SpaceBefore));
if li.StyleNo=rvsBreak then begin
inc(Params.prevdesc, GetDevY(RVStyle.ParaStyles[0].SpaceBefore));
y5 := MulDiv(5, sad.ppiyDevice, sad.ppiyScreen);
dli := TRVDrawLineInfo.CreateEx(sad.LeftMargin,
Params.baseline + Params.prevdesc, TextWidth, y5+y5+1, ItemNo, True);
end
else begin
Params.LineWidth := TextWidth - GetDevX(pi.LeftIndent+pi.RightIndent);
y5 := sad.LeftMargin+GetDevX(pi.LeftIndent); // y5 <- left
if rvflAllowCustomDrawItems in Flags then
dli := li.CreatePrintingDrawItem(Self,sad)
else
dli := TRVDrawLineInfo.Create;
li.OnDocWidthChange(Params.LineWidth, dli, rvflPrinting in Flags,
Params.FormatCanvas, Self, @sad, HShift, Desc, Params.NoCaching, Params.Reformatting);
if li.GetBoolValue(rvbpDrawingChangesFont) then
Params.LastTextStyle := -1;
dli.SetSize(GetDevX(TRVFullLineItemInfo(li).Width),
GetDevY(TRVFullLineItemInfo(li).Height));
case pi.Alignment of
rvaRight:
inc(y5, Params.LineWidth-dli.Width);
rvaCenter:
begin
inc(y5, (Params.LineWidth-dli.Width) div 2);
if y5<0 then y5 := 0;
end;
end;
dli.SetData(y5+HShift, Params.baseline + Params.prevdesc, ItemNo,True);
end;
if not ShareItems then
li.DrawItemNo := Params.LastDrawItem;
DrawItems.Insert(Params.LastDrawItem, dli);
if rvflUseJumps in Flags then
li.BuildJumps(dli.Left, dli.Top, nJmps, jumps);
//AdjustCP(li);
inc(Params.LastDrawItem);
if li.StyleNo=rvsBreak then begin
inc (Params.baseline,Params.prevdesc+y5+1);
Params.prevdesc := y5;
Params.prevabove := y5;
end
else begin
inc (Params.baseline,Params.prevdesc+dli.Height);
Params.prevabove := dli.Height;
Params.prevdesc := 0;
end;
end
end
else begin // text
{$IFNDEF RVDONOTUSEUNICODE}
IsUnicodeItem := rvioUnicode in li.ItemOptions;
if IsUnicodeItem then begin
sourceStrPtr := PChar(Text)+StartOffs*2;
OrigSourceStrPtr := PChar(OrigText)++StartOffs*2;
end
else
{$ENDIF}
begin
sourceStrPtr := PChar(Text)+StartOffs;
OrigSourceStrPtr := PChar(OrigText)+StartOffs;
end;
sourceStrPtrLen := Len;
ActualStyleNo := GetActualStyle(li);
if ActualStyleNo<>Params.LastTextStyle then begin
Params.FontInfoCache.LastTextStyle := Params.LastTextStyle;
Params.FontInfoCache.CurParaBiDiMode := GetParaBiDiMode(GetItemPara(ItemNo));
with Params.FontInfoCache[ActualStyleNo] do begin
Params.LastTextStyle := ActualStyleNo;
Params.TextMetric := TextMetric;
Params.VerticalOffs := VerticalOffset;
Params.FormatCanvas := {Params.FontInfoCache[ActualStyleNo].}Canvas;
end;
Params.FormatCanvasHandle := Params.FormatCanvas.Handle;
if (RVStyle.TextStyles[ActualStyleNo].CharSpacing<>0) and
(sad.ppixScreen<>sad.ppixDevice) and
(GetItemBiDiMode(ItemNo)=rvbdUnspecified) then
SetTextCharacterExtra(Params.FormatCanvasHandle,
GetDevX(RVStyle.TextStyles[ActualStyleNo].CharSpacing));
end;
if rvflUseExternalLeading in Flags then
ExternalLeading := Params.TextMetric.tmExternalLeading
else
ExternalLeading := 0;
AtStart := (StartOffs=0);
if sourceStrPtrLen=0 then begin {empty string}
sz.cy := Params.FontInfoCache[ActualStyleNo].EmptyLineHeight;
sz.cx := 0;
if not li.SameAsPrev then begin
OnStartNewLine(li, False);
Params.x :=0;
inc(Params.baseline, ExtraSpaceBelowLine);
y := Params.baseline+Params.prevDesc;
Params.prevabove := ExternalLeading+Params.TextMetric.tmAscent+Params.VerticalOffs;
inc(Params.baseline, Params.prevDesc+Params.prevabove);
Params.prevDesc := Params.TextMetric.tmDescent-Params.VerticalOffs;
end
else begin
AdjustLineHeight(ExternalLeading+Params.TextMetric.tmAscent+Params.VerticalOffs);
y := Params.baseline - (ExternalLeading+Params.TextMetric.tmAscent+Params.VerticalOffs);
if Params.prevDesc < Params.TextMetric.tmDescent-Params.VerticalOffs then
Params.prevDesc := Params.TextMetric.tmDescent-Params.VerticalOffs;
end;
dli := TRVDrawLineInfo.CreateEx(Params.x+Params.FirstIndent,y, sz.cx, sz.cy,
ItemNo, not li.SameAsPrev);
dli.Offs := 1+StartOffs;
inc(Params.x, sz.cx);
if RVStyle.TextStyles[ActualStyleNo].Jump then
TCustomRVItemInfo(Items.Objects[ItemNo]).JumpID := -3;
dli.Length := 0;
if AtStart and not ShareItems then
li.DrawItemNo := Params.LastDrawItem;
DrawItems.Insert(Params.LastDrawItem, dli);
//AdjustCP(li);
inc(Params.LastDrawItem);
exit;
end;
newline := AtStart and not li.SameAsPrev;
while sourceStrPtrLen>0 do begin
if newline then begin
OnStartNewLine(li, not Params.IsParaStart);
Params.x:=0;
if (rvflTrim in Flags) and not Params.SpaceEaten and
not Params.IsParaStart and (sourceStrPtrLen>1) then
{$IFNDEF RVDONOTUSEUNICODE}
if IsUnicodeItem then begin
if PWord(sourceStrPtr)^=ord(' ') then begin
inc(sourceStrPtr,2);
inc(OrigSourceStrPtr, 2);
dec(sourceStrPtrLen);
end;
end
else
{$ENDIF}
if sourceStrPtr^=' ' then begin
inc(sourceStrPtr);
inc(OrigSourceStrPtr);
dec(sourceStrPtrLen);
end;
Params.SpaceEaten := False;
end;
SpaceAfter := Params.LineWidth-Params.x;
if SpaceAfter<0 then SpaceAfter := 0;
{$IFNDEF RVDONOTUSEUNICODE}
if IsUnicodeItem then
max := MaxFitW
else
{$ENDIF}
max := MaxFitA;
max2 := max;
sourceStrPtr2 := sourceStrPtr;
if max=0 then
if newline
{$IFNDEF RVDONOTUSELISTS}
or (AtStart and (ItemNo>0) and (GetItemStyle(ItemNo-1)=rvsListMarker))
{$ENDIF}
then begin
max := 1;
{$IFNDEF RVDONOTUSEUNICODE}
if RVNT and IsUnicodeItem then
max := AdjustMaxFitR(max);
{$ENDIF}
end
else begin
Params.x:=0;
Params.IsParaStart := False;
newline := true;
continue;
end;
if max<sourceStrPtrLen then begin
{$IFNDEF RVDONOTUSEUNICODE}
if IsUnicodeItem then begin
strSpacePos := RVU_FindLineBreak(PRVWordArray(OrigSourceStrPtr), max,
max+1=sourceStrPtrLen); // MyStrRScanW(sourceStrPtr,' ',max)
if (strSpacePos<>nil) then
strSpacePos := sourceStrPtr + (strSpacePos-OrigSourceStrPtr);
{ // commented Jun 24 2004
if strSpacePos=sourceStrPtr+max*2 then
strSpacePos := nil;}
end
else
{$ENDIF}
begin
if max+1=sourceStrPtrLen then
strSpacePos := MyStrRScanA(sourceStrPtr,' ',max)
else
strSpacePos := MyStrRScanA(sourceStrPtr,' ',max+1);
end;
if (strSpacePos=nil) and (rvflTrim in Flags) and
((max+1<sourceStrPtrLen) or ((ItemNo+1<Items.Count) and not IsFromNewLine(ItemNo+1)))
then begin
{$IFNDEF RVDONOTUSEUNICODE}
if IsUnicodeItem then begin
if PRVWordArray(sourceStrPtr)[max]=UNI_Space then begin
strSpacePos := sourceStrPtr+max*2;
inc(max);
end;
end
else
{$ENDIF}
begin
if sourceStrPtr[max]=' ' then begin
strSpacePos := sourceStrPtr+max;
inc(max);
end;
end;
end;
if strSpacePos<>nil then begin
{$IFNDEF RVDONOTUSEUNICODE}
if IsUnicodeItem then begin
if (rvflTrim in Flags) and (PRVWordArray(strSpacePos)[0]=UNI_Space) and
(strSpacePos<>sourceStrPtr) then begin
max := (strSpacePos-sourceStrPtr) div 2;
Params.SpaceEaten := True;
end
else
max := (strSpacePos-sourceStrPtr) div 2+1;
end
else
{$ENDIF}
begin
if (rvflTrim in Flags) and (strSpacePos<>sourceStrPtr) then begin
max := strSpacePos-sourceStrPtr;
Params.SpaceEaten := True;
end
else
max := strSpacePos-sourceStrPtr+1;
end;
end
else if not (newline
{$IFNDEF RVDONOTUSELISTS}
or (AtStart and (ItemNo>0) and (GetItemStyle(ItemNo-1)=rvsListMarker))
{$ENDIF}
)
then begin
Params.IsParaStart := False;
newline := true;
continue;
end;
end;
{$IFNDEF RVDONOTUSEUNICODE}
if IsUnicodeItem then begin
Offs := (sourceStrPtr - PChar(Text)) div 2+1;
StrForAdd := sourceStrPtr;
inc(sourceStrPtr,max*2);
inc(OrigSourceStrPtr, max*2);
dec(sourceStrPtrLen,max);
if Params.SpaceEaten then begin
inc(sourceStrPtr, 2);
inc(OrigSourceStrPtr, 2);
dec(sourceStrPtrLen);
Params.SpaceEaten := sourceStrPtrLen=0;
end;
end
else
{$ENDIF}
begin
Offs := sourceStrPtr - PChar(Text)+1;
StrForAdd := sourceStrPtr;
inc(sourceStrPtr,max);
inc(OrigSourceStrPtr,max);
dec(sourceStrPtrLen,max);
if Params.SpaceEaten then begin
inc(sourceStrPtr);
inc(OrigsourceStrPtr);
dec(sourceStrPtrLen);
Params.SpaceEaten := sourceStrPtrLen=0;
end;
end;
if (newline or (max<>0)) then begin
dli := TRVDrawLineInfo.Create;
dli.ItemNo := ItemNo;
dli.Offs := Offs;
if {(sourceStrPtrLen<>0) and} ((max<>max2) or (sourceStrPtr2<>sourceStrPtr) or (rvpaoNoWrap in pi.Options)) then
{$IFNDEF RVDONOTUSEUNICODE}
if IsUnicodeItem then
RVU_GetTextExtentPoint32W(Params.FormatCanvas, Pointer(strForAdd), max, sz)
else
{$ENDIF}
GetTextExtentPoint32(Params.FormatCanvasHandle,strForAdd,max,sz);
if not newline then begin {continue line}
AdjustLineHeight(ExternalLeading+Params.TextMetric.tmAscent+Params.VerticalOffs);
y := Params.baseline - (ExternalLeading+Params.TextMetric.tmAscent+Params.VerticalOffs);
dli.FromNewLine := False;
end
else begin { new line }
dli.FromNewLine := True;
Params.x :=0;
inc(Params.baseline, ExtraSpaceBelowLine);
y := Params.baseline+Params.prevDesc;
Params.prevabove := ExternalLeading+Params.TextMetric.tmAscent+Params.VerticalOffs;
inc(Params.baseline, Params.prevDesc+Params.prevabove);
end;
dli.Left :=Params.x+Params.FirstIndent;
dli.Top := y;
dli.Width := sz.cx;
dli.Height := sz.cy;
dli.Length := max;
DrawItems.Insert(Params.LastDrawItem,dli);
if AtStart and not ShareItems then
li.DrawItemNo := Params.LastDrawItem;
inc(Params.LastDrawItem);
if (rvflUseJumps in Flags) and RVStyle.TextStyles[ActualStyleNo].Jump then begin
jmpinfo := TRVJumpInfo.Create;
jmpinfo.w := sz.cx;
jmpinfo.h := sz.cy;
jmpinfo.id := nJmps;
if StartOffs>0 then dec(jmpinfo.id);
jmpinfo.DrawItemNo := Params.LastDrawItem-1;
jmpinfo.Cursor := RVStyle.TextStyles[ActualStyleNo].JumpCursor;
jmpinfo.RVData := Self;
jumps.Add(jmpinfo);
end;
if newline or (Params.prevDesc < Params.TextMetric.tmDescent-Params.VerticalOffs) then
Params.prevDesc := Params.TextMetric.tmDescent-Params.VerticalOffs;
inc(Params.x,sz.cx);
newline := True;
Params.IsParaStart := False;
AtStart := False;
end
else
newline := true;
end; { while }
if RVStyle.TextStyles[ActualStyleNo].Jump and (StartOffs=0) then begin
TCustomRVItemInfo(Items.Objects[ItemNo]).JumpID := nJmps;
inc(nJmps);
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.FormatWords(ItemNo: Integer; Canvas: TCanvas;
var sad: TRVScreenAndDevice; var Params: TRVFormatParams);
var offs: Integer;
LinesNo, TmpStr, SpacePos: PChar;
Len, WordLen: Integer;
{$IFNDEF RVDONOTUSEUNICODE}
Unicode: Boolean;
{$ENDIF}
Text, OrigText: String;
begin
Len := Length(Items[ItemNo]);
if Len=0 then begin
FormatLine( '', '', 0, Len, ItemNo, Canvas, sad, Params);
exit;
end;
{$IFNDEF RVDONOTUSEUNICODE}
Unicode := rvioUnicode in GetItemOptions(ItemNo);
if Unicode then
Len := Len div 2;
{$ENDIF}
offs := 0;
OrigText := Items[ItemNo];
Text := RV_ReturnProcessedString(OrigText,
GetRVStyle.TextStyles[GetItemStyle(ItemNo)], False,
rvoShowSpecialCharacters in Options, False);
LinesNo := PChar(Text);
while Len>0 do begin
TmpStr := LinesNo;
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode then begin
if (PWord(TmpStr)^ = ord(' ')) then
inc(PChar(TmpStr), 2);
SpacePos := RVU_StrScanW(TmpStr, ord(' '), Len)
end
else
{$ENDIF}
begin
if (TmpStr^ = ' ') then
inc(TmpStr);
SpacePos := StrScan(TmpStr, ' ');
end;
if SpacePos=nil then
WordLen := Len
else begin
WordLen := SpacePos-LinesNo;
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode then
WordLen := WordLen div 2;
{$ENDIF}
end;
FormatLine(Text, OrigText, Offs, WordLen, ItemNo, Canvas, sad, Params);
inc(offs, WordLen);
inc(LinesNo, WordLen);
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode then
inc(LinesNo, WordLen);
{$ENDIF}
dec(Len, WordLen);
end;
end;
{------------------------------------------------------------------------------}
function TCustomRVFormattedData.GetHOffs: Integer;
begin
Result := 0;
end;
{------------------------------------------------------------------------------}
function TCustomRVFormattedData.GetVOffs: Integer;
begin
Result := 0;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.Format(NoCaching: Boolean);
begin
Format_(False, True, False, 0, GetCanvas, False, NoCaching, False);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.ApplyZoom(Canvas: TCanvas);
begin
{
if ZoomPercent<>100 then begin
SetMapMode(Canvas.Handle,MM_ANISOTROPIC);
SetWindowExtEx(Canvas.Handle,100,100,nil);
SetViewportExtEx(Canvas.Handle,ZoomPercent,ZoomPercent,nil);
end;
}
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.RestoreZoom(Canvas: TCanvas);
begin
{
if ZoomPercent<>100 then
SetMapMode(Canvas.Handle,MM_TEXT);
}
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.ZoomInt(var v: Integer);
begin
v := v;
//v := MulDiv(v,100,ZoomPercent);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.ZoomRectDown(var r: TRect);
begin
{
with r do begin
Left := MulDiv(Left,100,ZoomPercent);
Top := MulDiv(Top,100,ZoomPercent);
Right := MulDiv(Right,100,ZoomPercent);
Bottom := MulDiv(Bottom,100,ZoomPercent);
end;
}
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.GetSADForFormatting(Canvas: TCanvas;
var sad: TRVScreenAndDevice);
begin
// ApplyZoom(Canvas);
RV_InfoAboutSaD(sad, Canvas);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVFormattedData.Format_(OnlyResized, ForceFormat,
NoScroll: Boolean; depth: Integer; Canvas: TCanvas;
OnlyTail, NoCaching, Reformatting: Boolean);
var i: Integer;
oldtextwidth, olddocumentwidth, cw, ch: Integer;
sad: TRVScreenAndDevice;
StartLine: Integer;
StartNo, EndNo, StartOffs, EndOffs: Integer;
DevMinTextWidth, DevMaxTextWidth: Integer;
FV, DeltaFV: Integer;
RVStyle: TRVStyle;
ExtraSpaceBelowLine: Integer;
Params: TRVFormatParams;
begin
if AlreadyFormatted then begin
AlreadyFormatted := False;
exit;
end;
if (depth>1) or (GetRVStyle=nil) or (rvstSkipformatting in State) then exit;
if Canvas=nil then
Canvas := GetCanvas;
if depth=0 then begin
StartFormatting;
end;
try
Params.SpaceEaten := False;
Params.LastTabDrawItemNo := -1;
Params.NoCaching := NoCaching;
Params.Reformatting := Reformatting;
Params.FirstParaItemNo := -1;
Params.LastTextStyle := -1;
Params.IsParaStart := True;
FV := -1; { avoiding warings }
DeltaFV := 0; { avoiding warings }
if depth=0 then begin
if OnlyResized then begin
StoreSelBounds(StartNo, EndNo, StartOffs, EndOffs, False);
if not NoScroll then begin
FV := GetDrawItemNo(GetVOffs, gdinFirstVisible);
if FV>=DrawItems.Count then FV:=DrawItems.Count-1;
if FV<>-1 then begin
DeltaFV := GetVOffs-DrawItems[FV].Top;
FV := DrawItems[FV].ItemNo;
end;
end;
end;
if OnlyTail then FV := GetVOffs;
end;
oldtextwidth := TextWidth;
olddocumentwidth := DocumentWidth;
GetSADForFormatting(Canvas, sad);
sad.LeftMargin := MulDiv(GetLeftMargin, sad.ppixDevice, sad.ppixScreen);
sad.RightMargin := MulDiv(GetRightMargin, sad.ppixDevice, sad.ppixScreen);