3362 lines
86 KiB
ObjectPascal
3362 lines
86 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ Common designer workspace }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxDesgnWorkspace;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
{$IFNDEF FPC}Windows, Messages, {$ENDIF}
|
|
Types, SysUtils, Classes, Graphics, Controls, Forms,
|
|
Dialogs, ExtCtrls, Buttons, frxClass, frxUnicodeCtrls, frxDPIAwareBaseControls,
|
|
Variants, frxHint
|
|
{$IFDEF FPC}
|
|
,LCLType, LMessages, LazHelper, LCLIntf
|
|
{$ELSE}
|
|
, StdCtrls
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI16}
|
|
, System.UITypes
|
|
{$ENDIF}
|
|
;
|
|
|
|
|
|
const
|
|
crPencil = 11;
|
|
|
|
type
|
|
TfrxDesignMode = (dmSelect, dmInsert, dmDrag);
|
|
TfrxDesignMode1 = (dmNone, dmMove, dmSize, dmSizeBand, dmScale,
|
|
dmInplaceEdit, dmSelectionRect, dmInsertObject, dmInsertLine,
|
|
dmMoveGuide, dmContainer);
|
|
TfrxCursorType = (ct0, ct1, ct2, ct3, ct4, ct5, ct6, ct7, ct8, ct9, ct10);
|
|
TfrxNotifyPositionEvent = procedure (ARect: TfrxRect) of object;
|
|
|
|
TfrxInsertion = packed record
|
|
ComponentClass: TfrxComponentClass;
|
|
Left: Extended;
|
|
Top: Extended;
|
|
Width: Extended;
|
|
Height: Extended;
|
|
OriginalWidth: Extended;
|
|
OriginalHeight: Extended;
|
|
Flags: Word;
|
|
end;
|
|
|
|
TfrxDesignerWorkspace = class(TfrxDPIAwarePanel)
|
|
protected
|
|
FSkipPaintWindow: Boolean;
|
|
FBandHeader: Extended;
|
|
FCanvas: TCanvas;
|
|
FColor: TColor;
|
|
FIntersections: Boolean;
|
|
FIntersectionsColor: TColor;
|
|
FCT: TfrxCursorType;
|
|
FDblClicked: Boolean;
|
|
FDisableUpdate: Boolean;
|
|
FFreeBandsPlacement: Boolean;
|
|
FGapBetweenBands: Integer;
|
|
FGridAlign: Boolean;
|
|
FGridLCD: Boolean;
|
|
FGridType: TfrxGridType;
|
|
FGridX: Extended;
|
|
FGridY: Extended;
|
|
FInsertion: TfrxInsertion;
|
|
FLastMousePointX: Extended;
|
|
FLastMousePointY: Extended;
|
|
FMargins: TRect;
|
|
FMarginsPanel: TPanel;
|
|
FMode: TfrxDesignMode;
|
|
FMode1: TfrxDesignMode1;
|
|
FModifyFlag: Boolean;
|
|
FMouseDown: Boolean;
|
|
FObjects: TList;
|
|
FOffsetX: Extended;
|
|
FOffsetY: Extended;
|
|
FPage: TfrxPage;
|
|
FPageHeight: Integer;
|
|
FPageWidth: Integer;
|
|
FScale: Extended;
|
|
FScaleRect: TfrxRect;
|
|
FScaleRect1: TfrxRect;
|
|
FSelectedObjects: TfrxSelectedObjectsList;
|
|
FInternalSelObjects: TList;
|
|
FSavedAlign: TList;
|
|
FSelectionRect: TfrxRect;
|
|
FShowBandCaptions: Boolean;
|
|
FShowEdges: Boolean;
|
|
FShowGrid: Boolean;
|
|
FSizedBand: TfrxBand;
|
|
FOnModify: TNotifyEvent;
|
|
FOnEdit: TNotifyEvent;
|
|
FOnInsert: TNotifyEvent;
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnNotifyPosition: TfrxNotifyPositionEvent;
|
|
FOnSelectionChanged: TNotifyEvent;
|
|
FOnTopLeftChanged: TNotifyEvent;
|
|
FInPlaceditorsList: TfrxComponentEditorsList;
|
|
FLastObjectOver: TfrxComponent;
|
|
FPopUpActive: Boolean;
|
|
FfrxHintShowEvent: TfrxHintShowEvent;
|
|
FEnableHint: Boolean;
|
|
procedure DoModify;
|
|
procedure AdjustBandHeight(Bnd: TfrxBand);
|
|
procedure CheckGuides(var kx, ky: Extended; var Result: Boolean; IsMouseDown: Boolean); virtual;
|
|
procedure DoNudge(dx, dy: Extended; Smooth: Boolean);
|
|
procedure DoSize(dx, dy: Extended);
|
|
procedure DoStick(dx, dy: Integer);
|
|
procedure DoTab;
|
|
procedure DrawBackground;
|
|
procedure DrawCross(Down: Boolean);
|
|
procedure DrawInsertionRect;
|
|
procedure DrawObjects; virtual;
|
|
procedure DrawSelectionRect;
|
|
procedure FindNearest(dx, dy: Integer);
|
|
procedure MouseLeave;{$IFDEF FPC} override;{$ELSE} virtual; {$ENDIF}
|
|
procedure NormalizeCoord(c: TfrxComponent);
|
|
procedure NormalizeRect(var R: TfrxRect);
|
|
procedure SelectionChanged(aNewSelection: TList = nil);
|
|
procedure UpdateInternalSelection;
|
|
procedure SetScale(Value: Extended);
|
|
procedure SetShowBandCaptions(const Value: Boolean);
|
|
procedure UpdateBandHeader;
|
|
procedure DoFinishInPlace(Sender: TObject; Refresh, Modified: Boolean); virtual;
|
|
procedure SetDefaultEventParams(var EventParams: TfrxInteractiveEventsParams); virtual;
|
|
|
|
|
|
procedure DblClick; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
|
|
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
|
|
procedure WMMove(var Message: TWMMove); message WM_MOVE;
|
|
procedure WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND;
|
|
procedure SetEnableHint(vEnableHint: boolean);
|
|
procedure FakeHintShow(var Msg: TCMHintShow);
|
|
procedure RealHintShow(var Msg: TCMHintShow);
|
|
procedure WMFRXHintShow(var Msg: TCMHintShow); message CM_HINTSHOW;
|
|
|
|
// debug
|
|
// procedure PrepareShiftTree(Band: TfrxBand);
|
|
|
|
procedure SetColor_(const Value: TColor);
|
|
procedure SetGridType(const Value: TfrxGridType);
|
|
procedure SetOrigin(const Value: TPoint);
|
|
procedure SetParent(AParent: TWinControl); override;
|
|
procedure SetShowGrid(const Value: Boolean);
|
|
function GetOrigin: TPoint;
|
|
function GetRightBottomObject: TfrxComponent;
|
|
function GetSelectionBounds: TfrxRect;
|
|
function ListsEqual(List1, List2: TList): Boolean;
|
|
function SelectedCount: Integer;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Paint; override;
|
|
procedure PaintWindow(DC: HDC); override;
|
|
procedure AdjustBands(AttachObjects: Boolean = True);
|
|
procedure DeleteObjects; virtual;
|
|
procedure RemoveObjectsFromLits(aObjectsList: TList); virtual;
|
|
procedure DisableUpdate;
|
|
procedure EnableUpdate;
|
|
procedure EditObject; virtual;
|
|
procedure GroupObjects;
|
|
procedure UngroupObjects;
|
|
procedure SetInsertion(AClass: TfrxComponentClass;
|
|
AWidth, AHeight: Extended; AFlag: Word); virtual;
|
|
procedure SetPageDimensions(AWidth, AHeight: Integer; AMargins: TRect);
|
|
procedure UpdateView;
|
|
procedure ClearLastView; virtual;
|
|
procedure CreateInPlaceEditorsList;
|
|
procedure InternalCopy; virtual;
|
|
procedure InternalPaste; virtual;
|
|
procedure SetClipboardObject(Clipboard: TPersistent);
|
|
procedure SetVirtualGuids(VGuid, HGuid: Extended); virtual;
|
|
function InternalIsPasteAvailable: Boolean; virtual;
|
|
property EnableHint: Boolean read FEnableHint write SetEnableHint default True;
|
|
property BandHeader: Extended read FBandHeader write FBandHeader;
|
|
property Color: TColor read FColor write SetColor_;
|
|
property Intersections: Boolean read FIntersections write FIntersections;
|
|
property IntersectionsColor: TColor read FIntersectionsColor write FIntersectionsColor;
|
|
property FreeBandsPlacement: Boolean read FFreeBandsPlacement write FFreeBandsPlacement;
|
|
property GapBetweenBands: Integer read FGapBetweenBands write FGapBetweenBands;
|
|
property GridAlign: Boolean read FGridAlign write FGridAlign;
|
|
property GridLCD: Boolean read FGridLCD write FGridLCD;
|
|
property GridType: TfrxGridType read FGridType write SetGridType;
|
|
property GridX: Extended read FGridX write FGridX;
|
|
property GridY: Extended read FGridY write FGridY;
|
|
property Insertion: TfrxInsertion read FInsertion;
|
|
property IsMouseDown: Boolean read FMouseDown;
|
|
property Mode: TfrxDesignMode1 read FMode1;
|
|
property Objects: TList read FObjects write FObjects;
|
|
property OffsetX: Extended read FOffsetX write FOffsetX;
|
|
property OffsetY: Extended read FOffsetY write FOffsetY;
|
|
property Origin: TPoint read GetOrigin write SetOrigin;
|
|
property Page: TfrxPage read FPage write FPage;
|
|
property Scale: Extended read FScale write SetScale;
|
|
property SelectedObjects: TfrxSelectedObjectsList read FSelectedObjects write FSelectedObjects;
|
|
property ShowBandCaptions: Boolean read FShowBandCaptions write SetShowBandCaptions;
|
|
property ShowEdges: Boolean read FShowEdges write FShowEdges;
|
|
property ShowGrid: Boolean read FShowGrid write SetShowGrid;
|
|
property OnModify: TNotifyEvent read FOnModify write FOnModify;
|
|
property OnEdit: TNotifyEvent read FOnEdit write FOnEdit;
|
|
property OnInsert: TNotifyEvent read FOnInsert write FOnInsert;
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnNotifyPosition: TfrxNotifyPositionEvent read FOnNotifyPosition write
|
|
FOnNotifyPosition;
|
|
property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write
|
|
FOnSelectionChanged;
|
|
property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write
|
|
FOnTopLeftChanged;
|
|
end;
|
|
|
|
TInplaceMemo = class(TUnicodeMemo)
|
|
private
|
|
FDesigner: TfrxDesignerWorkspace;
|
|
FObject: TfrxCustomMemoView;
|
|
FOriginalSize: TSize;
|
|
procedure LinesChange(Sender: TObject);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure Edit(c: TfrxCustomMemoView);
|
|
procedure EditDone;
|
|
procedure KeyPress(var Key: Char); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
end;
|
|
|
|
TDesgnHintData = class(TBaseHintData)
|
|
private
|
|
FMemoView: TfrxCustomMemoView;
|
|
public
|
|
constructor Create(vHeaderPrefix, vHeaderText: String; vMultiPaint: Boolean; vMemoView: TfrxCustomMemoView); overload;
|
|
property MemoView: TfrxCustomMemoView read FMemoView;
|
|
end;
|
|
|
|
TDesgnHintWindow = class(TBaseHintWindow)
|
|
protected
|
|
procedure SetPlainTextOptions; override;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
{$R *.res}
|
|
|
|
uses
|
|
frxRes, frxDMPClass, frxUtils{$IFNDEF FPC}, frxCtrls{$ENDIF}, frxInPlaceEditors;
|
|
|
|
//const
|
|
// DefFontName = 'Tahoma';
|
|
|
|
|
|
type
|
|
TMarginsPanel = class(TPanel)
|
|
protected
|
|
FWorkspace: TfrxDesignerWorkspace;
|
|
procedure WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure Paint; override;
|
|
end;
|
|
|
|
THackComponent = class(TfrxComponent);
|
|
THackReportComponent = class(TfrxReportComponent);
|
|
|
|
|
|
{ TInplaceMemo }
|
|
|
|
constructor TInplaceMemo.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDesigner := TfrxDesignerWorkspace(AOwner);
|
|
Parent := FDesigner;
|
|
Visible := False;
|
|
WordWrap := False;
|
|
OnChange := LinesChange;
|
|
end;
|
|
|
|
procedure TInplaceMemo.Edit(c: TfrxCustomMemoView);
|
|
var
|
|
s: WideString;
|
|
begin
|
|
FObject := c;
|
|
|
|
s := c.Text;
|
|
if (s <> '') and (s[Length(s)] = #10) then
|
|
Delete(s, Length(s) - 1, 2);
|
|
Text := s;
|
|
|
|
SetBounds(Round(c.AbsLeft * FDesigner.Scale), Round(c.AbsTop * FDesigner.Scale),
|
|
Round(c.Width * FDesigner.Scale + 1), Round(c.Height * FDesigner.Scale + 1));
|
|
FOriginalSize.cx := Width;
|
|
FOriginalSize.cy := Height;
|
|
|
|
Font.Assign(c.Font);
|
|
Font.Height := Round(Font.Height * FDesigner.Scale);
|
|
if c.Color = clNone then
|
|
Color := clWhite else
|
|
Color := c.Color;
|
|
{$IFNDEF FPC}
|
|
Ctl3D := False;
|
|
{$ENDIF}
|
|
BorderStyle := bsNone;
|
|
|
|
Show;
|
|
SetFocus;
|
|
SelectAll;
|
|
end;
|
|
|
|
procedure TInplaceMemo.EditDone;
|
|
begin
|
|
if Modified then
|
|
begin
|
|
FObject.Text := Text;
|
|
if FOriginalSize.cx <> Width then
|
|
FObject.Width := (Width + 5) / FDesigner.Scale;
|
|
if FOriginalSize.cy <> Height then
|
|
FObject.Height := (Height + 5) / FDesigner.Scale;
|
|
FDesigner.FModifyFlag := True;
|
|
FDesigner.DoModify;
|
|
end;
|
|
Hide;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(FDesigner);
|
|
{$ELSE}
|
|
FDesigner.Repaint;
|
|
{$ENDIF}
|
|
FDesigner.Cursor := crDefault;
|
|
end;
|
|
|
|
procedure TInplaceMemo.KeyPress(var Key: Char);
|
|
begin
|
|
if Key = #27 then
|
|
begin
|
|
Modified := False;
|
|
EditDone;
|
|
end;
|
|
end;
|
|
|
|
procedure TInplaceMemo.LinesChange(Sender: TObject);
|
|
var
|
|
i, w0, w, h: Integer;
|
|
begin
|
|
h := (-Font.Height + 3) * Lines.Count + 4;
|
|
if h > Height - Font.Height then
|
|
Height := h;
|
|
|
|
FDesigner.Canvas.Font := Font;
|
|
|
|
w := Width;
|
|
for i := 0 to Lines.Count - 1 do
|
|
begin
|
|
w0 := FDesigner.Canvas.TextWidth(Lines[i]) + 6;
|
|
if w0 > w then
|
|
w := w0;
|
|
end;
|
|
|
|
if w > Width then
|
|
Width := w;
|
|
end;
|
|
|
|
procedure TInplaceMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
EditDone;
|
|
end;
|
|
|
|
|
|
{ TMarginsPanel }
|
|
|
|
constructor TMarginsPanel.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
Color := clWindow;
|
|
BevelInner := bvNone;
|
|
BevelOuter := bvNone;
|
|
end;
|
|
|
|
procedure TMarginsPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
inherited;
|
|
FWorkspace.MouseDown(Button, Shift, X - (FWorkspace.Left - Left),
|
|
Y - (FWorkspace.Top - Top));
|
|
end;
|
|
|
|
procedure TMarginsPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited;
|
|
|
|
if FWorkspace.FMode = dmSelect then
|
|
FWorkspace.MouseMove(Shift, X - (FWorkspace.Left - Left),
|
|
Y - (FWorkspace.Top - Top)) else
|
|
FWorkspace.MouseLeave;
|
|
Cursor := FWorkspace.Cursor;
|
|
end;
|
|
|
|
procedure TMarginsPanel.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
inherited;
|
|
FWorkspace.MouseUp(Button, Shift, X - (FWorkspace.Left - Left),
|
|
Y - (FWorkspace.Top - Top));
|
|
end;
|
|
|
|
procedure TMarginsPanel.Paint;
|
|
var
|
|
r: TRect;
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
Brush.Color := Color;
|
|
Pen.Color := $505050;
|
|
Pen.Width := 1;
|
|
Pen.Style := psSolid;
|
|
|
|
Rectangle(0, 0, Width - 1, Height - 1);
|
|
Polyline([Point(1, Height - 1), Point(Width - 1, Height - 1), Point(Width - 1, 0)]);
|
|
|
|
Pixels[0, Height - 1] := clGray;
|
|
Pixels[Width - 1, 0] := clGray;
|
|
|
|
|
|
Pen.Color := clSilver;
|
|
Pen.Style := psDot;
|
|
with FWorkspace, FWorkspace.FMargins do
|
|
r := Rect(Round(Left * FScale), Round(Top * FScale),
|
|
Self.Width - Round(Right * FScale) + 1,
|
|
Self.Height - Round(Bottom * FScale) + 1);
|
|
|
|
Polyline([Point(r.Left - 1, r.Top - 1),
|
|
Point(r.Left - 1, r.Bottom),
|
|
Point(r.Right, r.Bottom),
|
|
Point(r.Right, r.Top - 1),
|
|
Point(r.Left - 1, r.Top - 1)]);
|
|
end;
|
|
end;
|
|
|
|
procedure TMarginsPanel.WMEraseBackground(var Message: TMessage);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
|
|
{ TfrxDesignerWorkspace }
|
|
|
|
constructor TfrxDesignerWorkspace.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FSavedAlign := TList.Create;
|
|
FullRepaint := False;
|
|
Screen.Cursors[crPencil] := LoadCursor(hInstance, 'frxPENCIL');
|
|
|
|
FMarginsPanel := TMarginsPanel.Create(AOwner);
|
|
TMarginsPanel(FMarginsPanel).FWorkspace := Self;
|
|
//FInplaceMemo := TInplaceMemo.Create(Self);
|
|
EnableHint := True;
|
|
|
|
FBandHeader := fr01cm * 5;
|
|
FColor := clWhite;
|
|
FGridAlign := True;
|
|
FGridType := gt1cm;
|
|
FGridX := fr01cm;
|
|
FGridY := fr01cm;
|
|
FMode := dmSelect;
|
|
FMode1 := dmNone;
|
|
FScale := 1;
|
|
FShowGrid := True;
|
|
FShowEdges := True;
|
|
FInternalSelObjects := TList.Create;
|
|
CreateInPlaceEditorsList;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.CreateInPlaceEditorsList;
|
|
begin
|
|
{$IFNDEF FPC}
|
|
Locked := True;
|
|
try
|
|
{$ENDIF}
|
|
if Assigned(FInPlaceditorsList) then
|
|
FreeAndNil(FInPlaceditorsList);
|
|
FInPlaceditorsList := frxRegEditorsClasses.CreateEditorsInstances(evDesigner, Self);
|
|
{$IFNDEF FPC}
|
|
finally
|
|
Locked := False;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TfrxDesignerWorkspace.Destroy;
|
|
begin
|
|
FSavedAlign.Free;
|
|
FreeAndNil(FInPlaceditorsList);
|
|
FreeAndNil(FInternalSelObjects);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetParent(AParent: TWinControl);
|
|
begin
|
|
if not (csDestroying in ComponentState) then
|
|
FMarginsPanel.Parent := AParent;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DisableUpdate;
|
|
begin
|
|
FDisableUpdate := True;
|
|
FMode := dmSelect;
|
|
FMode1 := dmNone;
|
|
ClearLastView;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.EnableUpdate;
|
|
begin
|
|
FDisableUpdate := False;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.UpdateView;
|
|
var
|
|
NotifyRect: TfrxRect;
|
|
begin
|
|
Invalidate;
|
|
if SelectedCount = 0 then
|
|
NotifyRect := frxRect(0, 0, 0, 0) else
|
|
NotifyRect := GetSelectionBounds;
|
|
if Assigned(FOnNotifyPosition) then
|
|
FOnNotifyPosition(NotifyRect);
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.WMMove(var Message: TWMMove);
|
|
begin
|
|
inherited;
|
|
if Assigned(FOnTopLeftChanged) then
|
|
FOnTopLeftChanged(Self);
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetInsertion(AClass: TfrxComponentClass;
|
|
AWidth, AHeight: Extended; AFlag: Word);
|
|
begin
|
|
with FInsertion do
|
|
begin
|
|
ComponentClass := AClass;
|
|
Width := AWidth;
|
|
Height := AHeight;
|
|
OriginalWidth := AWidth;
|
|
OriginalHeight := AHeight;
|
|
Flags := AFlag;
|
|
end;
|
|
|
|
FMode := dmInsert;
|
|
if AClass = nil then
|
|
begin
|
|
FMode := dmSelect;
|
|
FMode1 := dmNone;
|
|
end
|
|
else if AClass.InheritsFrom(TfrxCustomLineView) then
|
|
begin
|
|
Cursor := crPencil;
|
|
FMode1 := dmInsertLine;
|
|
if FGridType = gtChar then
|
|
begin
|
|
FInsertion.Left := - FGridX / 2;
|
|
FInsertion.Top := - FGridY / 2;
|
|
end
|
|
else
|
|
begin
|
|
FInsertion.Left := - FGridX;
|
|
FInsertion.Top := - FGridY;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Cursor := crCross;
|
|
FMode1 := dmInsertObject;
|
|
FInsertion.Left := -1000 * FGridX;
|
|
FInsertion.Top := -1000 * FGridY;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetScale(Value: Extended);
|
|
begin
|
|
FScale := Value;
|
|
|
|
FMarginsPanel.Width := Round(FPageWidth * FScale);
|
|
FMarginsPanel.Height := Round(FPageHeight * FScale);
|
|
|
|
SetBounds(FMarginsPanel.Left + Round(FMargins.Left * FScale),
|
|
FMarginsPanel.Top + Round(FMargins.Top * FScale),
|
|
FMarginsPanel.Width - Round((FMargins.Left + FMargins.Right - 1) * FScale),
|
|
FMarginsPanel.Height - Round((FMargins.Top + FMargins.Bottom - 1) * FScale));
|
|
|
|
FMarginsPanel.Invalidate;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetPageDimensions(AWidth, AHeight: Integer;
|
|
AMargins: TRect);
|
|
begin
|
|
FPageWidth := AWidth;
|
|
FPageHeight := AHeight;
|
|
FMargins := AMargins;
|
|
SetScale(FScale);
|
|
AdjustBands;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetShowGrid(const Value: Boolean);
|
|
begin
|
|
FShowGrid := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetVirtualGuids(VGuid, HGuid: Extended);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.UpdateBandHeader;
|
|
begin
|
|
case FGridType of
|
|
gt1pt, gtDialog:
|
|
FBandHeader := 16;
|
|
gt1cm:
|
|
FBandHeader := fr01cm * 5;
|
|
gt1in:
|
|
FBandHeader := fr01in * 2;
|
|
gtChar:
|
|
FBandHeader := fr1CharY;
|
|
end;
|
|
|
|
if not FShowBandCaptions then
|
|
FBandHeader := 0;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.UpdateInternalSelection;
|
|
begin
|
|
if FSelectedObjects.Updated then
|
|
SelectionChanged;
|
|
FSelectedObjects.Updated := False;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetGridType(const Value: TfrxGridType);
|
|
begin
|
|
FGridType := Value;
|
|
UpdateBandHeader;
|
|
if FSelectedObjects.Count <> 0 then
|
|
MouseMove([], 0, 0);
|
|
AdjustBands;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetShowBandCaptions(const Value: Boolean);
|
|
begin
|
|
FShowBandCaptions := Value;
|
|
UpdateBandHeader;
|
|
AdjustBands;
|
|
Invalidate;
|
|
end;
|
|
|
|
function TfrxDesignerWorkspace.GetOrigin: TPoint;
|
|
begin
|
|
Result.X := FMarginsPanel.Left;
|
|
Result.Y := FMarginsPanel.Top;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetOrigin(const Value: TPoint);
|
|
begin
|
|
FMarginsPanel.Left := Value.X;
|
|
FMarginsPanel.Top := Value.Y;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetClipboardObject(Clipboard: TPersistent);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FInPlaceditorsList.Count - 1 do
|
|
FInPlaceditorsList.Editors[i].SetClipboardObject(Clipboard);
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetColor_(const Value: TColor);
|
|
begin
|
|
FColor := Value;
|
|
FMarginsPanel.Color := Value;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetDefaultEventParams(
|
|
var EventParams: TfrxInteractiveEventsParams);
|
|
begin
|
|
EventParams.EventSender := esDesigner;
|
|
EventParams.Refresh := False;
|
|
EventParams.PopupVisible := False;
|
|
EventParams.EditorsList := FInPlaceditorsList;
|
|
EventParams.Modified := False;
|
|
EventParams.OnFinish := DoFinishInPlace;
|
|
EventParams.OffsetX := 0;
|
|
EventParams.OffsetY := 0;
|
|
EventParams.Scale := FScale;
|
|
EventParams.Sender := Self;
|
|
EventParams.FireParentEvent := False;
|
|
EventParams.GridAlign := FGridAlign;
|
|
EventParams.GridType := FGridType;
|
|
EventParams.GridX := FGridX;
|
|
EventParams.GridY := FGridY;
|
|
EventParams.EditRestricted := False;
|
|
EventParams.DevicePPI := CurrentPPI;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DoFinishInPlace(Sender: TObject; Refresh,
|
|
Modified: Boolean);
|
|
begin
|
|
FModifyFlag := Modified;
|
|
if Modified then
|
|
DoModify;
|
|
if Refresh then
|
|
Invalidate;
|
|
//{$IFDEF FPC}
|
|
// frxUpdateControl(Self);
|
|
//{$ELSE}
|
|
// Repaint;
|
|
//{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DoModify;
|
|
begin
|
|
if FModifyFlag then
|
|
if Assigned(FOnModify) then
|
|
FOnModify(Self);
|
|
FModifyFlag := False;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SelectionChanged(aNewSelection: TList = nil);
|
|
var
|
|
i, j: Integer;
|
|
c, c1: TfrxComponent;
|
|
// bFirst: Boolean;
|
|
begin
|
|
// { check selection set from component }
|
|
// { inspector can select TPersistent ancestors }
|
|
// if aNewSelection <> nil then
|
|
// begin
|
|
// FSelectedObjects.InspSelectedObjects.Clear;
|
|
// bFirst := True;
|
|
// for i := 0 to aNewSelection.Count - 1 do
|
|
// begin
|
|
// if TObject(aNewSelection[i]) is TfrxComponent then
|
|
// begin
|
|
// if bFirst then
|
|
// begin
|
|
//// FSelectedObjects.Clear;
|
|
// bFirst := False;
|
|
// end;
|
|
// if FSelectedObjects.IndexOf(aNewSelection[i]) = -1 then
|
|
// FSelectedObjects.Add(aNewSelection[i]);
|
|
// end
|
|
// else
|
|
// if TObject(aNewSelection[i]) is TPersistent then
|
|
// FSelectedObjects.InspSelectedObjects.Add(aNewSelection[i]);
|
|
// end;
|
|
// end;
|
|
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
if (c is TfrxReportComponent) and (c.GroupIndex <> 0) then
|
|
for j := 0 to FObjects.Count - 1 do
|
|
begin
|
|
c1 := TfrxComponent(FObjects[j]);
|
|
if (c1 is TfrxReportComponent) and (c1.GroupIndex = c.GroupIndex) then
|
|
begin
|
|
if FSelectedObjects.IndexOf(c1) = -1 then
|
|
FSelectedObjects.Add(c1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if Assigned(FOnSelectionChanged) then
|
|
FOnSelectionChanged(Self);
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TfrxDesignerWorkspace.GetSelectionBounds: TfrxRect;
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
begin
|
|
if SelectedCount = 1 then
|
|
begin
|
|
with TfrxComponent(FSelectedObjects[0]) do
|
|
Result := frxRect(Left, Top, Width, Height);
|
|
Exit;
|
|
end;
|
|
|
|
Result := frxRect(1e10, 1e10, -1e10, -1e10);
|
|
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
|
|
if c.AbsLeft < Result.Left then
|
|
Result.Left := c.AbsLeft;
|
|
if c.AbsTop < Result.Top then
|
|
Result.Top := c.AbsTop;
|
|
if c.AbsLeft + c.Width > Result.Right then
|
|
Result.Right := c.AbsLeft + c.Width;
|
|
if c.AbsTop + c.Height > Result.Bottom then
|
|
Result.Bottom := c.AbsTop + c.Height;
|
|
end;
|
|
|
|
with Result do
|
|
Result := frxRect(Left, Top, Right - Left, Bottom - Top);
|
|
end;
|
|
|
|
function TfrxDesignerWorkspace.GetRightBottomObject: TfrxComponent;
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
maxx, maxy: Extended;
|
|
begin
|
|
maxx := 0;
|
|
maxy := 0;
|
|
Result := nil;
|
|
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
if (c.AbsLeft + c.Width > maxx) or
|
|
((c.AbsLeft + c.Width = maxx) and (c.AbsTop + c.Height > maxy)) then
|
|
begin
|
|
maxx := c.AbsLeft + c.Width;
|
|
maxy := c.AbsTop + c.Height;
|
|
Result := c;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TfrxDesignerWorkspace.SelectedCount: Integer;
|
|
begin
|
|
Result := FSelectedObjects.Count;
|
|
if (Result = 1) and
|
|
((TfrxComponent(FSelectedObjects[0]) = FPage) or (TObject(FSelectedObjects[0]) is TfrxReport)) then
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.WMEraseBackground(var Message: TMessage);
|
|
begin
|
|
// do nothing, prevent flickering
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.SetEnableHint(vEnableHint: boolean);
|
|
begin
|
|
FEnableHint := vEnableHint;
|
|
if (vEnableHint) then
|
|
FfrxHintShowEvent := RealHintShow
|
|
else
|
|
FfrxHintShowEvent := FakeHintShow;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.FakeHintShow(var Msg: TCMHintShow);
|
|
begin
|
|
//do nothing
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.RealHintShow(var Msg: TCMHintShow);
|
|
var
|
|
Header, PropText: String;
|
|
HMemoView: TfrxCustomMemoView;
|
|
begin
|
|
if not (FLastObjectOver is TfrxCustomMemoView) then Exit;
|
|
HMemoView := TfrxCustomMemoView(FLastObjectOver);
|
|
if HMemoView.HasOutboundContent then
|
|
begin
|
|
Header := frxResources.Get('obText');
|
|
PropText := HMemoView.Text;
|
|
|
|
Msg.HintInfo.HintStr := PropText;
|
|
Msg.HintInfo.HintWindowClass := TDesgnHintWindow;
|
|
Msg.HintInfo.HintData := TDesgnHintData.Create('', Header, False, HMemoView);
|
|
Msg.HintInfo.HideTimeout := MaxInt;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.WMFRXHintShow(var Msg: TCMHintShow);
|
|
begin
|
|
inherited;
|
|
FfrxHintShowEvent(Msg);
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.Paint;
|
|
var
|
|
bmp: TBitmap;
|
|
begin
|
|
bmp := TBitmap.Create;
|
|
try
|
|
{$IFDEF FPC}
|
|
with Self.BoundsRect do
|
|
// Canvas.ClipRect do
|
|
begin
|
|
bmp.Width := Right - Left;
|
|
bmp.Height := Bottom - Top;
|
|
FCanvas := bmp.Canvas;
|
|
//SetViewPortOrgEx(FCanvas.Handle, -Left, -Top, nil);
|
|
end;
|
|
{$ELSE}
|
|
with Canvas.ClipRect do
|
|
begin
|
|
bmp.Width := Right - Left;
|
|
bmp.Height := Bottom - Top;
|
|
FCanvas := bmp.Canvas;
|
|
SetViewPortOrgEx(FCanvas.Handle, -Left, -Top, nil);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
DrawBackground;
|
|
if not FDisableUpdate then
|
|
begin
|
|
if (FPage <> nil) and (FPage is TfrxPage) then
|
|
TfrxReportPage(FPage).Draw(FCanvas, FScale, FScale,
|
|
-FMargins.Left * FScale,
|
|
-FMargins.Top * FScale);
|
|
DrawObjects;
|
|
end;
|
|
|
|
BitBlt(Canvas.Handle, 0, 0, Width, Height, FCanvas.Handle, 0, 0, SRCCOPY);
|
|
{$IFDEF FPC}
|
|
DrawSelectionRect;
|
|
{$ENDIF}
|
|
finally
|
|
bmp.Free;
|
|
end;
|
|
FCanvas := nil;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.PaintWindow(DC: HDC);
|
|
begin
|
|
if not FSkipPaintWindow then
|
|
Inherited;
|
|
end;
|
|
|
|
type
|
|
THackfrxView = class(TfrxView);
|
|
|
|
procedure TfrxDesignerWorkspace.DrawObjects;
|
|
var
|
|
i: Integer;
|
|
cc: TfrxComponent;
|
|
// c: TfrxReportComponent;
|
|
function CreateRotatedFont(AFont: TFont; Rotation: Integer): HFont;
|
|
var
|
|
F: TLogFont;
|
|
begin
|
|
GetObject(AFont.Handle, SizeOf(TLogFont), @F);
|
|
F.lfEscapement := Rotation * 10;
|
|
F.lfOrientation := Rotation * 10;
|
|
Result := CreateFontIndirect(F);
|
|
end;
|
|
|
|
// procedure DrawPoint(x, y: Extended);
|
|
// var
|
|
// i, w: Integer;
|
|
// begin
|
|
// if FScale > 1.7 then
|
|
// w := 7
|
|
// else if FScale < 0.7 then
|
|
// w := 3 else
|
|
// w := 5;
|
|
// for i := 0 to w - 1 do
|
|
// begin
|
|
// FCanvas.MoveTo(Round(x * FScale) - w div 2, Round(y * FScale) - w div 2 + i);
|
|
// FCanvas.LineTo(Round(x * FScale) + w div 2 +1, Round(y * FScale) - w div 2 + i);
|
|
// end;
|
|
// end;
|
|
|
|
procedure DrawLine(x, y, dx, dy: Extended);
|
|
begin
|
|
FCanvas.MoveTo(Round(x * FScale), Round(y * FScale));
|
|
FCanvas.LineTo(Round((x + dx) * FScale), Round((y + dy) * FScale));
|
|
end;
|
|
|
|
// procedure DrawSqares(c: TfrxComponent);
|
|
// var
|
|
// px, py: Extended;
|
|
// begin
|
|
// with c, FCanvas do
|
|
// begin
|
|
// Pen.Style := psSolid;
|
|
// Pen.Width := 1;
|
|
// Pen.Mode := pmXor;
|
|
// Pen.Color := clWhite;
|
|
// px := AbsLeft + c.Width / 2;
|
|
// py := AbsTop + c.Height / 2;
|
|
//
|
|
// DrawPoint(AbsLeft, AbsTop);
|
|
// if not (c is TfrxCustomLineView) then
|
|
// begin
|
|
// DrawPoint(AbsLeft + c.Width, AbsTop);
|
|
// DrawPoint(AbsLeft, AbsTop + c.Height);
|
|
// end;
|
|
// if (SelectedCount > 1) and (c = GetRightBottomObject) then
|
|
// Pen.Color := clTeal;
|
|
// DrawPoint(AbsLeft + c.Width, AbsTop + c.Height);
|
|
//
|
|
// Pen.Color := clWhite;
|
|
// if (SelectedCount = 1) and not (c is TfrxCustomLineView) then
|
|
// begin
|
|
// DrawPoint(px, AbsTop);
|
|
// DrawPoint(px, AbsTop + c.Height);
|
|
// DrawPoint(AbsLeft, py);
|
|
// DrawPoint(AbsLeft + c.Width, py);
|
|
// end;
|
|
//
|
|
// Pen.Mode := pmCopy;
|
|
// end;
|
|
// end;
|
|
|
|
procedure DrawScriptSign(c: TfrxReportComponent);
|
|
var
|
|
NeedDraw: Boolean;
|
|
Offs: Extended;
|
|
begin
|
|
NeedDraw := False;
|
|
Offs := 0;
|
|
{$IFDEF FPC}
|
|
if c is TfrxCustomMemoView then
|
|
NeedDraw := TfrxCustomMemoView(c).Highlight.Condition <> '';
|
|
{$ENDIF}
|
|
if c is TfrxReportComponent then
|
|
with c do
|
|
if (OnBeforePrint <> '') or (OnAfterPrint <> '') or
|
|
(OnAfterData <> '') or (OnPreviewClick <> '') then
|
|
NeedDraw := True;
|
|
if c is TfrxDialogControl then
|
|
with TfrxDialogControl(c) do
|
|
if (OnClick <> '') or (OnDblClick <> '') or
|
|
(OnEnter <> '') or (OnExit <> '') or
|
|
(OnKeyDown <> '') or (OnKeyPress <> '') or
|
|
(OnKeyUp <> '') or (OnMouseDown <> '') or
|
|
(OnMouseMove <> '') or (OnMouseUp <> '') then
|
|
NeedDraw := True;
|
|
if c is TfrxBand then
|
|
with TfrxBand(c) do
|
|
begin
|
|
if (OnAfterCalcHeight <> '') then
|
|
NeedDraw := True;
|
|
if not Vertical then
|
|
Offs := -FBandHeader + 2;
|
|
end;
|
|
|
|
if NeedDraw then
|
|
with c, FCanvas do
|
|
begin
|
|
Pen.Style := psSolid;
|
|
Pen.Color := clRed;
|
|
Pen.Width := 1;
|
|
DrawLine(AbsLeft + 2, AbsTop + Offs + 1, 0, 7);
|
|
DrawLine(AbsLeft + 3, AbsTop + Offs + 2, 0, 5);
|
|
DrawLine(AbsLeft + 4, AbsTop + Offs + 3, 0, 3);
|
|
DrawLine(AbsLeft + 5, AbsTop + Offs + 4, 0, 1);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawObject(c: TfrxReportComponent);
|
|
begin
|
|
c.IsDesigning := True;
|
|
if c.IsOwnerDraw then Exit;
|
|
{ bands draws moved to Bands clases, move easy to handle draw (for drag and drop) }
|
|
{ assign header size from designer }
|
|
if c is TfrxBand then
|
|
TfrxBand(c).BandDesignHeader := FBandHeader;
|
|
FSkipPaintWindow := True;
|
|
c.InteractiveDraw(FCanvas, FScale, FScale, FOffsetX, FOffsetY, False);
|
|
FSkipPaintWindow := False;
|
|
|
|
DrawScriptSign(c);
|
|
|
|
if c.IsAncestor then
|
|
frxResources.MainButtonImages.Draw(FCanvas,
|
|
Round((c.AbsLeft + 2) * FScale), Round((c.AbsTop + 1) * FScale), 99);
|
|
end;
|
|
|
|
// debug
|
|
// procedure DrawShiftTree(c: TfrxReportComponent);
|
|
// var
|
|
// i: Integer;
|
|
// c1: TfrxReportComponent;
|
|
// begin
|
|
// for i := 0 to c.FShiftChildren.Count - 1 do
|
|
// begin
|
|
// c1 := TfrxReportComponent(c.FShiftChildren[i]);
|
|
// with FCanvas do
|
|
// begin
|
|
// Pen.Style := psSolid;
|
|
// Pen.Color := clRed;
|
|
// Pen.Mode := pmCopy;
|
|
// Pen.Width := 1;
|
|
// if c is TfrxBand then
|
|
// MoveTo(Round(c.AbsLeft + c.Width / 2), Round(c.AbsTop))
|
|
// else
|
|
// MoveTo(Round(c.AbsLeft + c.Width / 2), Round(c.AbsTop + c.Height));
|
|
// LineTo(Round(c1.AbsLeft + c1.Width / 2), Round(c1.AbsTop));
|
|
// end;
|
|
// DrawShiftTree(c1);
|
|
// end;
|
|
// end;
|
|
|
|
|
|
procedure DrawIntersections();
|
|
var
|
|
i, j: Integer;
|
|
FBufObjects: TList;
|
|
|
|
function frxIntersectRect(const obj1, obj2: THackfrxView): Boolean;
|
|
begin
|
|
Result := (obj1.FX < obj2.FX1)
|
|
and (obj1.FX1 > obj2.FX)
|
|
and (obj1.FY < obj2.FY1)
|
|
and (obj1.FY1 > obj2.FY);
|
|
end;
|
|
|
|
|
|
function DoHighlighting(c: TfrxView): TRect;
|
|
begin
|
|
c.Highlighting(FCanvas, IntersectionsColor)
|
|
end;
|
|
|
|
function CheckParent(obj1, obj2: TfrxComponent): Boolean;
|
|
begin
|
|
Result := False;
|
|
if (csContainer in obj2.frComponentStyle) or (csObjectsContainer in obj2.frComponentStyle) then
|
|
while (obj1.Parent <> nil) do
|
|
begin
|
|
if not (obj1.Parent is TfrxComponent) then
|
|
break;
|
|
obj1 := obj1.Parent;
|
|
if obj1.Parent = obj2 then
|
|
begin
|
|
Result := True;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FBufObjects := TList.Create;
|
|
|
|
for i := 0 to FObjects.Count - 1 do
|
|
begin
|
|
cc := TfrxComponent(FObjects[i]);
|
|
if (cc is TfrxView) and not(csContained in cc.frComponentStyle) then
|
|
FBufObjects.Add(cc);
|
|
end;
|
|
|
|
for i := 0 to FBufObjects.Count - 1 do
|
|
for j := 0 to FBufObjects.Count - 1 do
|
|
begin
|
|
if i <> j then
|
|
if frxIntersectRect(THackfrxView(FBufObjects[i]), THackfrxView(FBufObjects[j])) then
|
|
begin
|
|
if CheckParent(TfrxView(FBufObjects[i]), TfrxView(FBufObjects[j])) or CheckParent(TfrxView(FBufObjects[j]), TfrxView(FBufObjects[i])) then
|
|
continue;
|
|
DoHighlighting(TfrxView(FBufObjects[i]));
|
|
DoHighlighting(TfrxView(FBufObjects[j]));
|
|
end;
|
|
end;
|
|
FBufObjects.Free;
|
|
end;
|
|
|
|
|
|
begin
|
|
{ update aligned objects }
|
|
if Page is TfrxReportPage then
|
|
Page.AlignChildren;
|
|
|
|
{ draw objects }
|
|
for i := 0 to FObjects.Count - 1 do
|
|
begin
|
|
cc := TfrxComponent(FObjects[i]);
|
|
if (cc is TfrxReportComponent) and not(csContained in cc.frComponentStyle) then
|
|
DrawObject(TfrxReportComponent(cc));
|
|
end;
|
|
|
|
// debug
|
|
// for i := 0 to FObjects.Count - 1 do
|
|
// begin
|
|
// c := FObjects[i];
|
|
// if c is TfrxBand then
|
|
// begin
|
|
// PrepareShiftTree(TfrxBand(c));
|
|
// DrawShiftTree(TfrxReportComponent(c));
|
|
// end;
|
|
// end;
|
|
|
|
{ draw intersections }
|
|
if (FIntersections) then
|
|
DrawIntersections;
|
|
|
|
{ draw selection }
|
|
//TODO REMOVE
|
|
for i := 0 to SelectedCount - 1 do
|
|
if not FMouseDown and (Tobject(FSelectedObjects[i]) is TfrxReportComponent) then
|
|
THackReportComponent(FSelectedObjects[i]).DrawSizeBox(FCanvas, FScale, False);
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DrawBackground;
|
|
|
|
procedure LineXX(x, y, x1, y1: Integer);
|
|
begin
|
|
FCanvas.MoveTo(x, y);
|
|
FCanvas.LineTo(x1, y1);
|
|
end;
|
|
|
|
procedure DrawPoints;
|
|
var
|
|
GridBmp: TBitmap;
|
|
i: Extended;
|
|
c: TColor;
|
|
dx, dy: Extended;
|
|
begin
|
|
if FGridType = gtDialog then
|
|
c := clBlack else
|
|
c := clGray;
|
|
dx := FGridX * FScale;
|
|
dy := FGridY * FScale;
|
|
if (dx > 2) and (dy > 2) then
|
|
begin
|
|
GridBmp := TBitmap.Create;
|
|
GridBmp.Width:= Width;
|
|
GridBmp.Height := 1;
|
|
|
|
GridBmp.Canvas.Pen.Color := FColor;
|
|
GridBmp.Canvas.MoveTo(0, 0);
|
|
GridBmp.Canvas.LineTo(Width, 0);
|
|
|
|
i := 0;
|
|
while i < Width do
|
|
begin
|
|
GridBmp.Canvas.Pixels[Round(i), 0] := c;
|
|
i := i + dx;
|
|
end;
|
|
|
|
i := 0;
|
|
while i < Height do
|
|
begin
|
|
FCanvas.Draw(0, Round(i), GridBmp);
|
|
i := i + dy;
|
|
end;
|
|
|
|
GridBmp.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure DrawMM;
|
|
var
|
|
i, dx, maxi: Extended;
|
|
i1: Integer;
|
|
Color5, Color10: TColor;
|
|
begin
|
|
if FGridLCD then
|
|
begin
|
|
Color5 := $F2F2F2;
|
|
Color10 := $E2E2E2;
|
|
end
|
|
else
|
|
begin
|
|
Color5 := $F8F8F8;
|
|
Color10 := $E8E8E8;
|
|
end;
|
|
|
|
with FCanvas do
|
|
begin
|
|
Pen.Width := 1;
|
|
Pen.Mode := pmCopy;
|
|
Pen.Style := psSolid;
|
|
|
|
if FGridType = gt1cm then
|
|
dx := fr01cm * FScale else
|
|
dx := fr01in * FScale;
|
|
|
|
if Width > Height then
|
|
maxi := Width else
|
|
maxi := Height;
|
|
|
|
i := 0;
|
|
i1 := 0;
|
|
while i < maxi do
|
|
begin
|
|
if i1 mod 10 = 0 then
|
|
Pen.Color := Color10
|
|
else if i1 mod 5 = 0 then
|
|
Pen.Color := Color5
|
|
else if FGridType = gt1in then
|
|
Pen.Color := Color5
|
|
else
|
|
Pen.Color := clWhite;
|
|
if Pen.Color <> clWhite then
|
|
begin
|
|
LineXX(Round(i), 0, Round(i), Height);
|
|
LineXX(0, Round(i), Width, Round(i));
|
|
end;
|
|
i := i + dx;
|
|
Inc(i1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FCanvas.Brush.Color := FColor;
|
|
FCanvas.Brush.Style := bsSolid;
|
|
FCanvas.FillRect(Rect(0, 0, Width, Height));
|
|
|
|
if FShowGrid then
|
|
case FGridType of
|
|
gt1pt, gtDialog, gtChar:
|
|
DrawPoints;
|
|
gt1cm, gt1in:
|
|
DrawMM;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DrawSelectionRect;
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
Pen.Mode := pmXor;
|
|
Pen.Color := clSilver;
|
|
Pen.Width := 1;
|
|
Pen.Style := psDot;
|
|
Brush.Style := bsClear;
|
|
with FSelectionRect do
|
|
Rectangle(Round(Left), Round(Top), Round(Right), Round(Bottom));
|
|
Pen.Mode := pmCopy;
|
|
Brush.Style := bsSolid;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DrawInsertionRect;
|
|
var
|
|
R: TfrxRect;
|
|
begin
|
|
{$IFDEF FPC}
|
|
if not Assigned(FCanvas) then
|
|
exit;
|
|
with FCanvas do
|
|
{$ELSE}
|
|
with Canvas do
|
|
{$ENDIF}
|
|
begin
|
|
Pen.Mode := pmCopy;
|
|
Pen.Color := clBlack;
|
|
Pen.Width := 1;
|
|
Pen.Style := psDot;
|
|
Brush.Style := bsClear;
|
|
with FInsertion do
|
|
R := frxRect(Left, Top, Left + Width, Top + Height);
|
|
NormalizeRect(R);
|
|
Rectangle(Round(R.Left * FScale), Round(R.Top * FScale),
|
|
Round(R.Right * FScale) + 1, Round(R.Bottom * FScale) + 1);
|
|
Brush.Style := bsSolid;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DrawCross(Down: Boolean);
|
|
var
|
|
x, y: Extended;
|
|
begin
|
|
{$IFDEF FPC}
|
|
if not Assigned(FCanvas) then
|
|
exit;
|
|
{$ENDIF}
|
|
with FInsertion do
|
|
if Down then
|
|
begin
|
|
if Flags <> 0 then
|
|
begin
|
|
x := (Left + Width) * FScale;
|
|
y := (Top + Height) * FScale;
|
|
end
|
|
else if Abs(Width) > Abs(Height) then
|
|
begin
|
|
x := (Left + Width) * FScale;
|
|
y := Top * FScale;
|
|
end
|
|
else
|
|
begin
|
|
x := Left * FScale;
|
|
y := (Top + Height) * FScale;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
x := Left * FScale;
|
|
y := Top * FScale;
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
with FCanvas do
|
|
{$ELSE}
|
|
with Canvas do
|
|
{$ENDIF}
|
|
begin
|
|
Pen.Mode := pmXor;
|
|
Pen.Color := clSilver;
|
|
Pen.Width := 1;
|
|
Pen.Style := psSolid;
|
|
MoveTo(Round(x - 4), Round(y));
|
|
LineTo(Round(x + 5), Round(y));
|
|
MoveTo(Round(x), Round(y - 4));
|
|
LineTo(Round(x), Round(y + 5));
|
|
if Down then
|
|
begin
|
|
MoveTo(Round(FInsertion.Left * FScale), Round(FInsertion.Top * FScale));
|
|
LineTo(Round(x), Round(y));
|
|
end;
|
|
|
|
Pen.Mode := pmCopy;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.FindNearest(dx, dy: Integer);
|
|
var
|
|
i: Integer;
|
|
c, sel, found: TfrxComponent;
|
|
min, dist, dist_dx, dist_dy: Extended;
|
|
r1, r2, r3: TfrxRect;
|
|
|
|
function RectsIntersect(r1, r2: TfrxRect): Boolean;
|
|
begin
|
|
Result := not ((r2.Left > r1.Right) or (r2.Right < r1.Left) or
|
|
(r2.Top > r1.Bottom) or (r2.Bottom < r1.Top));
|
|
end;
|
|
|
|
begin
|
|
if SelectedCount <> 1 then Exit;
|
|
|
|
found := nil;
|
|
sel := TfrxComponent(FSelectedObjects[0]);
|
|
min := 1e10;
|
|
for i := 0 to FObjects.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(FObjects[i]);
|
|
if not (c is TfrxReportComponent) or (c is TfrxBand) or (c = sel) then continue;
|
|
|
|
r1 := frxRect(c.AbsLeft, c.AbsTop, c.AbsLeft + c.Width, c.AbsTop + c.Height);
|
|
dist := 0;
|
|
dist_dx := 0;
|
|
dist_dy := 0;
|
|
with sel do
|
|
if dx = 1 then
|
|
begin
|
|
r2 := frxRect(AbsLeft, AbsTop, 1e10, AbsTop + Height);
|
|
r3 := frxRect(AbsLeft, 0, 1e10, 1e10);
|
|
dist := r1.Left - r2.Left;
|
|
dist_dx := r1.Left - (AbsLeft + Width);
|
|
if r1.Top > r2.Top then
|
|
dist_dy := r1.Top - r2.Bottom else
|
|
dist_dy := r2.Top - r1.Bottom;
|
|
end
|
|
else if dx = -1 then
|
|
begin
|
|
r2 := frxRect(-1e10, AbsTop, AbsLeft + Width, AbsTop + Height);
|
|
r3 := frxRect(0, 0, AbsLeft + Width, 1e10);
|
|
dist := r2.Right - r1.Right;
|
|
dist_dx := AbsLeft - r1.Right;
|
|
if r1.Top > r2.Top then
|
|
dist_dy := r1.Top - r2.Bottom else
|
|
dist_dy := r2.Top - r1.Bottom;
|
|
end
|
|
else if dy = 1 then
|
|
begin
|
|
r2 := frxRect(AbsLeft, AbsTop, AbsLeft + Width, 1e10);
|
|
r3 := frxRect(0, AbsTop, 1e10, 1e10);
|
|
dist := r1.Top - r2.Top;
|
|
dist_dy := r1.Top - (AbsTop + Height);
|
|
if r1.Left > r2.Left then
|
|
dist_dx := r1.Left - r2.Right else
|
|
dist_dx := r2.Left - r1.Right;
|
|
end
|
|
else if dy = -1 then
|
|
begin
|
|
r2 := frxRect(AbsLeft, -1e10, AbsLeft + Width, AbsTop + Height);
|
|
r3 := frxRect(0, 0, 1e10, AbsTop + Height);
|
|
dist := r2.Bottom - r1.Bottom;
|
|
dist_dy := AbsTop - r1.Bottom;
|
|
if r1.Left > r2.Left then
|
|
dist_dx := r1.Left - r2.Right else
|
|
dist_dx := r2.Left - r1.Right;
|
|
end;
|
|
|
|
if not RectsIntersect(r1, r2) then
|
|
begin
|
|
if (not RectsIntersect(r1, r3)) or
|
|
((dx <> 0) and (dist_dx < dist_dy)) or
|
|
((dy <> 0) and (dist_dy < dist_dx)) or
|
|
((dist_dx = 0) and (dist_dy = 0)) then continue;
|
|
dist := sqrt(dist_dx * dist_dx + dist_dy * dist_dy) * (Width + Height);
|
|
end;
|
|
|
|
if dist < min then
|
|
begin
|
|
found := c;
|
|
min := dist;
|
|
end;
|
|
end;
|
|
|
|
if found <> nil then
|
|
begin
|
|
FSelectedObjects.Clear;
|
|
FSelectedObjects.Add(found);
|
|
if Assigned(FOnNotifyPosition) then
|
|
FOnNotifyPosition(GetSelectionBounds);
|
|
SelectionChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.NormalizeCoord(c: TfrxComponent);
|
|
begin
|
|
if c.Width < 0 then
|
|
begin
|
|
c.Width := -c.Width;
|
|
c.Left := c.Left - c.Width;
|
|
end;
|
|
if c.Height < 0 then
|
|
begin
|
|
c.Height := -c.Height;
|
|
c.Top := c.Top - c.Height;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.NormalizeRect(var R: TfrxRect);
|
|
var
|
|
i: Extended;
|
|
begin
|
|
with R do
|
|
begin
|
|
if Left > Right then
|
|
begin
|
|
i := Left;
|
|
Left := Right;
|
|
Right := i
|
|
end;
|
|
if Top > Bottom then
|
|
begin
|
|
i := Top;
|
|
Top := Bottom;
|
|
Bottom := i
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.AdjustBands(AttachObjects: Boolean = True);
|
|
var
|
|
i, j: Integer;
|
|
sl: {$IFNDEF NONWINFPC}TStringList{$ELSE}TfrxStringList{$ENDIF};
|
|
b: TfrxBand;
|
|
cc, cc0, cc1: TfrxComponent;
|
|
add, add1, aTop, aLeft: Extended;
|
|
l: TList;
|
|
ch: TfrxChild;
|
|
|
|
procedure BuildList(aComp: TfrxComponent);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if not(aComp is TfrxPage) and not(aComp is TfrxBand) then
|
|
l.Add(aComp);
|
|
for i := 0 to aComp.Objects.Count - 1 do
|
|
BuildList(TfrxComponent(aComp.Objects[i]));
|
|
end;
|
|
|
|
procedure DoBand(Bnd: TfrxBand);
|
|
var
|
|
y: Extended;
|
|
begin
|
|
if Bnd.Vertical then Exit;
|
|
|
|
if Bnd is TfrxPageHeader then
|
|
y := 0
|
|
else if Bnd is TfrxReportTitle then
|
|
y := 0.01
|
|
else if Bnd is TfrxColumnHeader then
|
|
y := 0.02
|
|
else if Bnd is TfrxColumnFooter then
|
|
y := 99999
|
|
else if Bnd is TfrxReportSummary then
|
|
y := 100000
|
|
else if Bnd is TfrxPageFooter then
|
|
y := 100001
|
|
else
|
|
y := Abs(Bnd.Top);
|
|
|
|
if TfrxReportPage(FPage).TitleBeforeHeader then
|
|
begin
|
|
if Bnd is TfrxReportTitle then
|
|
y := 0
|
|
else if Bnd is TfrxPageHeader then
|
|
y := 0.01
|
|
end;
|
|
|
|
sl.AddObject(Format('%9.2f', [y]), Bnd);
|
|
end;
|
|
|
|
function Round8(e: Extended): Extended;
|
|
begin
|
|
Result := Round(e * 100000000) / 100000000;
|
|
end;
|
|
begin
|
|
if (FPage = nil) or FDisableUpdate then Exit;
|
|
sl := {$IFNDEF NONWINFPC}TStringList.Create;{$ELSE}TfrxStringList.Create;{$ENDIF}
|
|
sl.Sorted := True;
|
|
sl.Duplicates := dupAccept;
|
|
|
|
{ sort bands }
|
|
for i := 0 to FObjects.Count - 1 do
|
|
if TObject(FObjects[i]) is TfrxBand then
|
|
DoBand(TfrxBand(FObjects[i]));
|
|
|
|
{ arrange child bands }
|
|
sl.Sorted := False;
|
|
i := 0;
|
|
while i < sl.Count do
|
|
begin
|
|
sl[i] := '';
|
|
b := TfrxBand(sl.Objects[i]);
|
|
if b.Child <> nil then
|
|
begin
|
|
j := sl.IndexOfObject(b.Child);
|
|
if j <> -1 then
|
|
begin
|
|
cc := TfrxComponent(sl.Objects[j]);
|
|
sl.Delete(j);
|
|
if j < i then
|
|
Dec(i);
|
|
sl.InsertObject(i + 1, '', cc);
|
|
end;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
|
|
{ set top/middle/bottom indexes }
|
|
i := 0;
|
|
while i < sl.Count do
|
|
begin
|
|
b := TfrxBand(sl.Objects[i]);
|
|
if sl[i] = '' then
|
|
if (b is TfrxPageHeader) or (b is TfrxReportTitle) or (b is TfrxColumnHeader) then
|
|
sl[i] := 'top'
|
|
else if (b is TfrxPageFooter) or (b is TfrxReportSummary) or (b is TfrxColumnFooter) then
|
|
sl[i] := 'bottom'
|
|
else
|
|
sl[i] := 'middle';
|
|
ch := b.Child;
|
|
while ch <> nil do
|
|
begin
|
|
j := sl.IndexOfObject(ch);
|
|
if j <> -1 then
|
|
sl[j] := sl[i];
|
|
ch := ch.Child;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
|
|
add1 := 0;
|
|
case FGridType of
|
|
gt1pt: add1 := 40;
|
|
gt1cm: add1 := fr1cm;
|
|
gt1in: add1 := fr1in * 0.4;
|
|
gtChar: add1 := fr1CharY;
|
|
end;
|
|
|
|
{ rearrange all bands }
|
|
if not FFreeBandsPlacement then
|
|
for i := 0 to sl.Count - 1 do
|
|
begin
|
|
cc := TfrxComponent(sl.Objects[i]);
|
|
if i = 0 then
|
|
cc.Top := Round8(FBandHeader)
|
|
else
|
|
begin
|
|
cc0 := TfrxComponent(sl.Objects[i - 1]);
|
|
if ((sl[i - 1] = 'top') and (sl[i] <> 'top')) or
|
|
((sl[i] = 'bottom') and (sl[i - 1] <> 'bottom')) then
|
|
add := add1 else
|
|
add := 0;
|
|
|
|
cc.Top := Round8(Round((cc0.Top + cc0.Height + FBandHeader + FGapBetweenBands)
|
|
/ FGridY) * FGridY + add);
|
|
end;
|
|
end;
|
|
|
|
sl.Free;
|
|
|
|
{ toss objects }
|
|
// TODO Save restrictions ?
|
|
if AttachObjects then
|
|
for i := 0 to FSelectedObjects.Count - 1 do
|
|
begin
|
|
cc := TfrxComponent(FSelectedObjects[i]);
|
|
// do not change parent of contained objects
|
|
// need for old CrossView behaviour
|
|
// TODO remove legacy code
|
|
if (csContained in cc.frComponentStyle) or
|
|
((cc.Parent <> nil) and (csContained in cc.Parent.frComponentStyle) and
|
|
not(csAcceptsFrxComponents in cc.Parent.frComponentStyle)) then
|
|
continue;
|
|
|
|
cc0 := FPage.GetContainedComponent(cc.AbsLeft + 1, cc.AbsTop + 1, cc);
|
|
if (cc0 <> nil) then
|
|
begin
|
|
aTop := cc.AbsTop;
|
|
aLeft := cc.AbsLeft;
|
|
cc.Parent := cc0;
|
|
if not(cc0 is TfrxDialogPage) then
|
|
begin
|
|
cc.Top := aTop - cc0.AbsTop;
|
|
cc.Left := aLeft - cc0.AbsLeft;
|
|
end
|
|
else
|
|
begin
|
|
cc.Top := aTop;
|
|
cc.Left := aLeft;
|
|
BringToFront;
|
|
end;
|
|
end;
|
|
|
|
{ assign childs if container moved over it }
|
|
{ old behaviour for free bands placement }
|
|
{ TODO: Make optional in Designer options }
|
|
if cc.IsAcceptControls and (cc <> FPage) then
|
|
begin
|
|
cc0 := cc.Parent;
|
|
if cc0 <> nil then
|
|
begin
|
|
l := TList.Create;
|
|
l.Assign(cc0.Objects);
|
|
for j := 0 to l.Count - 1 do
|
|
begin
|
|
cc1 := TfrxComponent(l[j]);
|
|
if (cc1 = cc) then
|
|
continue;
|
|
cc0 := cc.GetContainedComponent(cc1.AbsLeft, cc1.AbsTop, cc1);
|
|
if cc0 <> nil then
|
|
begin
|
|
aTop := cc1.AbsTop;
|
|
aLeft := cc1.AbsLeft;
|
|
cc1.Parent := cc0;
|
|
cc1.Top := aTop - cc0.AbsTop;
|
|
cc1.Left := aLeft - cc0.AbsLeft;
|
|
end;
|
|
end;
|
|
l.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ move all bands to the begin of objects list }
|
|
l := TList.Create;
|
|
for i := 0 to FObjects.Count - 1 do
|
|
if TObject(FObjects[i]) is TfrxBand then
|
|
l.Add(FObjects[i]);
|
|
// for i := 0 to FObjects.Count - 1 do
|
|
// if not (TObject(FObjects[i]) is TfrxBand) then
|
|
// TfrxReportComponent(FObjects[i]).Parent
|
|
// l.Add(FObjects[i]);
|
|
BuildList(FPage);
|
|
|
|
FObjects.Clear;
|
|
for i := 0 to l.Count - 1 do
|
|
FObjects.Add(l[i]);
|
|
l.Free;
|
|
end;
|
|
|
|
//procedure TfrxDesignerWorkspace.PrepareShiftTree(Band: TfrxBand);
|
|
//var
|
|
// i, j, k: Integer;
|
|
// c0, c1, c2, atop: TfrxReportComponent;
|
|
// allObjects: TStringList;
|
|
// Found: Boolean;
|
|
// area0, area1, area2, area01: TfrxRectArea;
|
|
//begin
|
|
// allObjects := TStringList.Create;
|
|
// allObjects.Duplicates := dupAccept;
|
|
//
|
|
// { temporary top object }
|
|
// atop := TfrxMemoView.Create(nil);
|
|
// atop.SetBounds(0, Band.Top-2, Band.Width, 1);
|
|
//
|
|
// { sort objects }
|
|
// for i := 0 to Band.Objects.Count - 1 do
|
|
// begin
|
|
// c0 := TfrxReportComponent(Band.Objects[i]);
|
|
// allObjects.AddObject(Format('%9.2f', [c0.Top]), c0);
|
|
// c0.FShiftChildren.Clear;
|
|
// end;
|
|
// allObjects.Sort;
|
|
// allObjects.InsertObject(0, Format('%10.2f', [atop.Top]), atop);
|
|
//
|
|
// for i := 0 to allObjects.Count - 1 do
|
|
// begin
|
|
// c0 := TfrxReportComponent(allObjects.Objects[i]);
|
|
// area0 := TfrxRectArea.Create(c0);
|
|
//
|
|
// { find an object under c0 }
|
|
// for j := i + 1 to allObjects.Count - 1 do
|
|
// begin
|
|
// c1 := TfrxReportComponent(allObjects.Objects[j]);
|
|
// area1 := TfrxRectArea.Create(c1);
|
|
//
|
|
// if not (area0.InterceptsY(area1)) and (area0.Y < area1.Y) and
|
|
// area0.InterceptsX(area1) then
|
|
// begin
|
|
// area01 := area0.InterceptX(area1);
|
|
// Found := False;
|
|
//
|
|
// { check if there is no other objects between c1 and c0 }
|
|
// for k := j - 1 downto i + 1 do
|
|
// begin
|
|
// c2 := TfrxReportComponent(allObjects.Objects[k]);
|
|
// area2 := TfrxRectArea.Create(c2);
|
|
//
|
|
// if not (area0.InterceptsY(area2)) and not (area1.InterceptsY(area2)) and
|
|
// area01.InterceptsX(area2) then
|
|
// Found := True;
|
|
//
|
|
// area2.Free;
|
|
// if Found then
|
|
// break;
|
|
// end;
|
|
//
|
|
// if not Found then
|
|
// c0.FShiftChildren.Add(c1);
|
|
//
|
|
// area01.Free;
|
|
// end;
|
|
//
|
|
// area1.Free;
|
|
// end;
|
|
//
|
|
// area0.Free;
|
|
// end;
|
|
//
|
|
// { copy children from the top object to the band }
|
|
// Band.FShiftChildren.Clear;
|
|
// for i := 0 to atop.FShiftChildren.Count - 1 do
|
|
// Band.FShiftChildren.Add(atop.FShiftChildren[i]);
|
|
//
|
|
// allObjects.Free;
|
|
// atop.Free;
|
|
//end;
|
|
|
|
procedure TfrxDesignerWorkspace.RemoveObjectsFromLits(aObjectsList: TList);
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
begin
|
|
for i := 0 to aObjectsList.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(aObjectsList[i]);
|
|
FSelectedObjects.Remove(c);
|
|
FObjects.Remove(c);
|
|
RemoveObjectsFromLits(c.Objects);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.AdjustBandHeight(Bnd: TfrxBand);
|
|
var
|
|
i: Integer;
|
|
max, min: Extended;
|
|
c: TfrxComponent;
|
|
begin
|
|
max := 0;
|
|
min := 0;
|
|
for i := 0 to Bnd.Objects.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(Bnd.Objects[i]);
|
|
if (c is TfrxView) and (TfrxView(c).Align in [baClient, baBottom]) then
|
|
continue;
|
|
if c.Top + c.Height > max then
|
|
max := c.Top + c.Height;
|
|
if c.Top < min then
|
|
min := c.Top;
|
|
end;
|
|
|
|
max := max - min;
|
|
if Bnd.Height < max then
|
|
Bnd.Height := max;
|
|
if min < 0 then
|
|
for i := 0 to Bnd.Objects.Count - 1 do
|
|
with TfrxComponent(Bnd.Objects[i]) do
|
|
Top := Top - min;
|
|
end;
|
|
|
|
function TfrxDesignerWorkspace.ListsEqual(List1, List2: TList): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := List1.Count = List2.Count;
|
|
if Result then
|
|
for i := 0 to List1.Count - 1 do
|
|
{$IFDEF FPC}
|
|
if List1.List^[i] <> List2.List^[i] then
|
|
{$ELSE}
|
|
if List1.List[i] <> List2.List[i] then
|
|
{$ENDIF}
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DeleteObjects;
|
|
var
|
|
c: TfrxComponent;
|
|
i: Integer;
|
|
begin
|
|
if SelectedCount = 0 then exit;
|
|
|
|
i := 0;
|
|
while FSelectedObjects.Count > i do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
|
|
if not (rfDontDelete in c.Restrictions){ and not (csContained in c.frComponentStyle)} then
|
|
begin
|
|
if c.IsAncestor then
|
|
raise Exception.Create('Could not delete ' + c.Name + ', it was introduced in the ancestor report');
|
|
FSelectedObjects.Remove(c);
|
|
FObjects.Remove(c);
|
|
RemoveObjectsFromLits(c.Objects);
|
|
c.Free;
|
|
end
|
|
else
|
|
Inc(i);
|
|
end;
|
|
|
|
if FSelectedObjects.Count = 0 then
|
|
FSelectedObjects.Add(FPage);
|
|
|
|
AdjustBands;
|
|
FModifyFlag := True;
|
|
DoModify;
|
|
SelectionChanged;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.EditObject;
|
|
begin
|
|
if FSelectedObjects.Count = 1 then
|
|
if Assigned(FOnEdit) then
|
|
FOnEdit(Self);
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DoNudge(dx, dy: Extended; Smooth: Boolean);
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
begin
|
|
if SelectedCount = 0 then exit;
|
|
if not Smooth or (GridType = gtChar) then
|
|
begin
|
|
dx := dx * FGridX;
|
|
dy := dy * FGridY;
|
|
end;
|
|
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
c.Left := c.Left + dx;
|
|
c.Top := c.Top + dy;
|
|
end;
|
|
|
|
FModifyFlag := True;
|
|
if Assigned(FOnNotifyPosition) then
|
|
FOnNotifyPosition(GetSelectionBounds);
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DoSize(dx, dy: Extended);
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
begin
|
|
if SelectedCount = 0 then exit;
|
|
dx := dx * FGridX;
|
|
dy := dy * FGridY;
|
|
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
c.Width := c.Width + dx;
|
|
if c.Width < 0 then
|
|
c.Width := c.Width - dx;
|
|
c.Height := c.Height + dy;
|
|
if c.Height < 0 then
|
|
c.Height := c.Height - dy;
|
|
end;
|
|
|
|
FModifyFlag := True;
|
|
if Assigned(FOnNotifyPosition) then
|
|
FOnNotifyPosition(GetSelectionBounds);
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DoStick(dx, dy: Integer);
|
|
var
|
|
i: Integer;
|
|
c, sel, found: TfrxComponent;
|
|
min, dist: Extended;
|
|
r1, r2: TfrxRect;
|
|
gapLeft, gapRight, gapTop, gapBottom: Extended;
|
|
|
|
function RectsIntersect(ar1, ar2: TfrxRect): Boolean;
|
|
begin
|
|
Result := not ((ar2.Left > ar1.Right) or (ar2.Right < ar1.Left) or
|
|
(ar2.Top > ar1.Bottom) or (ar2.Bottom < ar1.Top));
|
|
end;
|
|
|
|
begin
|
|
if SelectedCount <> 1 then exit;
|
|
|
|
found := nil;
|
|
sel := TfrxComponent(FSelectedObjects[0]);
|
|
min := 1e10;
|
|
for i := 0 to FObjects.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(FObjects[i]);
|
|
if not (c is TfrxReportComponent) or (c is TfrxBand) or (c = sel) then continue;
|
|
|
|
r1 := frxRect(c.AbsLeft, c.AbsTop, c.AbsLeft + c.Width, c.AbsTop + c.Height);
|
|
dist := 0;
|
|
with sel do
|
|
if dx = 1 then
|
|
begin
|
|
r2 := frxRect(AbsLeft, AbsTop, 1e10, AbsTop + Height);
|
|
dist := r1.Left - r2.Left;
|
|
end
|
|
else if dx = -1 then
|
|
begin
|
|
r2 := frxRect(-1e10, AbsTop, AbsLeft + Width, AbsTop + Height);
|
|
dist := r2.Right - r1.Right;
|
|
end
|
|
else if dy = 1 then
|
|
begin
|
|
r2 := frxRect(AbsLeft, AbsTop, AbsLeft + Width, 1e10);
|
|
dist := r1.Top - r2.Top;
|
|
end
|
|
else if dy = -1 then
|
|
begin
|
|
r2 := frxRect(AbsLeft, -1e10, AbsLeft + Width, AbsTop + Height);
|
|
dist := r2.Bottom - r1.Bottom;
|
|
end;
|
|
|
|
if RectsIntersect(r1, r2) then
|
|
if dist < min then
|
|
begin
|
|
found := c;
|
|
min := dist;
|
|
end;
|
|
end;
|
|
|
|
if found <> nil then
|
|
begin
|
|
gapLeft := 0;
|
|
gapRight := 0;
|
|
gapTop := 0;
|
|
gapBottom := 0;
|
|
if (sel is TfrxDMPMemoView) and (found is TfrxDMPMemoView) then
|
|
begin
|
|
if (ftLeft in TfrxDMPMemoView(sel).Frame.Typ) or
|
|
(ftRight in TfrxDMPMemoView(found).Frame.Typ) then
|
|
gapLeft := fr1CharX;
|
|
if (ftRight in TfrxDMPMemoView(sel).Frame.Typ) or
|
|
(ftLeft in TfrxDMPMemoView(found).Frame.Typ) then
|
|
gapRight := fr1CharX;
|
|
if (ftTop in TfrxDMPMemoView(sel).Frame.Typ) or
|
|
(ftBottom in TfrxDMPMemoView(found).Frame.Typ) then
|
|
gapTop := fr1CharY;
|
|
if (ftBottom in TfrxDMPMemoView(sel).Frame.Typ) or
|
|
(ftTop in TfrxDMPMemoView(found).Frame.Typ) then
|
|
gapBottom := fr1CharY;
|
|
end;
|
|
if dx = 1 then
|
|
sel.Left := found.Left - sel.Width - gapRight
|
|
else if dx = -1 then
|
|
sel.Left := found.Left + found.Width + gapLeft
|
|
else if dy = 1 then
|
|
sel.Top := found.Top - sel.Height - gapBottom
|
|
else if dy = -1 then
|
|
sel.Top := found.Top + found.Height + gapTop;
|
|
|
|
FModifyFlag := True;
|
|
if Assigned(FOnNotifyPosition) then
|
|
FOnNotifyPosition(GetSelectionBounds);
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DoTab;
|
|
var
|
|
c: TfrxComponent;
|
|
i: Integer;
|
|
begin
|
|
if SelectedCount <> 1 then Exit;
|
|
|
|
c := TfrxComponent(SelectedObjects[0]);
|
|
if (c is TfrxBand) and (c.Objects.Count > 0) then
|
|
SelectedObjects[0] := c.Objects[0]
|
|
else if c is TfrxView then
|
|
begin
|
|
i := c.Parent.Objects.IndexOf(c);
|
|
if i = c.Parent.Objects.Count - 1 then
|
|
i := 0
|
|
else
|
|
Inc(i);
|
|
SelectedObjects[0] := c.Parent.Objects[i];
|
|
end;
|
|
|
|
if Assigned(FOnNotifyPosition) then
|
|
FOnNotifyPosition(GetSelectionBounds);
|
|
SelectionChanged;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.KeyDown(var Key: Word; Shift: TShiftState);
|
|
var
|
|
p: TPoint;
|
|
dx, dy: Integer;
|
|
begin
|
|
if FDisableUpdate then exit;
|
|
P := Point(0, 0);
|
|
if ssAlt in Shift then
|
|
begin
|
|
GetCursorPos(p);
|
|
p := ScreenToClient(p);
|
|
MouseMove(Shift, p.X, p.Y);
|
|
end;
|
|
|
|
dx := 0; dy := 0;
|
|
|
|
case Key of
|
|
vk_Delete:
|
|
DeleteObjects;
|
|
|
|
vk_Return:
|
|
EditObject;
|
|
|
|
vk_Left:
|
|
dx := -1;
|
|
|
|
vk_Right:
|
|
dx := 1;
|
|
|
|
vk_Up:
|
|
dy := -1;
|
|
|
|
vk_Down:
|
|
dy := 1;
|
|
|
|
vk_Tab:
|
|
DoTab;
|
|
end;
|
|
|
|
if (dx <> 0) or (dy <> 0) then
|
|
begin
|
|
if ssCtrl in Shift then
|
|
DoNudge(dx, dy, not (ssShift in Shift))
|
|
else if ssShift in Shift then
|
|
DoSize(dx, dy)
|
|
else if ssAlt in Shift then
|
|
DoStick(dx, dy)
|
|
else
|
|
FindNearest(dx, dy);
|
|
AdjustBands;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.KeyUp(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if FDisableUpdate then exit;
|
|
DoModify;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
i, j: Integer;
|
|
c, c1: TfrxComponent;
|
|
EmptySpace: Boolean;
|
|
l: TList;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
p: TPoint;
|
|
begin
|
|
FPopUpActive := False;
|
|
inherited;
|
|
if FDisableUpdate or FMouseDown then exit;
|
|
if FDblClicked then
|
|
begin
|
|
FDblClicked := False;
|
|
exit;
|
|
end;
|
|
|
|
l := TList.Create;
|
|
for i := 0 to FSelectedObjects.Count - 1 do
|
|
l.Add(FSelectedObjects[i]);
|
|
|
|
if FPage is TfrxReportPage then
|
|
ValidParentForm(Self).ActiveControl := Parent else
|
|
ValidParentForm(Self).ActiveControl := nil;
|
|
|
|
FMouseDown := True;
|
|
FLastMousePointX := X / FScale;
|
|
FLastMousePointY := Y / FScale;
|
|
SetDefaultEventParams(EventParams);
|
|
|
|
// Ctrl was pressed
|
|
if (FMode1 = dmNone) and (ssCtrl in Shift) then
|
|
begin
|
|
FSelectedObjects.Clear;
|
|
FSelectedObjects.Add(FPage);
|
|
FMode1 := dmSelectionRect;
|
|
FSelectionRect := frxRect(X, Y, X, Y);
|
|
EventParams.Refresh := True;
|
|
end;
|
|
// TODO move it to Workspace1 or move FLastObjectOver code here
|
|
// clicked on object or on empty space
|
|
if FMode1 = dmNone then
|
|
begin
|
|
EmptySpace := True;
|
|
//for i := FObjects.Count - 1 downto 0 do
|
|
if Assigned(FLastObjectOver) then
|
|
begin
|
|
c := FLastObjectOver;///TfrxComponent(FObjects[i]);
|
|
if (c is TfrxComponent) and c.IsContain(X / Scale, Y / Scale) then
|
|
begin
|
|
EmptySpace := (c is TfrxPage);
|
|
|
|
if csContainer in c.frComponentStyle then
|
|
begin
|
|
//if c.DoMouseDown(Self, X, Y, Button, Shift, EventParams) then
|
|
// FMode1 := dmContainer
|
|
//else
|
|
for j := c.ContainerObjects.Count - 1 downto 0 do
|
|
begin
|
|
c1 := TfrxComponent(c.ContainerObjects[j]);
|
|
if c1.Visible and c1.IsContain(X / Scale, Y / Scale) then
|
|
begin
|
|
c := c1;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if ssShift in Shift then
|
|
if FSelectedObjects.IndexOf(c) <> -1 then
|
|
FSelectedObjects.Remove(c) else
|
|
FSelectedObjects.Add(c)
|
|
else if FSelectedObjects.IndexOf(c) = -1 then
|
|
begin
|
|
FSelectedObjects.Clear;
|
|
FSelectedObjects.Add(c);
|
|
end;
|
|
|
|
//break;
|
|
end;
|
|
end;
|
|
|
|
if EmptySpace then
|
|
begin
|
|
FSelectedObjects.Clear;
|
|
FSelectedObjects.Add(FPage);
|
|
FMode1 := dmSelectionRect;
|
|
FSelectionRect := frxRect(X, Y, X, Y);
|
|
end
|
|
else if FSelectedObjects.Count = 0 then
|
|
begin
|
|
FSelectedObjects.Add(FPage);
|
|
FMode1 := dmNone;
|
|
end
|
|
else
|
|
begin
|
|
FSelectedObjects.Remove(FPage);
|
|
if FMode1 <> dmContainer then
|
|
FMode1 := dmMove;
|
|
end;
|
|
|
|
EventParams.Refresh := True;
|
|
end;
|
|
|
|
//band detach band objects
|
|
if (FMode1 = dmMove) and (FSelectedObjects.Count = 1) and
|
|
(TObject(FSelectedObjects[0]) is TfrxBand) and (ssAlt in Shift) then
|
|
AdjustBands(False);
|
|
|
|
// scaling
|
|
if FMode1 = dmScale then
|
|
begin
|
|
FScaleRect := GetSelectionBounds;
|
|
FScaleRect.Right := FScaleRect.Right + FScaleRect.Left;
|
|
FScaleRect.Bottom := FScaleRect.Bottom + FScaleRect.Top;
|
|
FScaleRect1 := FScaleRect;
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
THackComponent(c).FOriginalRect := frxRect(c.AbsLeft, c.AbsTop, c.Width, c.Height);
|
|
end;
|
|
end;
|
|
|
|
// inserting a line
|
|
if FMode1 = dmInsertLine then
|
|
begin
|
|
FInsertion.Width := 0;
|
|
FInsertion.Height := 0;
|
|
end;
|
|
|
|
if EventParams.Refresh then
|
|
if not ListsEqual(l, FSelectedObjects) then
|
|
SelectionChanged else
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
|
|
if (Button = mbRight) and (PopupMenu <> nil) then
|
|
begin
|
|
FMode1 := dmNone;
|
|
FMouseDown := False;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
p := ClientToScreen(Point(X, Y));
|
|
PopupMenu.Popup(p.X, p.Y);
|
|
FPopUpActive := True;
|
|
end;
|
|
|
|
if FMode1 = dmMove then
|
|
begin
|
|
for i := 0 to FSelectedObjects.Count - 1 do
|
|
if TObject(FSelectedObjects[i]) is TfrxView then
|
|
begin
|
|
{$IFDEF FPC}
|
|
FSavedAlign.Add(Pointer(PtrInt(TfrxView(FSelectedObjects[i]).Align)));
|
|
{$ELSE}
|
|
FSavedAlign.Add(Pointer(Integer(TfrxView(FSelectedObjects[i]).Align)));
|
|
{$ENDIF}
|
|
TfrxView(FSelectedObjects[i]).Align := baNone;
|
|
end;
|
|
end;
|
|
|
|
l.Free;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
c: TfrxComponent;
|
|
kx, ky, nx, ny: Extended;
|
|
i: Integer;
|
|
NotifyRect, SaveBounds: TfrxRect;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
|
|
function Contain(px, py: Extended): Boolean;
|
|
begin
|
|
Result := (X / FScale >= px - 2) and (X / FScale <= px + 3) and
|
|
(Y / FScale >= py - 2) and (Y / FScale <= py + 3);
|
|
end;
|
|
|
|
function Contain0(py: Extended): Boolean;
|
|
begin
|
|
Result := (Y / FScale >= py - 2) and (Y / FScale <= py + 2);
|
|
end;
|
|
|
|
function Contain1(px, py: Extended): Boolean;
|
|
begin
|
|
Result := (FLastMousePointX >= px - 2) and (FLastMousePointX <= px + 3) and
|
|
(FLastMousePointY >= py - 2) and (FLastMousePointY <= py + 3);
|
|
end;
|
|
|
|
function Contain2(cc: TfrxComponent): Boolean;
|
|
var
|
|
w1, w2: Integer;
|
|
begin
|
|
w1 := 0;
|
|
w2 := 0;
|
|
if cc.Width = 0 then
|
|
w1 := 4 else
|
|
w2 := 4;
|
|
if (X / FScale >= cc.AbsLeft - w1) and (X / FScale <= cc.AbsLeft + cc.Width + w1) and
|
|
(Y / FScale >= cc.AbsTop - w2) and (Y / FScale <= cc.AbsTop + cc.Height + w2) then
|
|
Result := True else
|
|
Result := False;
|
|
end;
|
|
|
|
function Contain3(px: Extended): Boolean;
|
|
begin
|
|
Result := (X / FScale >= px - 2) and (X / FScale <= px + 2);
|
|
end;
|
|
|
|
function GridCheck: Boolean;
|
|
begin
|
|
Result := (kx >= FGridX) or (kx <= -FGridX) or
|
|
(ky >= FGridY) or (ky <= -FGridY);
|
|
if Result then
|
|
begin
|
|
kx := Trunc(kx / FGridX) * FGridX;
|
|
ky := Trunc(ky / FGridY) * FGridY;
|
|
end;
|
|
end;
|
|
|
|
function CheckMove: Boolean;
|
|
var
|
|
al: Boolean;
|
|
begin
|
|
al := FGridAlign;
|
|
if ssAlt in Shift then
|
|
al := not al;
|
|
|
|
Result := False;
|
|
|
|
if (al and not GridCheck) or ((kx = 0) and (ky = 0)) then
|
|
Result := True;
|
|
|
|
CheckGuides(kx, ky, Result, FMouseDown);
|
|
end;
|
|
|
|
procedure CheckNegative(cc: TfrxComponent);
|
|
const
|
|
ar1: array[ct1..ct8] of TfrxCursorType = (ct3, ct4, ct1, ct2, ct6, ct5, ct0, ct0);
|
|
ar2: array[ct1..ct8] of TfrxCursorType = (ct4, ct3, ct2, ct1, ct0, ct0, ct8, ct7);
|
|
ar3: array[ct1..ct8] of TfrxCursorType = (ct2, ct1, ct4, ct3, ct0, ct0, ct0, ct0);
|
|
begin
|
|
if (cc is TfrxLineView) and (TfrxLineView(cc).Diagonal = True) then exit;
|
|
if (cc.Width < 0) and (cc.Height < 0) then
|
|
FCT := ar3[FCT]
|
|
else if cc.Width < 0 then
|
|
FCT := ar1[FCT]
|
|
else if cc.Height < 0 then
|
|
FCT := ar2[FCT];
|
|
NormalizeCoord(cc);
|
|
end;
|
|
|
|
procedure CTtoCursor;
|
|
const
|
|
ar: array[ct0..ct10] of TCursor =
|
|
(crDefault, crSizeNWSE, crSizeNWSE, crSizeNESW,
|
|
crSizeNESW, crSizeWE, crSizeWE, crSizeNS, crSizeNS, crCross, crCross);
|
|
begin
|
|
Cursor := ar[FCT];
|
|
end;
|
|
|
|
begin
|
|
{$IFNDEF FPC}
|
|
// Lazarus trow AV fhen call from DragOver, need a fix
|
|
inherited;
|
|
{$ENDIF}
|
|
FPopUpActive := False;
|
|
if FDisableUpdate then Exit;
|
|
SetDefaultEventParams(EventParams);
|
|
|
|
if SelectedCount = 0 then
|
|
NotifyRect := frxRect(X / FScale, Y / FScale, 0, 0) else
|
|
NotifyRect := GetSelectionBounds;
|
|
|
|
// cursor shapes
|
|
if not FMouseDown and (FMode = dmSelect) then
|
|
if (SelectedCount = 1) and not (csContained in TfrxComponent(FSelectedObjects[0]).frComponentStyle) then
|
|
begin
|
|
FMode1 := dmSize;
|
|
c := TfrxComponent(FSelectedObjects[0]);
|
|
FCT := ct0;
|
|
if Contain(c.AbsLeft, c.AbsTop) then
|
|
FCT := ct1
|
|
else if Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height) then
|
|
FCT := ct2
|
|
else if Contain(c.AbsLeft + c.Width, c.AbsTop) then
|
|
FCT := ct3
|
|
else if Contain(c.AbsLeft, c.AbsTop + c.Height) then
|
|
FCT := ct4
|
|
else if Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height / 2) then
|
|
FCT := ct5
|
|
else if Contain(c.AbsLeft, c.AbsTop + c.Height / 2) then
|
|
FCT := ct6
|
|
else if Contain(c.AbsLeft + c.Width / 2, c.AbsTop) then
|
|
FCT := ct7
|
|
else if Contain(c.AbsLeft + c.Width / 2, c.AbsTop + c.Height) then
|
|
FCT := ct8;
|
|
|
|
if c is TfrxCustomLineView then
|
|
if not TfrxCustomLineView(c).Diagonal then
|
|
begin
|
|
if c.Width = 0 then
|
|
if FCT in [ct1, ct3] then
|
|
FCT := ct7
|
|
else if FCT in [ct4, ct2] then
|
|
FCT := ct8
|
|
else
|
|
FCT := ct0;
|
|
if c.Height = 0 then
|
|
if FCT in [ct1, ct4] then
|
|
FCT := ct6
|
|
else if FCT in [ct3, ct2] then
|
|
FCT := ct5
|
|
else
|
|
FCT := ct0;
|
|
end
|
|
else
|
|
if FCT = ct1 then
|
|
FCT := ct9
|
|
else if FCT = ct2 then
|
|
FCT := ct10
|
|
else
|
|
FCT := ct0;
|
|
|
|
|
|
if FCT = ct0 then
|
|
FMode1 := dmNone;
|
|
CTtoCursor;
|
|
end
|
|
else if SelectedCount > 1 then
|
|
begin
|
|
FMode1 := dmScale;
|
|
c := GetRightBottomObject;
|
|
if (c <> nil) and Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height) then
|
|
Cursor := crSizeNWSE
|
|
else
|
|
begin
|
|
Cursor := crDefault;
|
|
FMode1 := dmNone;
|
|
end;
|
|
end
|
|
else
|
|
Cursor := crDefault;
|
|
|
|
// resizing a band - setup
|
|
if not FMouseDown and (FMode = dmSelect) and not (FMode1 in [dmSize, dmScale]) then
|
|
begin
|
|
Cursor := crDefault;
|
|
FMode1 := dmNone;
|
|
for i := 0 to FObjects.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(FObjects[i]);
|
|
|
|
if c is TfrxBand then
|
|
if TfrxBand(c).Vertical then
|
|
begin
|
|
if Contain3(c.Left + c.Width) then
|
|
begin
|
|
Cursor := crHSplit;
|
|
FMode1 := dmSizeBand;
|
|
FSizedBand := TfrxBand(c);
|
|
break;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if Contain0(c.Top + c.Height) then
|
|
begin
|
|
Cursor := crVSplit;
|
|
FMode1 := dmSizeBand;
|
|
FSizedBand := TfrxBand(c);
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// resizing a band
|
|
if FMouseDown and (FMode1 = dmSizeBand) then
|
|
begin
|
|
kx := X / FScale - FLastMousePointX;
|
|
ky := Y / FScale - FLastMousePointY;
|
|
if CheckMove then Exit;
|
|
|
|
FModifyFlag := True;
|
|
if FSizedBand.Vertical then
|
|
FSizedBand.Width := FSizedBand.Width + kx
|
|
else
|
|
FSizedBand.Height := FSizedBand.Height + ky;
|
|
AdjustBandHeight(FSizedBand);
|
|
AdjustBands;
|
|
|
|
FLastMousePointX := FLastMousePointX + kx;
|
|
FLastMousePointY := FLastMousePointY + ky;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
with FSizedBand do
|
|
NotifyRect := frxRect(Left, Top, Width, Height);
|
|
end;
|
|
|
|
// inplace editing - setup REMOVE
|
|
if not FMouseDown and (ssAlt in Shift) then
|
|
begin
|
|
Cursor := crDefault;
|
|
FMode1 := dmNone;
|
|
for i := 0 to FObjects.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(FObjects[i]);
|
|
if (c is TfrxCustomMemoView) and Contain2(c) then
|
|
begin
|
|
//FInplaceObject := TfrxCustomMemoView(c);
|
|
Cursor := crIBeam;
|
|
FMode1 := dmInplaceEdit;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// inserting
|
|
if not FMouseDown and (FMode1 = dmInsertObject) then
|
|
begin
|
|
kx := X / FScale - FInsertion.Left;
|
|
ky := Y / FScale - FInsertion.Top;
|
|
if CheckMove then Exit;
|
|
|
|
FInsertion.Left := FInsertion.Left + kx;
|
|
FInsertion.Top := FInsertion.Top + ky;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
DrawInsertionRect;
|
|
with FInsertion do
|
|
NotifyRect := frxRect(Left, Top, Width, Height);
|
|
end;
|
|
|
|
// inserting + resizing
|
|
if FMouseDown and (FMode1 = dmInsertObject) then
|
|
begin
|
|
kx := X / FScale - FInsertion.Left;
|
|
ky := Y / FScale - FInsertion.Top;
|
|
if CheckMove then Exit;
|
|
|
|
FInsertion.Width := kx;
|
|
FInsertion.Height := ky;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
DrawInsertionRect;
|
|
with FInsertion do
|
|
NotifyRect := frxRect(Left, Top, Width, Height);
|
|
end;
|
|
|
|
// moving
|
|
if FMouseDown and (FMode1 = dmMove) and not(ssShift in Shift) then
|
|
begin
|
|
kx := X / FScale - FLastMousePointX;
|
|
ky := Y / FScale - FLastMousePointY;
|
|
if CheckMove then Exit;
|
|
|
|
{ vertical band }
|
|
if not FModifyFlag and (SelectedCount = 1) and
|
|
(TObject(FSelectedObjects[0]) is TfrxBand) and
|
|
(TfrxBand(FSelectedObjects[0]).Vertical) then
|
|
begin
|
|
for i := 0 to FObjects.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(FObjects[i]);
|
|
if (c is TfrxView) and
|
|
(c.Left >= TfrxBand(FSelectedObjects[0]).Left - 1e-4) and
|
|
(c.Left + c.Width <= TfrxBand(FSelectedObjects[0]).Left +
|
|
TfrxBand(FSelectedObjects[0]).Width + 1e-4) then
|
|
FSelectedObjects.Add(c);
|
|
end;
|
|
end;
|
|
|
|
if (SelectedCount > 0) and (TObject(FSelectedObjects[0]) is TfrxBand) and
|
|
(TfrxBand(FSelectedObjects[0]).Vertical) then
|
|
ky := 0;
|
|
|
|
FModifyFlag := True;
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
c.Left := c.Left + kx;
|
|
if FSelectedObjects.IndexOf(c.Parent) = -1 then
|
|
begin
|
|
if c.IsAncestor and (c is TfrxView) then
|
|
if (c.Top + ky < -1e-4) or (c.Top + ky > c.Parent.Height) then
|
|
continue;
|
|
c.Top := c.Top + ky;
|
|
end;
|
|
end;
|
|
|
|
FLastMousePointX := FLastMousePointX + kx;
|
|
FLastMousePointY := FLastMousePointY + ky;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
NotifyRect := GetSelectionBounds;
|
|
end;
|
|
|
|
// resizing one object
|
|
if FMouseDown and (FMode1 = dmSize) then
|
|
begin
|
|
kx := X / FScale - FLastMousePointX;
|
|
ky := Y / FScale - FLastMousePointY;
|
|
if CheckMove then Exit;
|
|
|
|
FModifyFlag := True;
|
|
c := TfrxComponent(FSelectedObjects[0]);
|
|
SaveBounds := frxRect(c.Left, c.Top, c.Width, c.Height);
|
|
case FCT of
|
|
ct1, ct9:
|
|
begin
|
|
c.Left := c.Left + kx;
|
|
c.Width := c.Width - kx;
|
|
c.Top := c.Top + ky;
|
|
c.Height := c.Height - ky;
|
|
end;
|
|
|
|
ct2, ct10:
|
|
begin
|
|
c.Width := c.Width + kx;
|
|
c.Height := c.Height + ky;
|
|
end;
|
|
|
|
ct3:
|
|
begin
|
|
c.Top := c.Top + ky;
|
|
c.Width := c.Width + kx;
|
|
c.Height := c.Height - ky;
|
|
end;
|
|
|
|
ct4:
|
|
begin
|
|
c.Left := c.Left + kx;
|
|
c.Width := c.Width - kx;
|
|
c.Height := c.Height + ky;
|
|
end;
|
|
|
|
ct5:
|
|
begin
|
|
c.Width := c.Width + kx;
|
|
end;
|
|
|
|
ct6:
|
|
begin
|
|
c.Left := c.Left + kx;
|
|
c.Width := c.Width - kx;
|
|
end;
|
|
|
|
ct7:
|
|
begin
|
|
c.Top := c.Top + ky;
|
|
c.Height := c.Height - ky;
|
|
end;
|
|
|
|
ct8:
|
|
begin
|
|
c.Height := c.Height + ky;
|
|
end;
|
|
end;
|
|
CheckNegative(c);
|
|
CTtoCursor;
|
|
|
|
if c.Left < 0 then
|
|
c.Left := 0;
|
|
|
|
if c.IsAncestor and (c is TfrxView) then
|
|
if (c.Top < -1e-4) or (c.Top > c.Parent.Height) then
|
|
c.SetBounds(SaveBounds.Left, SaveBounds.Top, SaveBounds.Right, SaveBounds.Bottom);
|
|
|
|
if c is TfrxBand then
|
|
begin
|
|
if FCT in [ct1, ct3, ct7] then
|
|
for i := 0 to c.Objects.Count - 1 do
|
|
with TfrxComponent(c.Objects[i]) do
|
|
Top := Top - ky;
|
|
AdjustBandHeight(TfrxBand(c));
|
|
AdjustBands;
|
|
end;
|
|
|
|
FLastMousePointX := FLastMousePointX + kx;
|
|
FLastMousePointY := FLastMousePointY + ky;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
NotifyRect := frxRect(c.Left, c.Top, c.Width, c.Height);
|
|
end;
|
|
|
|
// scaling
|
|
if FMouseDown and (FMode1 = dmScale) then
|
|
begin
|
|
kx := X / FScale - FLastMousePointX;
|
|
ky := Y / FScale - FLastMousePointY;
|
|
if CheckMove then Exit;
|
|
|
|
FModifyFlag := True;
|
|
with FScaleRect do
|
|
if not ((Right + kx < Left) or (Bottom + ky < Top)) then
|
|
FScaleRect := frxRect(Left, Top, Right + kx, Bottom + ky);
|
|
nx := (FScaleRect.Right - FScaleRect.Left) / (FScaleRect1.Right - FScaleRect1.Left);
|
|
ny := (FScaleRect.Bottom - FScaleRect.Top) / (FScaleRect1.Bottom - FScaleRect1.Top);
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
c.Left := FScaleRect1.Left + (THackComponent(c).FOriginalRect.Left - FScaleRect1.Left) * nx;
|
|
c.Top := FScaleRect1.Top + (THackComponent(c).FOriginalRect.Top - FScaleRect1.Top) * ny;
|
|
if c.Parent is TfrxBand then
|
|
c.Top := c.Top - c.Parent.Top;
|
|
c.Width := THackComponent(c).FOriginalRect.Right * nx;
|
|
c.Height := THackComponent(c).FOriginalRect.Bottom * ny;
|
|
end;
|
|
|
|
FLastMousePointX := FLastMousePointX + kx;
|
|
FLastMousePointY := FLastMousePointY + ky;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
with FScaleRect do
|
|
NotifyRect := frxRect(Right - Left, Bottom - Top, nx, ny);
|
|
end;
|
|
|
|
// drawing selection rectangle
|
|
if FMouseDown and (FMode1 = dmSelectionRect) then
|
|
begin
|
|
{$IFDEF NONWINFPC}
|
|
Update;
|
|
{$ELSE}
|
|
DrawSelectionRect;
|
|
{$ENDIF}
|
|
FSelectionRect := frxRect(FSelectionRect.Left, FSelectionRect.Top, X, Y);
|
|
{$IFDEF NONWINFPC}
|
|
Update;
|
|
{$ELSE}
|
|
DrawSelectionRect;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
// inserting a line
|
|
if not FMouseDown and (FMode1 = dmInsertLine) then
|
|
begin
|
|
kx := X / FScale - FInsertion.Left;
|
|
ky := Y / FScale - FInsertion.Top;
|
|
if CheckMove then Exit;
|
|
{$IFDEF NONWINFPC}
|
|
Update;
|
|
{$ELSE}
|
|
DrawCross(False);
|
|
{$ENDIF}
|
|
FInsertion.Left := FInsertion.Left + kx;
|
|
FInsertion.Top := FInsertion.Top + ky;
|
|
{$IFDEF NONWINFPC}
|
|
Update;
|
|
{$ELSE}
|
|
DrawCross(False);
|
|
{$ENDIF}
|
|
with FInsertion do
|
|
NotifyRect := frxRect(Left, Top, 0, 0);
|
|
end;
|
|
|
|
// inserting a line + resizing
|
|
if FMouseDown and (FMode1 = dmInsertLine) then
|
|
begin
|
|
kx := X / FScale - (FInsertion.Left + FInsertion.Width);
|
|
ky := Y / FScale - (FInsertion.Top + FInsertion.Height);
|
|
if CheckMove then Exit;
|
|
{$IFDEF NONWINFPC}
|
|
Update;
|
|
{$ELSE}
|
|
DrawCross(True);
|
|
{$ENDIF}
|
|
FInsertion.Width := FInsertion.Width + kx;
|
|
FInsertion.Height := FInsertion.Height + ky;
|
|
{$IFDEF NONWINFPC}
|
|
Update;
|
|
{$ELSE}
|
|
DrawCross(True);
|
|
{$ENDIF}
|
|
with FInsertion do
|
|
NotifyRect := frxRect(Left, Top, Width, Height);
|
|
end;
|
|
|
|
// handle containers TODO - REMOVE
|
|
if FMouseDown and (FMode1 = dmContainer) then
|
|
begin
|
|
kx := X / FScale - FLastMousePointX;
|
|
ky := Y / FScale - FLastMousePointY;
|
|
if CheckMove then Exit;
|
|
|
|
FModifyFlag := True;
|
|
// c := TfrxComponent(FSelectedObjects[0]);
|
|
// c.DoMouseMove(Self, X, Y, Shift, EventParams);
|
|
//ContainerMouseMove(Self, X, Y);
|
|
FLastMousePointX := FLastMousePointX + kx;
|
|
FLastMousePointY := FLastMousePointY + ky;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
if FMouseDown and (Cursor <> crHand) then
|
|
if Parent is TScrollingWinControl then
|
|
with TScrollingWinControl(Parent) do
|
|
begin
|
|
x := x + Round(FMargins.Left * FScale);
|
|
y := y + Round(FMargins.Top * FScale);
|
|
if x > (ClientRect.Right + HorzScrollBar.Position) then
|
|
begin
|
|
i := x - (ClientRect.Right + HorzScrollBar.Position);
|
|
HorzScrollBar.Position := HorzScrollBar.Position + i;
|
|
end;
|
|
if x < HorzScrollBar.Position then
|
|
begin
|
|
i := HorzScrollBar.Position - x;
|
|
HorzScrollBar.Position := HorzScrollBar.Position - i;
|
|
end;
|
|
if y > (ClientRect.Bottom + VertScrollBar.Position) then
|
|
begin
|
|
i := y - (ClientRect.Bottom + VertScrollBar.Position);
|
|
VertScrollBar.Position := VertScrollBar.Position + i;
|
|
end;
|
|
if y < VertScrollBar.Position then
|
|
begin
|
|
i := VertScrollBar.Position - y;
|
|
VertScrollBar.Position := VertScrollBar.Position - i;
|
|
end;
|
|
end;
|
|
|
|
if (SelectedCount = 0) or FMouseDown then
|
|
if Assigned(FOnNotifyPosition) then
|
|
FOnNotifyPosition(NotifyRect);
|
|
|
|
if not (FLastObjectOver is TfrxCustomMemoView) then
|
|
Application.CancelHint;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
i, j: Integer;
|
|
c, c1: TfrxComponent;
|
|
R: TfrxRect;
|
|
l: TList;
|
|
NotifyRect: TfrxRect;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
|
|
function Round8(e: Extended): Extended;
|
|
begin
|
|
Result := Round(e * 100000000) / 100000000;
|
|
end;
|
|
|
|
function Contain(c: TfrxComponent): Boolean;
|
|
var
|
|
cLeft, cTop, cRight, cBottom, e: Extended;
|
|
Sign: Boolean;
|
|
|
|
function Dist(x, y: Extended): Boolean;
|
|
var
|
|
k: Extended;
|
|
begin
|
|
k := c.Height / c.Width;
|
|
k := (k * (x / FScale - c.AbsLeft) - (y / FScale - c.AbsTop)) * cos(arctan(k));
|
|
Result := k >= 0;
|
|
end;
|
|
|
|
function RectInRect: Boolean;
|
|
begin
|
|
with FSelectionRect do
|
|
Result := not ((cLeft > Right / FScale) or
|
|
(cRight < Left / FScale) or
|
|
(cTop > Bottom / FScale) or
|
|
(cBottom < Top / FScale));
|
|
end;
|
|
|
|
begin
|
|
Result := False;
|
|
cLeft := c.AbsLeft;
|
|
cRight := c.AbsLeft + c.Width;
|
|
cTop := c.AbsTop;
|
|
cBottom := c.AbsTop + c.Height;
|
|
|
|
if cRight < cLeft then
|
|
begin
|
|
e := cRight;
|
|
cRight := cLeft;
|
|
cLeft := e;
|
|
end;
|
|
if cBottom < cTop then
|
|
begin
|
|
e := cBottom;
|
|
cBottom := cTop;
|
|
cTop := e;
|
|
end;
|
|
|
|
if (c is TfrxLineView) and TfrxLineView(c).Diagonal and
|
|
(c.Width <> 0) and (c.Height <> 0) then
|
|
with FSelectionRect do
|
|
begin
|
|
Sign := Dist(Left, Top);
|
|
if Dist(Right, Top) <> Sign then
|
|
Result := True;
|
|
if Dist(Left, Bottom) <> Sign then
|
|
Result := True;
|
|
if Dist(Right, Bottom) <> Sign then
|
|
Result := True;
|
|
|
|
if Result then
|
|
Result := RectInRect;
|
|
end
|
|
else
|
|
Result := RectInRect;
|
|
end;
|
|
|
|
begin
|
|
FPopUpActive := False;
|
|
inherited;
|
|
if FDisableUpdate then Exit;
|
|
if Button <> mbLeft then Exit;
|
|
SetDefaultEventParams(EventParams);
|
|
l := TList.Create;
|
|
for i := 0 to FSelectedObjects.Count - 1 do
|
|
l.Add(FSelectedObjects[i]);
|
|
FMouseDown := False;
|
|
|
|
// insert an object
|
|
if FMode = dmInsert then
|
|
begin
|
|
with FInsertion do
|
|
begin
|
|
R := frxRect(Left, Top, Left + Width, Top + Height);
|
|
if ((ComponentClass.InheritsFrom(TfrxCustomLineView)) and (Flags = 0)) then
|
|
begin
|
|
if Width < 0 then
|
|
R.Right := Left - Width;
|
|
if Height < 0 then
|
|
R.Bottom := Top - Height;
|
|
|
|
if (Width < 0) and (Abs(Width) > Abs(Height)) then
|
|
begin
|
|
R.Left := Left + Width;
|
|
R.Right := Left;
|
|
end;
|
|
if (Height < 0) and (Abs(Height) > Abs(Width)) then
|
|
begin
|
|
R.Top := Top + Height;
|
|
R.Bottom := Top;
|
|
end;
|
|
end
|
|
else if not ((ComponentClass.InheritsFrom(TfrxLineView)) and (Flags <> 0)) then
|
|
begin
|
|
if ((Width >= 0) and (Width < 4)) or ((Height > 0) and (Height < 4)) then
|
|
R := frxRect(Left, Top, Left + OriginalWidth, Top + OriginalHeight);
|
|
NormalizeRect(R);
|
|
end;
|
|
Left := Round8(R.Left);
|
|
Top := Round8(R.Top);
|
|
Width := Round8(R.Right - R.Left);
|
|
Height := Round8(R.Bottom - R.Top);
|
|
end;
|
|
|
|
if Assigned(FOnInsert) then
|
|
FOnInsert(Self);
|
|
end;
|
|
|
|
// select objects that inside of selection rect
|
|
if FMode1 = dmSelectionRect then
|
|
begin
|
|
NormalizeRect(FSelectionRect);
|
|
FSelectedObjects.Clear;
|
|
for i := 0 to FObjects.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(FObjects[i]);
|
|
if (c is TfrxReportComponent) and not (c is TfrxBand) and Contain(c) then
|
|
if not (csContainer in c.frComponentStyle) then
|
|
FSelectedObjects.Add(c)
|
|
else
|
|
begin
|
|
for j := 0 to c.ContainerObjects.Count - 1 do
|
|
begin
|
|
c1 := TfrxComponent(c.ContainerObjects[j]);
|
|
if c1.Visible and Contain(c1) then
|
|
FSelectedObjects.Add(c1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if FSelectedObjects.Count = 0 then
|
|
FSelectedObjects.Add(FPage);
|
|
end;
|
|
|
|
// inplace editing
|
|
if FMode1 = dmInplaceEdit then
|
|
FMode1 := dmNone;
|
|
|
|
// round coordinates
|
|
if FMode1 in [dmMove, dmSize] then
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
if (c is TfrxView) and (FMode1 = dmMove) then
|
|
if FSavedAlign.Count > 0 then
|
|
begin
|
|
TfrxView(c).Align := TfrxAlign(FSavedAlign[0]);
|
|
FSavedAlign.Delete(0);
|
|
end;
|
|
c.Left := Round8(c.Left);
|
|
c.Top := Round8(c.Top);
|
|
c.Width := Round8(c.Width);
|
|
c.Height := Round8(c.Height);
|
|
end;
|
|
if FMode1 = dmSizeBand then
|
|
FSizedBand.Height := Round8(FSizedBand.Height);
|
|
|
|
AdjustBands;
|
|
if not ListsEqual(l, FSelectedObjects) then
|
|
SelectionChanged else
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
DoModify;
|
|
l.Free;
|
|
FCT := ct0;
|
|
if not ((FMode = dmInsert) and (FInsertion.ComponentClass <> nil)) then
|
|
FMode1 := dmNone;
|
|
|
|
if SelectedCount = 0 then
|
|
NotifyRect := frxRect(X / FScale, Y / FScale, 0, 0) else
|
|
NotifyRect := GetSelectionBounds;
|
|
if Assigned(FOnNotifyPosition) then
|
|
FOnNotifyPosition(NotifyRect);
|
|
{$IFDEF FPC}
|
|
DrawSelectionRect;
|
|
//if SelectedCount > 0 then
|
|
FSelectionRect := frxRect(0,0,0,0);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.DblClick;
|
|
begin
|
|
inherited;
|
|
EditObject;
|
|
FDblClicked := True;
|
|
{$IFDEF FPC}
|
|
FMouseDown := False;
|
|
FDblClicked := False;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.MouseLeave;
|
|
begin
|
|
{$IFDEF FPC}
|
|
inherited;
|
|
{$ENDIF}
|
|
if not FMouseDown and (FMode1 = dmInsertObject) then
|
|
begin
|
|
// DrawInsertionRect;
|
|
FInsertion.Left := -FGridX * 1000;
|
|
FInsertion.Top := -FGridY * 1000;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
end;
|
|
if not FMouseDown and (FMode1 = dmInsertLine) then
|
|
begin
|
|
DrawCross(False);
|
|
if FGridType = gtChar then
|
|
begin
|
|
FInsertion.Left := - FGridX / 2;
|
|
FInsertion.Top := - FGridY / 2;
|
|
end
|
|
else
|
|
begin
|
|
FInsertion.Left := - FGridX;
|
|
FInsertion.Top := - FGridY;
|
|
end;
|
|
end;
|
|
if FMode = dmDrag then
|
|
SetInsertion(nil, 0, 0, 0);
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.CMMouseLeave(var Message: TMessage);
|
|
begin
|
|
FPopUpActive := False;
|
|
ClearLastView;
|
|
inherited;
|
|
MouseLeave;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.CheckGuides(var kx, ky: Extended;
|
|
var Result: Boolean; IsMouseDown: Boolean);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.ClearLastView;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.GroupObjects;
|
|
var
|
|
i, j: Integer;
|
|
c: TfrxComponent;
|
|
sl: TStringList;
|
|
begin
|
|
sl := TStringList.Create;
|
|
sl.Sorted := True;
|
|
sl.Duplicates := dupIgnore;
|
|
|
|
{ reset group index }
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
c.GroupIndex := 0;
|
|
end;
|
|
|
|
{ collect available indexes }
|
|
for i := 0 to FObjects.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(FObjects[i]);
|
|
sl.Add(IntToStr(c.GroupIndex));
|
|
end;
|
|
|
|
{ find an unique index }
|
|
j := 0;
|
|
repeat
|
|
Inc(j);
|
|
until sl.IndexOf(IntToStr(j)) = -1;
|
|
|
|
{ set group index }
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
c.GroupIndex := j;
|
|
end;
|
|
|
|
sl.Free;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.InternalCopy;
|
|
var
|
|
EditorsManager: TfrxComponentEditorsManager;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
begin
|
|
if FSelectedObjects.Count = 0 then Exit;
|
|
EditorsManager := frxGetInPlaceEditor(FInPlaceditorsList, TfrxComponent(FSelectedObjects[0]));
|
|
if Assigned(EditorsManager) then
|
|
begin
|
|
SetDefaultEventParams(EventParams);
|
|
EditorsManager.CopyContent(TfrxComponent(FSelectedObjects[0]), EventParams, nil);
|
|
end;
|
|
end;
|
|
|
|
function TfrxDesignerWorkspace.InternalIsPasteAvailable: Boolean;
|
|
var
|
|
EditorsManager: TfrxComponentEditorsManager;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
begin
|
|
Result := False;
|
|
if FSelectedObjects.Count = 0 then
|
|
Exit;
|
|
EditorsManager := frxGetInPlaceEditor(FInPlaceditorsList, TfrxComponent(FSelectedObjects[0]));
|
|
if Assigned(EditorsManager) then
|
|
begin
|
|
SetDefaultEventParams(EventParams);
|
|
Result := EditorsManager.IsPasteAvailable(TfrxComponent(FSelectedObjects[0]), EventParams);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.InternalPaste;
|
|
var
|
|
EditorsManager: TfrxComponentEditorsManager;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
begin
|
|
if FSelectedObjects.Count = 0 then Exit;
|
|
EditorsManager := frxGetInPlaceEditor(FInPlaceditorsList, TfrxComponent(FSelectedObjects[0]));
|
|
if Assigned(EditorsManager) then
|
|
begin
|
|
SetDefaultEventParams(EventParams);
|
|
EditorsManager.PasteContent(TfrxComponent(FSelectedObjects[0]), EventParams, nil);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.UngroupObjects;
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
begin
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
c := TfrxComponent(FSelectedObjects[i]);
|
|
c.GroupIndex := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxDesignerWorkspace.CMMouseEnter(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if Assigned(FOnMouseEnter) then
|
|
FOnMouseEnter(Self);
|
|
end;
|
|
|
|
{ TDesgnHintData }
|
|
|
|
constructor TDesgnHintData.Create(vHeaderPrefix, vHeaderText: String; vMultiPaint: Boolean; vMemoView: TfrxCustomMemoView);
|
|
begin
|
|
inherited Create(vHeaderPrefix, vHeaderText, vMultiPaint);
|
|
FMemoView := vMemoView;
|
|
end;
|
|
|
|
{ TDesgnHintWindow }
|
|
|
|
procedure TDesgnHintWindow.SetPlainTextOptions;
|
|
var
|
|
MemoView: TfrxCustomMemoView;
|
|
begin
|
|
MemoView := TDesgnHintData(FBaseHintData).MemoView;
|
|
FDrawTextPlain.SetOptions(MemoView.WordWrap, MemoView.AllowHTMLTags,
|
|
MemoView.RTLReading, MemoView.WordBreak, False, MemoView.Wysiwyg, 0);
|
|
end;
|
|
|
|
end.
|