david
3b72eb27ca
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.FastReport@22 475b051d-3a53-6940-addd-820bf0cfe0d7
536 lines
13 KiB
ObjectPascal
536 lines
13 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v4.0 }
|
|
{ RichEdit Add-In Object }
|
|
{ }
|
|
{ Copyright (c) 1998-2008 }
|
|
{ by Alexander Tzyganenko, }
|
|
{ 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}
|
|
;
|
|
|
|
|
|
type
|
|
TfrxRichObject = class(TComponent) // fake component
|
|
end;
|
|
|
|
|
|
TfrxRichView = class(TfrxStretcheable)
|
|
|
|
private
|
|
FAllowExpressions: Boolean;
|
|
FExpressionDelimiters: String;
|
|
FFlowTo: TfrxRichView;
|
|
FGapX: Extended;
|
|
FGapY: Extended;
|
|
FParaBreak: Boolean;
|
|
FRichEdit: TrxRichEdit;
|
|
FTempStream: TMemoryStream;
|
|
FTempStream1: TMemoryStream;
|
|
FWysiwyg: Boolean;
|
|
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;
|
|
property RichEdit: TrxRichEdit read FRichEdit;
|
|
published
|
|
property AllowExpressions: Boolean read FAllowExpressions
|
|
write FAllowExpressions default True;
|
|
property BrushStyle;
|
|
property Color;
|
|
property Cursor;
|
|
property DataField;
|
|
property DataSet;
|
|
property DataSetName;
|
|
property ExpressionDelimiters: String read FExpressionDelimiters
|
|
write FExpressionDelimiters stored IsExprDelimitersStored;
|
|
property FlowTo: TfrxRichView read FFlowTo write FFlowTo;
|
|
property Frame;
|
|
property GapX: Extended read FGapX write FGapX;
|
|
property GapY: Extended read FGapY write FGapY;
|
|
property TagStr;
|
|
property URL;
|
|
property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True;
|
|
end;
|
|
|
|
|
|
procedure frxAssignRich(RichFrom, RichTo: TrxRichEdit);
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
frxRichRTTI,
|
|
{$IFNDEF NO_EDITORS}
|
|
frxRichEditor,
|
|
{$ENDIF}
|
|
frxUtils, frxDsgnIntf, frxRes;
|
|
|
|
|
|
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;
|
|
FRichEdit := TrxRichEdit.Create(nil);
|
|
FRichEdit.Parent := frxParentForm;
|
|
SendMessage(frxParentForm.Handle, WM_CREATEHANDLE, Integer(FRichEdit), 0);
|
|
FRichEdit.AutoURLDetect := False;
|
|
{ make rich transparent }
|
|
SetWindowLong(FRichEdit.Handle, GWL_EXSTYLE,
|
|
GetWindowLong(FRichEdit.Handle, GWL_EXSTYLE) or WS_EX_TRANSPARENT);
|
|
|
|
FTempStream := TMemoryStream.Create;
|
|
FTempStream1 := TMemoryStream.Create;
|
|
|
|
FAllowExpressions := True;
|
|
FExpressionDelimiters := '[,]';
|
|
FGapX := 2;
|
|
FGapY := 1;
|
|
FWysiwyg := True;
|
|
end;
|
|
|
|
destructor TfrxRichView.Destroy;
|
|
begin
|
|
SendMessage(frxParentForm.Handle, WM_DESTROYHANDLE, Integer(FRichEdit), 0);
|
|
FRichEdit.Free;
|
|
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;
|
|
begin
|
|
if UsePrinterCanvas then
|
|
PrinterHandle := frxPrinters.Printer.Canvas.Handle
|
|
else
|
|
PrinterHandle := GetDC(0);
|
|
FillChar(Range, SizeOf(TFormatRange), 0);
|
|
|
|
with Range do
|
|
begin
|
|
rc := Rect(Round(GapX * 1440 / 96), Round(GapY * 1440 / 96),
|
|
Round((Width - GapX) * 1440 / 96),
|
|
Round((Height - GapY) * 1440 / 96));
|
|
rcPage := rc;
|
|
|
|
Result := TMetafile.Create;
|
|
Result.Width := Round(Width * GetDeviceCaps(PrinterHandle, LOGPIXELSX) / 96);
|
|
Result.Height := Round(Height * GetDeviceCaps(PrinterHandle, LOGPIXELSY) / 96);
|
|
|
|
EMFCanvas := TMetafileCanvas.Create(Result, PrinterHandle);
|
|
hdc := EMFCanvas.Handle;
|
|
hdcTarget := hdc;
|
|
|
|
chrg.cpMin := 0;
|
|
chrg.cpMax := -1;
|
|
FRichEdit.Perform(EM_FORMATRANGE, 1, Integer(@Range));
|
|
end;
|
|
|
|
if not UsePrinterCanvas then
|
|
ReleaseDC(0, PrinterHandle);
|
|
|
|
FRichEdit.Perform(EM_FORMATRANGE, 0, 0);
|
|
EMFCanvas.Free;
|
|
end;
|
|
|
|
procedure TfrxRichView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
|
|
OffsetY: Extended);
|
|
var
|
|
EMF: TMetafile;
|
|
begin
|
|
BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
|
|
DrawBackground;
|
|
|
|
EMF := CreateMetafile;
|
|
try
|
|
Canvas.StretchDraw(Rect(FX, FY, FX1, FY1), EMF);
|
|
finally
|
|
EMF.Free;
|
|
end;
|
|
|
|
DrawFrame;
|
|
end;
|
|
|
|
procedure TfrxRichView.BeforePrint;
|
|
begin
|
|
inherited;
|
|
FTempStream.Position := 0;
|
|
FRichEdit.Lines.SaveToStream(FTempStream);
|
|
end;
|
|
|
|
procedure TfrxRichView.AfterPrint;
|
|
begin
|
|
FTempStream.Position := 0;
|
|
FRichEdit.Lines.LoadFromStream(FTempStream);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxRichView.GetData;
|
|
var
|
|
ss: TStringStream;
|
|
i, j, TextLen: Integer;
|
|
s1, s2, dc1, dc2: String;
|
|
|
|
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;
|
|
|
|
function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
|
|
var
|
|
I,X: Integer;
|
|
Len, LenSubStr: Integer;
|
|
begin
|
|
if Offset = 1 then
|
|
Result := Pos(SubStr, S)
|
|
else
|
|
begin
|
|
I := Offset;
|
|
LenSubStr := Length(SubStr);
|
|
Len := Length(S) - LenSubStr + 1;
|
|
while I <= Len do
|
|
begin
|
|
if S[I] = SubStr[1] then
|
|
begin
|
|
X := 1;
|
|
while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
|
|
Inc(X);
|
|
if (X = LenSubStr) then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
end;
|
|
Inc(I);
|
|
end;
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
inherited;
|
|
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
|
|
FRichEdit.Lines.LoadFromStream(ss);
|
|
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);
|
|
|
|
with FRichEdit do
|
|
try
|
|
Lines.BeginUpdate;
|
|
|
|
i := Pos(dc1, Text);
|
|
while i > 0 do
|
|
begin
|
|
SelStart := i - 1 - GetSpecial(Text, i) div 2;
|
|
{$IFDEF Delphi12}
|
|
s1 := frxGetBrackedVariableW(Text, dc1, dc2, i, j);
|
|
{$ELSE}
|
|
s1 := frxGetBrackedVariable(Text, dc1, dc2, i, j);
|
|
{$ENDIF}
|
|
s2 := VarToStr(Report.Calc(s1));
|
|
|
|
SelLength := j - i + 1;
|
|
TextLen := Length(Text) - SelLength;
|
|
SelText := s2;
|
|
|
|
i := PosEx(dc1, Text, i + Length(Text) - TextLen);
|
|
end;
|
|
finally
|
|
Lines.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
if FFlowTo <> nil then
|
|
begin
|
|
InitPart;
|
|
DrawPart;
|
|
FTempStream1.Position := 0;
|
|
FlowTo.RichEdit.Lines.LoadFromStream(FTempStream1);
|
|
FFlowTo.AllowExpressions := False;
|
|
end;
|
|
end;
|
|
|
|
function TfrxRichView.CalcHeight: Extended;
|
|
var
|
|
Range: TFormatRange;
|
|
begin
|
|
FillChar(Range, SizeOf(TFormatRange), 0);
|
|
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;
|
|
|
|
chrg.cpMin := 0;
|
|
chrg.cpMax := -1;
|
|
FRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@Range));
|
|
|
|
if not UsePrinterCanvas then
|
|
ReleaseDC(0, hdc);
|
|
if RichEdit.GetTextLen = 0 then
|
|
Result := 0
|
|
else
|
|
Result := Round(rc.Bottom / (1440.0 / 96)) + 2 * GapY + 2;
|
|
end;
|
|
|
|
FRichEdit.Perform(EM_FORMATRANGE, 0, 0);
|
|
end;
|
|
|
|
function TfrxRichView.DrawPart: Extended;
|
|
var
|
|
Range: TFormatRange;
|
|
LastChar: Integer;
|
|
begin
|
|
{ get remained part of text }
|
|
FTempStream1.Position := 0;
|
|
FRichEdit.Lines.LoadFromStream(FTempStream1);
|
|
if FParaBreak then
|
|
begin
|
|
// FRichEdit.SelStart := 1;
|
|
// FRichEdit.SelLength := 1;
|
|
FRichEdit.Paragraph.FirstIndent := 0;
|
|
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;
|
|
|
|
chrg.cpMin := 0;
|
|
chrg.cpMax := -1;
|
|
LastChar := FRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@Range));
|
|
Result := Round((rcPage.Bottom - rc.Bottom) / (1440.0 / 96)) + 2 * GapY + 0.1;
|
|
|
|
if not UsePrinterCanvas then
|
|
ReleaseDC(0, hdc);
|
|
end;
|
|
FRichEdit.Perform(EM_FORMATRANGE, 0, 0);
|
|
|
|
{ text can't fit }
|
|
if Result < 0 then
|
|
begin
|
|
Result := Height;
|
|
Exit;
|
|
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 := FRichEdit.GetTextLen - LastChar + 1;
|
|
if FRichEdit.SelLength = 1 then
|
|
Result := 0;
|
|
FTempStream1.Clear;
|
|
FRichEdit.StreamMode := [smSelection];
|
|
FRichEdit.Lines.SaveToStream(FTempStream1);
|
|
FRichEdit.SelText := '';
|
|
finally
|
|
FRichEdit.StreamMode := [];
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxRichView.InitPart;
|
|
begin
|
|
FTempStream1.Clear;
|
|
FRichEdit.Lines.SaveToStream(FTempStream1);
|
|
FParaBreak := False;
|
|
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;
|
|
|
|
|
|
|
|
initialization
|
|
frxObjects.RegisterObject1(TfrxRichView, nil, '', '', 0, 26);
|
|
|
|
finalization
|
|
frxObjects.UnRegister(TfrxRichView);
|
|
|
|
|
|
end.
|
|
|
|
|
|
//
|