rm_editordictionary.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 922 行 · 第 1/2 页

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

unit RM_EditorDictionary;

interface

{$I RM.inc}

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

type
  TRMDictionaryForm = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    btnOK: TButton;
    btnCancel: TButton;
    ImageList1: TImageList;
    treeVariables: TTreeView;
    cmbDataSets: TComboBox;
    lstFields: TListBox;
    Label3: TLabel;
    Label4: TLabel;
    SaveDialog1: TSaveDialog;
    edtExpression: TEdit;
    btnNewCategory: TSpeedButton;
    btnNewVar: TSpeedButton;
    btnEdit: TSpeedButton;
    btnDel: TSpeedButton;
    btnExpression: TSpeedButton;
    PopupMenu1: TPopupMenu;
    NewCategory1: TMenuItem;
    NewVariable1: TMenuItem;
    N1: TMenuItem;
    Delete1: TMenuItem;
    TabSheet2: TTabSheet;
    lstAllDataSets: TListBox;
    btnFieldAddOne: TSpeedButton;
    btnFieldAddAll: TSpeedButton;
    btnFieldDeleteOne: TSpeedButton;
    btnFieldDeleteAll: TSpeedButton;
    Label8: TLabel;
    treeFieldAliases: TTreeView;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    chkFieldNoSelect: TCheckBox;
    edtFieldAlias: TEdit;
    btnPackDictionary: TButton;
    procedure btnNewCategoryClick(Sender: TObject);
    procedure btnNewVarClick(Sender: TObject);
    procedure btnEditClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure treeVariablesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure treeVariablesEdited(Sender: TObject; Node: TTreeNode; var S: string);
    procedure btnOKClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edtExpressionKeyPress(Sender: TObject; var Key: Char);
    procedure btnExpressionClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lstFieldsClick(Sender: TObject);
    procedure treeVariablesChange(Sender: TObject; Node: TTreeNode);
    procedure lstAllDataSetsDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure btnFieldAddOneClick(Sender: TObject);
    procedure btnFieldDeleteOneClick(Sender: TObject);
    procedure treeFieldAliasesExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure edtFieldAliasKeyPress(Sender: TObject; var Key: Char);
    procedure edtFieldAliasExit(Sender: TObject);
    procedure btnFieldAddAllClick(Sender: TObject);
    procedure btnFieldDeleteAllClick(Sender: TObject);
    procedure cmbDataSetsClick(Sender: TObject);
    procedure edtExpressionEnter(Sender: TObject);
    procedure edtExpressionExit(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure chkFieldNoSelectClick(Sender: TObject);
    procedure treeFieldAliasesChange(Sender: TObject; Node: TTreeNode);
    procedure btnPackDictionaryClick(Sender: TObject);
  private
    { Private declarations }
    FBusyFlag: Boolean;
    FVariables: TRMVariables;
    FFieldAliases: TRMVariables;
    FActiveNode: TTreeNode;

    procedure ApplyChanges;
    procedure Localize;

    procedure ShowValue(aValue: string);
    procedure AddFieldAlias(const aDataSet: string);
		procedure FillValiableDataSets;
  public
    { Public declarations }
    Report: TRMReport;
  end;

implementation

{$R *.DFM}

uses RM_DataSet, RM_Const, RM_Const1, RM_Utils, RM_EditorExpr;

const
  Dataset_INDEX = 1;
  Field_CanSelect = 2;
  Field_CannotSelect = 4;
  Variable_Category = 5;
  Variable_Variable = 6;
  Field_INDEX = 13;

type
  THackDictionary = class(TRMDictionary)
  end;

procedure TRMDictionaryForm.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(Label3, 'Caption', rmRes + 344);
  RMSetStrProp(Label4, 'Caption', rmRes + 345);
  RMSetStrProp(btnNewCategory, 'Hint', rmRes + 347);
  RMSetStrProp(btnNewVar, 'Hint', rmRes + 348);
  RMSetStrProp(btnEdit, 'Hint', rmRes + 349);
  RMSetStrProp(btnDel, 'Hint', rmRes + 350);
  RMSetStrProp(GroupBox1, 'Caption', rmRes + 354);
  RMSetStrProp(Label2, 'Caption', rmRes + 355);
  RMSetStrProp(chkFieldNoSelect, 'Caption', rmRes + 356);
  RMSetStrProp(Label8, 'Caption', rmRes + 358);
  RMSetStrProp(btnPackDictionary, 'Caption', rmRes + 360);

  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 TRMDictionaryForm.FillValiableDataSets;
var
  lList: TStringList;
begin
  lList := TStringList.Create;
  try
	  Report.Dictionary.GetDataSets(lList, FFieldAliases);
  	lList.Sort;
	  cmbDataSets.Items.Assign(lList);
  finally
	  lList.Free;
	  cmbDataSets.ItemIndex := 0;
  	cmbDataSetsClick(nil);
	end;
end;

procedure TRMDictionaryForm.FormCreate(Sender: TObject);
begin
  FVariables := TRMVariables.Create;
  FFieldAliases := TRMVariables.Create;

  PageControl1.ActivePage := TabSheet1;
  Localize;
end;

procedure TRMDictionaryForm.FormDestroy(Sender: TObject);
begin
  FVariables.Free;
  FFieldAliases.Free;
end;

procedure TRMDictionaryForm.FormShow(Sender: TObject);

  procedure _FillVariables; // 自定义变量
  var
    i: Integer;
    liParentNode, liNode: TTreeNode;
    s: string;
  begin
    FVariables.Assign(Report.Dictionary.Variables);
    treeVariables.Items.Clear;
    liParentNode := nil;
    for i := 0 to FVariables.Count - 1 do
    begin
      s := FVariables.Name[i];
      if (s <> '') and (s[1] = ' ') then // 目录
      begin
        liParentNode := treeVariables.Items.Add(nil, Copy(s, 2, 999));
        liParentNode.ImageIndex := 5;
        liParentNode.SelectedIndex := 5;
      end
      else if liParentNode <> nil then // 变量
      begin
        liNode := treeVariables.Items.AddChild(liParentNode, s);
        liNode.ImageIndex := 6;
        liNode.SelectedIndex := 6;
      end;
    end;

    treeVariables.FullExpand;
    if treeVariables.Items.Count > 0 then
      treeVariables.Items[0].Selected := True;
  end;

  procedure _FillDataSets;
  var
    i, liIndex: Integer;
    sl: TStringList;
    liDataSetName: string;
  begin
    FFieldAliases.Assign(Report.Dictionary.FieldAliases);
    treeFieldAliases.Items.Add(nil, RMLoadStr(rmRes + 352));
    sl := TStringList.Create;
    try
      RMGetComponents(Report.Owner, TRMDataset, sl, nil);
      sl.Sort;
      for i := 0 to sl.Count - 1 do
      begin
        liDataSetName := sl[i];
        liIndex := FFieldAliases.IndexOf(liDataSetName);
        if liIndex >= 0 then
        begin
          if FFieldAliases.Value[liIndex] <> '' then
            liDataSetName := liDataSetName + ' {' + FFieldAliases.Value[liIndex] + '}';
          AddFieldAlias(liDataSetName)
        end
        else
          lstAllDataSets.Items.Add(liDataSetName);
      end;

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

begin
  _FillVariables;
  FillValiableDataSets;
  _FillDataSets;

  treeVariables.SetFocus;
end;

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

procedure TRMDictionaryForm.ApplyChanges;
begin
  Report.Dictionary.Variables.Assign(FVariables);
  Report.Dictionary.FieldAliases.Assign(FFieldAliases);
end;

procedure TRMDictionaryForm.btnNewCategoryClick(Sender: TObject);
var
  ANode, TreeNode: TTreeNode;
  s: string;

  function CreateNewCategory: string;
  var
    i: Integer;

    function FindCategory(s: string): Boolean;
    var
      i: Integer;
    begin
      Result := False;
      for i := 0 to FVariables.Count - 1 do
      begin
        if AnsiCompareText(FVariables.Name[i], s) = 0 then
        begin
          Result := True;
          break;
        end;
      end;
    end;

  begin
    for i := 1 to 10000 do
    begin
      Result := 'Category' + IntToStr(i);
      if not FindCategory(' ' + Result) then
        break;
    end;
  end;

begin
  TreeNode := treeVariables.Selected;
  if treeVariables.ShowRoot = False then
  begin
    TreeNode.Delete;
    TreeNode := nil;
    treeVariables.ShowRoot := True;
  end;
  if TreeNode <> nil then
    TreeNode := treeVariables.Items[0];

  s := CreateNewCategory;
  FVariables[' ' + s] := '';
  ANode := treeVariables.Items.Add(TreeNode, s);
  ANode.ImageIndex := 5;
  ANode.SelectedIndex := 5;
  treeVariables.Selected := ANode;
  ANode.EditText;
end;

procedure TRMDictionaryForm.btnNewVarClick(Sender: TObject);
var
  ANode, TreeNode: TTreeNode;
  s: string;

  function CreateNewVariable: string;
  var
    i: Integer;

    function FindVariable(s: string): Boolean;
    var
      i: Integer;
    begin
      Result := False;
      for i := 0 to FVariables.Count - 1 do
      begin
        if AnsiCompareText(FVariables.Name[i], s) = 0 then
        begin
          Result := True;
          break;
        end;
      end;
    end;

  begin
    for i := 1 to 10000 do
    begin
      Result := 'Variable' + IntToStr(i);
      if not FindVariable(Result) then
        break;
    end;
  end;

begin
  TreeNode := treeVariables.Selected;
  if (TreeNode = nil) or not treeVariables.ShowRoot then Exit;
  if TreeNode.Parent <> nil then
    TreeNode := TreeNode.Parent;

  s := CreateNewVariable;

  if TreeNode.GetNextSibling <> nil then
    FVariables.Insert(FVariables.IndexOf(' ' + TreeNode.GetNextSibling.Text), s)
  else
    FVariables[s] := '';

  ANode := treeVariables.Items.AddChild(TreeNode, s);
  ANode.ImageIndex := 6;
  ANode.SelectedIndex := 6;
  TreeNode.Expand(True);
  treeVariables.Selected := ANode;
  ANode.EditText;
end;

procedure TRMDictionaryForm.btnEditClick(Sender: TObject);
var
  TreeNode: TTreeNode;
begin
  TreeNode := treeVariables.Selected;
  if (TreeNode <> nil) and treeVariables.ShowRoot then
    TreeNode.EditText;
end;

procedure TRMDictionaryForm.btnDelClick(Sender: TObject);
var
  TreeNode: TTreeNode;
  i: integer;
begin
  TreeNode := treeVariables.Selected;
  if (TreeNode <> nil) and treeVariables.ShowRoot then
  begin
    if TreeNode.ImageIndex = 5 then
    begin
      i := FVariables.IndexOf(' ' + TreeNode.Text);
      FVariables.Delete(i);
      while (i < FVariables.Count) and (FVariables.Name[i][1] <> ' ') do
        FVariables.Delete(i);
    end
    else
      FVariables.Delete(FVariables.IndexOf(TreeNode.Text));

    TreeNode.Delete;
    if treeVariables.Items.Count = 0 then
    begin
      TreeNode := treeVariables.Items.Add(treeVariables.Selected, RMLoadStr(SNotAssigned));
      TreeNode.ImageIndex := -1;
      TreeNode.SelectedIndex := -1;
      treeVariables.ShowRoot := False;
      treeVariables.Selected := treeVariables.Items[0];
    end;
  end;
end;

procedure TRMDictionaryForm.treeVariablesKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = vk_Insert then
  begin
    if ssCtrl in Shift then
      btnNewCategoryClick(nil)
    else if (treeVariables.Selected = nil) or (treeVariables.ShowRoot = False) then
      btnNewCategory.Click
    else
      btnNewVar.Click;
  end
  else if (Key = vk_Delete) and not treeVariables.IsEditing then
    btnDel.Click
  else if Key = vk_Return then
    btnEdit.Click
  else if (Key = vk_Escape) and not treeVariables.IsEditing then
    btnCancel.Click;
end;

procedure TRMDictionaryForm.treeVariablesEdited(Sender: TObject; Node: TTreeNode; var S: string);
var
  s1: string;
begin
  if Node.ImageIndex = 6 then
    s1 := s
  else
    s1 := ' ' + s;
  if (AnsiCompareText(s, Node.Text) <> 0) and (FVariables.IndexOf(s1) <> -1) then
    s := Node.Text
  else
  begin
    if Node.ImageIndex = 6 then
      FVariables.Name[FVariables.IndexOf(Node.Text)] := s1
    else
      FVariables.Name[FVariables.IndexOf(' ' + Node.Text)] := s1;
  end;
end;

procedure TRMDictionaryForm.edtExpressionKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    treeVariables.SetFocus;
end;

procedure TRMDictionaryForm.btnExpressionClick(Sender: TObject);