1613 lines
44 KiB
ObjectPascal
1613 lines
44 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ Designer workspace }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxDesgnWorkspace1;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
{$IFNDEF FPC}
|
|
Windows, Messages,
|
|
{$ENDIF}
|
|
Types, SysUtils, Classes, Graphics, Controls, Forms,
|
|
Dialogs, ExtCtrls, StdCtrls, Buttons, frxClass, frxDesgn,
|
|
frxDesgnWorkspace, frxPopupForm
|
|
{$IFDEF FPC}
|
|
,LCLType, LCLIntf, LazHelper
|
|
{$ENDIF}
|
|
{$IFDEF Delphi6}
|
|
, Variants
|
|
{$ENDIF}
|
|
{$IFDEF Delphi12}
|
|
, Character
|
|
{$ENDIF};
|
|
|
|
|
|
type
|
|
TfrxGuideItem = class(TCollectionItem)
|
|
public
|
|
Left, Top, Right, Bottom: Extended;
|
|
end;
|
|
|
|
TfrxVirtualGuides = class(TCollection)
|
|
private
|
|
function GetGuides(Index: Integer): TfrxGuideItem;
|
|
public
|
|
constructor Create;
|
|
procedure Add(Left, Top, Right, Bottom: Extended);
|
|
property Items[Index: Integer]: TfrxGuideItem read GetGuides; default;
|
|
end;
|
|
|
|
TDesignerWorkspace = class(TfrxDesignerWorkspace)
|
|
private
|
|
FAHGuides: TStrings;
|
|
FAVGuides: TStrings;
|
|
FDesigner: TfrxDesignerForm;
|
|
FGuide: Integer;
|
|
FShowGuides: Boolean;
|
|
FAutoGuides: Boolean;
|
|
FAutoGuidesH: Boolean;
|
|
FAutoGuidesV: Boolean;
|
|
FSimulateMove: Boolean;
|
|
FTool: TfrxDesignTool;
|
|
FVirtualGuides: TfrxVirtualGuides;
|
|
FVirtualGuideObjects: TList;
|
|
FGuidesObjects: TList;
|
|
FGuidesObjectsSize: TList;
|
|
FPopupFormVisible: Boolean;
|
|
FMouseDownObject: TfrxComponent;
|
|
FStickToGuides: Boolean;
|
|
FGuidesAsAnchor: Boolean;
|
|
FStickAccuracy: Extended;
|
|
FVVirtualGuid: Extended;
|
|
FHVirtualGuid: Extended;
|
|
procedure CreateVirtualGuides;
|
|
procedure SetShowGuides(const Value: Boolean);
|
|
procedure SetAutoGuides(const Value: Boolean);
|
|
procedure SetAutoGuidesH(const Value: Boolean);
|
|
procedure SetAutoGuidesV(const Value: Boolean);
|
|
procedure SetHGuides(const Value: TStrings);
|
|
procedure SetVGuides(const Value: TStrings);
|
|
function GetHGuides: TStrings;
|
|
function GetVGuides: TStrings;
|
|
function GetPageHGuides: TStrings;
|
|
function GetPageVGuides: TStrings;
|
|
procedure SetTool(const Value: TfrxDesignTool);
|
|
protected
|
|
function IsSupportsGuidlines(APage: TfrxPage): Boolean;
|
|
procedure CheckGuides(var kx, ky: Extended; var Result: Boolean; IsMouseDown: Boolean); override;
|
|
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
|
|
var Accept: Boolean); override;
|
|
procedure DrawObjects; override;
|
|
procedure DoFinishInPlace(Sender: TObject; Refresh, Modified: Boolean); override;
|
|
procedure SetDefaultEventParams(var EventParams: TfrxInteractiveEventsParams); override;
|
|
procedure KeyDown(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;
|
|
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
|
MousePos: TPoint): Boolean; override;
|
|
procedure DblClick; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure ClearLastView; override;
|
|
destructor Destroy; override;
|
|
procedure DeleteObjects; override;
|
|
procedure DragDrop(Source: TObject; X, Y: Integer); override;
|
|
procedure SimulateMove;
|
|
procedure SetVirtualGuids(VGuid, HGuid: Extended); override;
|
|
procedure SetInsertion(AClass: TfrxComponentClass;
|
|
AWidth, AHeight: Extended; AFlag: Word); override;
|
|
property HGuides: TStrings read GetHGuides write SetHGuides;
|
|
property VGuides: TStrings read GetVGuides write SetVGuides;
|
|
property PageHGuides: TStrings read GetPageHGuides;
|
|
property PageVGuides: TStrings read GetPageVGuides;
|
|
property ShowGuides: Boolean read FShowGuides write SetShowGuides;
|
|
property AutoGuides: Boolean read FAutoGuides write SetAutoGuides;
|
|
property AutoGuidesH: Boolean read FAutoGuidesH write SetAutoGuidesH;
|
|
property AutoGuidesV: Boolean read FAutoGuidesV write SetAutoGuidesV;
|
|
property StickToGuides: Boolean read FStickToGuides write FStickToGuides;
|
|
property GuidesAsAnchor: Boolean read FGuidesAsAnchor write FGuidesAsAnchor;
|
|
property StickAccuracy: Extended read FStickAccuracy write FStickAccuracy;
|
|
property Tool: TfrxDesignTool read FTool write SetTool;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
ComCtrls, frxDesgnCtrls, frxUtils, frxDataTree, frxDMPClass, frxRes;
|
|
|
|
type
|
|
THackMemo = class(TfrxCustomMemoView);
|
|
|
|
function Round8(e: Extended): Extended;
|
|
begin
|
|
Result := Round(e * 100000000) / 100000000;
|
|
end;
|
|
|
|
function ToIdent(const s: String): String;
|
|
|
|
{$IFDEF Delphi12}
|
|
function Alpha(C: Char): Boolean; inline;
|
|
begin
|
|
Result := TCharacter.IsLetter(C) or (C = '_');
|
|
end;
|
|
|
|
function AlphaNumeric(C: Char): Boolean; inline;
|
|
begin
|
|
Result := TCharacter.IsLetterOrDigit(C) or (C = '_');
|
|
end;
|
|
{$ENDIF}
|
|
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := '';
|
|
for i := 1 to Length(s) do
|
|
if i = 1 then
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
if Alpha(s[i]) then
|
|
{$ELSE}
|
|
if s[i] in ['A'..'Z','a'..'z','_'] then
|
|
{$ENDIF}
|
|
Result := Result + s[i]
|
|
end
|
|
{$IFDEF Delphi12}
|
|
else if AlphaNumeric(s[i]) then
|
|
{$ELSE}
|
|
else if s[i] in ['A'..'Z','a'..'z','_','0'..'9'] then
|
|
{$ENDIF}
|
|
Result := Result + s[i];
|
|
if Length(Result) < Length(s) * 2 div 3 then
|
|
Result := 'Memo';
|
|
end;
|
|
|
|
|
|
{ TfrxVirtualGuides }
|
|
|
|
constructor TfrxVirtualGuides.Create;
|
|
begin
|
|
inherited Create(TfrxGuideItem);
|
|
end;
|
|
|
|
procedure TfrxVirtualGuides.Add(Left, Top, Right, Bottom: Extended);
|
|
var
|
|
Item: TfrxGuideItem;
|
|
begin
|
|
Item := TfrxGuideItem(inherited Add);
|
|
Item.Left := Left;
|
|
Item.Top := Top;
|
|
Item.Right := Right;
|
|
Item.Bottom := Bottom;
|
|
end;
|
|
|
|
function TfrxVirtualGuides.GetGuides(Index: Integer): TfrxGuideItem;
|
|
begin
|
|
Result := TfrxGuideItem(inherited Items[Index]);
|
|
end;
|
|
|
|
|
|
{ TDesignerWorkspace }
|
|
|
|
procedure TDesignerWorkspace.ClearLastView;
|
|
var
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
begin
|
|
inherited;
|
|
if Assigned(FLastObjectOver) then
|
|
begin
|
|
SetDefaultEventParams(EventParams);
|
|
EventParams.PopupVisible := FPopupFormVisible;
|
|
FLastObjectOver.MouseLeave(-1, -1, nil, EventParams);
|
|
FPopupFormVisible := EventParams.PopupVisible;
|
|
FLastObjectOver := nil;
|
|
if EventParams.Refresh then
|
|
begin
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
end;
|
|
UpdateInternalSelection;
|
|
end;
|
|
FMouseDownObject := nil;
|
|
end;
|
|
|
|
constructor TDesignerWorkspace.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FDesigner := TfrxDesignerForm(AOwner);
|
|
FVirtualGuides := TfrxVirtualGuides.Create;
|
|
FVirtualGuideObjects := TList.Create;
|
|
FGuidesObjects := TList.Create;
|
|
FGuidesObjectsSize := TList.Create;
|
|
FMouseDownObject := nil;
|
|
FStickAccuracy := 1.5;
|
|
FVVirtualGuid := 0;
|
|
FHVirtualGuid := 0;
|
|
FAHGuides := TStringList.Create;
|
|
FAVGuides := TStringList.Create;
|
|
FAutoGuides := False;
|
|
end;
|
|
|
|
destructor TDesignerWorkspace.Destroy;
|
|
begin
|
|
FAHGuides.Free;
|
|
FAVGuides.Free;
|
|
FVirtualGuides.Free;
|
|
FVirtualGuideObjects.Free;
|
|
FGuidesObjects.Free;
|
|
FGuidesObjectsSize.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.DeleteObjects;
|
|
var
|
|
i: Integer;
|
|
NeedReload: Boolean;
|
|
begin
|
|
NeedReload := False;
|
|
for i := 0 to FSelectedObjects.Count - 1 do
|
|
begin
|
|
if TObject(FSelectedObjects[i]) is TfrxSubreport then
|
|
NeedReload := True;
|
|
//if FLastObjectOver = TObject(FSelectedObjects[i]) then
|
|
// FLastObjectOver := nil;
|
|
ClearLastView;
|
|
end;
|
|
|
|
inherited;
|
|
|
|
if NeedReload then
|
|
FDesigner.ReloadPages(FDesigner.Report.Objects.IndexOf(Page));
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SetInsertion(AClass: TfrxComponentClass;
|
|
AWidth, AHeight: Extended; AFlag: Word);
|
|
begin
|
|
inherited;
|
|
CreateVirtualGuides;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.DrawObjects;
|
|
var
|
|
i, d: Integer;
|
|
cc: TfrxComponent;
|
|
SelGuides: TStrings;
|
|
ValGuides, ValGuidesOld: Extended;
|
|
|
|
procedure SetSelGuides;
|
|
begin
|
|
if Cursor = crHSplit then
|
|
SelGuides := FAVGuides
|
|
else
|
|
SelGuides := FAHGuides;
|
|
end;
|
|
|
|
function FindGuide(AGuides: TStrings; Position: Extended): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to AGuides.Count - 1 do
|
|
begin
|
|
Result := Trunc(frxStrToFloat(AGuides[i])) = Trunc(Position);
|
|
if Result then Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure AddAutoGuides(AGuides, PGuides: TStrings; Position: Extended);
|
|
begin
|
|
if AGuides.IndexOf(frxFloatToStr(Position)) = -1 then
|
|
begin
|
|
AGuides.Add(frxFloatToStr(Position));
|
|
if FindGuide(PGuides, Position) then
|
|
AGuides.Objects[AGuides.Count - 1] := Pointer($3CC7FF)
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if FDesigner.Page is TfrxReportPage then
|
|
with TfrxReportPage(FDesigner.Page) do
|
|
if Columns > 1 then
|
|
for i := 0 to Columns - 1 do
|
|
begin
|
|
d := Round(frxStrToFloat(ColumnPositions[i]) * fr01cm * FScale);
|
|
if d = 0 then continue;
|
|
FCanvas.Pen.Color := clSilver;
|
|
FCanvas.MoveTo(d, 0);
|
|
FCanvas.LineTo(d, Self.Height);
|
|
end;
|
|
|
|
inherited;
|
|
{ draw guides on top }
|
|
if FShowGuides and IsSupportsGuidlines(FPage) then
|
|
begin
|
|
if (FAutoGuides) then
|
|
begin
|
|
ValGuidesOld := -1;
|
|
if FMouseDown and (FMode1 = dmMoveGuide) then
|
|
begin
|
|
SetSelGuides;
|
|
for i := 0 to SelGuides.Count - 1 do
|
|
if (SelGuides[i] = SelGuides[FGuide]) then
|
|
begin
|
|
ValGuidesOld := frxStrToFloat(SelGuides[FGuide]);
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
FAVGuides.Clear;
|
|
FAHGuides.Clear;
|
|
|
|
for i := 0 to FObjects.Count - 1 do
|
|
begin
|
|
cc := TfrxComponent(FObjects[i]);
|
|
if (cc is TfrxReportComponent) and not(csContained in cc.frComponentStyle) then
|
|
begin
|
|
if (FAutoGuidesH) then
|
|
begin
|
|
AddAutoGuides(FAHGuides, PageHGuides, cc.AbsTop);
|
|
AddAutoGuides(FAHGuides, PageHGuides, cc.AbsTop + cc.Height);
|
|
end;
|
|
if (FAutoGuidesV) then
|
|
begin
|
|
AddAutoGuides(FAVGuides, PageVGuides, cc.AbsLeft);
|
|
AddAutoGuides(FAVGuides, PageVGuides, cc.AbsLeft + cc.Width);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if FMouseDown and (FMode1 = dmMoveGuide) then
|
|
begin
|
|
SetSelGuides;
|
|
for i := 0 to SelGuides.Count - 1 do
|
|
begin
|
|
ValGuides := frxStrToFloat(SelGuides[i]);
|
|
if (ValGuides = ValGuidesOld) then
|
|
begin
|
|
FGuide := i;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
with FCanvas do
|
|
begin
|
|
Pen.Width := 1;
|
|
Pen.Style := psSolid;
|
|
Pen.Color := $FFCC00;
|
|
Pen.Mode := pmCopy;
|
|
end;
|
|
|
|
for i := 0 to HGuides.Count - 1 do
|
|
begin
|
|
d := Round(frxStrToFloat(HGuides[i]) * Scale);
|
|
if HGuides.Objects[i] <> nil then
|
|
FCanvas.Pen.Color := TColor(HGuides.Objects[i])
|
|
else
|
|
FCanvas.Pen.Color := $FFCC00;
|
|
FCanvas.MoveTo(0, d);
|
|
FCanvas.LineTo(Width, d);
|
|
end;
|
|
|
|
for i := 0 to VGuides.Count - 1 do
|
|
begin
|
|
d := Round(frxStrToFloat(VGuides[i]) * Scale);
|
|
if VGuides.Objects[i] <> nil then
|
|
FCanvas.Pen.Color := TColor(VGuides.Objects[i])
|
|
else
|
|
FCanvas.Pen.Color := $FFCC00;
|
|
FCanvas.MoveTo(d, 0);
|
|
FCanvas.LineTo(d, Height);
|
|
end;
|
|
|
|
if (FVVirtualGuid > 0) or (FHVirtualGuid > 0) then
|
|
begin
|
|
FCanvas.Pen.Mode := pmXor;
|
|
FCanvas.Pen.Color := clSilver;
|
|
FCanvas.Pen.Width := 1;
|
|
FCanvas.Pen.Style := psDot;
|
|
FCanvas.Brush.Style := bsClear;
|
|
|
|
|
|
if FVVirtualGuid > 0 then
|
|
begin
|
|
d := Round(FVVirtualGuid * Scale);
|
|
FCanvas.MoveTo(d, 0);
|
|
FCanvas.LineTo(d, Height);
|
|
end;
|
|
|
|
if FHVirtualGuid > 0 then
|
|
begin
|
|
d := Round(FHVirtualGuid * Scale);
|
|
FCanvas.MoveTo(0, d);
|
|
FCanvas.LineTo(Width, d);
|
|
end;
|
|
FCanvas.Pen.Mode := pmCopy;
|
|
FCanvas.Brush.Style := bsSolid;
|
|
end;
|
|
|
|
FDesigner.TopRuler.Guides := VGuides;
|
|
FDesigner.TopRuler.Invalidate;
|
|
FDesigner.LeftRuler.Guides := HGuides;
|
|
FDesigner.LeftRuler.Invalidate;
|
|
end;
|
|
|
|
if FVirtualGuides.Count > 0 then
|
|
begin
|
|
if FMouseDown or (FMode1 = dmInsertObject) or (FMode1 = dmInsertLine) then
|
|
with FCanvas do
|
|
begin
|
|
Pen.Width := 1;
|
|
Pen.Style := psSolid;
|
|
Pen.Color := $FFCC00;
|
|
Pen.Mode := pmCopy;
|
|
for i := 0 to FVirtualGuides.Count - 1 do
|
|
begin
|
|
MoveTo(Round(FVirtualGuides[i].Left * Scale), Round(FVirtualGuides[i].Top * Scale));
|
|
LineTo(Round(FVirtualGuides[i].Right * Scale), Round(FVirtualGuides[i].Bottom * Scale));
|
|
end;
|
|
end;
|
|
FVirtualGuides.Clear;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.DragOver(Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
var
|
|
ds: TfrxDataset;
|
|
s, fld: String;
|
|
w: Integer;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
begin
|
|
{$IFDEF FPC}
|
|
ds := nil;
|
|
fld := '';
|
|
{$ENDIF}
|
|
SetDefaultEventParams(EventParams);
|
|
if FLastObjectOver <> nil then
|
|
if FLastObjectOver.DragOver(Source, X, Y, State, Accept, EventParams) then
|
|
begin
|
|
FMode := dmDrag;
|
|
MouseMove([], X - 8, Y - 8);
|
|
Exit;
|
|
end;
|
|
|
|
Accept := ((FDesigner.CheckOp(drDontInsertObject) and
|
|
(((Source.InheritsFrom(TTreeView)) and
|
|
(FDesigner.DataTree.IsDataTree(Source)) and
|
|
((FDesigner.DataTree.GetFieldName(-1) <> '') or (FDesigner.DataTree.ActiveDS <> ''))) or not FDesigner.DataTree.IsDataField)) or
|
|
((Source is TfrxRuler) and FDesigner.ShowGuides)) and (FDesigner.Page is TfrxReportPage);
|
|
if not Accept then Exit;
|
|
|
|
FMode := dmDrag;
|
|
if Source is TfrxRuler then
|
|
with Canvas do
|
|
begin
|
|
Pen.Width := 1;
|
|
Pen.Style := psSolid;
|
|
Pen.Color := clBlack;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
|
|
if GridAlign then
|
|
begin
|
|
X := Round(Trunc(X / (GridX * Scale)) * GridX * Scale);
|
|
Y := Round(Trunc(Y / (GridY * Scale)) * GridY * Scale);
|
|
end;
|
|
|
|
if TfrxRuler(Source).Align = alLeft then
|
|
begin
|
|
MoveTo(X, 0);
|
|
LineTo(X, Height);
|
|
end
|
|
else
|
|
begin
|
|
MoveTo(0, Y);
|
|
LineTo(Width, Y);
|
|
end;
|
|
|
|
MouseMove([], X, Y);
|
|
end
|
|
else
|
|
begin
|
|
if (FInsertion.ComponentClass = nil) and
|
|
((dtfInsField in FDesigner.DataTree.DataTreeFlags) or
|
|
(dtfInsCaption in FDesigner.DataTree.DataTreeFlags) or
|
|
not FDesigner.DataTree.IsDataField) then
|
|
begin
|
|
s := FDesigner.DataTree.GetFieldName(-1);
|
|
s := Copy(s, 2, Length(s) - 2);
|
|
FDesigner.Report.GetDatasetAndField(s, ds, fld);
|
|
try
|
|
if (ds <> nil) and (fld <> '') then
|
|
w := ds.DisplayWidth[fld] else
|
|
w := 10;
|
|
except
|
|
w := 10;
|
|
end;
|
|
|
|
if w > 50 then
|
|
w := 50;
|
|
|
|
SetInsertion(TfrxMemoView, Round(w * 8 / GridX) * GridX,
|
|
FDesigner.GetDefaultObjectSize.Y, 0);
|
|
end;
|
|
|
|
MouseMove([], X - 8, Y - 8);
|
|
end;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.DragDrop(Source: TObject; X, Y: Integer);
|
|
var
|
|
eX, eY, OrgLeft: Extended;
|
|
m: TfrxCustomMemoView;
|
|
b: TfrxDataBand;
|
|
ds: TfrxDataset;
|
|
s, fld: String;
|
|
i, idx: Integer;
|
|
BandsList: TStringList;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
begin
|
|
{$IFDEF FPC}
|
|
ds := nil;
|
|
fld := '';
|
|
{$ENDIF}
|
|
SetDefaultEventParams(EventParams);
|
|
if FLastObjectOver <> nil then
|
|
if FLastObjectOver.DragDrop(Source, X, Y, EventParams) then
|
|
begin
|
|
SetInsertion(nil, 0, 0, 0);
|
|
FModifyFlag := EventParams.Modified;
|
|
MouseUp(mbLeft, [], X, Y);
|
|
UpdateInternalSelection;
|
|
SelectionChanged;
|
|
Exit;
|
|
end;
|
|
|
|
if (Source is TfrxRuler) and IsSupportsGuidlines(FPage) then
|
|
begin
|
|
if GridAlign then
|
|
begin
|
|
eX := Trunc(X / Scale / GridX) * GridX;
|
|
eY := Trunc(Y / Scale / GridY) * GridY;
|
|
end
|
|
else
|
|
begin
|
|
eX := X / Scale;
|
|
eY := Y / Scale;
|
|
end;
|
|
|
|
eX := Round8(eX);
|
|
eY := Round8(eY);
|
|
|
|
if TfrxRuler(Source).Align = alLeft then
|
|
VGuides.Add(FloatToStr(eX)) else
|
|
HGuides.Add(FloatToStr(eY));
|
|
FMode := dmSelect;
|
|
end
|
|
else if ((dtfInsField in FDesigner.DataTree.DataTreeFlags) or
|
|
(dtfInsCaption in FDesigner.DataTree.DataTreeFlags) or
|
|
not FDesigner.DataTree.IsDataField){$IFDEF FR_COM} and not FDesigner.IsExpired{$ENDIF} then
|
|
begin
|
|
// TODO: code for multi-selection need future refactoring
|
|
FSelectedObjects.Clear;
|
|
BandsList := TStringList.Create;
|
|
try
|
|
for i := FDesigner.DataTree.GetSelectionCount - 1 downto 0 do
|
|
begin
|
|
s := FDesigner.DataTree.GetFieldName(i);
|
|
ds := FDesigner.DataTree.GetDataSet(i);
|
|
if (s = '') and (ds <> nil) then
|
|
begin
|
|
if ds.IsHasMaster then
|
|
b := TfrxDetailData.Create(Page)
|
|
else
|
|
b := TfrxMasterData.Create(Page);
|
|
b.CreateUniqueName;
|
|
b.DataSet := ds;
|
|
BandsList.AddObject(ds.UserName, b);
|
|
end;
|
|
end;
|
|
ds := nil;
|
|
OrgLeft := FInsertion.Left;
|
|
|
|
for i := 0 to FDesigner.DataTree.GetSelectionCount - 1 do
|
|
begin
|
|
s := ToIdent(FDesigner.DataTree.GetFieldName(i));
|
|
ds := FDesigner.DataTree.GetDataSet(i);
|
|
if s <> '' then
|
|
begin
|
|
if Page is TfrxDMPPage then
|
|
m := TfrxDMPMemoView.Create(Page)
|
|
else
|
|
m := TfrxMemoView.Create(Page);
|
|
if (s <> 'Memo') and (FDesigner.Report.FindObject(s) = nil) and ((ds = nil) or (ds.UserName <> s) or (ds.Name <> s)) then
|
|
m.Name := s
|
|
else
|
|
begin
|
|
THackMemo(m).FBaseName := s;
|
|
m.CreateUniqueName;
|
|
end;
|
|
m.IndexTag := i + 1;
|
|
m.IsDesigning := True;
|
|
s := FDesigner.DataTree.GetFieldName(i);
|
|
s := Copy(s, 2, Length(s) - 2);
|
|
FDesigner.Report.GetDataSetAndField(s, ds, fld);
|
|
idx := -1;
|
|
|
|
if FInsertion.Left + FInsertion.Width > Page.Width then
|
|
begin
|
|
FInsertion.Left := OrgLeft;
|
|
if (dtfInsCaption in FDesigner.DataTree.DataTreeFlags) then
|
|
FInsertion.Top := FInsertion.Top + FInsertion.Height * 2
|
|
else
|
|
FInsertion.Top := FInsertion.Top + FInsertion.Height;
|
|
end;
|
|
|
|
if not FDesigner.DataTree.IsDataField or (dtfInsField in FDesigner.DataTree.DataTreeFlags) then
|
|
begin
|
|
m.DataSet := ds;
|
|
m.DataField := fld;
|
|
if (ds = nil) and (fld = '') then
|
|
begin
|
|
if Pos('<', FDesigner.DataTree.GetFieldName(i)) = 1 then
|
|
m.Text := '[' + s + ']' else
|
|
m.Text := '[' + FDesigner.DataTree.GetFieldName(i) + ']';
|
|
end;
|
|
|
|
if ds <> nil then
|
|
begin
|
|
idx := BandsList.IndexOf(ds.UserName);
|
|
if idx <> -1 then
|
|
begin
|
|
b := TfrxMasterData(BandsList.Objects[idx]);
|
|
b.SetBounds(0, Round8(FInsertion.Top),
|
|
FPage.Width, Round8(FInsertion.Height));
|
|
b.IsDesigning := True;
|
|
m.Parent := b;
|
|
m.Align := baLeft;
|
|
end;
|
|
end;
|
|
if idx <> -1 then
|
|
m.SetBounds(Round8(FInsertion.Left), 0,
|
|
Round8(FInsertion.Width), Round8(FInsertion.Height))
|
|
else if (dtfInsCaption in FDesigner.DataTree.DataTreeFlags) then
|
|
m.SetBounds(Round8(FInsertion.Left), Round8(FInsertion.Top + FInsertion.Height),
|
|
Round8(FInsertion.Width), Round8(FInsertion.Height))
|
|
else
|
|
m.SetBounds(Round8(FInsertion.Left), Round8(FInsertion.Top),
|
|
Round8(FInsertion.Width), Round8(FInsertion.Height));
|
|
|
|
FDesigner.SampleFormat.ApplySample(m);
|
|
FObjects.Add(m);
|
|
FSelectedObjects.Add(m);
|
|
end
|
|
else
|
|
m.Free;
|
|
if FDesigner.DataTree.IsDataField and (dtfInsCaption in FDesigner.DataTree.DataTreeFlags) then
|
|
begin
|
|
if Page is TfrxDMPPage then
|
|
m := TfrxDMPMemoView.Create(Page) else
|
|
m := TfrxMemoView.Create(Page);
|
|
m.CreateUniqueName;
|
|
m.IsDesigning := True;
|
|
m.Text := fld;
|
|
m.SetBounds(Round8(FInsertion.Left), Round8(FInsertion.Top),
|
|
Round8(FInsertion.Width), Round8(FInsertion.Height));
|
|
FDesigner.SampleFormat.ApplySample(m);
|
|
FObjects.Add(m);
|
|
FSelectedObjects.Add(m);
|
|
end;
|
|
FInsertion.Left := FInsertion.Left + FInsertion.Width;
|
|
if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.OnInsertObject) then
|
|
frxDesignerComp.OnInsertObject(m);
|
|
end;
|
|
end;
|
|
for i:= 0 to BandsList.Count - 1 do
|
|
begin
|
|
b := TfrxMasterData(BandsList.Objects[i]);
|
|
if b.Objects.Count = 0 then
|
|
b.Free
|
|
else
|
|
begin
|
|
FObjects.Add(b);
|
|
AdjustBandHeight(b);
|
|
end;
|
|
end;
|
|
finally
|
|
BandsList.Free;
|
|
end;
|
|
SetInsertion(nil, 0, 0, 0);
|
|
end;
|
|
|
|
FModifyFlag := True;
|
|
MouseUp(mbLeft, [], X, Y);
|
|
SelectionChanged;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
bEventProcessed: Boolean;
|
|
e: Extended;
|
|
i: Integer;
|
|
cc: TfrxComponent;
|
|
function CheckGuids(aGuids: TStrings; ePos: Extended): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to aGuids.Count -1 do
|
|
if Abs(frxStrToFloat(aGuids[i]) - ePos) <= 0.01 then
|
|
begin
|
|
Result := True;
|
|
break;
|
|
end;
|
|
end;
|
|
begin
|
|
if FDisableUpdate then Exit;
|
|
{ if popup active, send leave message to FLastObjectOver }
|
|
{ and mouse enter message to a new one }
|
|
if FPopUpActive and (Button = mbRight) then
|
|
begin
|
|
if Assigned(FMouseDownObject) then
|
|
begin
|
|
FLastObjectOver := FMouseDownObject;
|
|
FMouseDownObject := nil;
|
|
end;
|
|
MouseMove(Shift, X, Y);
|
|
end;
|
|
SetDefaultEventParams(EventParams);
|
|
FMouseDownObject := FLastObjectOver;
|
|
|
|
if FTool = dtHand then
|
|
begin
|
|
FMode1 := dmNone;
|
|
FMouseDown := True;
|
|
FLastMousePointX := X;
|
|
FLastMousePointY := Y;
|
|
Exit;
|
|
end
|
|
else if FTool in [dtZoom, dtText] then
|
|
begin
|
|
FMode1 := dmSelectionRect;
|
|
FSelectionRect := frxRect(X, Y, X, Y);
|
|
end
|
|
else if FTool = dtFormat then
|
|
begin
|
|
FMode1 := dmNone;
|
|
Exit;
|
|
end;
|
|
|
|
// csContainer handles in acenstor
|
|
if (FLastObjectOver <> nil) and FLastObjectOver.IsContain(X / FScale, Y / FScale)
|
|
{ and FDesigner.DropFields - link with memo processes there or remove} then
|
|
begin
|
|
bEventProcessed := FLastObjectOver.MouseDown(X, Y, Button, Shift,
|
|
EventParams);
|
|
FPopupFormVisible := EventParams.PopupVisible;
|
|
if FPopupFormVisible then
|
|
begin
|
|
FSelectedObjects.Clear;
|
|
FSelectedObjects.Add(FLastObjectOver);
|
|
FMode1 := dmNone;
|
|
FMouseDown := False;
|
|
// if (csContainer in FLastObjectOver.frComponentStyle) then
|
|
// FMode1 := dmContainer
|
|
end;
|
|
UpdateInternalSelection;
|
|
if bEventProcessed then
|
|
begin
|
|
if EventParams.Refresh then
|
|
begin
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
end;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
if not ((FTool = dtZoom) and (Button = mbRight)) then
|
|
inherited;
|
|
|
|
CreateVirtualGuides;
|
|
if (FMode1 = dmMoveGuide) and not (ssCtrl in Shift) and FStickToGuides then
|
|
begin
|
|
if IsSupportsGuidlines(FPage) then
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
cc := TfrxComponent(Objects[i]);
|
|
if not((cc is TfrxView) or (csContained in cc.frComponentStyle) or (cc is TfrxDialogControl)) then continue;
|
|
if Cursor = crHSplit then
|
|
begin
|
|
e := frxStrToFloat(VGuides[FGuide]);
|
|
if (Abs(cc.AbsLeft - e) <= FStickAccuracy) then
|
|
begin
|
|
if CheckGuids(VGuides, cc.AbsLeft + cc.Width) or (csContained in cc.frComponentStyle) and FGuidesAsAnchor then
|
|
FGuidesObjectsSize.Add(cc)
|
|
else
|
|
FGuidesObjects.Add(cc);
|
|
end;
|
|
if (Abs(cc.AbsLeft + cc.Width - e) <= FStickAccuracy) then
|
|
begin
|
|
if CheckGuids(VGuides, cc.AbsLeft) or (csContained in cc.frComponentStyle) and FGuidesAsAnchor then
|
|
FGuidesObjectsSize.Add(cc)
|
|
else
|
|
FGuidesObjects.Add(cc);
|
|
end;
|
|
end
|
|
else if Cursor = crVSplit then
|
|
begin
|
|
e := frxStrToFloat(HGuides[FGuide]);
|
|
if (Abs(cc.AbsTop - e) <= FStickAccuracy) then
|
|
begin
|
|
if CheckGuids(HGuides, cc.AbsTop + cc.Height) or (csContained in cc.frComponentStyle) and FGuidesAsAnchor then
|
|
FGuidesObjectsSize.Add(cc)
|
|
else
|
|
FGuidesObjects.Add(cc);
|
|
end;
|
|
if (Abs(cc.AbsTop + cc.Height - e) <= FStickAccuracy) then
|
|
begin
|
|
if CheckGuids(HGuides, cc.AbsTop) or (csContained in cc.frComponentStyle) and FGuidesAsAnchor then
|
|
FGuidesObjectsSize.Add(cc)
|
|
else
|
|
FGuidesObjects.Add(cc);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
i, px, py: Integer;
|
|
ContainedObj: TfrxComponent;
|
|
e, OldVal, kx, ky: Extended;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
|
|
function GridCheck: Boolean;
|
|
begin
|
|
Result := (kx >= GridX) or (kx <= -GridX) or
|
|
(ky >= GridY) or (ky <= -GridY);
|
|
if Result then
|
|
begin
|
|
kx := Trunc(kx / GridX) * GridX;
|
|
ky := Trunc(ky / GridY) * GridY;
|
|
end;
|
|
end;
|
|
|
|
procedure StickToGuides(aGuidsObjects: TList; Resize: Boolean; Vertical: Boolean);
|
|
var
|
|
i: Integer;
|
|
cc: TfrxComponent;
|
|
ePos, eLen: Extended;
|
|
begin
|
|
for I := 0 to aGuidsObjects.Count - 1 do
|
|
begin
|
|
cc := TfrxComponent(aGuidsObjects[I]);
|
|
if Vertical then
|
|
begin
|
|
ePos := cc.AbsLeft;
|
|
eLen := cc.Width;
|
|
end
|
|
else
|
|
begin
|
|
ePos := cc.AbsTop;
|
|
eLen := cc.Height;
|
|
end;
|
|
if (Abs(ePos - OldVal) <= FStickAccuracy) then
|
|
begin
|
|
if Resize then
|
|
begin
|
|
ePos := e;
|
|
eLen := eLen + (OldVal - e);
|
|
end
|
|
else
|
|
ePos := e;
|
|
end;
|
|
if (Abs(ePos + eLen - OldVal) <= FStickAccuracy) then
|
|
begin
|
|
if Resize then
|
|
eLen := e - ePos
|
|
else
|
|
ePos := e - eLen;
|
|
end;
|
|
if Vertical then
|
|
begin
|
|
cc.Left := ePos - (cc.AbsLeft - cc.Left);
|
|
cc.Width := eLen;
|
|
end
|
|
else
|
|
begin
|
|
cc.Top := ePos - (cc.AbsTop - cc.Top);
|
|
cc.Height := eLen;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SyncPageGuid(LGuides, PGuides: TStrings; const eValue: Extended);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Assigned(LGuides.Objects[FGuide]) then
|
|
begin
|
|
i := PGuides.IndexOf(LGuides[FGuide]);
|
|
if i >= 0 then
|
|
PGuides[i] := frxFloatToStr(eValue);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if FDisableUpdate then Exit;
|
|
inherited;
|
|
SetDefaultEventParams(EventParams);
|
|
if FTool = dtHand then
|
|
begin
|
|
Cursor := crHand;
|
|
|
|
if FMouseDown then
|
|
begin
|
|
kx := X - FLastMousePointX;
|
|
ky := Y - FLastMousePointY;
|
|
|
|
if Parent is TScrollingWinControl then
|
|
with TScrollingWinControl(Parent) do
|
|
begin
|
|
px := HorzScrollBar.Position;
|
|
py := VertScrollBar.Position;
|
|
HorzScrollBar.Position := px - Round(kx);
|
|
VertScrollBar.Position := py - Round(ky);
|
|
if HorzScrollBar.Position = px then
|
|
FLastMousePointX := X;
|
|
if VertScrollBar.Position = py then
|
|
FLastMousePointY := Y;
|
|
end;
|
|
end;
|
|
end
|
|
else if FTool = dtZoom then
|
|
Cursor := crZoom
|
|
else if FTool = dtText then
|
|
Cursor := crIBeam
|
|
else if FTool = dtFormat then
|
|
Cursor := crFormat;
|
|
|
|
if not FMouseDown and (FMode = dmSelect) and
|
|
((FMode1 = dmNone) or (FMode1 = dmMoveGuide)) and not FPopupFormVisible then
|
|
begin
|
|
if IsSupportsGuidlines(FPage) then
|
|
begin
|
|
for i := 0 to HGuides.Count - 1 do
|
|
begin
|
|
e := frxStrToFloat(HGuides[i]);
|
|
if (Y / Scale > e - 5) and (Y / Scale < e + 5) then
|
|
begin
|
|
FMode1 := dmMoveGuide;
|
|
Cursor := crVSplit;
|
|
FGuide := i;
|
|
end;
|
|
end;
|
|
|
|
for i := 0 to VGuides.Count - 1 do
|
|
begin
|
|
e := frxStrToFloat(VGuides[i]);
|
|
if (X / Scale > e - 5) and (X / Scale < e + 5) then
|
|
begin
|
|
FMode1 := dmMoveGuide;
|
|
Cursor := crHSplit;
|
|
FGuide := i;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if FMode1 in [dmNone, dmInsertObject, dmInsertLine, dmContainer, dmInplaceEdit] then
|
|
begin
|
|
EventParams.PopupVisible := FPopupFormVisible;
|
|
|
|
ContainedObj := nil;
|
|
if FPage <> nil then
|
|
ContainedObj := FPage.GetContainedComponent(X / FScale, Y / FScale);
|
|
|
|
{ call event only for top-most objects }
|
|
if Assigned(FMouseDownObject) and (FLastObjectOver = FMouseDownObject) then
|
|
ContainedObj := FMouseDownObject;
|
|
|
|
if Assigned(ContainedObj) then
|
|
begin
|
|
|
|
ContainedObj.MouseMove(X, Y, Shift, EventParams);
|
|
if (FLastObjectOver <> nil) and (FLastObjectOver <> ContainedObj) then
|
|
begin
|
|
FLastObjectOver.MouseLeave(X, Y, ContainedObj, EventParams);
|
|
EventParams.Refresh := True;
|
|
FLastObjectOver := nil;
|
|
end;
|
|
if (ContainedObj <> nil) and (FLastObjectOver <> ContainedObj) and not ((ContainedObj is TfrxPage) and (FLastObjectOver <> nil)) then
|
|
begin
|
|
ContainedObj.MouseEnter(FLastObjectOver, EventParams);
|
|
FLastObjectOver := ContainedObj;
|
|
end;
|
|
end
|
|
else if FLastObjectOver <> nil then
|
|
begin
|
|
FLastObjectOver.MouseLeave(X, Y, nil, EventParams);
|
|
EventParams.Refresh := True;
|
|
FLastObjectOver := nil;
|
|
end;
|
|
|
|
FPopupFormVisible := EventParams.PopupVisible;
|
|
UpdateInternalSelection;
|
|
if EventParams.Refresh then
|
|
begin
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
end;
|
|
UpdateInternalSelection;
|
|
end;
|
|
|
|
// moving the guideline
|
|
if FMouseDown and (FMode1 = dmMoveGuide) then
|
|
begin
|
|
if Cursor = crHSplit then
|
|
begin
|
|
e := frxStrToFloat(VGuides[FGuide]);
|
|
kx := X / Scale - FLastMousePointX;
|
|
ky := 0;
|
|
OldVal := e;
|
|
if not (GridAlign and not GridCheck) then
|
|
begin
|
|
FModifyFlag := True;
|
|
e := Round((e + kx) * 100000000) / 100000000;
|
|
FLastMousePointX := FLastMousePointX + kx;
|
|
end;
|
|
StickToGuides(FGuidesObjects, False, True);
|
|
StickToGuides(FGuidesObjectsSize, True, True);
|
|
SyncPageGuid(VGuides, PageVGuides, e);
|
|
VGuides[FGuide] := frxFloatToStr(e);
|
|
end
|
|
else
|
|
begin
|
|
e := frxStrToFloat(HGuides[FGuide]);
|
|
kx := 0;
|
|
ky := Y / Scale - FLastMousePointY;
|
|
OldVal := e;
|
|
if not (GridAlign and not GridCheck) then
|
|
begin
|
|
FModifyFlag := True;
|
|
e := Round((e + ky) * 100000000) / 100000000;
|
|
FLastMousePointY := FLastMousePointY + ky;
|
|
end;
|
|
StickToGuides(FGuidesObjects, False, False);
|
|
StickToGuides(FGuidesObjectsSize, True, False);
|
|
SyncPageGuid(HGuides, PageHGuides, e);
|
|
HGuides[FGuide] := frxFloatToStr(e);
|
|
end;
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Invalidate;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.MouseUp(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
i: Integer;
|
|
e: Extended;
|
|
c: TfrxComponent;
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
|
|
procedure CopyFormat(MemoFrom, MemoTo: TfrxMemoView);
|
|
begin
|
|
MemoTo.Color := MemoFrom.Color;
|
|
MemoTo.Font := MemoFrom.Font;
|
|
MemoTo.Frame.Assign(MemoFrom.Frame);
|
|
MemoTo.BrushStyle := MemoFrom.BrushStyle;
|
|
MemoTo.HAlign := MemoFrom.HAlign;
|
|
MemoTo.VAlign := MemoFrom.VAlign;
|
|
end;
|
|
|
|
begin
|
|
if FDisableUpdate then Exit;
|
|
|
|
FSimulateMove := False;
|
|
FVirtualGuideObjects.Clear;
|
|
FGuidesObjects.Clear;
|
|
FGuidesObjectsSize.Clear;
|
|
|
|
SetDefaultEventParams(EventParams);
|
|
|
|
if FLastObjectOver <> nil then
|
|
begin
|
|
TfrxComponent(FLastObjectOver).MouseUp(X, Y, Button, Shift, EventParams);
|
|
FModifyFlag := FModifyFlag or EventParams.Modified;
|
|
end;
|
|
|
|
if (FMode1 = dmSize) and FMouseDown then
|
|
for i := 0 to SelectedObjects.Count - 1 do
|
|
TfrxComponent(SelectedObjects[i]).UpdateBounds;
|
|
|
|
FMouseDownObject := nil;
|
|
UpdateInternalSelection;
|
|
|
|
if FTool = dtZoom then
|
|
begin
|
|
FMode1 := dmNone;
|
|
NormalizeRect(FSelectionRect);
|
|
|
|
with FSelectionRect do
|
|
if (Right - Left > 5) and (Bottom - Top > 5) then
|
|
begin
|
|
e := Scale;
|
|
|
|
if (Right - Left) / (Parent.ClientWidth - 16) <
|
|
(Bottom - Top) / (Parent.ClientHeight - 16) then
|
|
FDesigner.Scale := (Parent.ClientHeight - 16) / (Bottom - Top) * Scale else
|
|
FDesigner.Scale := (Parent.ClientWidth - 16) / (Right - Left) * Scale;
|
|
|
|
if Parent is TScrollingWinControl then
|
|
with TScrollingWinControl(Parent) do
|
|
begin
|
|
HorzScrollBar.Position := Round((FSelectionRect.Left / e +
|
|
TfrxReportPage(FDesigner.Page).LeftMargin * fr01cm) * Scale);
|
|
VertScrollBar.Position := Round((FSelectionRect.Top / e +
|
|
TfrxReportPage(FDesigner.Page).TopMargin * fr01cm) * Scale);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
e := Scale;
|
|
if Button = mbLeft then
|
|
begin
|
|
if FDesigner.Scale >= 1 then
|
|
FDesigner.Scale := FDesigner.Scale + 1
|
|
else
|
|
FDesigner.Scale := FDesigner.Scale + 0.25
|
|
end
|
|
else
|
|
begin
|
|
if FDesigner.Scale >= 2 then
|
|
FDesigner.Scale := FDesigner.Scale - 1
|
|
else if FDesigner.Scale > 0.4 then
|
|
FDesigner.Scale := FDesigner.Scale - 0.25
|
|
end;
|
|
if Parent is TScrollingWinControl then
|
|
with TScrollingWinControl(Parent) do
|
|
begin
|
|
HorzScrollBar.Position := Round((FSelectionRect.Left / e +
|
|
TfrxReportPage(FDesigner.Page).LeftMargin * fr01cm) * Scale -
|
|
ClientWidth / 2);
|
|
VertScrollBar.Position := Round((FSelectionRect.Top / e +
|
|
TfrxReportPage(FDesigner.Page).TopMargin * fr01cm) * Scale -
|
|
ClientHeight / 2);
|
|
end;
|
|
end;
|
|
end
|
|
|
|
else if (FTool = dtText) and FMouseDown then
|
|
begin
|
|
FMode1 := dmNone;
|
|
FMouseDown := False;
|
|
NormalizeRect(FSelectionRect);
|
|
|
|
with FSelectionRect do
|
|
if (Right - Left > 5) or (Bottom - Top > 5) then
|
|
begin
|
|
if GridAlign then
|
|
begin
|
|
Left := Trunc(Left / GridX) * GridX;
|
|
Right := Trunc(Right / GridX) * GridX;
|
|
Top := Trunc(Top / GridY) * GridY;
|
|
Bottom := Trunc(Bottom / GridY) * GridY;
|
|
end;
|
|
|
|
FInsertion.Left := Left / FScale;
|
|
FInsertion.Top := Top / FScale;
|
|
FInsertion.Width := (Right - Left) / FScale;
|
|
FInsertion.Height := (Bottom - Top) / FScale;
|
|
if Page is TfrxDMPPage then
|
|
FInsertion.ComponentClass := TfrxDMPMemoView else
|
|
FInsertion.ComponentClass := TfrxMemoView;
|
|
|
|
if Assigned(FOnInsert) then
|
|
FOnInsert(Self);
|
|
AdjustBands;
|
|
|
|
if TObject(FSelectedObjects[0]) is TfrxCustomMemoView then
|
|
FLastObjectOver := TfrxCustomMemoView(FSelectedObjects[0]);
|
|
end;
|
|
|
|
if FLastObjectOver <> nil then
|
|
begin
|
|
FSelectedObjects.Clear;
|
|
FSelectedObjects.Add(FLastObjectOver);
|
|
SelectionChanged;
|
|
end;
|
|
|
|
Exit;
|
|
end
|
|
else if FTool = dtFormat then
|
|
begin
|
|
FSelectionRect := frxRect(X, Y, X + 1, Y + 1);
|
|
for i := FObjects.Count - 1 downto 0 do
|
|
begin
|
|
c := TfrxComponent(FObjects[i]);
|
|
if (c is TfrxMemoView) and c.IsContain(X / FScale, Y / FScale) and not
|
|
(rfDontModify in c.Restrictions) and (c <> TfrxComponent(FSelectedObjects[0])) then
|
|
begin
|
|
CopyFormat(TfrxMemoView(FSelectedObjects[0]), TfrxMemoView(c));
|
|
FModifyFlag := True;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
if FMode1 = dmMoveGuide then
|
|
begin
|
|
if Cursor = crHSplit then
|
|
begin
|
|
e := frxStrToFloat(VGuides[FGuide]);
|
|
if (e < 3) or (e > (Width / Scale) - 3) then
|
|
VGuides.Delete(FGuide);
|
|
end
|
|
else
|
|
begin
|
|
e := frxStrToFloat(HGuides[FGuide]);
|
|
if (e < 3) or (e > (Height / Scale) - 3) then
|
|
HGuides.Delete(FGuide);
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.DblClick;
|
|
begin
|
|
if FTool = dtSelect then
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if (Key = VK_ESCAPE) and FSimulateMove then
|
|
begin
|
|
Key := VK_DELETE;
|
|
MouseUp(mbLeft, [], 0, 0);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SimulateMove;
|
|
var
|
|
r: TfrxRect;
|
|
begin
|
|
FMode1 := dmMove;
|
|
r := GetSelectionBounds;
|
|
MouseDown(mbLeft, [], Round(r.Left / Scale) + 20, Round(r.Top / Scale) + 20);
|
|
FSimulateMove := True;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.CreateVirtualGuides;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FVirtualGuideObjects.Clear;
|
|
for i := 0 to Objects.Count - 1 do
|
|
if (TObject(Objects[i]) is TfrxComponent) and not (csContained in TfrxComponent(Objects[i]).frComponentStyle) then
|
|
FVirtualGuideObjects.Add(Objects[i]);
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.DoFinishInPlace(Sender: TObject; Refresh,
|
|
Modified: Boolean);
|
|
begin
|
|
FPopupFormVisible := False;
|
|
Inherited;
|
|
end;
|
|
|
|
function TDesignerWorkspace.DoMouseWheel(Shift: TShiftState;
|
|
WheelDelta: Integer; MousePos: TPoint): Boolean;
|
|
var
|
|
EventParams: TfrxInteractiveEventsParams;
|
|
begin
|
|
inherited DoMouseWheel(Shift, WheelDelta, MousePos);
|
|
Result := True;
|
|
if FLastObjectOver <> nil then
|
|
begin
|
|
SetDefaultEventParams(EventParams);
|
|
Result := not TfrxComponent(FLastObjectOver).MouseWheel(Shift, WheelDelta, MousePos, EventParams);
|
|
FModifyFlag := EventParams.Modified;
|
|
UpdateInternalSelection;
|
|
DoModify;
|
|
if EventParams.Refresh then
|
|
begin
|
|
{$IFDEF FPC}
|
|
frxUpdateControl(Self);
|
|
{$ELSE}
|
|
Repaint;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
// if Result then
|
|
// Result := Inherited;
|
|
end;
|
|
|
|
function TDesignerWorkspace.IsSupportsGuidlines(APage: TfrxPage): Boolean;
|
|
begin
|
|
Result := Assigned(APage) and APage.IsSupportsGuidlines;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.CheckGuides(var kx, ky: Extended;
|
|
var Result: Boolean; IsMouseDown: Boolean);
|
|
var
|
|
i: Integer;
|
|
cc: TfrxComponent;
|
|
|
|
procedure CheckH(coord: Extended);
|
|
var
|
|
i: Integer;
|
|
e: Extended;
|
|
begin
|
|
if IsSupportsGuidlines(FPage) then
|
|
for i := 0 to HGuides.Count - 1 do
|
|
begin
|
|
e := frxStrToFloat(HGuides[i]);
|
|
if Abs(coord + ky - e) < 6 then
|
|
begin
|
|
ky := e - coord;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure CheckV(coord: Extended);
|
|
var
|
|
i: Integer;
|
|
e: Extended;
|
|
begin
|
|
if IsSupportsGuidlines(FPage) then
|
|
for i := 0 to VGuides.Count - 1 do
|
|
begin
|
|
e := frxStrToFloat(VGuides[i]);
|
|
if Abs(coord + kx - e) < 6 then
|
|
begin
|
|
kx := e - coord;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure CheckHH(Left, Top: Extended; Obj: TfrxComponent);
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
e: Extended;
|
|
begin
|
|
for i := 0 to FVirtualGuideObjects.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(FVirtualGuideObjects[i]);
|
|
if c = Obj then continue;
|
|
e := c.AbsTop;
|
|
if Abs(Top + ky - e) < 0.001 then
|
|
FVirtualGuides.Add(Left, e, c.AbsLeft, e);
|
|
e := c.AbsTop + c.Height;
|
|
if Abs(Top + ky - e) < 0.001 then
|
|
FVirtualGuides.Add(Left, e, c.AbsLeft, e);
|
|
end;
|
|
end;
|
|
|
|
procedure CheckVV(Left, Top: Extended; Obj: TfrxComponent);
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
e: Extended;
|
|
begin
|
|
for i := 0 to FVirtualGuideObjects.Count - 1 do
|
|
begin
|
|
c := TfrxComponent(FVirtualGuideObjects[i]);
|
|
if c = Obj then continue;
|
|
e := c.AbsLeft;
|
|
if Abs(Left + kx - e) < 0.001 then
|
|
FVirtualGuides.Add(e, c.AbsTop, e, Top);
|
|
e := c.AbsLeft + c.Width;
|
|
if Abs(Left + kx - e) < 0.001 then
|
|
FVirtualGuides.Add(e, c.AbsTop, e, Top);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if not FShowGuides then Exit;
|
|
|
|
FVirtualGuides.Clear;
|
|
|
|
if IsMouseDown and (FMode1 = dmSizeBand) then
|
|
CheckH(FSizedBand.Top + FSizedBand.Height);
|
|
|
|
if not IsMouseDown and ((FMode1 = dmInsertObject) or (FMode1 = dmInsertLine)) then
|
|
begin
|
|
CheckV(FInsertion.Left);
|
|
CheckH(FInsertion.Top);
|
|
CheckVV(FInsertion.Left, FInsertion.Top, nil);
|
|
CheckHH(FInsertion.Left, FInsertion.Top, nil);
|
|
CheckV(FInsertion.Left + FInsertion.Width);
|
|
CheckH(FInsertion.Top + FInsertion.Height);
|
|
CheckVV(FInsertion.Left + FInsertion.Width, FInsertion.Top, nil);
|
|
CheckHH(FInsertion.Left, FInsertion.Top + FInsertion.Height, nil);
|
|
end;
|
|
|
|
if IsMouseDown and ((FMode1 = dmInsertObject) or (FMode1 = dmInsertLine)) then
|
|
begin
|
|
CheckV(FInsertion.Left);
|
|
CheckH(FInsertion.Top);
|
|
CheckVV(FInsertion.Left, FInsertion.Top, nil);
|
|
CheckHH(FInsertion.Left, FInsertion.Top, nil);
|
|
end;
|
|
|
|
if IsMouseDown and (FMode1 = dmMove) then
|
|
for i := 0 to SelectedCount - 1 do
|
|
begin
|
|
cc := TfrxComponent(FSelectedObjects[i]);
|
|
CheckV(cc.Left);
|
|
CheckVV(cc.AbsLeft, cc.AbsTop, cc);
|
|
CheckHH(cc.AbsLeft, cc.AbsTop, cc);
|
|
CheckH(cc.AbsTop);
|
|
CheckH(cc.Top);
|
|
CheckV(cc.Left + cc.Width);
|
|
CheckVV(cc.AbsLeft + cc.Width, cc.AbsTop, cc);
|
|
CheckHH(cc.AbsLeft, cc.AbsTop + cc.Height, cc);
|
|
CheckH(cc.AbsTop + cc.Height);
|
|
end;
|
|
|
|
if IsMouseDown and (FMode1 = dmSize) then
|
|
begin
|
|
cc := TfrxComponent(FSelectedObjects[0]);
|
|
if FCT in [ct1, ct6, ct4] then
|
|
begin
|
|
CheckV(cc.Left);
|
|
CheckVV(cc.AbsLeft, cc.AbsTop, cc);
|
|
end;
|
|
if FCT in [ct1, ct7, ct3] then
|
|
begin
|
|
CheckH(cc.AbsTop);
|
|
CheckHH(cc.AbsLeft, cc.AbsTop, cc);
|
|
end;
|
|
if FCT in [ct3, ct5, ct2] then
|
|
begin
|
|
CheckV(cc.Left + cc.Width);
|
|
CheckVV(cc.AbsLeft + cc.Width, cc.AbsTop, cc);
|
|
end;
|
|
if FCT in [ct4, ct8, ct2] then
|
|
begin
|
|
CheckH(cc.AbsTop + cc.Height);
|
|
CheckHH(cc.AbsLeft, cc.AbsTop + cc.Height, cc);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SetShowGuides(const Value: Boolean);
|
|
begin
|
|
FShowGuides := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SetAutoGuides(const Value: Boolean);
|
|
begin
|
|
FAutoGuides := Value;
|
|
FAVGuides.Clear;
|
|
FAHGuides.Clear;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SetAutoGuidesH(const Value: Boolean);
|
|
begin
|
|
FAutoGuidesH := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SetAutoGuidesV(const Value: Boolean);
|
|
begin
|
|
FAutoGuidesV := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
function TDesignerWorkspace.GetHGuides: TStrings;
|
|
begin
|
|
Result := nil;
|
|
if not IsSupportsGuidlines(FPage) then Exit;
|
|
if FAutoGuides then
|
|
Result := FAHGuides
|
|
else
|
|
Result := TfrxReportPage(FPage).HGuides;
|
|
end;
|
|
|
|
function TDesignerWorkspace.GetPageHGuides: TStrings;
|
|
begin
|
|
Result := nil;
|
|
if IsSupportsGuidlines(FPage) then
|
|
Result := TfrxReportPage(FPage).HGuides;
|
|
end;
|
|
|
|
function TDesignerWorkspace.GetPageVGuides: TStrings;
|
|
begin
|
|
Result := nil;
|
|
if IsSupportsGuidlines(FPage) then
|
|
Result := TfrxReportPage(FPage).VGuides;
|
|
end;
|
|
|
|
function TDesignerWorkspace.GetVGuides: TStrings;
|
|
begin
|
|
Result := nil;
|
|
if not IsSupportsGuidlines(FPage) then Exit;
|
|
if FAutoGuides then
|
|
Result := FAVGuides
|
|
else
|
|
Result := TfrxReportPage(FPage).VGuides;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SetDefaultEventParams(
|
|
var EventParams: TfrxInteractiveEventsParams);
|
|
begin
|
|
inherited SetDefaultEventParams(EventParams);
|
|
EventParams.EditMode := FTool;
|
|
EventParams.SelectionList := FSelectedObjects;
|
|
FSelectedObjects.Updated := False;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SetHGuides(const Value: TStrings);
|
|
begin
|
|
TfrxReportPage(FPage).HGuides := Value;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SetVGuides(const Value: TStrings);
|
|
begin
|
|
TfrxReportPage(FPage).VGuides := Value;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SetVirtualGuids(VGuid, HGuid: Extended);
|
|
begin
|
|
FVVirtualGuid := VGuid;
|
|
FHVirtualGuid := HGuid;
|
|
end;
|
|
|
|
procedure TDesignerWorkspace.SetTool(const Value: TfrxDesignTool);
|
|
begin
|
|
FTool := Value;
|
|
end;
|
|
|
|
end.
|