1299 lines
31 KiB
ObjectPascal
1299 lines
31 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v4.0 }
|
|
{ Designer controls }
|
|
{ }
|
|
{ Copyright (c) 1998-2008 }
|
|
{ by Alexander Tzyganenko, }
|
|
{ Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit FMX.frxDesgnCtrls;
|
|
|
|
interface
|
|
|
|
{$I fmx.inc}
|
|
{$I frx.inc}
|
|
{$I fmx.inc}
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Objects, FMX.Types,
|
|
FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Layouts, FMX.frxClass, FMX.frxPictureCache,
|
|
System.Variants, FMX.TabControl, System.UIConsts
|
|
{$IFDEF DELPHI18}
|
|
,FMX.StdCtrls
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI19}
|
|
, FMX.Graphics
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI20}
|
|
, System.Math.Vectors
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI28}
|
|
, FMX.BaseTypeAliases, FMX.FormTypeAliases
|
|
{$ENDIF};
|
|
|
|
|
|
type
|
|
TfrxRulerUnits = (ruCM, ruInches, ruPixels, ruChars);
|
|
{$I frxFMX_PlatformsAttribute.inc}
|
|
TfrxRuler = class(TPanel)
|
|
private
|
|
FOffset: Integer;
|
|
FScale: Double;
|
|
FStart: Integer;
|
|
FUnits: TfrxRulerUnits;
|
|
FPosition: Double;
|
|
FRulerSize: Integer;
|
|
FBitmap: TBitmap;
|
|
FNeedRedraw: Boolean;
|
|
FBackgroundColor: TAlphaColor;
|
|
procedure SetOffset(const Value: Integer);
|
|
procedure SetScale(const Value: Double);
|
|
procedure SetStart(const Value: Integer);
|
|
procedure SetUnits(const Value: TfrxRulerUnits);
|
|
procedure SetPosition(const Value: Double);
|
|
procedure SetRulerSize(const Value: Integer);
|
|
protected
|
|
procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); virtual;
|
|
procedure DrawRuler;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure ApplyStyle; override;
|
|
published
|
|
property Offset: Integer read FOffset write SetOffset;
|
|
property Scale: Double read FScale write SetScale;
|
|
property Start: Integer read FStart write SetStart;
|
|
property Units: TfrxRulerUnits read FUnits write SetUnits default ruPixels;
|
|
property RulePosition: Double read FPosition write SetPosition;
|
|
property RulerSize: Integer read FRulerSize write SetRulerSize;
|
|
end;
|
|
|
|
TfrxScrollBox = class(TScrollBox)
|
|
private
|
|
FContent: TContent;
|
|
FOnPositionChanged: TNotifyEvent;
|
|
protected
|
|
procedure ApplyStyle; override;
|
|
procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); virtual;
|
|
procedure DialogKey(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
|
|
procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
|
|
{$IFDEF DELPHI18}
|
|
procedure HScrollChange; override;
|
|
procedure VScrollChange; override;
|
|
{$ELSE}
|
|
procedure HScrollChange(Sender: TObject); override;
|
|
procedure VScrollChange(Sender: TObject); override;
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI18}
|
|
// public
|
|
// property HScrollBar;
|
|
// property VScrollBar;
|
|
{$ENDIF}
|
|
published
|
|
property OnPositionChanged: TNotifyEvent read FOnPositionChanged write FOnPositionChanged;
|
|
end;
|
|
|
|
TfrxTabControl = class(TTabControl)
|
|
protected
|
|
procedure ApplyStyle; override;
|
|
end;
|
|
|
|
TfrxCustomSelector = class(TPopup)
|
|
protected
|
|
FMouseOver: Boolean;
|
|
FX, FY: Single;
|
|
procedure DrawEdge(X, Y: Single); virtual; abstract;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
|
|
procedure DoMouseEnter; override;
|
|
procedure DoMouseLeave; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure Popup(AControl: TControl); reintroduce; overload;
|
|
end;
|
|
|
|
TfrxColorSelector = class(TfrxCustomSelector)
|
|
private
|
|
FColor: TColor;
|
|
FOnColorChanged: TNotifyEvent;
|
|
FBtnCaption: String;
|
|
protected
|
|
procedure DrawEdge(X, Y: Single); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Single); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure DoPaint; override;
|
|
property Color: TColor read FColor write FColor;
|
|
property OnColorChanged: TNotifyEvent read FOnColorChanged write FOnColorChanged;
|
|
property BtnCaption: String read FBtnCaption write FBtnCaption;
|
|
end;
|
|
|
|
TfrxLineSelector = class(TfrxCustomSelector)
|
|
private
|
|
FStyle: Byte;
|
|
FOnStyleChanged: TNotifyEvent;
|
|
protected
|
|
procedure DrawEdge(X, Y: Single); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Single); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure DoPaint; override;
|
|
property Style: Byte read FStyle;
|
|
property OnStyleChanged: TNotifyEvent read FOnStyleChanged write FOnStyleChanged;
|
|
end;
|
|
|
|
TfrxUndoBuffer = class(TObject)
|
|
private
|
|
FPictureCache: TfrxPictureCache;
|
|
FRedo: TList;
|
|
FUndo: TList;
|
|
function GetRedoCount: Integer;
|
|
function GetUndoCount: Integer;
|
|
procedure SetPictureFlag(ReportComponent: TfrxComponent; Flag: Boolean);
|
|
procedure SetPictures(ReportComponent: TfrxComponent);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure AddUndo(ReportComponent: TfrxComponent);
|
|
procedure AddRedo(ReportComponent: TfrxComponent);
|
|
procedure GetUndo(ReportComponent: TfrxComponent);
|
|
procedure GetRedo(ReportComponent: TfrxComponent);
|
|
procedure ClearUndo;
|
|
procedure ClearRedo;
|
|
property UndoCount: Integer read GetUndoCount;
|
|
property RedoCount: Integer read GetRedoCount;
|
|
property PictureCache: TfrxPictureCache read FPictureCache write FPictureCache;
|
|
end;
|
|
|
|
TfrxClipboard = class(TObject)
|
|
private
|
|
FDesigner: TfrxCustomDesigner;
|
|
FPictureCache: TfrxPictureCache;
|
|
function GetPasteAvailable: Boolean;
|
|
public
|
|
constructor Create(ADesigner: TfrxCustomDesigner);
|
|
procedure Copy;
|
|
procedure Paste;
|
|
property PasteAvailable: Boolean read GetPasteAvailable;
|
|
property PictureCache: TfrxPictureCache read FPictureCache write FPictureCache;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Math, FMX.frxDMPClass, FMX.frxDsgnIntf, FMX.frxCtrls, FMX.frxXMLSerializer, FMX.Platform,
|
|
FMX.frxUtils, FMX.frxXML, FMX.frxFMX;
|
|
|
|
const
|
|
Colors: array[0..47] of TAlphaColor =
|
|
(claNull, claWhite, claBlack, claMaroon, claGreen, claOlive, claNavy, claPurple,
|
|
claGray, claSilver, claTeal, claRed, claLime, claYellow, claBlue, claFuchsia,
|
|
$FFCCCCCC, $FFE4E4E4, claAqua, $FF00CCFF, $FF00CC98, $FF98FFFF, $FFFFCC00, $FFFF98CC,
|
|
$FFD8D8D8, $FFF0F0F0, $FFFFFFDC, $FFCAE4FF, $FFCCFFCC, $FFCCFFFF, $FFFFF4CC, $FFCC98FF,
|
|
claGray, $FF46DAFF, $FF9BEBFF, $FF00A47B, $FFFDBD97, $FFFED3BA, $FF6ACFFF, $FFFFF4CC,
|
|
claGray, claGray, claGray, claGray, claGray, claGray, claGray, claGray);
|
|
|
|
|
|
|
|
{ TfrxRuler }
|
|
|
|
procedure TfrxRuler.ApplyStyle;
|
|
var
|
|
StyleObject: TFmxObject;
|
|
begin
|
|
inherited;
|
|
StyleObject := GetStyleObject;
|
|
try
|
|
if StyleObject is TRectangle then
|
|
FBackgroundColor := TRectangle(StyleObject).Fill.Color
|
|
finally
|
|
StyleObject.Free;
|
|
end;
|
|
end;
|
|
|
|
constructor TfrxRuler.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FScale := 1;
|
|
OnPaint := DoContentPaint;
|
|
StyleLookup := 'backgroundstyle';
|
|
FBackgroundColor := $FFF5F5F5;
|
|
FBitmap := TBitmap.Create(1, 1);
|
|
FNeedRedraw := True;
|
|
end;
|
|
|
|
destructor TfrxRuler.Destroy;
|
|
begin
|
|
FBitmap.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxRuler.DoContentPaint(Sender: TObject; Canvas: TCanvas;
|
|
const ARect: TRectF);
|
|
var
|
|
SaveState: TCanvasSaveState;
|
|
|
|
procedure Line(x, y, dx, dy: Integer);
|
|
begin
|
|
Canvas.DrawLine(PointF(x + 0.5, y + 0.5), PointF(x + dx + 0.5, y + dy + 0.5), 1);
|
|
end;
|
|
|
|
procedure DrawLines;
|
|
var
|
|
i, dx: Single;
|
|
ofs: Integer;
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
Stroke.Color := claBlack;
|
|
Stroke.Kind := TBrushKind.bkSolid;
|
|
Fill.Kind := TBrushKind.bkNone;
|
|
|
|
if FUnits = ruCM then
|
|
dx := fr01cm * FScale
|
|
else if FUnits = ruInches then
|
|
dx := fr01in * FScale
|
|
else if FUnits = ruChars then
|
|
begin
|
|
if Align = TAlignLayout.alLeft then
|
|
dx := fr1CharY * FScale / 10 else
|
|
dx := fr1CharX * FScale / 10
|
|
end
|
|
else
|
|
dx := FScale;
|
|
|
|
ofs := FOffset - FStart;
|
|
if FUnits = ruChars then
|
|
begin
|
|
if Align = TAlignLayout.alLeft then
|
|
Inc(ofs, Round(fr1CharY * FScale / 2)) else
|
|
Inc(ofs, Round(fr1CharX * FScale / 2))
|
|
end;
|
|
i := FPosition * dx;
|
|
if FUnits <> ruPixels then
|
|
i := i * 10;
|
|
if ofs + i >= FOffset then
|
|
if Align = TAlignLayout.alLeft then
|
|
Line(3, ofs + Round(i), 13, 0) else
|
|
Line(ofs + Round(i), 3, 0, 13);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if FNeedRedraw then
|
|
begin
|
|
FNeedRedraw := False;
|
|
DrawRuler;
|
|
end;
|
|
|
|
SaveState := Canvas.SaveState;
|
|
try
|
|
Canvas.IntersectClipRect(ARect);
|
|
Canvas.DrawBitmap(FBitmap, RectF(0, 0, FBitmap.Width, FBitmap.Height), ARect, 1);
|
|
DrawLines;
|
|
finally
|
|
Canvas.RestoreState(SaveState);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxRuler.DrawRuler;
|
|
var
|
|
sz: Single;
|
|
SaveStateA, SaveStateB: TCanvasSaveState;
|
|
RMatrix, OldM: TMatrix;
|
|
|
|
|
|
procedure Line(x, y, dx, dy: Integer);
|
|
begin
|
|
FBitmap.Canvas.DrawLine(PointF(x + 0.5, y + 0.5), PointF(x + dx + 0.5, y + dy + 0.5), 1);
|
|
end;
|
|
|
|
procedure DrawLines;
|
|
var
|
|
i, dx, maxi, maxw, tx, ty: Single;
|
|
i1, h, w, w5, w10, ofs: Integer;
|
|
s: String;
|
|
begin
|
|
with FBitmap.Canvas do
|
|
begin
|
|
Stroke.Color := claBlack;
|
|
Stroke.Kind := TBrushKind.bkSolid;
|
|
Fill.Kind := TBrushKind.bkNone;
|
|
w5 := 5;
|
|
w10 := 10;
|
|
if FUnits = ruCM then
|
|
dx := fr01cm * FScale
|
|
else if FUnits = ruInches then
|
|
dx := fr01in * FScale
|
|
else if FUnits = ruChars then
|
|
begin
|
|
if Align = TAlignLayout.alLeft then
|
|
dx := fr1CharY * FScale / 10 else
|
|
dx := fr1CharX * FScale / 10
|
|
end
|
|
else
|
|
begin
|
|
dx := FScale;
|
|
w5 := 50;
|
|
w10 := 100;
|
|
end;
|
|
|
|
if FRulerSize = 0 then
|
|
begin
|
|
if Align = TAlignLayout.alLeft then
|
|
maxi := Height + FStart else
|
|
maxi := Self.Width + FStart;
|
|
end
|
|
else
|
|
maxi := FRulerSize;
|
|
|
|
if FUnits = ruPixels then
|
|
s := IntToStr(FStart + Round(maxi / dx)) else
|
|
s := IntToStr((FStart + Round(maxi / dx)) div 10);
|
|
|
|
maxw := TextWidth(s);
|
|
ofs := FOffset - FStart;
|
|
if FUnits = ruChars then
|
|
begin
|
|
if Align = TAlignLayout.alLeft then
|
|
Inc(ofs, Round(fr1CharY * FScale / 2)) else
|
|
Inc(ofs, Round(fr1CharX * FScale / 2))
|
|
end;
|
|
|
|
i := 0;
|
|
i1 := 0;
|
|
while i < maxi do
|
|
begin
|
|
h := 0;
|
|
if i1 = 0 then
|
|
h := 0
|
|
else if i1 mod w10 = 0 then
|
|
h := 6
|
|
else if i1 mod w5 = 0 then
|
|
h := 4
|
|
else if FUnits <> ruPixels then
|
|
h := 2;
|
|
|
|
if (h = 2) and (dx * w10 < 41) then
|
|
h := 0;
|
|
if (h = 4) and (dx * w10 < 21) then
|
|
h := 0;
|
|
|
|
w := 0;
|
|
if h = 6 then
|
|
begin
|
|
if maxw > dx * w10 * 1.5 then
|
|
w := w10 * 4
|
|
else if maxw > dx * w10 * 0.7 then
|
|
w := w10 * 2
|
|
else
|
|
w := w10;
|
|
end;
|
|
|
|
if FUnits = ruPixels then
|
|
s := IntToStr(i1) else
|
|
s := IntToStr(i1 div 10);
|
|
Fill.Color := claBlack;
|
|
Fill.Kind := TBrushKind.bkSolid;
|
|
if (w <> 0) and (i1 mod w = 0) and (ofs + i >= FOffset) then
|
|
begin
|
|
if Align = TAlignLayout.alLeft then
|
|
begin
|
|
tx := -(ofs + i - TextWidth(s) / 2 + 6);
|
|
ty := Self.Width - FBitmap.Canvas.TextHeight(s) - 8;
|
|
SaveStateB := SaveState;
|
|
|
|
SetMatrix(RMatrix);
|
|
end
|
|
else
|
|
begin
|
|
tx := ofs + Round(i) - TextWidth(s) / 2 + 1;
|
|
ty := 5;
|
|
end;
|
|
|
|
FillText(RectF(tx, ty, tx + 100, ty + 100), s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
|
|
if Align = TAlignLayout.alLeft then
|
|
RestoreState(SaveStateB);
|
|
end
|
|
else if (h <> 0) and (ofs + i >= FOffset) then
|
|
if Align = TAlignLayout.alLeft then
|
|
Line(3 + (13 - h) div 2, ofs + Round(i), h, 0) else
|
|
Line(ofs + Round(i), 3 + (13 - h) div 2, 0, h);
|
|
|
|
i := i + dx;
|
|
Inc(i1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FBitmap.SetSize(Round(Self.Width), Round(Self.Height));
|
|
FBitmap.Canvas.BeginScene();
|
|
SaveStateA := FBitmap.Canvas.SaveState;
|
|
try
|
|
with FBitmap.Canvas do
|
|
begin
|
|
Fill.Kind := TBrushKind.bkSolid;
|
|
Fill.Color := FBackgroundColor;
|
|
FillRect(RectF(0, 0, FBitmap.Width, FBitmap.Height), 1, 1, AllCorners, 1);
|
|
Fill.Color := claWhite;
|
|
|
|
{$IFDEF LINUX}
|
|
Font.Family := 'Liberation Sans';
|
|
{$ELSE}
|
|
Font.Family := 'Arial';
|
|
{$ENDIF}
|
|
Font.Size := 8;
|
|
if Align = TAlignLayout.alLeft then
|
|
begin
|
|
if FRulerSize = 0 then
|
|
sz := Self.Height
|
|
else
|
|
sz := FRulerSize + FOffset;
|
|
FillRect(RectF(3, FOffset, Self.Width - 5, sz), 1, 1, AllCorners, 1);
|
|
RMatrix := CreateRotationMatrix(-DegToRad(90));
|
|
//RMatrix.m31 := Self.GetAbsoluteRect.Left;
|
|
//RMatrix.m32 := Self.GetAbsoluteRect.Top;
|
|
RMatrix := MatrixMultiply(RMatrix, Matrix);
|
|
OldM := Matrix;
|
|
end
|
|
else
|
|
begin
|
|
if FRulerSize = 0 then
|
|
sz := Self.Width
|
|
else
|
|
sz := FRulerSize + FOffset;
|
|
FillRect(RectF(FOffset, 3, sz, Self.Height - 5), 1, 1, AllCorners, 1);
|
|
end;
|
|
end;
|
|
DrawLines;
|
|
finally
|
|
FBitmap.Canvas.RestoreState(SaveStateA);
|
|
FBitmap.Canvas.EndScene;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxRuler.SetOffset(const Value: Integer);
|
|
begin
|
|
FOffset := Value;
|
|
FNeedRedraw := True;
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TfrxRuler.SetPosition(const Value: Double);
|
|
begin
|
|
FPosition := Value;
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TfrxRuler.SetScale(const Value: Double);
|
|
begin
|
|
FScale := Value;
|
|
FNeedRedraw := True;
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TfrxRuler.SetStart(const Value: Integer);
|
|
begin
|
|
FStart := Value;
|
|
FNeedRedraw := True;
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TfrxRuler.SetUnits(const Value: TfrxRulerUnits);
|
|
begin
|
|
FUnits := Value;
|
|
FNeedRedraw := True;
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TfrxRuler.SetRulerSize(const Value: Integer);
|
|
begin
|
|
FRulerSize := Value;
|
|
FNeedRedraw := True;
|
|
Repaint;
|
|
end;
|
|
|
|
|
|
{ TfrxScrollBox }
|
|
|
|
procedure TfrxScrollBox.ApplyStyle;
|
|
var
|
|
B: TFmxObject;
|
|
begin
|
|
inherited;
|
|
B := FindStyleResource('content');
|
|
if (B <> nil) and (B is TControl) then
|
|
begin
|
|
FContent := TContent(B);
|
|
FContent.OnPaint := DoContentPaint;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxScrollBox.DialogKey(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxScrollBox.DoContentPaint(Sender: TObject; Canvas: TCanvas;
|
|
const ARect: TRectF);
|
|
begin
|
|
Canvas.Fill.Kind := TBrushKind.bkSolid;
|
|
Canvas.Fill.Color := $FFE0E0E0;
|
|
Canvas.FillRect(ARect, 1, 1, AllCorners, 1, TCornerType.ctBevel);
|
|
end;
|
|
|
|
procedure TfrxScrollBox.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
|
//var
|
|
// i: Integer;
|
|
begin
|
|
inherited;
|
|
{for i := 0 to ControlCount - 1 do
|
|
if Controls[i] is TWinControl then
|
|
THackControl(Controls[i]).KeyDown(Key, Shift);}
|
|
end;
|
|
|
|
//procedure TfrxScrollBox.KeyPress(var Key: Char);
|
|
//var
|
|
// i: Integer;
|
|
//begin
|
|
// inherited;
|
|
// for i := 0 to ControlCount - 1 do
|
|
// if Controls[i] is TWinControl then
|
|
// THackControl(Controls[i]).KeyPress(Key);
|
|
//end;
|
|
|
|
procedure TfrxScrollBox.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
|
//var
|
|
// i: Integer;
|
|
begin
|
|
inherited;
|
|
{for i := 0 to ControlCount - 1 do
|
|
if Controls[i] is TWinControl then
|
|
THackControl(Controls[i]).KeyUp(Key, Shift);}
|
|
end;
|
|
|
|
{$IFDEF DELPHI18}
|
|
procedure TfrxScrollBox.HScrollChange;
|
|
{$ELSE}
|
|
procedure TfrxScrollBox.HScrollChange(Sender: TObject);
|
|
{$ENDIF}
|
|
begin
|
|
inherited;
|
|
if Assigned(FOnPositionChanged) then
|
|
FOnPositionChanged(Self);
|
|
end;
|
|
|
|
{$IFDEF DELPHI18}
|
|
procedure TfrxScrollBox.VScrollChange;
|
|
{$ELSE}
|
|
procedure TfrxScrollBox.VScrollChange(Sender: TObject);
|
|
{$ENDIF}
|
|
begin
|
|
inherited;
|
|
if Assigned(FOnPositionChanged) then
|
|
FOnPositionChanged(Self);
|
|
end;
|
|
|
|
|
|
|
|
{ TfrxCustomSelector }
|
|
|
|
constructor TfrxCustomSelector.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
StyleLookup := 'panelstyle';
|
|
end;
|
|
|
|
procedure TfrxCustomSelector.Popup(AControl: TControl);
|
|
begin
|
|
Tag := AControl.Tag;
|
|
PlacementTarget := AControl;
|
|
Popup;
|
|
end;
|
|
|
|
procedure TfrxCustomSelector.DoMouseEnter;
|
|
begin
|
|
FMouseOver := True;
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TfrxCustomSelector.DoMouseLeave;
|
|
begin
|
|
FMouseOver := False;
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TfrxCustomSelector.MouseMove(Shift: TShiftState; X, Y: Single);
|
|
begin
|
|
inherited;
|
|
FX := X;
|
|
FY := Y;
|
|
Repaint;
|
|
end;
|
|
|
|
|
|
|
|
{ TfrxColorSelector }
|
|
|
|
constructor TfrxColorSelector.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
Width := 155;
|
|
Height := 143;
|
|
FBtnCaption := 'Other...';
|
|
end;
|
|
|
|
procedure TfrxColorSelector.DrawEdge(X, Y: Single);
|
|
var
|
|
r: TRectF;
|
|
begin
|
|
X := Trunc((X - 5) / 18);
|
|
if X >= 8 then
|
|
X := 7;
|
|
Y := Trunc((Y - 5) / 18);
|
|
|
|
if Y < 6 then
|
|
r := RectF(X * 18 + 5.5, Y * 18 + 5.5, X * 18 + 23.5, Y * 18 + 23.5) else
|
|
r := RectF(5.5, 113.5, Width - 5.5, Height - 5.5);
|
|
|
|
with Canvas do
|
|
begin
|
|
Stroke.Kind := TBrushKind.bkSolid;
|
|
Stroke.Color := $FFC56A31;
|
|
|
|
DrawRect(r, 0, 0, AllCorners, 1);
|
|
InflateRect(r, -1, -1);
|
|
Stroke.Color := $FFE8E6E2;
|
|
|
|
DrawRect(r, 0, 0, AllCorners, 1);
|
|
InflateRect(r, -1, -1);
|
|
|
|
DrawRect(r, 0, 0, AllCorners, 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxColorSelector.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Single);
|
|
//var
|
|
//cd: TColorDialog;
|
|
|
|
procedure AddCustomColor;
|
|
var
|
|
i: Integer;
|
|
Found: Boolean;
|
|
Empty: Integer;
|
|
begin
|
|
Found := False;
|
|
Empty := 0;
|
|
for i := 0 to 47 do
|
|
begin
|
|
if Colors[i] = Cardinal(FColor) then
|
|
Found := True;
|
|
if (i > 37) and (Colors[i] = claGray) and (Empty = 0) then
|
|
Empty := i;
|
|
end;
|
|
|
|
if Found then exit;
|
|
|
|
if Empty = 0 then
|
|
begin
|
|
for i := 40 to 46 do
|
|
Colors[i] := Colors[i + 1];
|
|
Empty := 47;
|
|
end;
|
|
Colors[Empty] := FColor
|
|
end;
|
|
|
|
begin
|
|
X := Trunc((X - 5) / 18);
|
|
if X >= 8 then
|
|
X := 7;
|
|
Y := Trunc((Y - 5) / 18);
|
|
|
|
if Y < 6 then
|
|
FColor := Colors[Round(X + Y * 8)]
|
|
else
|
|
begin
|
|
//TForm(Parent).AutoSize := False;
|
|
//Parent.Height := 0;
|
|
//cd := TColorDialog.Create(Self);
|
|
//cd.Options := [cdFullOpen];
|
|
//cd.Color := FColor;
|
|
//if cd.Execute then
|
|
// FColor := cd.Color else
|
|
// Exit;
|
|
// todo color selector form
|
|
AddCustomColor;
|
|
end;
|
|
|
|
ClosePopup;
|
|
if Assigned(FOnColorChanged) then
|
|
FOnColorChanged(Self);
|
|
end;
|
|
|
|
procedure TfrxColorSelector.DoPaint;
|
|
var
|
|
i, j: Integer;
|
|
s: String;
|
|
r: TRectF;
|
|
begin
|
|
inherited;
|
|
|
|
with Canvas do
|
|
begin
|
|
Fill.Kind := TBrushKind.bkSolid;
|
|
Stroke.Kind := TBrushKind.bkSolid;
|
|
for j := 0 to 5 do
|
|
for i := 0 to 7 do
|
|
begin
|
|
if (i = 0) and (j = 0) then
|
|
Fill.Color := claWhite else
|
|
Fill.Color := Colors[i + j * 8];
|
|
Stroke.Color := claGray;
|
|
r := RectF(i * 18 + 8.5, j * 18 + 8.5, i * 18 + 20.5, j * 18 + 20.5);
|
|
FillRect(r, 0, 0, AllCorners, 1);
|
|
DrawRect(r, 0, 0, AllCorners, 1);
|
|
if (i = 0) and (j = 0) then
|
|
begin
|
|
DrawLine(PointF(i * 18 + 10.5, j * 18 + 10.5), PointF(i * 18 + 18.5, j * 18 + 18.5), 1);
|
|
DrawLine(PointF(i * 18 + 18.5, j * 18 + 10.5), PointF(i * 18 + 10.5, j * 18 + 18.5), 1);
|
|
end;
|
|
end;
|
|
|
|
Stroke.Color := claGray;
|
|
Fill.Color := claGray;
|
|
s := FBtnCaption;
|
|
|
|
{$IFDEF LINUX}
|
|
DrawRect(RectF(8.5, 116.5, Width - 20, Height - 20), 0, 0, AllCorners, 1);
|
|
FillText(RectF(8.5, 116.5, Width - 20, Height - 20), s, False, 1, [], TTextAlign.taCenter, TTextAlign.taCenter)
|
|
{$ELSE}
|
|
DrawRect(RectF(8.5, 116.5, Width - 8.5, Height - 8.5), 0, 0, AllCorners, 1);
|
|
FillText(RectF(10, 116, Width - 10, Height - 8), s, False, 1, [], TTextAlign.taCenter, TTextAlign.taCenter)
|
|
{$ENDIF}
|
|
end;
|
|
|
|
if FMouseOver then
|
|
DrawEdge(FX, FY);
|
|
end;
|
|
|
|
|
|
{ TfrxLineSelector }
|
|
|
|
constructor TfrxLineSelector.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
Width := 98;
|
|
Height := 106;
|
|
end;
|
|
|
|
procedure TfrxLineSelector.DrawEdge(X, Y: Single);
|
|
var
|
|
r: TRectF;
|
|
begin
|
|
Y := Trunc((Y - 5) / 16);
|
|
if Y > 5 then
|
|
Y := 5;
|
|
|
|
r := RectF(5.5, Y * 16 + 5.5, Width - 6.5, Y * 16 + 19.5);
|
|
with Canvas do
|
|
begin
|
|
Stroke.Kind := TBrushKind.bkSolid;
|
|
Stroke.Color := claGray;
|
|
{$IFDEF Delphi25}
|
|
Stroke.Thickness := 1;
|
|
{$ELSE}
|
|
StrokeThickness := 1;
|
|
{$ENDIF}
|
|
DrawRect(r, 0, 0, AllCorners, 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxLineSelector.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Single);
|
|
begin
|
|
Y := Trunc((Y - 5) / 16);
|
|
if Y > 5 then
|
|
Y := 5;
|
|
|
|
FStyle := Round(Y);
|
|
|
|
ClosePopup;
|
|
if Assigned(FOnStyleChanged) then
|
|
FOnStyleChanged(Self);
|
|
end;
|
|
|
|
procedure TfrxLineSelector.DoPaint;
|
|
var
|
|
i: Integer;
|
|
|
|
procedure DrawLine(Y, Style: Integer);
|
|
begin
|
|
if Style = 5 then
|
|
begin
|
|
Style := 0;
|
|
DrawLine(Y - 2, Style);
|
|
Inc(Y, 2);
|
|
end;
|
|
|
|
with Canvas do
|
|
begin
|
|
Stroke.Color := claBlack;
|
|
{$IFDEF Delphi25}
|
|
Stroke.Thickness := 2;
|
|
Stroke.Dash := TStrokeDash(Style);
|
|
{$ELSE}
|
|
StrokeDash := TStrokeDash(Style);
|
|
StrokeThickness := 2;
|
|
{$ENDIF}
|
|
DrawLine(PointF(7, Y), PointF(Self.Width - 8, Y), 1);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
inherited;
|
|
for i := 0 to 5 do
|
|
DrawLine(12 + i * 16, i);
|
|
if FMouseOver then
|
|
DrawEdge(FX, FY);
|
|
end;
|
|
|
|
|
|
{ TfrxUndoBuffer }
|
|
|
|
constructor TfrxUndoBuffer.Create;
|
|
begin
|
|
FRedo := TList.Create;
|
|
FUndo := TList.Create;
|
|
end;
|
|
|
|
destructor TfrxUndoBuffer.Destroy;
|
|
begin
|
|
ClearUndo;
|
|
ClearRedo;
|
|
FUndo.Free;
|
|
FRedo.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxUndoBuffer.AddUndo(ReportComponent: TfrxComponent);
|
|
var
|
|
m: TMemoryStream;
|
|
begin
|
|
m := TMemoryStream.Create;
|
|
FUndo.Add(m);
|
|
SetPictureFlag(ReportComponent, False);
|
|
try
|
|
ReportComponent.SaveToStream(m);
|
|
finally
|
|
SetPictureFlag(ReportComponent, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxUndoBuffer.AddRedo(ReportComponent: TfrxComponent);
|
|
var
|
|
m: TMemoryStream;
|
|
begin
|
|
m := TMemoryStream.Create;
|
|
FRedo.Add(m);
|
|
SetPictureFlag(ReportComponent, False);
|
|
try
|
|
ReportComponent.SaveToStream(m);
|
|
finally
|
|
SetPictureFlag(ReportComponent, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxUndoBuffer.GetUndo(ReportComponent: TfrxComponent);
|
|
var
|
|
m: TMemoryStream;
|
|
IsReport: Boolean;
|
|
begin
|
|
IsReport := False;
|
|
if ReportComponent is TfrxReport then
|
|
isReport := True;
|
|
m := FUndo[FUndo.Count - 2];
|
|
m.Position := 0;
|
|
if IsReport then
|
|
TfrxReport(ReportComponent).Reloading := True;
|
|
try
|
|
ReportComponent.LoadFromStream(m);
|
|
finally
|
|
if IsReport then
|
|
TfrxReport(ReportComponent).Reloading := False;
|
|
end;
|
|
SetPictures(ReportComponent);
|
|
|
|
m := FUndo[FUndo.Count - 1];
|
|
m.Free;
|
|
FUndo.Delete(FUndo.Count - 1);
|
|
end;
|
|
|
|
procedure TfrxUndoBuffer.GetRedo(ReportComponent: TfrxComponent);
|
|
var
|
|
m: TMemoryStream;
|
|
IsReport: Boolean;
|
|
begin
|
|
IsReport := False;
|
|
if ReportComponent is TfrxReport then
|
|
isReport := True;
|
|
m := FRedo[FRedo.Count - 1];
|
|
m.Position := 0;
|
|
if IsReport then
|
|
TfrxReport(ReportComponent).Reloading := True;
|
|
try
|
|
ReportComponent.LoadFromStream(m);
|
|
finally
|
|
if IsReport then
|
|
TfrxReport(ReportComponent).Reloading := False;
|
|
end;
|
|
SetPictures(ReportComponent);
|
|
|
|
m.Free;
|
|
FRedo.Delete(FRedo.Count - 1);
|
|
end;
|
|
|
|
procedure TfrxUndoBuffer.ClearUndo;
|
|
begin
|
|
while FUndo.Count > 0 do
|
|
begin
|
|
TMemoryStream(FUndo[0]).Free;
|
|
FUndo.Delete(0);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxUndoBuffer.ClearRedo;
|
|
begin
|
|
while FRedo.Count > 0 do
|
|
begin
|
|
TMemoryStream(FRedo[0]).Free;
|
|
FRedo.Delete(0);
|
|
end;
|
|
end;
|
|
|
|
function TfrxUndoBuffer.GetRedoCount: Integer;
|
|
begin
|
|
Result := FRedo.Count;
|
|
end;
|
|
|
|
function TfrxUndoBuffer.GetUndoCount: Integer;
|
|
begin
|
|
Result := FUndo.Count;
|
|
end;
|
|
|
|
procedure TfrxUndoBuffer.SetPictureFlag(ReportComponent: TfrxComponent; Flag: Boolean);
|
|
var
|
|
i: Integer;
|
|
l: TList;
|
|
c: TfrxComponent;
|
|
begin
|
|
l := ReportComponent.AllObjects;
|
|
for i := 0 to l.Count - 1 do
|
|
begin
|
|
c := l[i];
|
|
if c is TfrxPictureView then
|
|
begin
|
|
TfrxPictureView(c).IsPictureStored := Flag;
|
|
TfrxPictureView(c).IsImageIndexStored := not Flag;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxUndoBuffer.SetPictures(ReportComponent: TfrxComponent);
|
|
var
|
|
i: Integer;
|
|
l: TList;
|
|
c: TfrxComponent;
|
|
begin
|
|
l := ReportComponent.AllObjects;
|
|
for i := 0 to l.Count - 1 do
|
|
begin
|
|
c := l[i];
|
|
if c is TfrxPictureView then
|
|
FPictureCache.GetPicture(TfrxPictureView(c));
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TfrxClipboard }
|
|
|
|
constructor TfrxClipboard.Create(ADesigner: TfrxCustomDesigner);
|
|
begin
|
|
FDesigner := ADesigner;
|
|
end;
|
|
|
|
procedure TfrxClipboard.Copy;
|
|
var
|
|
c, c1: TfrxComponent;
|
|
i, j: Integer;
|
|
text: String;
|
|
minX, minY: Extended;
|
|
List: TList;
|
|
Flag: Boolean;
|
|
|
|
procedure Write(c: TfrxComponent);
|
|
var
|
|
c1: TfrxComponent;
|
|
Writer: TfrxXMLSerializer;
|
|
begin
|
|
c1 := TfrxComponent(c.NewInstance);
|
|
c1.Create(FDesigner.Page);
|
|
|
|
if c is TfrxPictureView then
|
|
begin
|
|
TfrxPictureView(c).IsPictureStored := False;
|
|
TfrxPictureView(c).IsImageIndexStored := True;
|
|
end;
|
|
|
|
try
|
|
c1.Assign(c);
|
|
finally
|
|
if c is TfrxPictureView then
|
|
begin
|
|
TfrxPictureView(c).IsPictureStored := True;
|
|
TfrxPictureView(c).IsImageIndexStored := False;
|
|
TfrxPictureView(c1).IsImageIndexStored := True;
|
|
end;
|
|
end;
|
|
|
|
c1.Left := c1.Left - minX;
|
|
c1.Top := c.AbsTop - minY;
|
|
|
|
Writer := TfrxXMLSerializer.Create(nil);
|
|
Writer.Owner := c1.Report;
|
|
text := text + '<' + c1.ClassName + ' Name="' + c.Name + '"' + Writer.ObjToXML(c1) + '/>';
|
|
Writer.Free;
|
|
|
|
c1.Free;
|
|
end;
|
|
|
|
begin
|
|
text := '#FR3 clipboard#' + #10#13;
|
|
|
|
minX := 100000;
|
|
minY := 100000;
|
|
for i := 0 to FDesigner.SelectedObjects.Count - 1 do
|
|
begin
|
|
c := FDesigner.SelectedObjects[i];
|
|
if c.AbsLeft < minX then
|
|
minX := c.AbsLeft;
|
|
if c.AbsTop < minY then
|
|
minY := c.AbsTop;
|
|
end;
|
|
|
|
List := FDesigner.Page.AllObjects;
|
|
for i := 0 to List.Count - 1 do
|
|
begin
|
|
c := List[i];
|
|
if FDesigner.SelectedObjects.IndexOf(c) <> -1 then
|
|
begin
|
|
Write(c);
|
|
if c is TfrxBand then
|
|
begin
|
|
Flag := False;
|
|
for j := 0 to c.Objects.Count - 1 do
|
|
begin
|
|
c1 := c.Objects[j];
|
|
if FDesigner.SelectedObjects.IndexOf(c1) <> -1 then
|
|
Flag := True;
|
|
end;
|
|
|
|
if not Flag then
|
|
for j := 0 to c.Objects.Count - 1 do
|
|
Write(c.Objects[j]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
SetClipboard(text);
|
|
end;
|
|
|
|
function TfrxClipboard.GetPasteAvailable: Boolean;
|
|
var
|
|
cb: Variant;
|
|
begin
|
|
Result := False;
|
|
try
|
|
cb := GetClipboard;
|
|
if cb <> null then
|
|
Result := (Pos('#FR3 clipboard#', cb) = 1);
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxClipboard.Paste;
|
|
var
|
|
c: TfrxComponent;
|
|
sl: TStrings;
|
|
s: TStream;
|
|
List: TList;
|
|
NewCompName: string;
|
|
NewComp: TfrxComponent;
|
|
|
|
function ReadComponent_(AReader: TfrxXMLSerializer; Root: TfrxComponent): TfrxComponent;
|
|
var
|
|
rd: TfrxXMLReader;
|
|
RootItem: TfrxXMLItem;
|
|
begin
|
|
rd := TfrxXMLReader.Create(AReader.Stream);
|
|
RootItem := TfrxXMLItem.Create;
|
|
|
|
try
|
|
rd.ReadRootItem(RootItem, False);
|
|
Result := AReader.ReadComponentStr(Root, RootItem.Name + ' ' + RootItem.Text);
|
|
|
|
NewCompName := RootItem.Prop['Name'];
|
|
finally
|
|
rd.Free;
|
|
RootItem.Free;
|
|
end;
|
|
end;
|
|
|
|
function ReadComponent: TfrxComponent;
|
|
var
|
|
Reader: TfrxXMLSerializer;
|
|
begin
|
|
Reader := TfrxXMLSerializer.Create(s);
|
|
Result := ReadComponent_(Reader, FDesigner.Report);
|
|
Reader.Free;
|
|
end;
|
|
|
|
function FindBand(Band: TfrxComponent): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to FDesigner.Page.Objects.Count - 1 do
|
|
if (FDesigner.Page.Objects[i] <> Band) and
|
|
(TObject(FDesigner.Page.Objects[i]) is Band.ClassType) then
|
|
Result := True;
|
|
end;
|
|
|
|
function CanInsert(c: TfrxComponent): Boolean;
|
|
begin
|
|
Result := True;
|
|
if (c is TfrxDialogControl) and (FDesigner.Page is TfrxReportPage) then
|
|
Result := False;
|
|
if not (c is TfrxDialogComponent) and not (c is TfrxDialogControl) and
|
|
(FDesigner.Page is TfrxDialogPage) then
|
|
Result := False;
|
|
if ((c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or (c is TfrxDMPCommand)) and
|
|
not (FDesigner.Page is TfrxDMPPage) then
|
|
Result := False;
|
|
if not ((c is TfrxBand) or (c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or
|
|
(c is TfrxDMPCommand)) and (FDesigner.Page is TfrxDMPPage) then
|
|
Result := False;
|
|
if not ((c is TfrxCustomLineView) or (c is TfrxCustomMemoView) or
|
|
(c is TfrxShapeView) or (c is TfrxDialogComponent)) and
|
|
(FDesigner.Page is TfrxDataPage) then
|
|
Result := False;
|
|
end;
|
|
|
|
procedure FindParent(c: TfrxComponent);
|
|
var
|
|
i: Integer;
|
|
Found: Boolean;
|
|
c1: TfrxComponent;
|
|
begin
|
|
Found := False;
|
|
if not (c is TfrxBand) then
|
|
for i := List.Count - 1 downto 0 do
|
|
begin
|
|
c1 := List[i];
|
|
if c1 is TfrxBand then
|
|
if (c.Top >= c1.Top) and (c.Top < c1.Top + c1.Height) then
|
|
begin
|
|
c.Parent := c1;
|
|
c.Top := c.Top - c1.Top;
|
|
Found := True;
|
|
break;
|
|
end;
|
|
end;
|
|
if not Found then
|
|
c.Parent := FDesigner.Page;
|
|
end;
|
|
|
|
begin
|
|
FDesigner.SelectedObjects.Clear;
|
|
|
|
sl := TStringList.Create;
|
|
sl.Text := GetClipboard;
|
|
sl.Delete(0);
|
|
|
|
s := TMemoryStream.Create;
|
|
sl.SaveToStream(s, TEncoding.UTF8);
|
|
sl.Free;
|
|
s.Position := 0;
|
|
|
|
List := TList.Create;
|
|
|
|
while s.Position < s.Size do
|
|
begin
|
|
c := ReadComponent;
|
|
if c = nil then break;
|
|
|
|
if (((c is TfrxReportTitle) or (c is TfrxReportSummary) or
|
|
(c is TfrxPageHeader) or (c is TfrxPageFooter) or
|
|
(c is TfrxColumnHeader) or (c is TfrxColumnFooter)) and FindBand(c)) or
|
|
not CanInsert(c) then
|
|
c.Free
|
|
else
|
|
begin
|
|
if c is TfrxPictureView then
|
|
FPictureCache.GetPicture(TfrxPictureView(c));
|
|
List.Add(c);
|
|
FindParent(c);
|
|
if FDesigner.IsPreviewDesigner then
|
|
NewComp := FDesigner.Report.FindObject(NewCompName) as TfrxComponent
|
|
else
|
|
NewComp := FDesigner.Report.FindComponent(NewCompName) as TfrxComponent;
|
|
if ((NewComp <> nil) and (NewComp <> c)) or (NewCompName = '') then
|
|
c.CreateUniqueName
|
|
else
|
|
c.Name := NewCompName;
|
|
c.GroupIndex := 0;
|
|
FDesigner.Objects.Add(c);
|
|
if c.Parent = FDesigner.Page then
|
|
FDesigner.SelectedObjects.Add(c);
|
|
c.OnPaste;
|
|
end;
|
|
end;
|
|
|
|
if FDesigner.SelectedObjects.Count = 0 then
|
|
FDesigner.SelectedObjects.Add(FDesigner.Page);
|
|
|
|
List.Free;
|
|
s.Free;
|
|
end;
|
|
|
|
|
|
{ TfrxTabControl }
|
|
|
|
procedure TfrxTabControl.ApplyStyle;
|
|
var
|
|
B: TFmxObject;
|
|
begin
|
|
inherited;
|
|
B := FindStyleResource('rectangle');
|
|
if (B <> nil) and (B is TRectangle) then
|
|
TRectangle(B).Sides := [];
|
|
end;
|
|
|
|
|
|
initialization
|
|
StartClassGroup(TFmxObject);
|
|
ActivateClassGroup(TFmxObject);
|
|
GroupDescendentsWith(TfrxRuler, TFmxObject);
|
|
GroupDescendentsWith(TfrxScrollBox, TFmxObject);
|
|
RegisterFmxClasses([TfrxRuler, TfrxScrollBox]);
|
|
|
|
end.
|