rm_dict.pas

进销存·完整的·有数据库的·非常完整·只得参考

{******************************************}
{                                          }
{          Report Machine v2.0             }
{             Data dictionary              }
{                                          }
{******************************************}

unit RM_dict;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, RM_Class, RM_DSet, RM_Pars, ExtCtrls, Buttons, Menus
{$IFDEF Delphi4}, ImgList{$ENDIF};

type
  TRMDictForm = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    btnOK: TButton;
    btnCancel: TButton;
    treeFieldAliases: TTreeView;
    GroupBox1: TGroupBox;
    chkFieldNoSelect: TCheckBox;
    Label2: TLabel;
    edtFieldAlias: TEdit;
    ImageList1: TImageList;
    treeVar: TTreeView;
    cmbVal: TComboBox;
    lstVal: TListBox;
    Label3: TLabel;
    Label4: TLabel;
    chkExpr: TCheckBox;
    GroupBox2: TGroupBox;
    Label5: TLabel;
    edtBandAlias: TEdit;
    treeBandDS: TTreeView;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    SaveDialog1: TSaveDialog;
    edtExpr: TEdit;
    btnNewCategory: TSpeedButton;
    btnNewVar: TSpeedButton;
    btnEdit: TSpeedButton;
    btnDel: TSpeedButton;
    Label7: TLabel;
    lstAllTables: TListBox;
    Label8: TLabel;
    lstAllBands: TListBox;
    btnTableAdd: TSpeedButton;
    btnTableRemove: TSpeedButton;
    btnTableRemoveAll: TSpeedButton;
    btnTableAddAll: TSpeedButton;
    btnDatasourceAdd: TSpeedButton;
    btnDatasourceRemove: TSpeedButton;
    btnDatasourceAddAll: TSpeedButton;
    btnDatasourceRemoveAll: TSpeedButton;
    Image4: TImage;
    btnExpr: TSpeedButton;
    PopupMenu1: TPopupMenu;
    NewCategory1: TMenuItem;
    NewVariable1: TMenuItem;
    N1: TMenuItem;
    Delete1: TMenuItem;
    procedure treeFieldAliasesClick(Sender: TObject);
    procedure edtFieldAliasExit(Sender: TObject);
    procedure chkFieldNoSelectClick(Sender: TObject);
    procedure btnNewCategoryClick(Sender: TObject);
    procedure btnNewVarClick(Sender: TObject);
    procedure btnEditClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure treeVarKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cmbValClick(Sender: TObject);
    procedure cmbValDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure treeFieldAliasesKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edtFieldAliasKeyPress(Sender: TObject; var Key: Char);
    procedure treeFieldAliasesChange(Sender: TObject; Node: TTreeNode);
    procedure chkExprClick(Sender: TObject);
    procedure treeBandDSKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure treeBandDSClick(Sender: TObject);
    procedure treeBandDSChange(Sender: TObject; Node: TTreeNode);
    procedure edtBandAliasExit(Sender: TObject);
    procedure edtBandAliasKeyPress(Sender: TObject; var Key: Char);
    procedure treeVarEdited(Sender: TObject; Node: TTreeNode; var S: string);
    procedure treeVarChange(Sender: TObject; Node: TTreeNode);
    procedure lstValClick(Sender: TObject);
    procedure ExprEditExit(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edtExprKeyPress(Sender: TObject; var Key: Char);
    procedure edtExprEnter(Sender: TObject);
    procedure btnExprClick(Sender: TObject);
    procedure lstAllTablesDblClick(Sender: TObject);
    procedure lstAllTablesDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure lstAllTablesDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure btnTableAddClick(Sender: TObject);
    procedure btnTableRemoveClick(Sender: TObject);
    procedure btnTableAddAllClick(Sender: TObject);
    procedure btnTableRemoveAllClick(Sender: TObject);
    procedure btnDatasourceAddClick(Sender: TObject);
    procedure btnDatasourceRemoveClick(Sender: TObject);
    procedure btnDatasourceAddAllClick(Sender: TObject);
    procedure btnDatasourceRemoveAllClick(Sender: TObject);
    procedure lstAllBandsDblClick(Sender: TObject);
    procedure lstAllBandsDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure lstAllBandsDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure treeFieldAliasesDragDrop(Sender, Source: TObject; X,
      Y: Integer);
    procedure treeFieldAliasesDragOver(Sender, Source: TObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean);
    procedure treeBandDSDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure treeBandDSDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure treeFieldAliasesExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    Variables: TRMVariables;
    FieldAliases: TRMVariables;
    BandDatasources: TRMVariables;
    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(const s: string): string;
    procedure AddFieldAlias(DSName: string);
    procedure DeleteFieldAlias(TreeNode: TTreeNode);
    procedure AddBandDS(DSName: string);
    procedure Localize;
  public
    { Public declarations }
    Doc: TRMReport;
  end;

implementation

{$R *.DFM}

uses RM_Const, RM_Const1, RM_Utils, RM_DBRel, RM_DlgExpr, DB;

procedure TRMDictForm.Localize;
begin
	Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Self, 'Caption', rmRes + 340);
  RMSetStrProp(TabSheet1, 'Caption', rmRes + 341);
  RMSetStrProp(TabSheet2, 'Caption', rmRes + 342);
  RMSetStrProp(TabSheet3, 'Caption', rmRes + 343);
  RMSetStrProp(Label3, 'Caption', rmRes + 344);
  RMSetStrProp(Label4, 'Caption', rmRes + 345);
  RMSetStrProp(chkExpr, 'Caption', rmRes + 346);
  RMSetStrProp(btnNewCategory, 'Hint', rmRes + 347);
  RMSetStrProp(btnNewVar, 'Hint', rmRes + 348);
  RMSetStrProp(btnEdit, 'Hint', rmRes + 349);
  RMSetStrProp(btnDel, 'Hint', rmRes + 350);
  RMSetStrProp(Label7, 'Caption', rmRes + 353);
  RMSetStrProp(GroupBox1, 'Caption', rmRes + 354);
  RMSetStrProp(GroupBox2, 'Caption', rmRes + 354);
  RMSetStrProp(Label2, 'Caption', rmRes + 355);
  RMSetStrProp(Label5, 'Caption', rmRes + 355);
  RMSetStrProp(chkFieldNoSelect, 'Caption', rmRes + 356);
  RMSetStrProp(Label8, 'Caption', rmRes + 358);

	RMSetStrProp(NewCategory1, 'Caption', rmRes + 347);
  RMSetStrProp(NewVariable1, 'Caption', rmRes + 348);
  RMSetStrProp(Delete1, 'Caption', rmRes + 350);

  btnOK.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

procedure TRMDictForm.FormShow(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  Variables := TRMVariables.Create;
  FieldAliases := TRMVariables.Create;
  BandDatasources := TRMVariables.Create;

  FillVariables(True);
  FillFieldAliases;
  FillBandDataSources;
  FillValCombo;
  cmbVal.ItemIndex := 0;
  cmbValClick(nil);
  chkExprClick(nil);
  treeVar.SetFocus;

  Screen.Cursor := crDefault;
end;

procedure TRMDictForm.FormDestroy(Sender: TObject);
begin
  Variables.Free;
  FieldAliases.Free;
  BandDataSources.Free;
end;

procedure TRMDictForm.btnOKClick(Sender: TObject);
begin
  ApplyChanges;
end;

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

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

{ Field aliases }

procedure TRMDictForm.AddFieldAlias(DSName: string);
var
  TreeNode: TTreeNode;
begin
  if DSName <> '' then
  begin
    treeFieldAliases.Items.AddChild(treeFieldAliases.Items[0], DSName);
    TreeNode := treeFieldAliases.Items[0].GetLastChild;
    TreeNode.ImageIndex := 1;
    TreeNode.SelectedIndex := 1;
    treeFieldAliases.Items.AddChild(TreeNode, RMLoadStr(SNotAssigned));
  end;
end;

procedure TRMDictForm.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 TRMDictForm.FillFieldAliases;
var
  i, n: Integer;
  TreeNode: TTreeNode;
  sl: TStringList;
  DataSet: TDataSet;
  s, s1: string;
begin
  FieldAliases.Assign(Doc.Dictionary.FieldAliases);

  TreeNode := treeFieldAliases.Items[0];
  TreeNode.Text := RMLoadStr(rmRes + 352);
  TreeNode.DeleteChildren;
  CurReport := Doc;

  sl := TStringList.Create;
  RMGetComponents(Doc.Owner, TDataSet, sl, nil);
  sl.Sort;

  for i := 0 to sl.Count - 1 do
  begin
    DataSet := RMGetDataSet(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
        lstAllTables.Items.Add(s1);
    end;
  end;

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

procedure TRMDictForm.treeFieldAliasesExpanding(Sender: TObject;
  Node: TTreeNode; var AllowExpansion: Boolean);
var
  i, n, ImageIndex: Integer;
  sl: TStringList;
  ItemName, s: string;
  DataSet: TDataSet;
  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 := RMGetDataSet(ItemName);
    try
      RMGetFieldNames(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
      begin
        if FieldAliases.Value[n] <> '' then
          s := sl[i] + ' {' + FieldAliases.Value[n] + '}'
        else
          ImageIndex := 4;
      end;

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

    sl.Free;
  end;
end;

procedure TRMDictForm.treeFieldAliasesClick(Sender: TObject);
var
  TreeNode: TTreeNode;
  s: string;
begin
  if edtFieldAlias.Modified then edtFieldAliasExit(nil);
  TreeNode := treeFieldAliases.Selected;
  if TreeNode <> treeFieldAliases.Items[0] then
  begin
    s := TreeNode.Text;
    if Pos('{', s) <> 0 then
      s := Copy(s, Pos('{', s) + 1, Pos('}', s) - Pos('{', s) - 1);
    edtFieldAlias.Text := s;
  end
  else
    edtFieldAlias.Text := '';

  ActiveNode := TreeNode;
  Busy := True;
  chkFieldNoSelect.Checked := (TreeNode <> treeFieldAliases.Items[0]) and (TreeNode.ImageIndex in [3, 4]);
  Busy := False;
end;

procedure TRMDictForm.edtFieldAliasExit(Sender: TObject);
var
  s: string;
begin
  if edtFieldAlias.Modified then
  begin
    if ActiveNode <> treeFieldAliases.Items[0] then
    begin
      s := GetItemName(ActiveNode.Text);
      ActiveNode.Text := s + ' {' + edtFieldAlias.Text + '}';
      if ActiveNode.ImageIndex = 2 then
        s := GetItemName(ActiveNode.Parent.Text) + '.' + s;
      FieldAliases[s] := edtFieldAlias.Text;
    end;
  end;
  edtFieldAlias.Modified := False;
end;

procedure TRMDictForm.chkFieldNoSelectClick(Sender: TObject);
var
  TreeNode: TTreeNode;
  ItemName, FullName: string;
begin
  if Busy then Exit;
  TreeNode := treeFieldAliases.Selected;
  if (TreeNode = treeFieldAliases.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 TRMDictForm.treeFieldAliasesKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = vk_Return then
    edtFieldAlias.SetFocus
  else if Key = vk_Space then
    chkFieldNoSelect.Checked := not chkFieldNoSelect.Checked;