d9a05ba0b9
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5844 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1140 lines
34 KiB
ObjectPascal
1140 lines
34 KiB
ObjectPascal
{
|
|
richmemo.pas
|
|
|
|
Author: Dmitry 'skalogryz' Boyarintsev
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
|
|
unit RichMemo;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$OBJECTCHECKS OFF}
|
|
|
|
interface
|
|
|
|
uses
|
|
Types, Classes, SysUtils
|
|
, LCLType, LCLIntf, Printers
|
|
, Graphics, Controls, StdCtrls, LazUTF8;
|
|
|
|
type
|
|
TVScriptPos = (vpNormal, vpSubScript, vpSuperScript);
|
|
|
|
TFontParams = record
|
|
Name : String;
|
|
Size : Integer;
|
|
Color : TColor;
|
|
Style : TFontStyles;
|
|
HasBkClr : Boolean;
|
|
BkColor : TColor;
|
|
VScriptPos : TVScriptPos;
|
|
end;
|
|
|
|
TParaAlignment = (paLeft, paRight, paCenter, paJustify);
|
|
TParaMetric = record
|
|
FirstLine : Double; // in points
|
|
TailIndent : Double; // in points
|
|
HeadIndent : Double; // in points
|
|
SpaceBefore : Double; // in points
|
|
SpaceAfter : Double; // in points
|
|
LineSpacing : Double; // multiplier - matching CSS line-height by percentage/em
|
|
// note, that normal LineSpacing is 1.2, not 1.0
|
|
end;
|
|
|
|
const
|
|
DefLineSpacing = 1.2;
|
|
SingleLineSpacing = DefLineSpacing;
|
|
OneHalfLineSpacing = DefLineSpacing * 1.5;
|
|
DoubleLineSpacing = DefLineSpacing * 2.0;
|
|
|
|
|
|
type
|
|
TParaNumStyle = (pnNone, pnBullet, pnNumber, pnLowLetter
|
|
, pnLowRoman, pnUpLetter, pnUpRoman, pnCustomChar);
|
|
|
|
TParaNumbering = record
|
|
Style : TParaNumStyle;
|
|
Indent : Double;
|
|
CustomChar : WideChar;
|
|
NumberStart : Integer; // used for pnNumber only
|
|
SepChar : WideChar;
|
|
ForceNewNum : Boolean; // if true and Style is pnNumber, NumberStart is used for the new numbering
|
|
end;
|
|
|
|
const
|
|
SepNone = #0;
|
|
SepPar = ')';
|
|
SepDot = '.';
|
|
|
|
|
|
type
|
|
TTextModifyMask = set of (tmm_Color, tmm_Name, tmm_Size, tmm_Styles, tmm_BackColor);
|
|
TParaModifyMask = set of (pmm_FirstLine, pmm_HeadIndent, pmm_TailIndent, pmm_SpaceBefore, pmm_SpaceAfter, pmm_LineSpacing);
|
|
|
|
TSearchOption = (soMatchCase, soWholeWord, soBackward);
|
|
TSearchOptions = set of TSearchOption;
|
|
|
|
TParaRange = record
|
|
start : Integer; // the first character in the paragraph
|
|
lengthNoBr : Integer; // the length of the paragraph, excluding the line break character
|
|
length : Integer; // the length of the paragrpah, including the line break, if present
|
|
// the last line in the control doesn't contain a line break character,
|
|
// thus length = lengthNoBr
|
|
end;
|
|
|
|
type
|
|
TTabAlignment = (tabLeft, tabCenter, tabRight, tabDecimal, tabWordBar);
|
|
|
|
TTabStop = record
|
|
Offset : Double;
|
|
Align : TTabAlignment; // not used
|
|
end;
|
|
|
|
TTabStopList = record
|
|
Count : Integer;
|
|
Tabs : array of TTabStop;
|
|
end;
|
|
|
|
type
|
|
TRectOffsets = record
|
|
Left : Double;
|
|
Top : Double;
|
|
Right : Double;
|
|
Bottom : Double;
|
|
end;
|
|
|
|
TPrintParams = record
|
|
JobTitle : String; // print job title to be shown in system printing manager
|
|
Margins : TRectOffsets; // margins in points
|
|
SelStart : Integer;
|
|
SelLength : Integer;
|
|
end;
|
|
|
|
TPrintMeasure = record
|
|
Pages : Integer;
|
|
end;
|
|
|
|
TPrintAction = (paDocStart, paPageStart, paPageEnd, paDocEnd);
|
|
|
|
TPrintActionEvent = procedure (Sender: TObject;
|
|
APrintAction: TPrintAction;
|
|
PrintCanvas: TCanvas;
|
|
CurrentPage: Integer; var AbortPrint: Boolean) of object;
|
|
|
|
type
|
|
TLinkAction = (laClick);
|
|
|
|
TLinkMouseInfo = record
|
|
button : TMouseButton;
|
|
end;
|
|
|
|
TLinkActionEvent = procedure (Sender: TObject;
|
|
ALinkAction: TLinkAction;
|
|
const info: TLinkMouseInfo;
|
|
LinkStart, LinkLen: Integer) of object;
|
|
|
|
TTextUIFeature = (uiLink);
|
|
TTextUIFeatures = set of TTextUIFeature;
|
|
|
|
TTextUIParam = record
|
|
features : TTextUIFeatures;
|
|
linkref : String;
|
|
end;
|
|
|
|
type
|
|
TRichMemoObject = class(TObject);
|
|
TCustomRichMemo = class;
|
|
|
|
TRichMemoInlineWSObject = TObject;
|
|
|
|
{ TRichMemoInline }
|
|
|
|
TRichMemoInline = class(TObject)
|
|
private
|
|
WSObj : TRichMemoInlineWSObject;
|
|
fOwner : TCustomRichMemo;
|
|
public
|
|
procedure Draw(Canvas: TCanvas; const ASize: TSize); virtual;
|
|
procedure SetVisible(AVisible: Boolean); virtual;
|
|
procedure Invalidate;
|
|
property Owner: TCustomRichMemo read fOwner;
|
|
end;
|
|
|
|
{ TCustomRichMemo }
|
|
|
|
TCustomRichMemo = class(TCustomMemo)
|
|
private
|
|
fHideSelection : Boolean;
|
|
fOnSelectionChange : TNotifyEvent;
|
|
fOnPrintAction : TPrintActionEvent;
|
|
fOnLinkAction : TLinkActionEvent;
|
|
fZoomFactor : Double;
|
|
private
|
|
procedure InlineInvalidate(handler: TRichMemoInline);
|
|
|
|
//todo: PrintMeasure doesn't work propertly
|
|
function PrintMeasure(const params: TPrintParams; var est: TPrintMeasure): Boolean;
|
|
protected
|
|
procedure DoSelectionChange;
|
|
class procedure WSRegisterClass; override;
|
|
procedure CreateWnd; override;
|
|
procedure UpdateRichMemo; virtual;
|
|
procedure SetHideSelection(AValue: Boolean);
|
|
function GetContStyleLength(TextStart: Integer): Integer;
|
|
|
|
procedure SetSelText(const SelTextUTF8: string); override;
|
|
function GetZoomFactor: Double; virtual;
|
|
procedure SetZoomFactor(AValue: Double); virtual;
|
|
|
|
procedure DoPrintAction(PrintJobEvent: TPrintAction;
|
|
PrintCanvas: TCanvas;
|
|
CurrentPage: Integer; var AbortPrint: Boolean);
|
|
procedure DoLinkAction(ALinkAction: TLinkAction; const AMouseInfo: TLinkMouseInfo;
|
|
LinkStart, LinkEnd: Integer);
|
|
function GetCanRedo: Boolean; virtual;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure CopyToClipboard; override;
|
|
procedure CutToClipboard; override;
|
|
procedure PasteFromClipboard; override;
|
|
function CanPaste: Boolean; virtual;
|
|
|
|
procedure SetTextAttributes(TextStart, TextLen: Integer; const TextParams: TFontParams); virtual;
|
|
function GetTextAttributes(TextStart: Integer; var TextParams: TFontParams): Boolean; virtual;
|
|
function GetStyleRange(CharOfs: Integer; var RangeStart, RangeLen: Integer): Boolean; virtual;
|
|
|
|
function GetParaAlignment(TextStart: Integer; var AAlign: TParaAlignment): Boolean; overload; virtual;
|
|
function GetParaAlignment(TextStart: Integer): TParaAlignment; overload;
|
|
procedure SetParaAlignment(TextStart, TextLen: Integer; AAlign: TParaAlignment); virtual;
|
|
function GetParaMetric(TextStart: Integer; var AMetric: TParaMetric): Boolean; virtual;
|
|
procedure SetParaMetric(TextStart, TextLen: Integer; const AMetric: TParaMetric); virtual;
|
|
function GetParaNumbering(TextStart: Integer; var ANumber: TParaNumbering): Boolean; virtual;
|
|
procedure SetParaNumbering(TextStart, TextLen: Integer; const ANumber: TParaNumbering); virtual;
|
|
function GetParaRange(CharOfs: Integer; var ParaRange: TParaRange): Boolean; virtual;
|
|
function GetParaRange(CharOfs: Integer; var TextStart, TextLength: Integer): Boolean;
|
|
|
|
procedure SetParaTabs(TextStart, TextLen: Integer; const AStopList: TTabStopList); virtual;
|
|
function GetParaTabs(CharOfs: Integer; var AStopList: TTabStopList): Boolean; virtual;
|
|
|
|
procedure SetTextAttributes(TextStart, TextLen: Integer; AFont: TFont);
|
|
procedure SetRangeColor(TextStart, TextLength: Integer; FontColor: TColor);
|
|
procedure SetRangeParams(TextStart, TextLength: Integer; ModifyMask: TTextModifyMask;
|
|
const FontName: String; FontSize: Integer; FontColor: TColor; AddFontStyle, RemoveFontStyle: TFontStyles); overload;
|
|
procedure SetRangeParams(TextStart, TextLength: Integer; ModifyMask: TTextModifyMask;
|
|
const fnt: TFontParams; AddFontStyle, RemoveFontStyle: TFontStyles); overload;
|
|
procedure SetRangeParaParams(TextStart, TextLength: Integer; ModifyMask: TParaModifyMask;
|
|
const ParaMetric: TParaMetric);
|
|
|
|
procedure SetLink(TextStart, TextLength: Integer; AIsLink: Boolean; const ALinkRef: String = ''); virtual;
|
|
function isLink(TextStart: Integer): Boolean; virtual;
|
|
|
|
function LoadRichText(Source: TStream): Boolean; virtual;
|
|
function SaveRichText(Dest: TStream): Boolean; virtual;
|
|
|
|
function InDelText(const UTF8Text: string; InsStartChar, ReplaceLength: Integer): Integer; virtual;
|
|
function InDelInline(inlineobj: TRichMemoInline; InsStartChar, ReplaceLength: Integer; const ASize: TSize): Integer; virtual;
|
|
function GetText(TextStart, TextLength: Integer): String;
|
|
function GetUText(TextStart, TextLength: Integer): UnicodeString;
|
|
|
|
procedure SetSelLengthFor(const aselstr: string);
|
|
|
|
function Search(const ANiddle: string; Start, Len: Integer; const SearchOpt: TSearchOptions): Integer; overload;
|
|
function Search(const ANiddle: string; Start, Len: Integer; const SearchOpt: TSearchOptions; var ATextStart, ATextLength: Integer): Boolean; overload;
|
|
|
|
function Print(const params: TPrintParams): Integer;
|
|
|
|
function CharAtPos(x, y: Integer): Integer;
|
|
|
|
procedure Redo; virtual;
|
|
|
|
property HideSelection : Boolean read fHideSelection write SetHideSelection;
|
|
property OnSelectionChange: TNotifyEvent read fOnSelectionChange write fOnSelectionChange;
|
|
property ZoomFactor: Double read GetZoomFactor write SetZoomFactor;
|
|
property OnPrintAction: TPrintActionEvent read fOnPrintAction write fOnPrintAction;
|
|
property OnLinkAction: TLinkActionEvent read fOnLinkAction write fOnLinkAction;
|
|
property CanRedo: Boolean read GetCanRedo;
|
|
end;
|
|
|
|
{ TRichMemo }
|
|
|
|
TRichMemo = class(TCustomRichMemo)
|
|
protected
|
|
// this is "design-time" property
|
|
fRtf: string; // initial RichText
|
|
function GetRTF: string; virtual;
|
|
procedure SetRTF(const AValue: string); virtual;
|
|
procedure UpdateRichMemo; override;
|
|
procedure DestroyHandle; override;
|
|
published
|
|
property Align;
|
|
property Alignment;
|
|
property Anchors;
|
|
property BidiMode;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property Color;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property HideSelection;
|
|
property Lines;
|
|
property MaxLength;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEditingDone;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnLinkAction;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnSelectionChange;
|
|
property OnStartDrag;
|
|
property OnPrintAction;
|
|
property OnUTF8KeyPress;
|
|
property ParentBidiMode;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property PopupMenu;
|
|
property ParentShowHint;
|
|
property ReadOnly;
|
|
property Rtf: string read GetRTF write SetRTF;
|
|
property ScrollBars;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
property WantReturns;
|
|
property WantTabs;
|
|
property WordWrap;
|
|
property ZoomFactor;
|
|
end;
|
|
|
|
procedure InitFontParams(var p: TFontParams);
|
|
function GetFontParams(styles: TFontStyles): TFontParams; overload;
|
|
function GetFontParams(color: TColor; styles: TFontStyles): TFontParams; overload;
|
|
function GetFontParams(const Name: String; color: TColor; styles: TFontStyles): TFontParams; overload;
|
|
function GetFontParams(const Name: String; Size: Integer; color: TColor; styles: TFontStyles): TFontParams; overload;
|
|
function GetFontParams(AFont: TFont): TFontParams; overload;
|
|
|
|
procedure InitParaMetric(var m: TParaMetric);
|
|
procedure InitParaNumbering(var n: TParaNumbering);
|
|
procedure InitParaNumber(var n: TParaNumbering; ASepChar: WideChar = SepPar; StartNum: Integer = 1);
|
|
procedure InitParaBullet(var n: TParaNumbering);
|
|
procedure InitTabStopList(var tabs: TTabStopList); overload;
|
|
procedure InitTabStopList(var tabs: TTabStopList; const TabStopsPt: array of double); overload;
|
|
procedure InitPrintParams(var prm: TPrintParams);
|
|
|
|
procedure InitTextUIParams(var prm: TTextUIParam);
|
|
|
|
var
|
|
RTFLoadStream : function (AMemo: TCustomRichMemo; Source: TStream): Boolean = nil;
|
|
RTFSaveStream : function (AMemo: TCustomRichMemo; Dest: TStream): Boolean = nil;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{%H-}RichMemoFactory, WSRichMemo;
|
|
|
|
procedure InitFontParams(var p: TFontParams);
|
|
begin
|
|
FillChar(p, SizeOf(p), 0);
|
|
end;
|
|
|
|
function GetFontParams(styles: TFontStyles): TFontParams; overload;
|
|
begin
|
|
Result := GetFontParams('', 0, 0, styles);
|
|
end;
|
|
|
|
function GetFontParams(color: TColor; styles: TFontStyles): TFontParams; overload;
|
|
begin
|
|
Result := GetFontParams('', 0, color, styles);
|
|
end;
|
|
|
|
function GetFontParams(const Name: String; color: TColor; styles: TFontStyles): TFontParams; overload;
|
|
begin
|
|
Result := GetFontParams(Name, 0, color, styles);
|
|
end;
|
|
|
|
function GetFontParams(const Name: String; Size: Integer; color: TColor; styles: TFontStyles): TFontParams; overload;
|
|
begin
|
|
InitFontParams(Result);
|
|
Result.Name := Name;
|
|
Result.Size := Size;
|
|
Result.Color := color;
|
|
Result.Style := styles;
|
|
end;
|
|
|
|
//todo: get rid of this Graphics.GetFontData dupication
|
|
//this is the only function that's using LCLType and LCLIntf
|
|
function RMGetFontData(Font: HFont): TFontData;
|
|
var
|
|
ALogFont: TLogFont;
|
|
begin
|
|
Result := DefFontData;
|
|
if Font <> 0 then
|
|
begin
|
|
if GetObject(Font, SizeOf(ALogFont), @ALogFont) <> 0 then
|
|
with Result, ALogFont do
|
|
begin
|
|
Height := lfHeight;
|
|
if lfWeight >= FW_BOLD then Include(Style, fsBold);
|
|
if lfItalic > 0 then Include(Style, fsItalic);
|
|
if lfUnderline > 0 then Include(Style, fsUnderline);
|
|
if lfStrikeOut > 0 then Include(Style, fsStrikeOut);
|
|
Charset := TFontCharset(lfCharSet);
|
|
Name := lfFaceName;
|
|
case lfPitchAndFamily and $F of
|
|
VARIABLE_PITCH: Pitch := fpVariable;
|
|
FIXED_PITCH: Pitch := fpFixed;
|
|
else
|
|
Pitch := fpDefault;
|
|
end;
|
|
Orientation := lfOrientation;
|
|
Handle := Font;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetFontParams(AFont: TFont): TFontParams; overload;
|
|
var
|
|
data : TFontData;
|
|
wstest : Boolean;
|
|
begin
|
|
InitFontParams(Result);
|
|
if not Assigned(AFont) then Exit;
|
|
|
|
if AFont.Reference.Handle <> 0 then begin
|
|
// WSGetFontParams is introduced, because default Gtk widgetset returns
|
|
// only FontName from the handle.
|
|
wstest:= Assigned(WSGetFontParams) and WSGetFontParams(AFont.Reference.Handle, Result);
|
|
if not wstest then begin
|
|
data:=RMGetFontData(AFont.Reference.Handle);
|
|
if data.Height<0
|
|
then Result.Size:=round(abs(data.Height)/ScreenInfo.PixelsPerInchY*72)
|
|
else Result.Size:=data.Height;
|
|
Result.Name:=data.Name;
|
|
Result.Style:=data.Style;
|
|
end;
|
|
// color is not stored with system font information
|
|
// it's an additional attribute introduced in TFont class
|
|
Result.Color:=AFont.Color;
|
|
end else begin
|
|
Result.Name := AFont.Name;
|
|
Result.Color := AFont.Color;
|
|
Result.Size := AFont.Size;
|
|
Result.Style := AFont.Style;
|
|
end;
|
|
end;
|
|
|
|
procedure InitParaMetric(var m: TParaMetric);
|
|
begin
|
|
FillChar(m, sizeof(m), 0);
|
|
m.LineSpacing:=DefLineSpacing;
|
|
end;
|
|
|
|
procedure InitParaNumbering(var n: TParaNumbering);
|
|
begin
|
|
FillChar(n, sizeof(n), 0);
|
|
end;
|
|
|
|
procedure InitParaNumber(var n: TParaNumbering; ASepChar: WideChar; StartNum: Integer);
|
|
begin
|
|
InitParaNumbering(n);
|
|
n.Style:=pnNumber;
|
|
n.NumberStart:=StartNum;
|
|
n.SepChar:=ASepChar;
|
|
end;
|
|
|
|
procedure InitParaBullet(var n: TParaNumbering);
|
|
begin
|
|
InitParaNumbering(n);
|
|
n.Style:=pnBullet;
|
|
end;
|
|
|
|
procedure InitTabStopList(var tabs: TTabStopList);
|
|
begin
|
|
FillChar(tabs, sizeof(tabs), 0);
|
|
end;
|
|
|
|
procedure InitTabStopList(var tabs: TTabStopList; const TabStopsPt: array of double);
|
|
var
|
|
i : Integer;
|
|
begin
|
|
InitTabStopList(tabs);
|
|
tabs.count:=length(TabStopsPt);
|
|
SetLength(tabs.tabs, tabs.Count);
|
|
for i:=0 to tabs.Count-1 do begin
|
|
tabs.tabs[i].Offset:=TabStopsPt[i];
|
|
end;
|
|
end;
|
|
|
|
procedure InitPrintParams(var prm: TPrintParams);
|
|
begin
|
|
FillChar(prm, sizeof(prm), 0);
|
|
end;
|
|
|
|
procedure InitTextUIParams(var prm: TTextUIParam);
|
|
begin
|
|
FillChar(prm, sizeof(prm), 0);
|
|
end;
|
|
|
|
{ TRichMemoInline }
|
|
|
|
procedure TRichMemoInline.Draw(Canvas: TCanvas; const ASize: TSize);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TRichMemoInline.SetVisible(AVisible: Boolean);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TRichMemoInline.Invalidate;
|
|
begin
|
|
if not Assigned(fOwner) then Exit;
|
|
Owner.InlineInvalidate( Self );
|
|
end;
|
|
|
|
{ TRichMemo }
|
|
|
|
function TRichMemo.GetRTF: string;
|
|
var
|
|
st : TStringStream;
|
|
begin
|
|
if (csDesigning in ComponentState) or not HandleAllocated then
|
|
Result:=fRTF
|
|
else begin
|
|
try
|
|
st := TStringStream.Create('');
|
|
try
|
|
SaveRichText(st);
|
|
Result:=st.DataString;
|
|
finally
|
|
st.Free;
|
|
end;
|
|
except
|
|
Result:='';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRichMemo.SetRTF(const AValue: string);
|
|
var
|
|
st : TStringStream;
|
|
begin
|
|
if (csDesigning in ComponentState) or not HandleAllocated then
|
|
fRTF:=AValue;
|
|
|
|
if HandleAllocated then
|
|
try
|
|
st := TStringStream.Create(AValue);
|
|
try
|
|
LoadRichText(st);
|
|
finally
|
|
st.Free;
|
|
end;
|
|
except
|
|
end;
|
|
|
|
if ([csDesigning, csLoading] * ComponentState = []) and HandleAllocated then begin
|
|
fRTF:=''; // reduce memory usage in run-time
|
|
end;
|
|
end;
|
|
|
|
procedure TRichMemo.UpdateRichMemo;
|
|
begin
|
|
inherited UpdateRichMemo;
|
|
// if fRTF is blank, Text property would be used
|
|
if fRTF<>'' then SetRTF(fRTF);
|
|
end;
|
|
|
|
procedure TRichMemo.DestroyHandle;
|
|
begin
|
|
fRTF:=GetRTF;
|
|
inherited DestroyHandle;
|
|
end;
|
|
|
|
{ TCustomRichMemo }
|
|
|
|
procedure TCustomRichMemo.SetHideSelection(AValue: Boolean);
|
|
begin
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetHideSelection(Self, AValue);
|
|
fHideSelection := AValue;
|
|
end;
|
|
|
|
function TCustomRichMemo.GetZoomFactor: Double;
|
|
begin
|
|
Result:=fZoomFactor;
|
|
if HandleAllocated then begin
|
|
if TWSCustomRichMemoClass(WidgetSetClass).GetZoomFactor(Self, Result) then
|
|
fZoomFactor:=Result;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetZoomFactor(AValue: Double);
|
|
begin
|
|
if AValue=0 then AValue:=1.0;
|
|
fZoomFactor:=AValue;
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetZoomFactor(Self, AValue);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.DoPrintAction(PrintJobEvent: TPrintAction;
|
|
PrintCanvas: TCanvas; CurrentPage: Integer; var AbortPrint: Boolean);
|
|
begin
|
|
if Assigned(OnPrintAction) then
|
|
OnPrintAction(Self, PrintJobEvent, PrintCanvas, CurrentPAge, AbortPrint);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.DoLinkAction(ALinkAction: TLinkAction; const AMouseInfo: TLinkMouseInfo; LinkStart,
|
|
LinkEnd: Integer);
|
|
begin
|
|
if Assigned(OnLinkAction) then
|
|
OnLinkAction(Self, ALinkAction, AMouseInfo, LinkStart, LinkEnd);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.InlineInvalidate(handler: TRichMemoInline);
|
|
begin
|
|
if not Assigned(handler) then Exit;
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).InlineInvalidate(Self, handler, handler.WSObj);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.DoSelectionChange;
|
|
begin
|
|
if Assigned(fOnSelectionChange) then fOnSelectionChange(Self);
|
|
end;
|
|
|
|
class procedure TCustomRichMemo.WSRegisterClass;
|
|
begin
|
|
inherited;
|
|
WSRegisterCustomRichMemo;
|
|
end;
|
|
|
|
procedure TCustomRichMemo.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
UpdateRichMemo;
|
|
end;
|
|
|
|
procedure TCustomRichMemo.UpdateRichMemo;
|
|
begin
|
|
if not HandleAllocated then Exit;
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetHideSelection(Self, fHideSelection);
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetZoomFactor(Self, fZoomFactor);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetTextAttributes(TextStart, TextLen: Integer;
|
|
AFont: TFont);
|
|
begin
|
|
if not Assigned(AFont) then Exit;
|
|
SetTextAttributes(TextStart, TextLen, GetFontParams(AFont));
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetTextAttributes(TextStart, TextLen: Integer;
|
|
{SetMask: TTextStyleMask;} const TextParams: TFontParams);
|
|
begin
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetTextAttributes(Self, TextStart, TextLen, {SetMask,} TextParams);
|
|
end;
|
|
|
|
function TCustomRichMemo.GetTextAttributes(TextStart: Integer; var TextParams: TFontParams): Boolean;
|
|
begin
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated then
|
|
Result := TWSCustomRichMemoClass(WidgetSetClass).GetTextAttributes(Self, TextStart, TextParams)
|
|
else
|
|
Result := false;
|
|
end;
|
|
|
|
function TCustomRichMemo.GetStyleRange(CharOfs: Integer; var RangeStart,
|
|
RangeLen: Integer): Boolean;
|
|
begin
|
|
if HandleAllocated then begin
|
|
Result := TWSCustomRichMemoClass(WidgetSetClass).GetStyleRange(Self, CharOfs, RangeStart, RangeLen);
|
|
if Result and (RangeLen = 0) then RangeLen := 1;
|
|
end else begin
|
|
RangeStart := -1;
|
|
RangeLen := -1;
|
|
Result := false;
|
|
end;
|
|
end;
|
|
|
|
function TCustomRichMemo.GetParaAlignment(TextStart: Integer;
|
|
var AAlign: TParaAlignment): Boolean;
|
|
begin
|
|
Result := HandleAllocated and
|
|
TWSCustomRichMemoClass(WidgetSetClass).GetParaAlignment(Self, TextStart, AAlign);
|
|
end;
|
|
|
|
function TCustomRichMemo.GetParaAlignment(TextStart: Integer): TParaAlignment;
|
|
begin
|
|
GetParaAlignment(TextStart, Result);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetParaAlignment(TextStart, TextLen: Integer;
|
|
AAlign: TParaAlignment);
|
|
begin
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetParaAlignment(Self, TextStart, TextLen, AAlign);
|
|
end;
|
|
|
|
function TCustomRichMemo.GetParaMetric(TextStart: Integer;
|
|
var AMetric: TParaMetric): Boolean;
|
|
begin
|
|
if HandleAllocated then
|
|
Result := TWSCustomRichMemoClass(WidgetSetClass).GetParaMetric(Self, TextStart, AMetric)
|
|
else
|
|
Result := false;
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetParaMetric(TextStart, TextLen: Integer;
|
|
const AMetric: TParaMetric);
|
|
begin
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetParaMetric(Self, TextStart, TextLen, AMetric);
|
|
end;
|
|
|
|
function TCustomRichMemo.GetParaNumbering(TextStart: Integer;
|
|
var ANumber: TParaNumbering): Boolean;
|
|
begin
|
|
if HandleAllocated then
|
|
Result := TWSCustomRichMemoClass(WidgetSetClass).GetParaNumbering(Self, TextStart, ANumber)
|
|
else
|
|
Result := false;
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetParaNumbering(TextStart, TextLen: Integer;
|
|
const ANumber: TParaNumbering);
|
|
begin
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetParaNumbering(Self, TextStart, TextLen, ANumber);
|
|
end;
|
|
|
|
function TCustomRichMemo.GetParaRange(CharOfs: Integer;
|
|
var ParaRange: TParaRange): Boolean;
|
|
begin
|
|
Result:=false;
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated then
|
|
Result:=TWSCustomRichMemoClass(WidgetSetClass).GetParaRange(Self, CharOfs, ParaRange);
|
|
end;
|
|
|
|
function TCustomRichMemo.GetParaRange(CharOfs: Integer; var TextStart,
|
|
TextLength: Integer): Boolean;
|
|
var
|
|
p : TParaRange;
|
|
begin
|
|
Result:=GetParaRange(CharOfs, p);
|
|
TextStart:=p.start;
|
|
TextLength:=p.length;
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetParaTabs(TextStart, TextLen: Integer;
|
|
const AStopList: TTabStopList);
|
|
begin
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetParaTabs(Self, TextStart, TextLen, AStopList);
|
|
end;
|
|
|
|
function TCustomRichMemo.GetParaTabs(CharOfs: Integer; var AStopList: TTabStopList): Boolean;
|
|
begin
|
|
Result:=false;
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated then
|
|
Result:=TWSCustomRichMemoClass(WidgetSetClass).GetParaTabs(Self, CharOfs, AStopList);
|
|
end;
|
|
|
|
function TCustomRichMemo.GetContStyleLength(TextStart: Integer): Integer;
|
|
var
|
|
ofs, len : Integer;
|
|
begin
|
|
if GetStyleRange(TextStart, ofs, len)
|
|
then Result := len - (TextStart-ofs)
|
|
else Result := 0;
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetSelText(const SelTextUTF8: string);
|
|
var
|
|
st : Integer;
|
|
begin
|
|
if not HandleAllocated then HandleNeeded;
|
|
Lines.BeginUpdate;
|
|
try
|
|
st := SelStart;
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).InDelText(Self, SelTextUTF8, SelStart, SelLength);
|
|
SelStart := st;
|
|
SelLength := length(UTF8Decode(SelTextUTF8));
|
|
finally
|
|
Lines.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
constructor TCustomRichMemo.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
fZoomFactor:=1;
|
|
end;
|
|
|
|
|
|
procedure TCustomRichMemo.CopyToClipboard;
|
|
begin
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).CopyToClipboard(Self);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.CutToClipboard;
|
|
begin
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).CutToClipboard(Self);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.PasteFromClipboard;
|
|
begin
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).PasteFromClipboard(Self);
|
|
end;
|
|
|
|
function TCustomRichMemo.CanPaste: Boolean;
|
|
begin
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated then
|
|
Result:=TWSCustomRichMemoClass(WidgetSetClass).CanPasteFromClipboard(Self);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetRangeColor(TextStart, TextLength: Integer; FontColor: TColor);
|
|
begin
|
|
SetRangeParams(TextStart, TextLength, [tmm_Color], '', 0, FontColor, [], []);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetRangeParams(TextStart, TextLength: Integer; ModifyMask: TTextModifyMask;
|
|
const FontName: String; FontSize: Integer; FontColor: TColor; AddFontStyle, RemoveFontStyle: TFontStyles);
|
|
var
|
|
fnt : TFontParams;
|
|
begin
|
|
InitFontParams(fnt);
|
|
fnt.Name:=FontName;
|
|
fnt.Size:=FontSize;
|
|
fnt.Color:=FontColor;
|
|
SetRangeParams(TextStart, TextLength, ModifyMask, fnt, AddFontStyle, RemoveFontStyle);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetRangeParams(TextStart, TextLength: Integer;
|
|
ModifyMask: TTextModifyMask; const fnt: TFontParams; AddFontStyle,
|
|
RemoveFontStyle: TFontStyles);
|
|
var
|
|
i : Integer;
|
|
j : Integer;
|
|
l : Integer;
|
|
p : TFontParams;
|
|
allowInternalChange: Boolean;
|
|
fp : TFontParams;
|
|
const
|
|
AllFontStyles : TFontStyles = [fsBold, fsItalic, fsUnderline, fsStrikeOut];
|
|
begin
|
|
if not HandleAllocated then HandleNeeded;
|
|
|
|
if (ModifyMask = []) or (TextLength = 0) then Exit;
|
|
|
|
allowInternalChange:=(not (tmm_Styles in ModifyMask)) or (AddFontStyle+RemoveFontStyle=AllFontStyles);
|
|
|
|
if allowInternalChange and (TWSCustomRichMemoClass(WidgetSetClass).isInternalChange(Self, ModifyMask)) then
|
|
begin
|
|
// more effecient from OS view
|
|
fp:=fnt;
|
|
if tmm_Styles in ModifyMask then fp.Style:=AddFontStyle;
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetTextAttributesInternal(Self,
|
|
TextStart, TextLength, ModifyMask, fp);
|
|
Exit;
|
|
end;
|
|
|
|
Lines.BeginUpdate;
|
|
try
|
|
// manually looping from text ranges and re-applying
|
|
// all the style. changing only the ones that in the mask
|
|
i := TextStart;
|
|
j := TextStart + TextLength;
|
|
while i < j do begin
|
|
GetTextAttributes(i, p);
|
|
|
|
if tmm_Name in ModifyMask then p.Name := fnt.Name;
|
|
if tmm_Color in ModifyMask then p.Color := fnt.Color;
|
|
if tmm_Size in ModifyMask then p.Size := fnt.Size;
|
|
if tmm_Styles in ModifyMask then p.Style := p.Style + AddFontStyle - RemoveFontStyle;
|
|
if tmm_BackColor in ModifyMask then begin
|
|
p.HasBkClr:=fnt.HasBkClr;
|
|
p.BkColor:=fnt.BkColor;
|
|
end;
|
|
l := GetContStyleLength(i);
|
|
if i + l > j then l := j - i;
|
|
if l = 0 then Break;
|
|
SetTextAttributes(i, l, p);
|
|
inc(i, l);
|
|
end;
|
|
finally
|
|
Lines.EndUpdate
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetRangeParaParams(TextStart, TextLength: Integer;
|
|
ModifyMask: TParaModifyMask; const ParaMetric: TParaMetric);
|
|
var
|
|
ln: Integer;
|
|
m : TParaMetric;
|
|
begin
|
|
repeat
|
|
if not GetParaRange(TextStart, TextStart, ln) then Break;
|
|
if ln=0 then Break;
|
|
GetParaMetric(TextStart, m);
|
|
|
|
if pmm_FirstLine in ModifyMask then m.FirstLine:=ParaMetric.FirstLine;
|
|
if pmm_HeadIndent in ModifyMask then m.HeadIndent:=ParaMetric.HeadIndent;
|
|
if pmm_TailIndent in ModifyMask then m.TailIndent:=ParaMetric.TailIndent;
|
|
if pmm_SpaceBefore in ModifyMask then m.SpaceBefore:=ParaMetric.SpaceBefore;
|
|
if pmm_SpaceAfter in ModifyMask then m.SpaceAfter:=ParaMetric.SpaceAfter;
|
|
if pmm_LineSpacing in ModifyMask then m.LineSpacing:=ParaMetric.LineSpacing;
|
|
SetParaMetric(TextStart, 1, m);
|
|
|
|
inc(TextStart, ln);
|
|
dec(TextLength, ln);
|
|
|
|
until TextLength<=0;
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetLink(TextStart, TextLength: Integer; AIsLink: Boolean; const ALinkRef: String);
|
|
var
|
|
ui : TTextUIParam;
|
|
begin
|
|
if HandleAllocated then begin
|
|
TWSCustomRichMemoClass(WidgetSetClass).GetTextUIParams(Self, TextStart, ui);
|
|
if AIsLink then begin
|
|
Include(ui.features, uiLink);
|
|
ui.linkref:=ALinkRef;
|
|
end else
|
|
Exclude(ui.features, uiLink);
|
|
TWSCustomRichMemoClass(WidgetSetClass).SetTextUIParams(Self, TextStart, TextLength, ui);
|
|
end;
|
|
end;
|
|
|
|
function TCustomRichMemo.isLink(TextStart: Integer): Boolean;
|
|
var
|
|
ui : TTextUIParam;
|
|
begin
|
|
Result:=HandleAllocated and TWSCustomRichMemoClass(WidgetSetClass).GetTextUIParams(Self, TextStart, ui);
|
|
if Result then Result:=uiLink in ui.features;
|
|
end;
|
|
|
|
function TCustomRichMemo.LoadRichText(Source: TStream): Boolean;
|
|
begin
|
|
Result:=false;
|
|
if not HandleAllocated then HandleNeeded;
|
|
if Assigned(Source) and HandleAllocated then begin
|
|
if Assigned(RTFLoadStream) then begin
|
|
Self.Lines.BeginUpdate;
|
|
try
|
|
Self.Lines.Clear;
|
|
Result:=RTFLoadStream(Self, Source);
|
|
finally
|
|
Self.Lines.EndUpdate;
|
|
end;
|
|
end else begin
|
|
Result := TWSCustomRichMemoClass(WidgetSetClass).LoadRichText(Self, Source);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomRichMemo.SaveRichText(Dest: TStream): Boolean;
|
|
begin
|
|
if Assigned(Dest) and HandleAllocated then begin
|
|
|
|
if Assigned(RTFSaveStream) then begin
|
|
Result := RTFSaveStream(Self, Dest)
|
|
end else
|
|
Result := TWSCustomRichMemoClass(WidgetSetClass).SaveRichText(Self, Dest);
|
|
end else
|
|
Result := false;
|
|
end;
|
|
|
|
function TCustomRichMemo.InDelText(const UTF8Text: string; InsStartChar, ReplaceLength: Integer): Integer;
|
|
begin
|
|
Result:=0;
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated then begin
|
|
TWSCustomRichMemoClass(WidgetSetClass).InDelText(Self, UTF8Text, InsStartChar, ReplaceLength);
|
|
Result:=UTF8length(UTF8Text);
|
|
end;
|
|
end;
|
|
|
|
function TCustomRichMemo.InDelInline(inlineobj: TRichMemoInline; InsStartChar,
|
|
ReplaceLength: Integer; const ASize: TSize): Integer;
|
|
var
|
|
obj : TRichMemoInlineWSObject;
|
|
begin
|
|
Result:=0;
|
|
if not Assigned(inlineObj) then Exit;
|
|
if Assigned(inlineobj.fOwner) and (inlineobj.fOwner<>Self) then Exit;
|
|
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated then begin
|
|
obj:=nil;
|
|
if not TWSCustomRichMemoClass(WidgetSetClass).InlineInsert(Self, InsStartChar
|
|
, ReplaceLength, ASize, inlineObj, obj) then begin
|
|
inlineObj.Free;
|
|
Result:=0;
|
|
end;
|
|
if not Assigned(inlineObj.fOwner) then inlineObj.fOwner:=Self;
|
|
inlineObj.WSObj:=obj;
|
|
Result:=ReplaceLength;
|
|
end else
|
|
inlineObj.Free;
|
|
end;
|
|
|
|
function TCustomRichMemo.GetText(TextStart, TextLength: Integer): String;
|
|
var
|
|
isu : Boolean;
|
|
txt : String;
|
|
utxt : UnicodeString;
|
|
begin
|
|
Result:='';
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated and not TWSCustomRichMemoClass(WidgetSetClass).GetSubText(Self, TextStart, TextLength, false, isu, txt, utxt) then
|
|
Exit;
|
|
if isu then Result:=UTF8Decode(utxt)
|
|
else Result:=txt;
|
|
end;
|
|
|
|
function TCustomRichMemo.GetUText(TextStart, TextLength: Integer): UnicodeString;
|
|
var
|
|
isu : Boolean;
|
|
txt : String;
|
|
utxt : UnicodeString;
|
|
begin
|
|
Result:='';
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated and not TWSCustomRichMemoClass(WidgetSetClass).GetSubText(Self, TextStart, TextLength, false, isu, txt, utxt) then
|
|
Exit;
|
|
if isu then Result:=utxt
|
|
else Result:=UTF8Encode(txt);
|
|
end;
|
|
|
|
procedure TCustomRichMemo.SetSelLengthFor(const aselstr: string);
|
|
begin
|
|
SelLength:=UTF8Length(aselstr);
|
|
end;
|
|
|
|
function TCustomRichMemo.Search(const ANiddle: string; Start, Len: Integer;
|
|
const SearchOpt: TSearchOptions): Integer;
|
|
var
|
|
ln : Integer;
|
|
begin
|
|
ln := 0;
|
|
if not Search(ANiddle, Start, Len, SearchOpt, Result, ln) then Result:=-1;
|
|
end;
|
|
|
|
function TCustomRichMemo.Search(const ANiddle: string; Start, Len: Integer; const SearchOpt: TSearchOptions;
|
|
var ATextStart, ATextLength: Integer): Boolean; overload;
|
|
var
|
|
so : TIntSearchOpt;
|
|
begin
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated then begin
|
|
so.len:=Len;
|
|
so.start:=Start;
|
|
so.options:=SearchOpt;
|
|
if not TWSCustomRichMemoClass(WidgetSetClass).isSearchEx then begin
|
|
ATextStart:=TWSCustomRichMemoClass(WidgetSetClass).Search(Self, ANiddle, so);
|
|
// not recommended. The text found coulbe longer than Niddle
|
|
// depending on the language and search options (to be done)
|
|
// mostly for Arabi and Hebrew languages
|
|
ATextLength:=UTF8Length(ANiddle);
|
|
end else begin
|
|
Result:=TWSCustomRichMemoClass(WidgetSetClass).SearchEx(Self, ANiddle, so, ATextStart, ATextLength);
|
|
end;
|
|
end else
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCustomRichMemo.Print(const params: TPrintParams): Integer;
|
|
begin
|
|
Result:=0;
|
|
if not Assigned(Printer) then Exit;
|
|
if not HandleAllocated then HandleNeeded;
|
|
if HandleAllocated then
|
|
Result:=TWSCustomRichMemoClass(WidgetSetClass).Print(Self, Printer, params, true);
|
|
end;
|
|
|
|
function TCustomRichMemo.CharAtPos(x, y: Integer): Integer;
|
|
begin
|
|
if HandleAllocated then
|
|
Result:=TWSCustomRichMemoClass(WidgetSetClass).CharAtPos(Self, x, y)
|
|
else
|
|
Result:=-1;
|
|
end;
|
|
|
|
function TCustomRichMemo.GetCanRedo: Boolean;
|
|
begin
|
|
if HandleAllocated then
|
|
Result:=TWSCustomRichMemoClass(WidgetSetClass).GetCanRedo(Self)
|
|
else
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCustomRichMemo.PrintMeasure(const params: TPrintParams; var est: TPrintMeasure): Boolean;
|
|
begin
|
|
if not Assigned(Printer) then begin
|
|
Result:=False;
|
|
Exit;
|
|
end;
|
|
|
|
if not HandleAllocated then HandleNeeded;
|
|
|
|
if HandleAllocated then begin
|
|
est.Pages:=TWSCustomRichMemoClass(WidgetSetClass).Print(Self, Printer, params, false);
|
|
end else
|
|
Result:=false;
|
|
end;
|
|
|
|
procedure TCustomRichMemo.Redo;
|
|
begin
|
|
if HandleAllocated then
|
|
TWSCustomRichMemoClass(WidgetSetClass).Redo(Self);
|
|
end;
|
|
|
|
end.
|
|
|