frxdatatree.pas

这个是功能强大的报表软件

{******************************************}
{                                          }
{             FastReport v4.0              }
{          Data Tree tool window           }
{                                          }
{         Copyright (c) 1998-2008          }
{         by Alexander Tzyganenko,         }
{            Fast Reports Inc.             }
{                                          }
{******************************************}

unit frxDataTree;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, frxClass, fs_xml, ComCtrls
{$IFDEF UseTabset}
, Tabs
{$ENDIF}
{$IFDEF Delphi6}
, Variants
{$ENDIF};


type
  TfrxDataTreeForm = class(TForm)
    DataPn: TPanel;
    DataTree: TTreeView;
    CBPanel: TPanel;
    InsFieldCB: TCheckBox;
    InsCaptionCB: TCheckBox;
    VariablesPn: TPanel;
    VariablesTree: TTreeView;
    FunctionsPn: TPanel;
    Splitter1: TSplitter;
    HintPanel: TScrollBox;
    FunctionDescL: TLabel;
    FunctionNameL: TLabel;
    FunctionsTree: TTreeView;
    ClassesPn: TPanel;
    ClassesTree: TTreeView;
    NoDataPn: TScrollBox;
    NoDataL: TLabel;
    SortCB: TCheckBox;
    procedure FormResize(Sender: TObject);
    procedure DataTreeCustomDrawItem(Sender: TCustomTreeView;
      Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure FunctionsTreeChange(Sender: TObject; Node: TTreeNode);
    procedure DataTreeDblClick(Sender: TObject);
    procedure ClassesTreeExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure ClassesTreeCustomDrawItem(Sender: TCustomTreeView;
      Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure SortCBClick(Sender: TObject);
  private
    { Private declarations }
    FXML: TfsXMLDocument;
    FImages: TImageList;
    FReport: TfrxReport;
    FUpdating: Boolean;
    FFirstTime: Boolean;
{$IFDEF UseTabset}
    FTabs: TTabSet;
{$ELSE}
    FTabs: TTabControl;
{$ENDIF}
    procedure FillClassesTree;
    procedure FillDataTree;
    procedure FillFunctionsTree;
    procedure FillVariablesTree;
    procedure TabsChange(Sender: TObject);
    function GetCollapsedNodes: String;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetColor(Color: TColor);
    procedure SetControlsParent(AParent: TWinControl);
    procedure SetLastPosition(p: TPoint);
    procedure ShowTab(Index: Integer);
    procedure UpdateItems;
    procedure UpdateSelection;
    procedure UpdateSize;
    function GetActivePage: Integer;
    function GetFieldName: String;
    function GetLastPosition: TPoint;
    function IsDataField: Boolean;
    property Report: TfrxReport read FReport write FReport;
  end;


implementation

{$R *.DFM}

uses fs_iinterpreter, fs_itools, frxRes;

var
  CollapsedNodes: String;

type
  THackWinControl = class(TWinControl);


procedure SetImageIndex(Node: TTreeNode; Index: Integer);
begin
  Node.ImageIndex := Index;
  Node.StateIndex := Index;
  Node.SelectedIndex := Index;
end;


{ TfrxDataTreeForm }

constructor TfrxDataTreeForm.Create(AOwner: TComponent);
begin
  inherited;
  FImages := frxResources.MainButtonImages;
  DataTree.Images := FImages;
  VariablesTree.Images := FImages;
  FunctionsTree.Images := FImages;
  ClassesTree.Images := FImages;
{$IFDEF UseTabset}
  DataTree.BevelKind := bkFlat;
  VariablesTree.BevelKind := bkFlat;
  FunctionsTree.BevelKind := bkFlat;
  ClassesTree.BevelKind := bkFlat;
{$ELSE}
  DataTree.BorderStyle := bsSingle;
  VariablesTree.BorderStyle := bsSingle;
  FunctionsTree.BorderStyle := bsSingle;
  ClassesTree.BorderStyle := bsSingle;
{$ENDIF}
  FXML := TfsXMLDocument.Create;
  FFirstTime := True;
{$IFDEF UseTabset}
  FTabs := TTabSet.Create(Self);
  FTabs.ShrinkToFit := True;
  FTabs.Style := tsSoftTabs;
  FTabs.TabPosition := tpTop;
{$ELSE}
  FTabs := TTabControl.Create(Self);
{$ENDIF}
  FTabs.Parent := Self;
  FTabs.SendToBack;

  Caption := frxGet(2100);
  FTabs.Tabs.AddObject(frxGet(2101), DataPn);
  FTabs.Tabs.AddObject(frxGet(2102), VariablesPn);
  FTabs.Tabs.AddObject(frxGet(2103), FunctionsPn);
  FTabs.Tabs.AddObject(frxGet(2106), ClassesPn);
  FTabs.TabIndex := 0;
  InsFieldCB.Caption := frxGet(2104);
  InsCaptionCB.Caption := frxGet(2105);
  SortCB.Caption := frxGet(6004);
{$IFDEF UseTabset}
  FTabs.OnClick := TabsChange;
{$ELSE}
  FTabs.OnChange := TabsChange;
{$ENDIF}
end;

destructor TfrxDataTreeForm.Destroy;
begin
  if Owner is TfrxCustomDesigner then
    CollapsedNodes := GetCollapsedNodes;
  FUpdating := True;
  FXML.Free;
  inherited;
end;

procedure TfrxDataTreeForm.FillDataTree;
var
  ds: TfrxDataSet;
  DatasetsList, FieldsList: TStrings;
  i, j: Integer;
  Root, Node1, Node2: TTreeNode;
  s, Collapsed: String;
begin
  DatasetsList := TStringList.Create;
  FieldsList := TStringList.Create;
  TStringList(FieldsList).Sorted := SortCB.Checked;
  TStringList(DatasetsList).Sorted := SortCB.Checked;

  FReport.GetDataSetList(DatasetsList);

  try
    if FFirstTime then
      Collapsed := CollapsedNodes
    else
      Collapsed := GetCollapsedNodes;

    DataTree.Items.BeginUpdate;
    DataTree.Items.Clear;
    if DatasetsList.Count = 0 then
    begin
      NoDataL.Caption := frxResources.Get('dtNoData') + '.' + #13#10#13#10 +
        frxResources.Get('dtNoData1');
      NoDataPn.Visible := True;
    end
    else
    begin
      NoDataPn.Visible := False;
      s := frxResources.Get('dtData');
      Root := DataTree.Items.AddChild(nil, s);
      SetImageIndex(Root, 53);

      for i := 0 to DatasetsList.Count - 1 do
      begin
        ds := TfrxDataSet(DatasetsList.Objects[i]);
        if ds = nil then continue;
        try
          ds.GetFieldList(FieldsList);
        except
        end;

        Node1 := DataTree.Items.AddChild(Root, FReport.GetAlias(ds));
        Node1.Data := ds;
        SetImageIndex(Node1, 72);

        for j := 0 to FieldsList.Count - 1 do
        begin
          Node2 := DataTree.Items.AddChild(Node1, FieldsList[j]);
          Node2.Data := ds;
          SetImageIndex(Node2, 54);
        end;
      end;
      DataTree.Items[0].Expanded := True;
      for i := 0 to DataTree.Items[0].Count - 1 do
      begin
        s := DataTree.Items[0][i].Text;
        if Pos(s + ',', Collapsed) = 0 then
          DataTree.Items[0][i].Expanded := True;
      end;
    end;
  finally
    DataTree.Items.EndUpdate;
    DatasetsList.Free;
    FieldsList.Free;
  end;
end;

procedure TfrxDataTreeForm.FillVariablesTree;
var
  CategoriesList, VariablesList: TStrings;
  i: Integer;
  Root, Node: TTreeNode;

  procedure AddVariables(Node: TTreeNode);
  var
    i: Integer;
    Node1: TTreeNode;
  begin
    for i := 0 to VariablesList.Count - 1 do
    begin
      Node1 := VariablesTree.Items.AddChild(Node, VariablesList[i]);
      SetImageIndex(Node1, 80);
    end;
  end;

  procedure AddSystemVariables;
  var
    SysNode: TTreeNode;

    procedure AddNode(const s: String);
    var
      Node: TTreeNode;
    begin
      Node := VariablesTree.Items.AddChild(SysNode, s);
      SetImageIndex(Node, 80);
    end;

  begin
    SysNode := VariablesTree.Items.AddChild(Root, frxResources.Get('dtSysVar'));
    SetImageIndex(SysNode, 66);

    AddNode('Date');
    AddNode('Time');
    AddNode('Page');
    AddNode('Page#');
    AddNode('TotalPages');
    AddNode('TotalPages#');
    AddNode('Line');
    AddNode('Line#');
    AddNode('CopyName#');
  end;

begin
  CategoriesList := TStringList.Create;
  VariablesList := TStringList.Create;
  FReport.Variables.GetCategoriesList(CategoriesList);

  VariablesTree.Items.BeginUpdate;
  VariablesTree.Items.Clear;
  Root := VariablesTree.Items.AddChild(nil, frxResources.Get('dtVar'));
  SetImageIndex(Root, 66);

  for i := 0 to CategoriesList.Count - 1 do
  begin
    FReport.Variables.GetVariablesList(CategoriesList[i], VariablesList);
    Node := VariablesTree.Items.AddChild(Root, CategoriesList[i]);
    SetImageIndex(Node, 66);
    AddVariables(Node);
  end;

  if CategoriesList.Count = 0 then
  begin
    FReport.Variables.GetVariablesList('', VariablesList);
    AddVariables(Root);
  end;

  AddSystemVariables;

  VariablesTree.FullExpand;
  VariablesTree.TopItem := Root;
  VariablesTree.Items.EndUpdate;
  CategoriesList.Free;
  VariablesList.Free;
end;

procedure TfrxDataTreeForm.FillFunctionsTree;

  procedure AddFunctions(xi: TfsXMLItem; Root: TTreeNode);
  var
    i: Integer;
    Node: TTreeNode;
    s: String;
  begin
    s := xi.Prop['text'];
    if xi.Count = 0 then
      s := Copy(s, Pos(' ', s) + 1, 255) else  { function }
      s := frxResources.Get(s);                { category }

    if CompareText(s, 'hidden') = 0 then Exit;
    Node := FunctionsTree.Items.AddChild(Root, s);
    if xi.Count = 0 then
      Node.Data := xi;
    if Root = nil then
      Node.Text := frxResources.Get('dtFunc');
    if xi.Count = 0 then
      SetImageIndex(Node, 52) else
      SetImageIndex(Node, 66);

    for i := 0 to xi.Count - 1 do
      AddFunctions(xi[i], Node);
  end;