rm_editordictionary.pas

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

var
  expr: string;
begin
  expr := edtExpression.Text;
  if RMGetExpression('', expr, nil, False) then
  begin
    edtExpression.Text := expr;
    edtExpression.SetFocus;
    edtExpression.Modified := True;
  end;
end;

procedure TRMDictionaryForm.lstFieldsClick(Sender: TObject);
var
  liNode: TTreeNode;
  liValue: string;
begin
  if edtExpression.Modified then
    edtExpressionExit(nil);

  liNode := treeVariables.Selected;
  if (liNode = nil) or (liNode.ImageIndex <> 6) then Exit;

  if lstFields.ItemIndex <= 0 then
    liValue := ''
  else
    liValue := cmbDataSets.Text + '."' + lstFields.Items[lstFields.ItemIndex] + '"';

  FVariables[liNode.Text] := liValue;
end;

procedure TRMDictionaryForm.ShowValue(aValue: string);
var
  i, n: Integer;
  s1, s2: string;
  Found: Boolean;

  function FindStr(aList: TStrings; aStr: string; aIsField: Boolean): Integer;
  var
    i: Integer;
    lStr: string;
  begin
    Result := -1;
    for i := 0 to aList.Count - 1 do
    begin
      if aIsField then
        lStr := Report.Dictionary.RealFieldName[aList[i]]
      else
        lStr := Report.Dictionary.RealDataSetName[aList[i]];

      if AnsiCompareText(lStr, aStr) = 0 then
      begin
        Result := i;
        Break;
      end;
    end;
  end;

begin
  s1 := '';
  s2 := '';
  Found := False;

  if Pos('.', aValue) <> 0 then
  begin
    for i := Length(aValue) downto 1 do
    begin
      if aValue[i] = '.' then
      begin
        s1 := Copy(aValue, 1, i - 1);
        s2 := Copy(aValue, i + 1, 255);
        break;
      end;
    end;

    n := FindStr(cmbDataSets.Items, s1, FALSE);
    if n <> -1 then
    begin
      if cmbDataSets.ItemIndex <> n then
      begin
        cmbDataSets.ItemIndex := n;
        cmbDataSetsClick(nil);
      end;
      if (s2 <> '') and (s2[1] = '"') then
        s2 := Copy(s2, 2, Length(s2) - 2);
      n := FindStr(lstFields.Items, s2, TRUE);
      if n <> -1 then
      begin
        lstFields.ItemIndex := n;
        Found := True;
      end;
    end;
  end;

  if not Found then
  begin
    if Trim(aValue) = '' then
    begin
      lstFields.ItemIndex := 0;
      edtExpression.Text := '';
    end;

    edtExpression.Text := aValue;
    lstFields.ItemIndex := 0;
  end
  else
  begin
    edtExpression.Text := '';
  end;
end;

procedure TRMDictionaryForm.treeVariablesChange(Sender: TObject; Node: TTreeNode);
var
  lVariableName: string;
begin
  if edtExpression.Modified then
    edtExpressionExit(nil);

  RMEnableControls([edtExpression, btnExpression], (Node <> nil) and (Node.ImageIndex = Variable_Variable));
  if Node.ImageIndex = Variable_Category then
    lVariableName := ' ' + Node.Text
  else if Node.ImageIndex = Variable_Variable then
    lVariableName := Node.Text
  else
    Exit;

  ShowValue(FVariables[lVariableName]);
end;

procedure TRMDictionaryForm.lstAllDataSetsDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  s: string;
  liBmp: TBitmap;
  liCanvas: TCanvas;
begin
  liBmp := TBitmap.Create;
  liCanvas := nil;
  try
    if Control = lstAllDataSets then
    begin
      liCanvas := lstAllDataSets.Canvas;
      s := lstAllDataSets.Items[Index];
      ImageList1.GetBitmap(Dataset_INDEX, liBmp);
    end
    else if Control = cmbDataSets then
    begin
      liCanvas := cmbDataSets.Canvas;
      s := cmbDataSets.Items[Index];
      ImageList1.GetBitmap(Dataset_INDEX, liBmp);
    end
    else if Control = lstFields then
    begin
      liCanvas := lstFields.Canvas;
      s := lstFields.Items[Index];
      ImageList1.GetBitmap(Field_INDEX, liBmp);
    end;

    if liCanvas <> nil then
    begin
      liCanvas.FillRect(Rect);
      liCanvas.BrushCopy(Bounds(Rect.Left + 2, Rect.Top, liBmp.Width, liBmp.Height),
        liBmp, Bounds(0, 0, liBmp.Width, liBmp.Height), liBmp.TransparentColor);
      liCanvas.TextOut(Rect.Left + 4 + liBmp.Width, Rect.Top, s);
    end;
  finally
    liBmp.Free;
  end;
end;

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

procedure TRMDictionaryForm.AddFieldAlias(const aDataSet: string);
var
  liNode: TTreeNode;
begin
  if aDataSet <> '' then
  begin
    treeFieldAliases.Items.AddChild(treeFieldAliases.Items[0], aDataSet);
    liNode := treeFieldAliases.Items[0].GetLastChild;
    liNode.ImageIndex := Dataset_INDEX;
    liNode.SelectedIndex := Dataset_INDEX;
    treeFieldAliases.Items.AddChild(liNode, RMLoadStr(SNotAssigned));
    FFieldAliases[aDataSet] := '';
  end;
  btnFieldDeleteAll.Enabled := treeFieldAliases.Items.Count > 1;
end;

procedure TRMDictionaryForm.btnFieldAddOneClick(Sender: TObject);
var
  i: Integer;
begin
  i := 0;
  while i < lstAllDataSets.Items.Count do
  begin
    if lstAllDataSets.Selected[i] then
    begin
      AddFieldAlias(lstAllDataSets.Items[i]);
      lstAllDataSets.Items.Delete(i);
    end
    else
      Inc(i);
  end;

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

procedure TRMDictionaryForm.btnFieldDeleteOneClick(Sender: TObject);
var
  lNode: TTreeNode;
  lFlag: Boolean;
  s: string;

  procedure _DeleteFieldAlias(aNode: TTreeNode);
  var
    i, n: Integer;
    s, lItemName: string;
  begin
    lItemName := GetItemName(aNode.Text);
    for i := 0 to aNode.Count - 1 do
    begin
      s := aNode.Item[i].Text;
      n := FFieldAliases.IndexOf(lItemName + '."' + GetItemName(s) + '"');
      if n <> -1 then
        FFieldAliases.Delete(n);
    end;
    btnFieldDeleteAll.Enabled := treeFieldAliases.Items.Count > 1;
  end;

begin
  lNode := treeFieldAliases.Selected;
  if (lNode = nil) or (lNode.ImageIndex <> Dataset_INDEX) then Exit;

  treeFieldAliasesExpanding(nil, lNode, lFlag);
  s := GetItemName(lNode.Text);
  _DeleteFieldAlias(lNode);
  lstAllDataSets.Items.Add(s);
  lNode.Delete;
  FFieldAliases.Delete(FFieldAliases.IndexOf(s));
  treeFieldAliasesChange(nil, nil);
end;

procedure TRMDictionaryForm.treeFieldAliasesExpanding(Sender: TObject;
  Node: TTreeNode; var AllowExpansion: Boolean);
var
  i, lIndex, ImageIndex: Integer;
  sl: TStringList;
  ItemName, s: string;
  liNode: TTreeNode;
  lDataSet: TRMDataSet;
  lComponent: TComponent;
begin
  if Node.ImageIndex = 3 then
    AllowExpansion := False
  else if (Node.ImageIndex = Dataset_INDEX) and (Node.GetLastChild.ImageIndex = 0) then
  begin
    Node.DeleteChildren;
    sl := TStringList.Create;
    ItemName := GetItemName(Node.Text);

    lDataSet := nil;
    lComponent := RMFindComponent(Report.Owner, ItemName);
    if (lComponent <> nil) and (lComponent is TRMDataset) then
      lDataSet := TRMDataSet(lComponent);
    if lDataSet <> nil then
    begin
      try
        lDataSet.GetFieldsList(sl);
        //      Report.Dictionary.GetDataSetFields(ItemName, sl);
      except;
      end;

      for i := 0 to sl.Count - 1 do
      begin
        ImageIndex := Field_CanSelect;
        s := sl[i];
        lIndex := FFieldAliases.IndexOf(ItemName + '."' + sl[i] + '"');
        if lIndex >= 0 then
        begin
          if FFieldAliases.Value[lIndex] <> '' then
            s := sl[i] + ' {' + FFieldAliases.Value[lIndex] + '}'
          else
            ImageIndex := Field_CannotSelect;
        end;

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

    sl.Free;
  end;
end;

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

procedure TRMDictionaryForm.edtFieldAliasExit(Sender: TObject);
var
  s: string;
begin
  if edtFieldAlias.Modified then
  begin
    if (FActiveNode <> nil) and (FActiveNode <> treeFieldAliases.Items[0]) then
    begin
      s := GetItemName(FActiveNode.Text);
      FActiveNode.Text := s + ' {' + edtFieldAlias.Text + '}';
      if FActiveNode.ImageIndex = Field_CanSelect then
        s := GetItemName(FActiveNode.Parent.Text) + '."' + s + '"';
      FFieldAliases[s] := edtFieldAlias.Text;
    end;
  end;
  edtFieldAlias.Modified := False;
end;

procedure TRMDictionaryForm.btnFieldAddAllClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to lstAllDataSets.Items.Count - 1 do
    AddFieldAlias(lstAllDataSets.Items[i]);

  lstAllDataSets.Items.Clear;
  treeFieldAliases.Items[0].Expand(False);
  treeFieldAliases.Selected := treeFieldAliases.Items[0];
end;

procedure TRMDictionaryForm.btnFieldDeleteAllClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to FFieldAliases.Count - 1 do
  begin
    if Pos('"', FFieldAliases.Name[i]) = 0 then
      lstAllDataSets.Items.Add(FFieldAliases.Name[i]);
  end;

  FFieldAliases.Clear;
  treeFieldAliases.Items[0].DeleteChildren;
  btnFieldDeleteAll.Enabled := treeFieldAliases.Items.Count > 1;
  treeFieldAliasesChange(nil, nil);
end;

procedure TRMDictionaryForm.cmbDataSetsClick(Sender: TObject);
begin
  if cmbDataSets.ItemIndex >= 0 then
  begin
    RMDesigner.Report.Dictionary.GetDataSetFields(cmbDataSets.Items[cmbDataSets.ItemIndex],
      lstFields.Items, FFieldAliases);
  end
  else
    lstFields.Items.Clear;

  lstFields.Items.Insert(0, RMLoadStr(SNotAssigned));
end;

procedure TRMDictionaryForm.edtExpressionEnter(Sender: TObject);
begin
  FActiveNode := treeVariables.Selected;
end;

procedure TRMDictionaryForm.edtExpressionExit(Sender: TObject);
begin
  if (FActiveNode = nil) or (FActiveNode.ImageIndex <> 6) then Exit;
  if edtExpression.Modified then
  begin
    FVariables[FActiveNode.Text] := edtExpression.Text;
  end;

  edtExpression.Modified := False;
  FActiveNode := nil;
end;

procedure TRMDictionaryForm.PageControl1Change(Sender: TObject);
begin
  FActiveNode := nil;
  if PageControl1.ActivePage = TabSheet1 then
  begin
		FillValiableDataSets;
    treeVariablesChange(nil, treeVariables.Selected);
  end;
end;

procedure TRMDictionaryForm.chkFieldNoSelectClick(Sender: TObject);
var
  liNode: TTreeNode;
  ItemName, FullName: string;
begin
  if FBusyFlag then Exit;
  liNode := treeFieldAliases.Selected;
  if (liNode = nil) or (liNode = treeFieldAliases.Items[0]) then Exit;

  if liNode.ImageIndex in [Field_CanSelect, Field_CannotSelect] then
  begin
    ItemName := GetItemName(liNode.Text);
    FullName := GetItemName(liNode.Parent.Text) + '."' + ItemName + '"';
    if liNode.ImageIndex = Field_CanSelect then
      liNode.ImageIndex := Field_CannotSelect
    else
      liNode.ImageIndex := Field_CanSelect;
    liNode.SelectedIndex := liNode.ImageIndex;

    if liNode.ImageIndex = Field_CanSelect then
      FFieldAliases.Delete(FFieldAliases.IndexOf(FullName))
    else
      FFieldAliases[FullName] := '';
    liNode.Text := ItemName;
  end;
end;

procedure TRMDictionaryForm.treeFieldAliasesChange(Sender: TObject; Node: TTreeNode);
var
  s: string;
begin
  if edtFieldAlias.Modified then edtFieldAliasExit(nil);

  FActiveNode := treeFieldAliases.Selected;
  btnFieldDeleteOne.Enabled := (FActiveNode.ImageIndex = Dataset_INDEX);
  btnFieldDeleteAll.Enabled := treeFieldAliases.Items.Count > 1;
  if FActiveNode <> treeFieldAliases.Items[0] then
  begin
    s := FActiveNode.Text;
    if Pos('{', s) <> 0 then
      s := Copy(s, Pos('{', s) + 1, Pos('}', s) - Pos('{', s) - 1);
    edtFieldAlias.Text := s;
  end
  else
    edtFieldAlias.Text := '';

  FBusyFlag := True;
  RMEnableControls([Label2, edtFieldAlias], FActiveNode.ImageIndex <> 0);
  chkFieldNoSelect.Enabled := FActiveNode.ImageIndex in [Field_CanSelect, Field_CannotSelect];
  chkFieldNoSelect.Checked := (FActiveNode <> treeFieldAliases.Items[0]) and
    (FActiveNode.ImageIndex = Field_CannotSelect);
  FBusyFlag := False;
end;

procedure TRMDictionaryForm.btnPackDictionaryClick(Sender: TObject);
begin
  THackDictionary(Report.Dictionary).Pack1(FFieldAliases);
end;

end.