1056 lines
27 KiB
ObjectPascal
1056 lines
27 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ RichEdit Add-In Object }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxRich;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Forms, Menus, frxClass,
|
|
RichEdit,
|
|
frxRichEdit,
|
|
frxPrinter
|
|
{$IFDEF Delphi6}
|
|
, Variants
|
|
{$ENDIF}
|
|
{$IFDEF FR_COM}
|
|
, ActiveX, AxCtrls
|
|
, ClrStream
|
|
, FastReport_TLB
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI16}
|
|
, Vcl.Controls
|
|
{$ENDIF};
|
|
|
|
|
|
{$IFDEF WIN64}
|
|
//const RichEditVersion: Integer = 3;
|
|
{$ENDIF}
|
|
|
|
type
|
|
{$IFDEF DELPHI16}
|
|
/// <summary>
|
|
/// The TfrxRichObject allows the use of thee RichText component in your
|
|
/// report. TfrxRichObject is an empty component. It is used to add the
|
|
/// frxRich.pas file to the "uses" list. The main component is TfrxRichView.
|
|
/// </summary>
|
|
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
|
|
{$ENDIF}
|
|
TfrxRichObject = class(TComponent) // fake component
|
|
end;
|
|
{$IFDEF FR_COM}
|
|
TfrxRichView = class(TfrxStretcheable, IfrxRichView)
|
|
{$ELSE}
|
|
/// <summary>
|
|
/// The TfrxRichView component represents a RichText object. Component uses
|
|
/// the RX RichEdit and allows RTF 4.1 text. You can also show RTF text
|
|
/// contained in the DB field (you should set DataSet, DataField
|
|
/// properties). RTF text may contain expressions.
|
|
/// </summary>
|
|
TfrxRichView = class(TfrxStretcheable)
|
|
{$ENDIF}
|
|
private
|
|
FAllowExpressions: Boolean;
|
|
FExpressionDelimiters: String;
|
|
FFlowTo: TfrxRichView;
|
|
FGapX: Extended;
|
|
FGapY: Extended;
|
|
FParaBreak: Boolean;
|
|
FRichEdit: TrxRichEdit;
|
|
FTempStream: TMemoryStream;
|
|
FTempStream1: TMemoryStream;
|
|
FWysiwyg: Boolean;
|
|
FHasNextDataPart: Boolean;
|
|
FStopSplit: Boolean;
|
|
FLastChar: Integer;
|
|
FFileLink: String;
|
|
function CreateMetafile: TMetafile;
|
|
function IsExprDelimitersStored: Boolean;
|
|
function UsePrinterCanvas: Boolean;
|
|
procedure ReadData(Stream: TStream);
|
|
procedure WriteData(Stream: TStream);
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
|
|
procedure AfterPrint; override;
|
|
procedure BeforePrint; override;
|
|
procedure GetData; override;
|
|
procedure InitPart; override;
|
|
function CalcHeight: Extended; override;
|
|
function DrawPart: Extended; override;
|
|
class function GetDescription: String; override;
|
|
function GetComponentText: String; override;
|
|
function HasNextDataPart(aFreeSpace: Extended): Boolean; override;
|
|
function IsEMFExportable: Boolean; override;
|
|
/// <summary>
|
|
/// Reference to internal TrxRichEdit object.
|
|
/// </summary>
|
|
property RichEdit: TrxRichEdit read FRichEdit;
|
|
published
|
|
/// <summary>
|
|
/// Determines if the RTF text may contain expressions.
|
|
/// </summary>
|
|
property AllowExpressions: Boolean read FAllowExpressions
|
|
write FAllowExpressions default True;
|
|
property BrushStyle;
|
|
property Color;
|
|
property Cursor;
|
|
property DataField;
|
|
property DataSet;
|
|
property DataSetName;
|
|
/// <summary>
|
|
/// Set of symbols, designating the expression. Default value is '[,]'.
|
|
/// You can use several symbols, for example '<%,%>'. The opening
|
|
/// and closing symbols cannot be similar, so '%,%' will not work.
|
|
/// </summary>
|
|
property ExpressionDelimiters: String read FExpressionDelimiters
|
|
write FExpressionDelimiters stored IsExprDelimitersStored;
|
|
/// <summary>
|
|
/// Link to the Rich object that will show the text that not fit in this
|
|
/// object.
|
|
/// </summary>
|
|
property FlowTo: TfrxRichView read FFlowTo write FFlowTo;
|
|
property FillType;
|
|
property Fill;
|
|
property Frame;
|
|
property FileLink: String read FFileLink write FFileLink;
|
|
/// <summary>
|
|
/// The left indent of the text, in pixels.
|
|
/// </summary>
|
|
property GapX: Extended read FGapX write FGapX;
|
|
/// <summary>
|
|
/// The top indent of the text, in pixels.
|
|
/// </summary>
|
|
property GapY: Extended read FGapY write FGapY;
|
|
property TagStr;
|
|
property URL;
|
|
/// <summary>
|
|
/// Determines if the object should use the printer canvas to format the
|
|
/// text. A printer should be installed and ready.
|
|
/// </summary>
|
|
property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True;
|
|
end;
|
|
|
|
|
|
/// <summary>
|
|
/// Method copies the RichFrom to RichTo RichEdit object.
|
|
/// </summary>
|
|
procedure frxAssignRich(RichFrom, RichTo: TrxRichEdit);
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
frxRichRTTI,
|
|
{$IFNDEF NO_EDITORS}
|
|
frxRichEditor, frxRichInPlaceEditor,
|
|
{$ENDIF}
|
|
frxUtils, frxDsgnIntf, frxRes, StrUtils
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
, SyncObjs
|
|
{$ENDIF};
|
|
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
var
|
|
frxCSRich: TCriticalSection;
|
|
{$ENDIF}
|
|
|
|
procedure frxAssignRich(RichFrom, RichTo: TrxRichEdit);
|
|
var
|
|
st: TMemoryStream;
|
|
begin
|
|
st := TMemoryStream.Create;
|
|
try
|
|
RichFrom.Lines.SaveToStream(st);
|
|
st.Position := 0;
|
|
RichTo.Lines.LoadFromStream(st);
|
|
finally
|
|
st.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TfrxRichView }
|
|
|
|
constructor TfrxRichView.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
try
|
|
{$ENDIF}
|
|
FRichEdit := TrxRichEdit.Create(nil);
|
|
FRichEdit.Parent := frxParentForm;
|
|
SendMessage(frxParentForm.Handle, WM_CREATEHANDLE, frxInteger(FRichEdit), 0);
|
|
FRichEdit.AutoURLDetect := False;
|
|
|
|
{ make rich transparent }
|
|
SetWindowLong(FRichEdit.Handle, GWL_EXSTYLE,
|
|
GetWindowLong(FRichEdit.Handle, GWL_EXSTYLE) or WS_EX_TRANSPARENT);
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
finally
|
|
frxCSRich.Leave;
|
|
end;
|
|
{$ENDIF}
|
|
FTempStream := TMemoryStream.Create;
|
|
FTempStream1 := TMemoryStream.Create;
|
|
|
|
FAllowExpressions := True;
|
|
FExpressionDelimiters := '[,]';
|
|
FGapX := 2;
|
|
FGapY := 1;
|
|
FWysiwyg := True;
|
|
FHasNextDataPart := True;
|
|
FLastChar := 0;
|
|
end;
|
|
|
|
destructor TfrxRichView.Destroy;
|
|
begin
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
try
|
|
{$ENDIF}
|
|
SendMessage(frxParentForm.Handle, WM_DESTROYHANDLE, frxInteger(FRichEdit), 0);
|
|
FRichEdit.Free;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
finally
|
|
frxCSRich.Leave;
|
|
end;
|
|
{$ENDIF}
|
|
FTempStream.Free;
|
|
FTempStream1.Free;
|
|
inherited;
|
|
end;
|
|
|
|
class function TfrxRichView.GetDescription: String;
|
|
begin
|
|
Result := frxResources.Get('obRich');
|
|
end;
|
|
|
|
function TfrxRichView.IsExprDelimitersStored: Boolean;
|
|
begin
|
|
Result := FExpressionDelimiters <> '[,]';
|
|
end;
|
|
|
|
procedure TfrxRichView.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
Filer.DefineBinaryProperty('RichEdit', ReadData, WriteData, True);
|
|
end;
|
|
|
|
procedure TfrxRichView.ReadData(Stream: TStream);
|
|
begin
|
|
FRichEdit.Lines.LoadFromStream(Stream);
|
|
end;
|
|
|
|
procedure TfrxRichView.WriteData(Stream: TStream);
|
|
begin
|
|
FRichEdit.Lines.SaveToStream(Stream);
|
|
end;
|
|
|
|
procedure TfrxRichView.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = FFlowTo) then
|
|
FFlowTo := nil;
|
|
end;
|
|
|
|
function TfrxRichView.UsePrinterCanvas: Boolean;
|
|
begin
|
|
Result := frxPrinters.HasPhysicalPrinters and FWysiwyg;
|
|
end;
|
|
|
|
function TfrxRichView.CreateMetafile: TMetafile;
|
|
var
|
|
Range: TFormatRange;
|
|
EMFCanvas: TMetafileCanvas;
|
|
PrinterHandle: THandle;
|
|
aScaleX, aScaleY: Extended;
|
|
// BottomOffset :Integer;
|
|
begin
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
{$ENDIF}
|
|
try
|
|
if UsePrinterCanvas then
|
|
PrinterHandle := frxPrinters.Printer.Canvas.Handle
|
|
else
|
|
PrinterHandle := GetDC(0);
|
|
finally
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Leave;
|
|
{$ENDIF}
|
|
end;
|
|
FillChar(Range, SizeOf(TFormatRange), 0);
|
|
|
|
Range.rc := Rect(Round(GapX * 1440 / 96), Round(GapY * 1440 / 96),
|
|
Round((Width - GapX) * 1440 / 96), Round((Height - GapY) * 1440 / 96));
|
|
Range.rcPage := Range.rc;
|
|
|
|
Result := TMetafile.Create;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
{$ENDIF}
|
|
try
|
|
GetDisplayScale(PrinterHandle, UsePrinterCanvas, aScaleX, aScaleY);
|
|
finally
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Leave;
|
|
{$ENDIF}
|
|
end;
|
|
Result.Width := Round(Width * aScaleX);
|
|
Result.Height := Round(Height * aScaleY);
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
{$ENDIF}
|
|
EMFCanvas := TMetafileCanvas.Create(Result, PrinterHandle);
|
|
|
|
EMFCanvas.Lock;
|
|
try
|
|
Range.hdc := EMFCanvas.Handle;
|
|
Range.hdcTarget := Range.hdc;
|
|
|
|
(* code to process all Rich edit page,
|
|
at this moment engine split big RTF by page tag
|
|
so this code is nessasary only for very small RTF wit pages
|
|
therefore i have commented it.
|
|
Delete in futer if none will ask it
|
|
|
|
chrg.cpMax := RichEdit.GetTextLen;
|
|
chrg.cpMin:= 0;
|
|
BottomOffset := 0;
|
|
{ process all pages in RichEdit, maybe it contain /PAGE tag}
|
|
repeat
|
|
with rc do
|
|
begin
|
|
FRichEdit.Perform(EM_FORMATRANGE, 0, frxInteger(@Range));
|
|
if Bottom > rcPage.Bottom then break;
|
|
chrg.cpMin := FRichEdit.Perform(EM_FORMATRANGE, 1, frxInteger(@Range));
|
|
Top := Top + Bottom - BottomOffset;
|
|
BottomOffset := Bottom;
|
|
Bottom := rcPage.Bottom - Bottom;
|
|
end;
|
|
until (chrg.cpMin >= chrg.cpMax) or (Height <= Round(BottomOffset / (1440.0 / 96)) + 2 * GapY + 1 );
|
|
*)
|
|
Range.chrg.cpMax := -1;
|
|
Range.chrg.cpMin := 0;
|
|
FRichEdit.SendSynchMessage(EM_FORMATRANGE, 1, frxInteger(@Range), True);
|
|
|
|
if not UsePrinterCanvas then
|
|
ReleaseDC(0, PrinterHandle);
|
|
|
|
FRichEdit.SendSynchMessage(EM_FORMATRANGE, 0, 0, True);
|
|
finally
|
|
EMFCanvas.Unlock;
|
|
EMFCanvas.Free;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Leave;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxRichView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
|
|
OffsetY: Extended);
|
|
var
|
|
EMF: TMetafile;
|
|
begin
|
|
if Height < 0 then Height := Height * (-1);
|
|
BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
|
|
DrawBackground;
|
|
EMF := CreateMetafile;
|
|
try
|
|
Canvas.StretchDraw(Rect(FX, FY, FX1, FY1), EMF);
|
|
finally
|
|
EMF.Free;
|
|
end;
|
|
|
|
if not FObjAsMetafile then
|
|
DrawFrame;
|
|
end;
|
|
|
|
procedure TfrxRichView.BeforePrint;
|
|
begin
|
|
inherited;
|
|
FTempStream.Position := 0;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
try
|
|
{$ENDIF}
|
|
FRichEdit.Lines.SaveToStream(FTempStream);
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
finally
|
|
frxCSRich.Leave;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxRichView.AfterPrint;
|
|
begin
|
|
FTempStream.Position := 0;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
try
|
|
{$ENDIF}
|
|
FRichEdit.Lines.LoadFromStream(FTempStream);
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
finally
|
|
frxCSRich.Leave;
|
|
end;
|
|
{$ENDIF}
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxRichView.GetData;
|
|
const
|
|
RTFHeader = '{\rtf';
|
|
URTFHeader = '{urtf';
|
|
type
|
|
tag_settextex = record
|
|
flags: DWORD;
|
|
codepage: UINT;
|
|
end;
|
|
var
|
|
ss: TStringStream;
|
|
i, j, TextLen, sStart, sLen: Integer;
|
|
s1, s2, dc1, dc2: String;
|
|
SetText: tag_settextex;
|
|
cf: TCharFormat2A;
|
|
{$IFDEF Delphi12}
|
|
AnsiStr: AnsiString;
|
|
{$ENDIF}
|
|
|
|
function GetSpecial(const s: String; Pos: Integer): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := 0;
|
|
for i := 1 to Pos do
|
|
{$IFDEF Delphi12}
|
|
if CharInSet(s[i], [#10, #13]) then
|
|
{$ELSE}
|
|
if s[i] in [#10, #13] then
|
|
{$ENDIF}
|
|
Inc(Result);
|
|
end;
|
|
|
|
{ this function search expression broken by new line}
|
|
{ [ }
|
|
{ IIF(1>2,'oh', }
|
|
{ 'OK') }
|
|
{ ] }
|
|
{ EM_FINDTEXTEX coldn't search text with new line }
|
|
function SearchForText(const s: String; StartPos: Integer): Boolean;
|
|
var
|
|
i, sPos, sLen, SelStart, SelEnd: Integer;
|
|
sText: String;
|
|
Sel: TCharRange;
|
|
begin
|
|
sLen := Length(s);
|
|
SelStart := -1;
|
|
sPos := 1;
|
|
for i := 1 to sLen do
|
|
{$IFDEF Delphi12}
|
|
if CharInSet(s[i], [#10, #13]) then
|
|
{$ELSE}
|
|
if s[i] in [#10, #13] then
|
|
{$ENDIF}
|
|
begin
|
|
if (sPos = i) and (i <> 2) then
|
|
begin
|
|
sPos := i + 1;
|
|
continue;
|
|
end;
|
|
sText := Copy(s, sPos, i - sPos);
|
|
Result := (FRichEdit.FindText(sText, StartPos - 1 - GetSpecial(FRichEdit.Text, StartPos) div 2, -1, [stSetSelection]) > 0);
|
|
if not Result then Exit;
|
|
|
|
Sel := FRichEdit.GetSelection;
|
|
if sPos = 1 then
|
|
SelStart := Sel.cpMin;
|
|
Inc(StartPos, Sel.cpMax - Sel.cpMin);
|
|
sPos := i + 1;
|
|
end;
|
|
if SelStart = -1 then
|
|
Result := (FRichEdit.FindText(s, StartPos - 1 - GetSpecial(FRichEdit.Text, StartPos) div 2, -1, [stSetSelection]) >= 0)
|
|
else
|
|
begin
|
|
Result := (FRichEdit.FindText(Copy(s, sPos, Length(s) - (sPos - 1)), StartPos - 1 - GetSpecial(FRichEdit.Text, StartPos) div 2, -1, [stSetSelection]) > 0);
|
|
Sel := FRichEdit.GetSelection;
|
|
SelEnd := Sel.cpMax;
|
|
FRichEdit.SetSelection(SelStart, SelEnd, False);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
inherited;
|
|
if FFileLink <> '' then
|
|
begin
|
|
s1 := FFileLink;
|
|
if Pos('[', s1) <> 0 then
|
|
ExpandVariables(s1);
|
|
if FileExists(s1) then
|
|
FRichEdit.Lines.LoadFromFile(s1);
|
|
end
|
|
else if IsDataField then
|
|
begin
|
|
if DataSet.IsBlobField(DataField) then
|
|
begin
|
|
ss := TStringStream.Create('');
|
|
DataSet.AssignBlobTo(DataField, ss)
|
|
end
|
|
else
|
|
ss := TStringStream.Create(VarToStr(DataSet.Value[DataField]));
|
|
try
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
try
|
|
{$ENDIF}
|
|
FRichEdit.Lines.LoadFromStream(ss);
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
finally
|
|
frxCSRich.Leave;
|
|
end;
|
|
{$ENDIF}
|
|
finally
|
|
ss.Free;
|
|
end;
|
|
end;
|
|
|
|
if FAllowExpressions then
|
|
begin
|
|
dc1 := FExpressionDelimiters;
|
|
dc2 := Copy(dc1, Pos(',', dc1) + 1, 255);
|
|
dc1 := Copy(dc1, 1, Pos(',', dc1) - 1);
|
|
TextLen := 0;
|
|
with FRichEdit do
|
|
try
|
|
Lines.BeginUpdate;
|
|
i := Pos(dc1, Text);
|
|
while i > 0 do
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
s1 := frxGetBrackedVariableW(Text, dc1, dc2, i, j);
|
|
{$ELSE}
|
|
s1 := frxGetBrackedVariable(Text, dc1, dc2, i, j);
|
|
{$ENDIF}
|
|
// win8.1 old detection of expression doesn't work anymore
|
|
// search it by using control, maybe litle slower , but works
|
|
// temprary solution - TODO search expressions in RAW rtf
|
|
if IsWin8 then
|
|
begin
|
|
if not SearchForText(dc1 + s1 + dc2, i) then
|
|
raise Exception.Create('Could not search for expression in RichText.');
|
|
end
|
|
else
|
|
SelStart := i - 1 - GetSpecial(Text, i) div 2;
|
|
|
|
s2 := VarToStr(Report.Calc(s1));
|
|
if IsWin8 then
|
|
i := i + Length(s2)
|
|
else
|
|
begin
|
|
SelLength := j - i + 1;
|
|
TextLen := Length(Text) - SelLength;
|
|
end;
|
|
|
|
|
|
if (Copy(s2, 1, 5) = RTFHeader) or (Copy(s2, 1, 6) = URTFHeader) then
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
AnsiStr := AnsiString(s2);
|
|
{$ENDIF}
|
|
if RichEditVersion = 4 then
|
|
begin
|
|
SetText.flags := 2;//ST_SELECTION
|
|
{$IFDEF Delphi12}
|
|
SetText.codepage := 1200;
|
|
{$ELSE}
|
|
SetText.codepage := CP_ACP;
|
|
{$ENDIF}
|
|
sStart := SelStart;
|
|
sLen := FRichEdit.SendSynchMessage(WM_USER + 97 {EM_SETTEXTEX}, frxInteger(@SetText),
|
|
frxInteger({$IFDEF Delphi12}PAnsiChar(AnsiStr){$ELSE}PChar(s2){$ENDIF}));
|
|
|
|
if IsWin8 then
|
|
begin
|
|
if not IsWin10 then
|
|
begin
|
|
cf.cbSize := sizeof(TCharFormat2A);
|
|
cf.dwMask := CFM_CHARSET;
|
|
FRichEdit.SendSynchMessage(EM_GETCHARFORMAT, SCF_SELECTION, frxInteger(@cf));
|
|
cf.dwMask := CFM_CHARSET;
|
|
SelStart := sStart;
|
|
SelLength := sLen;
|
|
FRichEdit.SendSynchMessage(EM_SETCHARFORMAT, SCF_SELECTION, frxInteger(@cf));
|
|
end;
|
|
i := i - (Length(s2) - sLen) ;
|
|
end;
|
|
|
|
{ empty line workraround }
|
|
SelStart := SelStart + SelLength - 1;
|
|
SelLength := 1;
|
|
if (SelText = #13) then
|
|
SelText := '';
|
|
end
|
|
else
|
|
FRichEdit.SendSynchMessage(EM_REPLACESEL, frxInteger(True),
|
|
frxInteger({$IFDEF Delphi12}PAnsiChar(AnsiStr){$ELSE}PChar(s2){$ENDIF}));// rich text workground
|
|
|
|
end else
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
//AnsiStr := AnsiString(s2);
|
|
{$ENDIF}
|
|
if RichEditVersion = 4 then
|
|
begin
|
|
SetText.flags := 2;//ST_SELECTION
|
|
{$IFDEF Delphi12}
|
|
SetText.codepage := 1200;
|
|
//SetText.codepage := CP_ACP;
|
|
{$ELSE}
|
|
SetText.codepage := CP_ACP;
|
|
{$ENDIF}
|
|
FRichEdit.SendSynchMessage(WM_USER + 97 {EM_SETTEXTEX}, frxInteger(@SetText),
|
|
frxInteger({$IFDEF Delphi12}s2{$ELSE}PChar(s2){$ENDIF}));
|
|
{ empty line workraround }
|
|
if SelLength > 0 then
|
|
begin
|
|
SelStart := SelStart + SelLength - 1;
|
|
SelLength := 1;
|
|
if (SelText = #13) then
|
|
SelText := '';
|
|
end;
|
|
end
|
|
else
|
|
SelText := s2;
|
|
end;
|
|
if IsWin8 then
|
|
i := PosEx(dc1, Text, i)
|
|
else
|
|
i := PosEx(dc1, Text, i + Length(Text) - TextLen);
|
|
end;
|
|
finally
|
|
Lines.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
if FFlowTo <> nil then
|
|
begin
|
|
InitPart;
|
|
DrawPart;
|
|
FTempStream1.Position := 0;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
try
|
|
{$ENDIF}
|
|
FlowTo.RichEdit.Lines.LoadFromStream(FTempStream1);
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
finally
|
|
frxCSRich.Leave;
|
|
end;
|
|
{$ENDIF}
|
|
FFlowTo.AllowExpressions := False;
|
|
end;
|
|
end;
|
|
|
|
function TfrxRichView.CalcHeight: Extended;
|
|
var
|
|
Range: TFormatRange;
|
|
chrgRange: TCharRange;
|
|
rcBottom: Integer;
|
|
begin
|
|
FillChar(Range, SizeOf(TFormatRange), 0);
|
|
Result := 0;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
try
|
|
{$ENDIF}
|
|
with Range do
|
|
begin
|
|
rc := Rect(0, 0, Round((Width - GapX * 2) * 1440 / 96),
|
|
Round(1000000 * 1440.0 / 96));
|
|
rcPage := rc;
|
|
|
|
if UsePrinterCanvas then
|
|
hdc := frxPrinters.Printer.Canvas.Handle
|
|
else
|
|
hdc := GetDC(0);
|
|
hdcTarget := hdc;
|
|
chrgRange.cpMax := RichEdit.GetTextLen;
|
|
|
|
chrg.cpMax := -1;
|
|
chrg.cpMin := 0;
|
|
rcBottom := 0;
|
|
{ process all pages in RichEdit, maybe it contain /PAGE tag }
|
|
// FRichEdit.Perform(EM_SETSEL, -1, -1);
|
|
repeat
|
|
rc := rcPage;
|
|
chrg.cpMin := FRichEdit.SendSynchMessage(EM_FORMATRANGE, 0, frxInteger(@Range), True);
|
|
rcBottom := rcBottom + rc.Bottom;
|
|
until (chrg.cpMin >= chrgRange.cpMax);
|
|
|
|
if chrgRange.cpMax = 0 then
|
|
Result := 0
|
|
else
|
|
Result := Result + Round(rcBottom / (1440.0 / 96)) + 2 * GapY + 2;
|
|
|
|
if not UsePrinterCanvas then
|
|
ReleaseDC(0, hdc);
|
|
end;
|
|
FRichEdit.SendSynchMessage(EM_FORMATRANGE, 0, 0, True);
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
finally
|
|
frxCSRich.Leave;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TfrxRichView.DrawPart: Extended;
|
|
var
|
|
Range: TFormatRange;
|
|
LastChar: Integer;
|
|
begin
|
|
{ text can't fit }
|
|
if (Round((Height - GapY * 2)) <= 0)then
|
|
begin
|
|
Result := Height;
|
|
FHasNextDataPart := True;
|
|
Exit;
|
|
end;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
try
|
|
{$ENDIF}
|
|
{ get remained part of text }
|
|
FTempStream1.Position := 0;
|
|
FRichEdit.Lines.LoadFromStream(FTempStream1);
|
|
if FParaBreak then
|
|
with FRichEdit.Paragraph do
|
|
begin
|
|
FirstIndent := FirstIndent + LeftIndent;
|
|
FRichEdit.Paragraph.LeftIndent := 0;
|
|
end;
|
|
{ calculate the last visible char }
|
|
FillChar(Range, SizeOf(TFormatRange), 0);
|
|
|
|
with Range do
|
|
begin
|
|
rc := Rect(0, 0, Round((Width - GapX * 2) * 1440 / 96),
|
|
Round((Height - GapY * 2) * 1440 / 96));
|
|
rcPage := rc;
|
|
if UsePrinterCanvas then
|
|
hdc := frxPrinters.Printer.Canvas.Handle
|
|
else
|
|
hdc := GetDC(0);
|
|
hdcTarget := hdc;
|
|
|
|
FRichEdit.SendSynchMessage(EM_SETSEL, WPARAM(-1), LPARAM(-1), True);
|
|
// need for RE 4.1 and tables
|
|
chrg.cpMin := 0;
|
|
chrg.cpMax := -1;
|
|
|
|
{ RTF4.1 trying to place data, if data doesn't fit decrease line index and try again }
|
|
{ need for tables and object in richedit }
|
|
repeat
|
|
LastChar := FRichEdit.SendSynchMessage(EM_FORMATRANGE, 0, frxInteger(@Range), True);
|
|
if (LastChar = -1) then
|
|
break; // can't be split
|
|
if chrg.cpMax <> -1 then
|
|
LastChar := chrg.cpMax;
|
|
chrg.cpMax := FRichEdit.LineFromChar(LastChar - 1) - 1;
|
|
if chrg.cpMax <= 0 then
|
|
break;
|
|
chrg.cpMax := FRichEdit.GetLineIndex(chrg.cpMax);
|
|
|
|
until ((rcPage.Bottom - rc.Bottom >= 0) or (chrg.cpMax = LastChar));
|
|
|
|
Result := Round((rcPage.Bottom - rc.Bottom) / (1440.0 / 96));
|
|
if Result > 0 then
|
|
Result := Result + GapY * 2 + 2;
|
|
|
|
if not UsePrinterCanvas then
|
|
ReleaseDC(0, hdc);
|
|
|
|
FRichEdit.SendSynchMessage(EM_FORMATRANGE, 0, 0, True);
|
|
end;
|
|
|
|
{ text can't fit }
|
|
try
|
|
if (Result < 0) then
|
|
begin
|
|
Result := Height;
|
|
if FLastChar = LastChar then
|
|
begin
|
|
FHasNextDataPart := False;
|
|
FStopSplit := True;
|
|
end;
|
|
exit;
|
|
end;
|
|
finally
|
|
FLastChar := LastChar;
|
|
end;
|
|
|
|
{ copy the outbounds text to the temp stream }
|
|
try
|
|
if LastChar > 1 then
|
|
begin
|
|
FRichEdit.SelStart := LastChar - 1;
|
|
FRichEdit.SelLength := 1;
|
|
FParaBreak := FRichEdit.SelText <> #13;
|
|
end;
|
|
|
|
FRichEdit.SelStart := LastChar;
|
|
FRichEdit.SelLength := RichEdit.GetTextLen - LastChar + 1;
|
|
|
|
if FRichEdit.SelLength <= 1 then
|
|
begin
|
|
Result := 0;
|
|
FHasNextDataPart := False;
|
|
end
|
|
else
|
|
FHasNextDataPart := True;
|
|
|
|
FTempStream1.Clear;
|
|
FRichEdit.StreamMode := [smSelection];
|
|
if FHasNextDataPart then
|
|
FRichEdit.Lines.SaveToStream(FTempStream1);
|
|
FRichEdit.SelText := '';
|
|
finally
|
|
FRichEdit.StreamMode := [];
|
|
{ bug fix when the last line hides }
|
|
FRichEdit.Paragraph.SpaceAfter := 0;
|
|
FRichEdit.Paragraph.SpaceBefore := 0;
|
|
FRichEdit.SendSynchMessage(EM_SETSEL, WPARAM(-1), LPARAM(-1));
|
|
end;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
finally
|
|
frxCSRich.Leave;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxRichView.InitPart;
|
|
begin
|
|
FTempStream1.Clear;
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Enter;
|
|
try
|
|
{$ENDIF}
|
|
FRichEdit.Lines.SaveToStream(FTempStream1);
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
finally
|
|
frxCSRich.Leave;
|
|
end;
|
|
{$ENDIF}
|
|
FParaBreak := False;
|
|
FHasNextDataPart := True;
|
|
FStopSplit := False;
|
|
FLastChar := 0;
|
|
end;
|
|
|
|
function TfrxRichView.GetComponentText: String;
|
|
var
|
|
FTStream: TMemoryStream;
|
|
{$IFDEF Delphi12}
|
|
TempStr: AnsiString;
|
|
{$ENDIF}
|
|
begin
|
|
if PlainText then
|
|
begin
|
|
FTStream := TMemoryStream.Create;
|
|
try
|
|
FTempStream.Clear;
|
|
FRichEdit.Lines.SaveToStream(FTStream);
|
|
FRichEdit.PlainText := True;
|
|
FRichEdit.Lines.SaveToStream(FTempStream);
|
|
{$IFDEF Delphi12}
|
|
SetLength(TempStr, FTempStream.Size);
|
|
FTempStream.Position := 0;
|
|
FTempStream.Read(TempStr[1], FTempStream.Size);
|
|
Result := String(TempStr);
|
|
{$ELSE}
|
|
SetLength(Result, FTempStream.Size);
|
|
FTempStream.Position := 0;
|
|
FTempStream.Read(Result[1], FTempStream.Size);
|
|
{$ENDIF}
|
|
FRichEdit.PlainText := False;
|
|
FTStream.Position := 0;
|
|
FRichEdit.Lines.LoadFromStream(FTStream);
|
|
finally
|
|
FTStream.Free;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
FTempStream.Clear;
|
|
FRichEdit.Lines.SaveToStream(FTempStream);
|
|
{$IFDEF Delphi12}
|
|
SetLength(TempStr, FTempStream.Size);
|
|
FTempStream.Position := 0;
|
|
FTempStream.Read(TempStr[1], FTempStream.Size);
|
|
Result := String(TempStr);
|
|
{$ELSE}
|
|
SetLength(Result, FTempStream.Size);
|
|
FTempStream.Position := 0;
|
|
FTempStream.Read(Result[1], FTempStream.Size);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function TfrxRichView.HasNextDataPart(aFreeSpace: Extended): Boolean;
|
|
begin
|
|
Result := FHasNextDataPart and (StretchMode <> smDontStretch) or
|
|
(Inherited HasNextDataPart(aFreeSpace) and not FStopSplit {and (StretchMode = smDontStretch)});
|
|
end;
|
|
|
|
function TfrxRichView.IsEMFExportable: Boolean;
|
|
begin
|
|
Result := AllowVectorExport;
|
|
end;
|
|
|
|
{$IFDEF FR_COM}
|
|
function TfrxRichView.LoadViewFromStream(const Stream: IUnknown): HResult; stdcall;
|
|
var
|
|
ComStream: IStream;
|
|
OleStream: TOleStream;
|
|
|
|
NetStream: _Stream;
|
|
ClrStream: TClrStream;
|
|
begin
|
|
try
|
|
Result := Stream.QueryInterface(IStream, ComStream);
|
|
if Result = S_OK then
|
|
begin
|
|
OleStream := TOleStream.Create(ComStream);
|
|
ReadData(OleStream);
|
|
OleStream.Free;
|
|
ComStream := nil;
|
|
end
|
|
else
|
|
begin
|
|
Result := Stream.QueryInterface(_Stream, NetStream);
|
|
if Result = S_OK then
|
|
begin
|
|
ClrStream := TClrStream.Create(NetStream);
|
|
ReadData(ClrStream);
|
|
ClrStream.Free;
|
|
NetStream._Release();
|
|
end;
|
|
end;
|
|
except
|
|
Result := E_FAIL;
|
|
end;
|
|
end;
|
|
|
|
function TfrxRichView.SaveViewToStream(const Stream: IUnknown): HResult; stdcall;
|
|
var
|
|
ComStream: IStream;
|
|
OleStream: TOleStream;
|
|
|
|
NetStream: _Stream;
|
|
ClrStream: TClrStream;
|
|
begin
|
|
try
|
|
Result := Stream.QueryInterface(IStream, ComStream);
|
|
if Result = S_OK then
|
|
begin
|
|
OleStream := TOleStream.Create(ComStream);
|
|
WriteData(OleStream);
|
|
OleStream.Free;
|
|
ComStream := nil;
|
|
end
|
|
else
|
|
begin
|
|
Result := Stream.QueryInterface(_Stream, NetStream);
|
|
if Result = S_OK then
|
|
begin
|
|
ClrStream := TClrStream.Create(NetStream);
|
|
WriteData(ClrStream);
|
|
ClrStream.Free;
|
|
NetStream._Release();
|
|
end;
|
|
end;
|
|
except
|
|
Result := E_FAIL;
|
|
end;
|
|
end;
|
|
|
|
function TfrxRichView.Get_RichAlign(out Value: frxHAlign): HResult; stdcall;
|
|
begin
|
|
Result := S_OK;
|
|
Value := frxHAlign(FRichEdit.Paragraph.Alignment);
|
|
end;
|
|
|
|
function TfrxRichView.Set_RichAlign(Value: frxHAlign): HResult; stdcall;
|
|
begin
|
|
Result := S_OK;
|
|
FRichEdit.SelectAll;
|
|
case Value of
|
|
hAlignLeft: FRichEdit.Paragraph.Alignment := paLeftJustify;
|
|
hAlignRight: FRichEdit.Paragraph.Alignment := paRightJustify;
|
|
hAlignCenter: FRichEdit.Paragraph.Alignment := paCenter;
|
|
hAlignBlock: FRichEdit.Paragraph.Alignment := paJustify;
|
|
else Result := E_FAIL;
|
|
end;
|
|
end;
|
|
|
|
function TfrxRichView.Get_WYSIWIG(out Value: WordBool): HResult; stdcall;
|
|
begin
|
|
Value := FWysiwyg;
|
|
Result := S_OK;
|
|
end;
|
|
|
|
function TfrxRichView.Set_WYSIWIG(Value: WordBool): HResult; stdcall;
|
|
begin
|
|
FWysiwyg := Value;
|
|
Result := S_OK;
|
|
end;
|
|
|
|
function TfrxRichView.Get_AllowExpressions(out Value: WordBool): HResult; stdcall;
|
|
begin
|
|
Value := FAllowExpressions;
|
|
Result := S_OK;
|
|
end;
|
|
|
|
function TfrxRichView.Set_AllowExpressions(Value: WordBool): HResult; stdcall;
|
|
begin
|
|
FAllowExpressions := Value;
|
|
Result := S_OK;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
initialization
|
|
{$IFDEF DELPHI16}
|
|
StartClassGroup(TControl);
|
|
ActivateClassGroup(TControl);
|
|
GroupDescendentsWith(TfrxRichObject, TControl);
|
|
{$ENDIF}
|
|
frxObjects.RegisterObject1(TfrxRichView, nil, '', '', 0, 26);
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich := TCriticalSection.Create;
|
|
{$ENDIF}
|
|
|
|
finalization
|
|
frxObjects.UnRegister(TfrxRichView);
|
|
{$IFNDEF NO_CRITICAL_SECTION}
|
|
frxCSRich.Free;
|
|
{$ENDIF}
|
|
|
|
|
|
end.
|