rm_dict.pas

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

      begin
        if AnsiCompareText(Variables.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 := treeVar.Selected;
  if (TreeNode = nil) or not treeVar.ShowRoot then Exit;
  if TreeNode.Parent <> nil then
    TreeNode := TreeNode.Parent;

  s := CreateNewVariable;

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

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

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

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

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

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

procedure TRMDictForm.treeVarEdited(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 (Variables.IndexOf(s1) <> -1) then
    s := Node.Text
  else
  begin
    if Node.ImageIndex = 6 then
      Variables.Name[Variables.IndexOf(Node.Text)] := s1
    else
      Variables.Name[Variables.IndexOf(' ' + Node.Text)] := s1;
  end;
end;

function TRMDictForm.CurDataSet: string;
begin
  Result := '';
  if cmbVal.ItemIndex <> -1 then
    Result := cmbVal.Items[cmbVal.ItemIndex];
end;

procedure TRMDictForm.FillValCombo;
var
  s: TStringList;
begin
  s := TStringList.Create;
  CurReport.Dictionary.GetDatasetList(s);
  s.Sort;
  s.Add(RMLoadStr(SSystemVariables));
  cmbVal.Items.Assign(s);
  s.Free;
end;

procedure TRMDictForm.cmbValClick(Sender: TObject);
begin
  if CurDataSet <> RMLoadStr(SSystemVariables) then
    GetFields(CurDataSet)
  else
    GetSpecValues;
end;

procedure TRMDictForm.GetFields(Value: string);
begin
  CurReport.Dictionary.GetFieldList(Value, lstVal.Items);
  lstVal.Items.Insert(0, RMLoadStr(SNotAssigned));
end;

procedure TRMDictForm.GetSpecValues;
var
  i: Integer;
begin
  with lstVal.Items do
  begin
    Clear;
    Add(RMLoadStr(SNotAssigned));
    for i := 0 to RMSpecCount - 1 do
    begin
      if i <> 1 then
        Add(RMLoadStr(SVar1 + i));
    end;
  end;
end;

procedure TRMDictForm.cmbValDrawItem(Control: TWinControl; Index: Integer;
  ARect: TRect; State: TOwnerDrawState);
var
  Image: TImage;
  r: TRect;
begin
  r := ARect;
  r.Right := r.Left + 18;
  r.Bottom := r.Top + 16;
  OffsetRect(r, 2, 0);
  if Control = cmbVal then
  begin
    with cmbVal.Canvas do
    begin
      FillRect(ARect);
      if Index = cmbVal.Items.Count - 1 then
        Image := Image3
      else
        Image := Image1;
      BrushCopy(r, Image.Picture.Bitmap, Rect(0, 0, 18, 16),
        Image.Picture.Bitmap.TransparentColor);
      TextOut(ARect.Left + 20, ARect.Top + 1, cmbVal.Items[Index]);
    end;
  end
  else if Control = lstAllTables then
  begin
    with lstAllTables.Canvas do
    begin
      FillRect(ARect);
      BrushCopy(r, Image1.Picture.Bitmap, Rect(0, 0, 18, 16),
        Image1.Picture.Bitmap.TransparentColor);
      TextOut(ARect.Left + 20, ARect.Top + 1, lstAllTables.Items[Index]);
    end;
  end
  else if Control = lstAllBands then
  begin
    with lstAllBands.Canvas do
    begin
      FillRect(ARect);
      BrushCopy(r, Image4.Picture.Bitmap, Rect(0, 0, 18, 16),
        Image4.Picture.Bitmap.TransparentColor);
      TextOut(ARect.Left + 20, ARect.Top + 1, lstAllBands.Items[Index]);
    end;
  end;
end;

procedure TRMDictForm.chkExprClick(Sender: TObject);
begin
  RMEnableControls([edtExpr, btnExpr], chkExpr.Checked);
  if not chkExpr.Checked then
  begin
    edtExpr.Text := '';
    if not Busy then
    begin
      lstVal.ItemIndex := 0;
      lstValClick(nil);
    end;
  end
  else if not Busy then
  begin
    if not treeVar.Focused then
      edtExpr.SetFocus;
    lstVal.ItemIndex := 0;
  end;
end;

procedure TRMDictForm.treeVarChange(Sender: TObject; Node: TTreeNode);
var
  s: string;
begin
  if Busy then Exit;
  ExprEditExit(nil);
  if Node.ImageIndex = 5 then
    s := ' ' + Node.Text
  else if Node.ImageIndex = 6 then
    s := Node.Text
  else
    Exit;

  chkExpr.Enabled := Node.ImageIndex = 6;
  if not chkExpr.Enabled then
    chkExpr.Checked := False;

  ShowValue(Variables[s]);
end;

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

  procedure SetDisable;
  begin
    Busy := True;
    RMEnableControls([edtExpr, btnExpr], FALSE);
    edtExpr.Text := '';
    chkExpr.Checked := False;
    Busy := False;
  end;

  function FindStr(List: TStrings; Str: string; IsField: Boolean): Integer;
  var
    i: Integer;
    s: string;
  begin
    Result := -1;
    for i := 0 to List.Count - 1 do
    begin
      if IsField then
        s := CurReport.Dictionary.RealFieldName[List[i]]
      else
        s := CurReport.Dictionary.RealDataSetName[List[i]];
      if AnsiCompareText(s, Str) = 0 then
      begin
        Result := i;
        break;
      end;
    end;
  end;

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

  if Pos('.', Value) <> 0 then
  begin
    for i := Length(Value) downto 1 do
    begin
      if Value[i] = '.' then
      begin
        s1 := Copy(Value, 1, i - 1);
        s2 := Copy(Value, i + 1, 255);
        break;
      end;
    end;
    n := FindStr(cmbVal.Items, s1, FALSE);
    if n <> -1 then
    begin
      if cmbVal.ItemIndex <> n then
      begin
        cmbVal.ItemIndex := n;
        cmbValClick(nil);
      end;
      if (s2 <> '') and (s2[1] = '"') then
        s2 := Copy(s2, 2, Length(s2) - 2);
      n := FindStr(lstVal.Items, s2, TRUE);
      if n <> -1 then
      begin
        lstVal.ItemIndex := n;
        Found := True;
      end;
    end;
  end;

  if not Found then
  begin
    if Trim(Value) = '' then
    begin
      lstVal.ItemIndex := 0;
      edtExpr.Text := '';
      chkExpr.Checked := False;
    end
    else
    begin
      for i := 0 to RMSpecCount - 1 do
      begin
        if AnsiCompareText(RMSpecFuncs[i], Value) = 0 then
        begin
          n := cmbVal.Items.IndexOf(RMLoadStr(SSystemVariables));
          if cmbVal.ItemIndex <> n then
          begin
            cmbVal.ItemIndex := n;
            cmbValClick(nil);
          end;
          if i = 0 then
            lstVal.ItemIndex := 1
          else
            lstVal.ItemIndex := i;
          Found := True;
          break;
        end;
      end;

      if not Found then
      begin
        RMEnableControls([edtExpr, btnExpr], True);
        edtExpr.Text := Value;
        chkExpr.Checked := True;
        lstVal.ItemIndex := 0;
        Found := TRUE;
      end;
    end;

    if not Found then
      SetDisable;
  end
  else
    SetDisable;
end;

procedure TRMDictForm.lstValClick(Sender: TObject);
var
  TreeNode: TTreeNode;
  s: string;
  n: Integer;
begin
  Busy := True;
  chkExpr.Checked := False;
  Busy := FALSE;
  TreeNode := treeVar.Selected;
  if (TreeNode = nil) or (TreeNode.ImageIndex <> 6) then Exit;

  if lstVal.ItemIndex = 0 then
    s := ''
  else
  begin
    if CurDataset = RMLoadStr(SSystemVariables) then
    begin
      n := lstVal.ItemIndex;
      if n = 1 then
        n := 0;
      s := RMSpecFuncs[n];
    end
    else
    begin
      with CurReport.Dictionary do
        s := RealDataSetName[CurDataset] + '."' + RealFieldName[lstVal.Items[lstVal.ItemIndex]] + '"'; end;
  end;
  Variables[TreeNode.Text] := s;
end;

procedure TRMDictForm.edtExprEnter(Sender: TObject);
begin
  ActiveNode := treeVar.Selected;
end;

procedure TRMDictForm.ExprEditExit(Sender: TObject);
var
  TreeNode: TTreeNode;
begin
  TreeNode := ActiveNode;
  if (TreeNode = nil) or (TreeNode.ImageIndex <> 6) or not btnExpr.Enabled then Exit;
  Variables[TreeNode.Text] := edtExpr.Text;
  ActiveNode := nil;
end;

procedure TRMDictForm.FormCreate(Sender: TObject);
begin
	Localize;
  PageControl1.ActivePage := TabSheet1;
end;

procedure TRMDictForm.edtExprKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    treeVar.SetFocus;
end;

procedure TRMDictForm.btnExprClick(Sender: TObject);
var
  expr: string;
begin
  expr := edtExpr.Text;
  if RM_DlgExpr.RMGetExpression('', expr, nil) then
  begin
    edtExpr.Text := expr;
    edtExpr.SetFocus;
  end;
end;

end.