FastReport_2022_VCL/LibD28/frxReportTree.pas
2024-01-01 16:13:08 +01:00

452 lines
12 KiB
ObjectPascal

{******************************************}
{ }
{ FastReport VCL }
{ Report Tree }
{ }
{ Copyright (c) 1998-2021 }
{ by Fast Reports Inc. }
{ }
{******************************************}
unit frxReportTree;
interface
{$I frx.inc}
uses
{$IFNDEF FPC}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, frxClass, frxBaseForm, Types, frxComCtrls, frxDock
{$IFDEF FPC}
, LCLType
{$ENDIF}
{$IFDEF Delphi6}
, Variants
{$ENDIF};
type
TfrxReportTreeForm = class(TfrxDockForm)
procedure FormShow(Sender: TObject);
procedure TreeChange(Sender: TObject; Node: TTreeNode);
procedure FormCreate(Sender: TObject);
procedure TreeKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure TreeDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure TreeDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure TreeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FTreePanel: TfrxTreePanel;
FTree: TfrxTreeView;
FComponents: TList;
FDesigner: TfrxCustomDesigner;
FNodes: TList;
FReport: TfrxReport;
FUpdating: Boolean;
FOnSelectionChanged: TNotifyEvent;
FSelectedNodeList: TList;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure LoadFormPreferences(PreferencesStorage: TObject; DefPreferencesStorage: TObject); override;
procedure SaveFormPreferences(PreferencesStorage: TObject; DefPreferencesStorage: TObject); override;
procedure SetColor_(Value: TColor);
procedure UpdateItems;
procedure UpdateSelection;
procedure UpdateFormPPI(aNewPPI: Integer); override;
property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged
write FOnSelectionChanged;
end;
implementation
{$IFDEF FPC}
{$R *.lfm}
{$ELSE}
{$R *.DFM}
{$ENDIF}
uses frxRes, frxDesgn, frxDsgnIntf{$IFDEF FPC}, ExtCtrls{$ENDIF}, IniFiles;
type
THackWinControl = class(TWinControl);
{ TfrxReportTreeForm }
constructor TfrxReportTreeForm.Create(AOwner: TComponent);
begin
inherited;
FComponents := TList.Create;
FNodes := TList.Create;
FTreePanel := TfrxTreePanel.Create(Self);
FTreePanel.Parent := Self;
FTreePanel.Align := alClient;
FTreePanel.BorderStyle := bsNone;
FTreePanel.BorderWidth := 0;
{$IFNDEF FPC}
FTreePanel.BevelKind := bkFlat;
FTreePanel.BevelWidth := 1;
FTreePanel.ToolPanel.BevelKind := bkNone;
{$ENDIF}
FTreePanel.AutoSize := False;
FTreePanel.ToolPanel.AutoSize := False;
FTreePanel.ToolPanel.BorderStyle := bsNone;
FTreePanel.ToolPanel.ImageList := frxResources.MainButtonImages;
FTreePanel.FilterActiveImageIndex := 121;
FTreePanel.FilterUnactiveImageIndex := 122;
FTreePanel.TreeView.DrawExpandButton := True;
FTreePanel.FilterAlign := fraWidth;
FTreePanel.ToolPanelAlign := ftaBottom;
FTreePanel.ToolVisible := False;
FTree := FTreePanel.TreeView;
FTree.Align := alClient;
FTree.TabOrder := 0;
FTree.BorderStyle := bsNone;
FTree.DragMode := dmAutomatic;
FTree.ShowRoot := False;
FTree.ReadOnly := True;
FTree.HideSelection := False;
FTree.MultiSelect := True;
FTree.MultiSelectStyle := [msControlSelect, msVisibleOnly];
FTree.OnChange := TreeChange;
FTree.OnDragDrop := TreeDragDrop;
FTree.OnDragOver := TreeDragOver;
FTree.OnKeyDown := TreeKeyDown;
FTree.OnMouseDown := TreeMouseDown;
{$IFDEF UseTabset}
{$IFNDEF FPC}
FTree.BevelKind := bkNone;
{$ENDIF}
{$ELSE}
FTree.BorderStyle := bsSingle;
{$ENDIF}
FSelectedNodeList := TList.Create;
end;
destructor TfrxReportTreeForm.Destroy;
begin
FComponents.Free;
FNodes.Free;
FSelectedNodeList.Free;
inherited;
end;
procedure TfrxReportTreeForm.FormShow(Sender: TObject);
begin
UpdateItems;
end;
procedure TfrxReportTreeForm.LoadFormPreferences(PreferencesStorage,
DefPreferencesStorage: TObject);
var
Ini: TCustomIniFile;
begin
inherited;
if not(PreferencesStorage is TCustomIniFile) then Exit;
Ini := TCustomIniFile(PreferencesStorage);
FTreePanel.ToolVisible := Ini.ReadBool(GetFormSectionName, 'ToolVisible', FTreePanel.ToolVisible);
end;
procedure TfrxReportTreeForm.UpdateFormPPI(aNewPPI: Integer);
begin
inherited;
FTree.Images := frxResources.ObjectImages;
FTreePanel.ToolImageList := frxResources.MainButtonImages;
end;
procedure TfrxReportTreeForm.UpdateItems;
procedure SetImageIndex(Node: TTreeNode; Index: Integer);
begin
Node.ImageIndex := Index;
Node.StateIndex := Index;
Node.SelectedIndex := Index;
end;
procedure EnumItems(c: TfrxComponent; RootNode: TTreeNode);
var
i: Integer;
Node: TTreeNode;
Item: TfrxObjectItem;
begin
if (c is TfrxDataPage) and (frxDesignerComp <> nil) and
(drDontEditInternalDatasets in frxDesignerComp.Restrictions) then
Exit;
Node := FTree.Items.AddChild(RootNode, c.Name);
FComponents.Add(c);
FNodes.Add(Node);
Node.Data := c;
if c is TfrxReport then
begin
Node.Text := 'Report';
SetImageIndex(Node, 34);
end
else if c is TfrxReportPage then
SetImageIndex(Node, 35)
else if c is TfrxDialogPage then
SetImageIndex(Node, 36)
else if c is TfrxDataPage then
SetImageIndex(Node, 37)
else if c is TfrxBand then
SetImageIndex(Node, 40)
else
begin
for i := 0 to frxObjects.Count - 1 do
begin
Item := frxObjects[i];
if Item.ClassRef = c.ClassType then
begin
SetImageIndex(Node, Item.ButtonImageIndex);
break;
end;
end;
end;
if c is TfrxDataPage then
begin
for i := 0 to c.Objects.Count - 1 do
if TObject(c.Objects[i]) is TfrxDialogComponent then
EnumItems(TfrxComponent(c.Objects[i]), Node)
end
else
for i := 0 to c.Objects.Count - 1 do
EnumItems(TfrxComponent(c.Objects[i]), Node);
end;
begin
FTree.Items.BeginUpdate;
FTree.Items.Clear;
FComponents.Clear;
FNodes.Clear;
EnumItems(FReport, nil);
FTree.FullExpand;
UpdateSelection;
FTree.Items.EndUpdate;
FTree.UpdateFilter;
end;
procedure TfrxReportTreeForm.TreeChange(Sender: TObject; Node: TTreeNode);
var
i: Integer;
begin
{$IFDEF LCLGTK2}
if Assigned(FReport.Designer) then
if TfrxDesignerForm(FReport.Designer).LockSelectionChanged then
begin
TfrxDesignerForm(FReport.Designer).LockSelectionChanged := False;
Exit;
end;
{$ENDIF}
if FUpdating then Exit;
FDesigner.SelectedObjects.Clear;
FSelectedNodeList.Clear;
if (FTree.Selected <> nil) and (FTree.Selected.Data <> nil) then
begin
if FTree.SelectionCount <= 1 then
begin
FDesigner.SelectedObjects.Add(FTree.Selected.Data);
FSelectedNodeList.Add(FTree.Selected);
end
else
begin
for i := 0 to FTree.SelectionCount - 1 do
begin
FDesigner.SelectedObjects.Add(FTree.Selections[i].Data);
FSelectedNodeList.Add(FTree.Selections[i]);
end;
end;
if Assigned(FOnSelectionChanged) then
FOnSelectionChanged(Self);
end;
end;
procedure TfrxReportTreeForm.TreeDragDrop(Sender, Source: TObject; X,
Y: Integer);
var
Node, SelectedNode: TTreeNode;
i: Integer;
c: TfrxReportComponent;
Modified: Boolean;
begin
Modified := False;
if Source = FTree then
begin
Node := FTree.GetNodeAt(X, Y);
if Node <> nil then
begin
if (TObject(Node.Data) is TfrxBand) or (TObject(Node.Data) is TfrxReportPage) then
begin
FTree.Items.BeginUpdate;
for i := 0 to FSelectedNodeList.Count - 1 do
begin
SelectedNode := TTreeNode(FSelectedNodeList[i]);
if (TObject(SelectedNode.Data) is TfrxBand) and (SelectedNode <> Node) then
begin
while SelectedNode.Count <> 0 do
if (TObject(SelectedNode.{$IFDEF FPC}Items{$ELSE}Item{$ENDIF}[0].Data) is TfrxReportComponent) and not (TObject(SelectedNode.{$IFDEF FPC}Items{$ELSE}Item{$ENDIF}[0].Data) is TfrxDialogComponent) then
begin
TfrxReportComponent(SelectedNode.{$IFDEF FPC}Items{$ELSE}Item{$ENDIF}[0].Data).Parent := TfrxReportComponent(Node.Data);
SelectedNode.{$IFDEF FPC}Items{$ELSE}Item{$ENDIF}[0].MoveTo(Node, naAddChild);
Modified := True;
end;
end
else if (TObject(SelectedNode.Data) is TfrxReportComponent) then
begin
c := TObject(SelectedNode.Data) as TfrxReportComponent;
if (c <> nil) and not (c is TfrxDialogComponent) and not(csContained in c.frComponentStyle) then
begin
SelectedNode.MoveTo(Node, naAddChild);
if c <> Node.Data then
c.Parent := TfrxReportComponent(Node.Data);
Modified := True;
end;
end;
end;
FTree.Items.EndUpdate;
// for any case, to avoid TreeChange call
FUpdating := True;
{$IFDEF FPC}
//ApplyStoredSelection
{$ELSE}
FTree.Select(FSelectedNodeList);
{$ENDIF}
FUpdating := False;
if Assigned(FOnSelectionChanged) then
FOnSelectionChanged(Self);
if Modified then
TfrxDesignerForm(FDesigner).Modified := True;
end;
end;
end;
end;
procedure TfrxReportTreeForm.TreeDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var
Node: TTreeNode;
begin
Node := FTree.GetNodeAt(X, Y);
if Node <> nil then
Accept := (TObject(Node.Data) is TfrxBand) or (TObject(Node.Data) is TfrxReportPage);
end;
procedure TfrxReportTreeForm.SaveFormPreferences(PreferencesStorage,
DefPreferencesStorage: TObject);
var
Ini: TCustomIniFile;
begin
inherited;
if not(PreferencesStorage is TCustomIniFile) then Exit;
Ini := TCustomIniFile(PreferencesStorage);
Ini.WriteBool(GetFormSectionName, 'ToolVisible', FTreePanel.ToolVisible);
end;
procedure TfrxReportTreeForm.SetColor_(Value: TColor);
begin
FTree.Color := Value;
FTreePanel.FilterColor := Value;
UpdateItems;
end;
procedure TfrxReportTreeForm.FormCreate(Sender: TObject);
begin
FDesigner := TfrxCustomDesigner(Owner);
FReport := FDesigner.Report;
Caption := frxGet(2200);
if UseRightToLeftAlignment then
FlipChildren(True);
end;
{$IFDEF FPC}
type
THackCustomTreeView = class(TCustomTreeView)
public
property ChangeTimer: TTimer read FChangeTimer write FChangeTimer;
end;
{$ENDIF}
procedure TfrxReportTreeForm.UpdateSelection;
var
c: TComponent;
i, idx: Integer;
SelList: {$IFDEF FPC}Classes.{$ENDIF}TList;
begin
if FDesigner.SelectedObjects.Count = 0 then
Exit;
FUpdating := True;
FTree.Items.BeginUpdate;
SelList := {$IFDEF FPC}Classes.{$ENDIF}TList.Create;
try
//Tree.ClearSelection();
for idx := 0 to FDesigner.SelectedObjects.Count - 1 do
begin
c := TComponent(FDesigner.SelectedObjects[idx]);
i := FComponents.IndexOf(c);
if i <> -1 then
SelList.Add(FNodes[i]);
{$IFDEF FPC}
// OLD code - remove
// if i <> -1 then
// begin
//SelList.Add(FNodes[i]);
// if idx = 0 then
// TTreeNode(FNodes[i]).Selected := True
// else
// TTreeNode(FNodes[i]).Selected := True;
// Tree.TopItem := TTreeNode(FNodes[i]);
// end;
{$ENDIF}
end;
//{$IFNDEF FPC}
FTree.Select(SelList);
if SelList.Count > 0 then
FTree.TopItem := TTreeNode(SelList[SelList.Count - 1]);
//{$ENDIF}
finally
FTree.Items.EndUpdate;
{$IFDEF FPC}
THackCustomTreeView(FTree).ChangeTimer.Enabled := False;
{$ENDIF}
FUpdating := False;
SelList.Free;
end;
end;
procedure TfrxReportTreeForm.TreeKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = vk_Delete then
begin
THackWinControl(TfrxDesignerForm(FDesigner).Workspace).KeyDown(Key, Shift);
end;
end;
procedure TfrxReportTreeForm.TreeMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
p: TPoint;
i: Integer;
begin
if (PopupMenu = nil) or not (ssRight in Shift) then Exit;
for i := 0 to FTree.SelectionCount - 1 do
if FTree.Selections[i].Text = 'Report' then
Exit;
p := ClientToScreen(Point(X, Y));
PopupMenu.Popup(p.X, p.Y);
end;
end.