fr_dict.pas

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

procedure TfrDictForm.NewVarBtnClick(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 Variables.Count - 1 do
      begin
        if AnsiCompareText(Variables.Name[i], s) = 0 then
        begin
          Result := True;
          break;
        end;
      end;
    end;

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

begin
  TreeNode := VarTree.Selected;
  if (TreeNode = nil) or not VarTree.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 := VarTree.Items.AddChild(TreeNode, s);
  ANode.ImageIndex := 6;
  ANode.SelectedIndex := 6;
  TreeNode.Expand(True);
  VarTree.Selected := ANode;
  ANode.EditText;
end;

procedure TfrDictForm.EditBtnClick(Sender: TObject);
var
  TreeNode: TTreeNode;
begin
  TreeNode := VarTree.Selected;
  if (TreeNode <> nil) and VarTree.ShowRoot then
    TreeNode.EditText;
end;

procedure TfrDictForm.DelBtnClick(Sender: TObject);
var
  TreeNode: TTreeNode;
  i: Integer;
begin
  TreeNode := VarTree.Selected;
  if (TreeNode <> nil) and VarTree.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 VarTree.Items.Count = 0 then
    begin
      TreeNode := VarTree.Items.Add(VarTree.Selected, frLoadStr(SNotAssigned));
      TreeNode.ImageIndex := -1;
      TreeNode.SelectedIndex := -1;
      VarTree.ShowRoot := False;
      VarTree.Selected := VarTree.Items[0];
      ExprCB.Enabled := False;
    end;
  end;
end;

procedure TfrDictForm.VarTreeKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = vk_Insert then
    if ssCtrl in Shift then
      NewCategoryBtnClick(nil)
    else
      if (VarTree.Selected = nil) or (VarTree.ShowRoot = False) then
        NewCategoryBtnClick(nil) else
        NewVarBtnClick(nil)
  else if (Key = vk_Delete) and not VarTree.IsEditing then
    DelBtnClick(nil)
  else if Key = vk_Return then
    EditBtnClick(nil)
  else if (Key = vk_Escape) and not VarTree.IsEditing then
    Button2.Click;
end;

procedure TfrDictForm.VarTreeEdited(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 TfrDictForm.CurDataSet: String;
begin
  Result := '';
  if ValCombo.ItemIndex <> -1 then
    Result := ValCombo.Items[ValCombo.ItemIndex];
end;

procedure TfrDictForm.FillValCombo;
var
  s: TStringList;
begin
  s := TStringList.Create;
  CurReport.Dictionary.GetDatasetList(s);
  s.Sort;
  s.Add(frLoadStr(SSystemVariables));
  ValCombo.Items.Assign(s);
  s.Free;
end;

procedure TfrDictForm.ValComboClick(Sender: TObject);
begin
  if CurDataSet <> frLoadStr(SSystemVariables) then
    GetFields(CurDataSet) else
    GetSpecValues;
end;

procedure TfrDictForm.GetFields(Value: String);
begin
  CurReport.Dictionary.GetFieldList(Value, ValList.Items);
  ValList.Items.Insert(0, frLoadStr(SNotAssigned));
end;

procedure TfrDictForm.GetSpecValues;
var
  i: Integer;
begin
  with ValList.Items do
  begin
    Clear;
    Add(frLoadStr(SNotAssigned));
    for i := 0 to frSpecCount - 1 do
      if i <> 1 then
        Add(frLoadStr(SVar1 + i));
  end;
end;

procedure TfrDictForm.ValComboDrawItem(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);
  with ValCombo.Canvas do
  begin
    FillRect(ARect);
    if Index = ValCombo.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, ValCombo.Items[Index]);
  end;
end;

procedure TfrDictForm.ValListDrawItem(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 + 15;
  OffsetRect(r, 2, 0);
  with ValList.Canvas do
  begin
    FillRect(ARect);
    if CurDataSet = frLoadStr(SSystemVariables) then
      Image := Image3 else
      Image := Image2;
    if Index <> 0 then
      BrushCopy(r, Image.Picture.Bitmap, Rect(0, 0, 18, 15),
        Image.Picture.Bitmap.TransparentColor);
    TextOut(ARect.Left + 20, ARect.Top + 1, ValList.Items[Index]);
  end;
end;

procedure TfrDictForm.ExprCBClick(Sender: TObject);
begin
  frEnableControls([ExprEdit], ExprCB.Checked);
  if not ExprCB.Checked then
  begin
    ExprEdit.Text := '';
    if not Busy then
    begin
      ValList.ItemIndex := 0;
      ValListClick(nil);
    end;
  end
  else if not Busy then
  begin
    if not VarTree.Focused then
      ExprEdit.SetFocus;
    ValList.ItemIndex := 0;
  end;
end;

procedure TfrDictForm.VarTreeChange(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;
  ExprCB.Enabled := Node.ImageIndex = 6;
  if not ExprCB.Enabled then
    ExprCB.Checked := False;
  ShowValue(Variables[s]);
end;

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

  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
      if Value[i] = '.' then
      begin
        s1 := Copy(Value, 1, i - 1);
        s2 := Copy(Value, i + 1, 255);
        break;
      end;
    n := FindStr(ValCombo.Items, s1, False);
    if n <> -1 then
    begin
      if ValCombo.ItemIndex <> n then
      begin
        ValCombo.ItemIndex := n;
        ValComboClick(nil);
      end;
      if (s2 <> '') and (s2[1] = '"') then
        s2 := Copy(s2, 2, Length(s2) - 2);
      n := FindStr(ValList.Items, s2, True);
      if n <> - 1 then
      begin
        ValList.ItemIndex := n;
        Found := True;
      end;
    end;
  end;

  if not Found then
  begin
    if Trim(Value) = '' then
    begin
      ValList.ItemIndex := 0;
      ExprEdit.Text := '';
      ExprCB.Checked:= False;
    end
    else
    begin
      for i := 0 to frSpecCount - 1 do
        if AnsiCompareText(frSpecFuncs[i], Value) = 0 then
        begin
          n := ValCombo.Items.IndexOf(frLoadStr(SSystemVariables));
          if ValCombo.ItemIndex <> n then
          begin
            ValCombo.ItemIndex := n;
            ValComboClick(nil);
          end;
          if i = 0 then
            ValList.ItemIndex := 1 else
            ValList.ItemIndex := i;
          Found := True;
          break;
        end;

      if not Found then
      begin
        ExprEdit.Text := Value;
        ExprCB.Checked := True;
      end;
    end;
  end;

  if Found then
  begin
    Busy := True;
    ExprCB.Checked := False;
    Busy := False;
  end;
end;

procedure TfrDictForm.ValListClick(Sender: TObject);
var
  TreeNode: TTreeNode;
  s: String;
  n: Integer;
begin
  Busy := True;
  ExprCB.Checked := False;
  Busy := False;
  TreeNode := VarTree.Selected;
  if (TreeNode = nil) or (TreeNode.ImageIndex <> 6) then Exit;

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

procedure TfrDictForm.ExprEditEnter(Sender: TObject);
begin
  ActiveNode := VarTree.Selected;
end;

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

procedure TfrDictForm.EditListBtnClick(Sender: TObject);
begin
  with TfrVaredForm.Create(nil) do
  begin
    Variables := Self.Variables;
    if ShowModal = mrOk then
      FillVariables(False);
    VarTree.Items[0].Selected := True;
    Free;
  end;
end;

procedure TfrDictForm.ExprEditButtonClick(Sender: TObject);
begin
  with TfrExprForm.Create(nil) do
  begin
    ExprMemo.Text := ExprEdit.Text;
    if ShowModal = mrOk then
      ExprEdit.Text := ExprMemo.Text;
    Free;
  end;
end;


procedure TfrDictForm.FormResize(Sender: TObject);
begin
{$IFDEF Delphi4}
  PageControl1.Anchors := [akLeft, akTop, akRight, akBottom];
  VarTree.Anchors := [akLeft, akTop, akRight, akBottom];
  ValList.Anchors := [akTop, akRight, akBottom];
  ValCombo.Anchors := [akTop, akRight];
  Label4.Anchors := [akTop, akRight];
  ExprCB.Anchors := [akLeft, akBottom];
  ExprEdit.Anchors := [akLeft, akRight, akBottom];
  Button1.Anchors := [akRight, akBottom];
  Button2.Anchors := [akRight, akBottom];
  NewCategoryBtn.Top := VarTree.Height + 26;
  NewVarBtn.Top := NewCategoryBtn.Top;
  EditBtn.Top := NewCategoryBtn.Top;
  DelBtn.Top := NewCategoryBtn.Top;
  EditListBtn.Top := NewCategoryBtn.Top;
{$ENDIF}
end;

end.