fr_dict.pas

FASTREPORT报表工具,可以迅速制作报表.

{******************************************}
{                                          }
{             FastReport v2.4              }
{             Data dictionary              }
{                                          }
{ Copyright (c) 1998-2001 by Tzyganenko A. }
{                                          }
{******************************************}

unit FR_Dict;

interface

{$I FR.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, FR_Class, FR_Ctrls, FR_DSet, FR_Pars, ExtCtrls
{$IFDEF Delphi4}, ImgList, Buttons {$ENDIF};

type
  TfrDictForm = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Button1: TButton;
    Button2: TButton;
    FieldAliasesTree: TTreeView;
    Label1: TLabel;
    GroupBox1: TGroupBox;
    CB1: TCheckBox;
    Label2: TLabel;
    Edit1: TEdit;
    ImageList1: TImageList;
    VarTree: TTreeView;
    ValCombo: TComboBox;
    ValList: TListBox;
    Label3: TLabel;
    Label4: TLabel;
    ExprEdit: TfrComboEdit;
    ExprCB: TCheckBox;
    NewCategoryBtn: TfrSpeedButton;
    NewVarBtn: TfrSpeedButton;
    EditBtn: TfrSpeedButton;
    DelBtn: TfrSpeedButton;
    EditListBtn: TfrSpeedButton;
    GroupBox2: TGroupBox;
    Label5: TLabel;
    Edit2: TEdit;
    Label6: TLabel;
    BandDSTree: TTreeView;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    AllTablesLB: TListBox;
    frSpeedButton1: TfrSpeedButton;
    frSpeedButton2: TfrSpeedButton;
    frSpeedButton3: TfrSpeedButton;
    frSpeedButton4: TfrSpeedButton;
    frSpeedButton5: TfrSpeedButton;
    frSpeedButton6: TfrSpeedButton;
    frSpeedButton7: TfrSpeedButton;
    frSpeedButton8: TfrSpeedButton;
    AllBandsLB: TListBox;
    Image4: TImage;
    procedure FieldAliasesTreeClick(Sender: TObject);
    procedure Edit1Exit(Sender: TObject);
    procedure CB1Click(Sender: TObject);
    procedure NewCategoryBtnClick(Sender: TObject);
    procedure NewVarBtnClick(Sender: TObject);
    procedure EditBtnClick(Sender: TObject);
    procedure DelBtnClick(Sender: TObject);
    procedure VarTreeKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ValComboClick(Sender: TObject);
    procedure ValComboDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure ValListDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure FieldAliasesTreeKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure FieldAliasesTreeChange(Sender: TObject; Node: TTreeNode);
    procedure ExprCBClick(Sender: TObject);
    procedure BandDSTreeKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BandDSTreeClick(Sender: TObject);
    procedure BandDSTreeChange(Sender: TObject; Node: TTreeNode);
    procedure Edit2Exit(Sender: TObject);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure VarTreeEdited(Sender: TObject; Node: TTreeNode; var S: string);
    procedure VarTreeChange(Sender: TObject; Node: TTreeNode);
    procedure ValListClick(Sender: TObject);
    procedure ExprEditExit(Sender: TObject);
    procedure ExprEditEnter(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure EditListBtnClick(Sender: TObject);
    procedure ExprEditButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FieldAliasesTreeExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure AllTablesLBDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure AllBandsLBDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure frSpeedButton1Click(Sender: TObject);
    procedure frSpeedButton3Click(Sender: TObject);
    procedure frSpeedButton4Click(Sender: TObject);
    procedure frSpeedButton2Click(Sender: TObject);
    procedure frSpeedButton5Click(Sender: TObject);
    procedure frSpeedButton6Click(Sender: TObject);
    procedure frSpeedButton7Click(Sender: TObject);
    procedure frSpeedButton8Click(Sender: TObject);
    procedure FieldAliasesTreeDragOver(Sender, Source: TObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean);
    procedure FieldAliasesTreeDragDrop(Sender, Source: TObject; X,
      Y: Integer);
    procedure AllTablesLBDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure AllTablesLBDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure BandDSTreeDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure BandDSTreeDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure AllBandsLBDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure AllBandsLBDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure AllTablesLBDblClick(Sender: TObject);
    procedure AllBandsLBDblClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    Variables: TfrVariables;
    FieldAliases: TfrVariables;
    BandDatasources: TfrVariables;
    ActiveNode: TTreeNode;
    Busy: Boolean;
    procedure FillFieldAliases;
    procedure FillBandDataSources;
    procedure FillVariables(FirstTime: Boolean);
    function CurDataSet: String;
    procedure GetFields(Value: String);
    procedure GetSpecValues;
    procedure FillValCombo;
    procedure ShowValue(Value: String);
    procedure ApplyChanges;
    function GetItemName(s: String): String;
    procedure AddFieldAlias(DSName: String);
    procedure DeleteFieldAlias(TreeNode: TTreeNode);
    procedure AddBandDS(DSName: String);
    procedure Localize;
  public
    { Public declarations }
    Doc: TfrReport;
  end;


implementation

{$R *.DFM}

uses FR_Const, FR_Utils, FR_DBRel, FR_Vared, FR_Expr
{$IFDEF IBO}
  , IB_Components
{$ELSE}
  , DB
{$ENDIF};


procedure TfrDictForm.Localize;
begin
  Caption := frLoadStr(frRes + 340);
  TabSheet1.Caption := frLoadStr(frRes + 341);
  TabSheet2.Caption := frLoadStr(frRes + 342);
  TabSheet3.Caption := frLoadStr(frRes + 343);
  Label3.Caption := frLoadStr(frRes + 344);
  Label4.Caption := frLoadStr(frRes + 345);
  ExprCB.Caption := frLoadStr(frRes + 346);
  NewCategoryBtn.Hint := frLoadStr(frRes + 347);
  NewVarBtn.Hint := frLoadStr(frRes + 348);
  EditBtn.Hint := frLoadStr(frRes + 349);
  DelBtn.Hint := frLoadStr(frRes + 350);
  EditListBtn.Hint := frLoadStr(frRes + 351);
  Label1.Caption := frLoadStr(frRes + 353);
  GroupBox1.Caption := frLoadStr(frRes + 354);
  GroupBox2.Caption := frLoadStr(frRes + 354);
  Label2.Caption := frLoadStr(frRes + 355);
  Label5.Caption := frLoadStr(frRes + 355);
  CB1.Caption := frLoadStr(frRes + 356);
  Label6.Caption := frLoadStr(frRes + 358);
  Button1.Caption := frLoadStr(SOk);
  Button2.Caption := frLoadStr(SCancel);
end;

procedure TfrDictForm.FormCreate(Sender: TObject);
begin
  Localize;
{$IFDEF Delphi4}
  BorderStyle := bsSizeable;
{$ENDIF}
end;

procedure TfrDictForm.FormShow(Sender: TObject);
begin
  Variables := TfrVariables.Create;
  FieldAliases := TfrVariables.Create;
  BandDatasources := TfrVariables.Create;

  FillVariables(True);
  FillFieldAliases;
  FillBandDataSources;
  FillValCombo;
  ValCombo.ItemIndex := 0;
  ValComboClick(nil);
  ExprCBClick(nil);
  VarTree.SetFocus;
end;

procedure TfrDictForm.FormHide(Sender: TObject);
begin
  Variables.Free;
  FieldAliases.Free;
  BandDataSources.Free;
end;

procedure TfrDictForm.Button1Click(Sender: TObject);
begin
  ApplyChanges;
end;

procedure TfrDictForm.ApplyChanges;
begin
  Doc.Dictionary.Variables.Assign(Variables);
  Doc.Dictionary.FieldAliases.Assign(FieldAliases);
  Doc.Dictionary.BandDataSources.Assign(BandDataSources);
end;

function TfrDictForm.GetItemName(s: String): String;
begin
  if Pos('{', s) <> 0 then
    Result := Trim(Copy(s, 1, Pos('{', s) - 1)) else
    Result := s;
end;


{ Field aliases }

procedure TfrDictForm.AddFieldAlias(DSName: String);
var
  TreeNode: TTreeNode;
begin
  if DSName <> '' then
  begin
    FieldAliasesTree.Items.AddChild(FieldAliasesTree.Items[0], DSName);
    TreeNode := FieldAliasesTree.Items[0].GetLastChild;
    TreeNode.ImageIndex := 1;
    TreeNode.SelectedIndex := 1;
    FieldAliasesTree.Items.AddChild(TreeNode, frLoadStr(SNotAssigned));
  end;
end;

procedure TfrDictForm.DeleteFieldAlias(TreeNode: TTreeNode);
var
  i, n: Integer;
  s, ItemName: String;
begin
  ItemName := GetItemName(TreeNode.Text);
  for i := 0 to TreeNode.Count - 1 do
  begin
    s := TreeNode.Item[i].Text;
    n := FieldAliases.IndexOf(ItemName + '.' + GetItemName(s));
    if n <> -1 then
      FieldAliases.Delete(n);
  end;
end;

procedure TfrDictForm.FillFieldAliases;
var
  i, n: Integer;
  TreeNode: TTreeNode;
  sl: TStringList;
  DataSet: TfrTDataSet;
  s, s1: String;
begin
  FieldAliases.Assign(Doc.Dictionary.FieldAliases);

  TreeNode := FieldAliasesTree.Items[0];
  TreeNode.Text := frLoadStr(frRes + 352);
  TreeNode.DeleteChildren;
  CurReport := Doc;

  sl := TStringList.Create;
{$IFDEF IBO}
  frGetComponents(Doc.Owner, TIB_DataSet, sl, nil);
{$ELSE}
  frGetComponents(Doc.Owner, TDataSet, sl, nil);
{$ENDIF}
  sl.Sort;

  for i := 0 to sl.Count - 1 do
  begin
    DataSet := frGetDataSet(sl[i]);
    if (DataSet <> nil) and Doc.Dictionary.DataSetEnabled(sl[i]) then
    begin
      s := sl[i];
      s1 := s;

      n := FieldAliases.IndexOf(s);
      if (FieldAliases.Count = 0) or (n = -1) then
        s := ''
      else if FieldAliases.Value[n] <> '' then
        s := s + ' {' + FieldAliases.Value[n] + '}';

      if s <> '' then
        AddFieldAlias(s) else
        AllTablesLB.Items.Add(s1);
    end;
  end;

  FieldAliasesTree.Items[0].Expand(False);
  FieldAliasesTree.Selected := FieldAliasesTree.Items[0];
  sl.Free;
end;

procedure TfrDictForm.FieldAliasesTreeExpanding(Sender: TObject;
  Node: TTreeNode; var AllowExpansion: Boolean);
var
  i, n, ImageIndex: Integer;
  sl: TStringList;
  ItemName, s: String;
  DataSet: TfrTDataSet;
  NewItem: TTreeNode;
begin
  if Node.ImageIndex = 3 then
    AllowExpansion := False
  else if Node.ImageIndex = 1 then
  begin
    if Node.GetLastChild.ImageIndex = 0 then
      Node.DeleteChildren else
      Exit;
    sl := TStringList.Create;
    ItemName := GetItemName(Node.Text);
    DataSet := frGetDataSet(ItemName);
    try
      frGetFieldNames(DataSet, sl);
      sl.Sort;
    except;
    end;

    for i := 0 to sl.Count - 1 do
    begin
      ImageIndex := 2;
      s := sl[i];
      n := FieldAliases.IndexOf(ItemName + '.' + sl[i]);
      if n <> -1 then
        if FieldAliases.Value[n] <> '' then
          s := sl[i] + ' {' + FieldAliases.Value[n] + '}' else
          ImageIndex := 4;

      FieldAliasesTree.Items.AddChild(Node, s);
      NewItem := Node.GetLastChild;
      NewItem.ImageIndex := ImageIndex;
      NewItem.SelectedIndex := ImageIndex;
    end;

    sl.Free;
  end;
end;

procedure TfrDictForm.FieldAliasesTreeClick(Sender: TObject);
var
  TreeNode: TTreeNode;
  s: String;
begin
  if Edit1.Modified then Edit1Exit(nil);
  TreeNode := FieldAliasesTree.Selected;
  if TreeNode <> FieldAliasesTree.Items[0] then
  begin
    s := TreeNode.Text;
    if Pos('{', s) <> 0 then
      s := Copy(s, Pos('{', s) + 1, Pos('}', s) - Pos('{', s) - 1);
    Edit1.Text := s;
  end
  else
    Edit1.Text := '';
  ActiveNode := TreeNode;
  Busy := True;
  CB1.Checked := (TreeNode <> FieldAliasesTree.Items[0]) and (TreeNode.ImageIndex in [3, 4]);
  Busy := False;
end;

procedure TfrDictForm.Edit1Exit(Sender: TObject);
var
  s: String;
begin
  if Edit1.Modified then
    if ActiveNode <> FieldAliasesTree.Items[0] then
    begin
      s := GetItemName(ActiveNode.Text);
      ActiveNode.Text := s + ' {' + Edit1.Text + '}';
      if ActiveNode.ImageIndex = 2 then
        s := GetItemName(ActiveNode.Parent.Text) + '.' + s;
      FieldAliases[s] := Edit1.Text;
    end;
  Edit1.Modified := False;
end;

procedure TfrDictForm.CB1Click(Sender: TObject);
var
  TreeNode: TTreeNode;
  ItemName, FullName: String;
begin
  if Busy then Exit;
  TreeNode := FieldAliasesTree.Selected;
  if (TreeNode = FieldAliasesTree.Items[0]) or (TreeNode = nil) then Exit;

  if TreeNode.ImageIndex in [2, 4] then
  begin
    ItemName := GetItemName(TreeNode.Text);
    FullName := GetItemName(TreeNode.Parent.Text) + '.' + ItemName;
    if TreeNode.ImageIndex = 2 then
      TreeNode.ImageIndex := 4 else
      TreeNode.ImageIndex := 2;
    TreeNode.SelectedIndex := TreeNode.ImageIndex;

    if TreeNode.ImageIndex = 2 then
      FieldAliases.Delete(FieldAliases.IndexOf(FullName)) else
      FieldAliases[FullName] := '';
    TreeNode.Text := ItemName;
  end;
end;

procedure TfrDictForm.FieldAliasesTreeKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = vk_Return then
    Edit1.SetFocus
  else if Key = vk_Space then
    CB1.Checked := not CB1.Checked;
end;

procedure TfrDictForm.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    FieldAliasesTree.SetFocus;
end;