teedbtre.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

  if ParentField<>Value then
  begin
    CreateParentLayout;
    Layout[0].FParentField:=Value;
  end;
end;

function TCustomDBTree.IsLayoutStored: Boolean;
begin
  result:=Layout.Count>0;
end;

{ TDBLayout }

procedure TDBLayout.Prepare;

  // Find all AFields (field names) in ADataSet and return
  // field objects in AFieldsArray.
  Procedure ObtainFields( Const AFields:String; ADataSet:TDataSet;
                          Var AFieldsArray:TDBTreeFields);

    Procedure FieldNotFound(ADataSet:TDataSet; Const AFieldName:String);
    begin
      raise EDBTreeException.CreateFmt(TreeMsg_DBFieldNotFound,
                  [AFieldName,ADataSet.Name]);
    end;

  var t     : Integer;
      tmpSt : String;
  begin
    ADataSet.FieldDefs.Update;
    AFieldsArray.Count:=TeeNumFields(AFields);
    for t:=0 to AFieldsArray.Count-1 do
    begin
      tmpSt:=TeeExtractField(AFields,t+1);
      AFieldsArray.Field[t]:=ADataSet.FieldByName(tmpSt);
      if not Assigned(AFieldsArray.Field[t]) then FieldNotFound(ADataSet,tmpSt);
    end;
  end;

begin
  if Assigned(DataSet) then
  With DataSet do
  if Active then
  begin
    ObtainFields(Self.Fields,DataSet,IFields);
    if IFields.Count=0 then
        raise EDBTreeException.Create(TreeMsg_OneDetailField);

    ObtainFields(FParentField,DataSet,IParents);

    if (FCodeField<>'') and (IParents.Count=0) then
       raise EDBTreeException.Create(TreeMsg_OneParentField);

    if FCodeField='' then ICodeField:=nil
                     else ICodeField:=DataSet.FieldByName(FCodeField);
  end
  else
  begin
    IFields.Count:=0;
    IParents.Count:=0;
    ICodeField:=nil;
  end;
end;

procedure TDBLayout.SetCodeField(const Value: String);
begin
  FCodeField:=Value;
end;

procedure TDBLayout.SetParentField(const Value: String);
begin
  FParentField:=Value;
end;

function TDBLayout.Tree: TCustomDBTree;
begin
  result:=TCustomDBTree(TDBTreeLayout(Collection).GetOwner);
end;

Procedure TDBLayout.FinishAddingText(ANode:TTreeNodeShape);
begin
  if Assigned(ICodeField) then ANode.Tag:=ICodeField.AsInteger;
  AddNodeText(ANode,IFields);
end;

Procedure TDBLayout.RunNextLayouts(ADetailRoot:TTreeNodeShape);
var t : Integer;
begin
  for t:=Index+1 to Collection.Count-1 do
      with TDBTreeLayout(Collection)[t] do
      if (IFields.Count>0) and (Self.IDetails.IndexOf(DataSet)<>-1) then
         Run(ADetailRoot);
end;

Function TDBLayout.AddNode(AParent:TTreeNodeShape):TTreeNodeShape;
begin
  if Assigned(AParent) then
     result:=AParent.AddChild(IFields.Field[0].DisplayText)
  else
     result:=Tree.Add(IFields.Field[0].DisplayText);

  if Assigned(FFormat) then result.AssignFormat(FFormat);
end;

Function TDBLayout.AddText(AChild:TTreeNodeShape):TTreeNodeShape;
var t : Integer;
begin
  if DisplayMode=ldGrid then
  begin
    result:=TGridShape.Create(nil);
    with TGridShape(result) do
    begin
      AutoSize:=True;
      Tree:=Self.Tree;
      Parent:=AChild;
      Columns:=IFields.Count;
      Rows:=1;

      for t:=0 to IFields.Count-1 do
      begin
        Cells[0,t].Text.Add(IFields.Field[t].DisplayText);
        if Assigned(FFormat) then
          Cells[0,t].AssignFormat(FFormat);
      end;

      if Assigned(FFormat) then result.AssignFormat(FFormat);
    end;
  end
  else
  begin
    result:=AddNode(AChild);
    FinishAddingText(result);
  end;
end;

procedure TDBLayout.Assign(Source: TPersistent);
begin
  if Source is TDBLayout then
  with TDBLayout(Source) do
  begin
    Self.FCodeField   :=FCodeField;
    Self.DataSet      :=FDataSet;
    Self.FDisplayMode :=FDisplayMode;
    Self.FParentField :=FParentField;
    Self.Format       :=FFormat;
    Self.HeaderFormat :=FHeaderFormat;
    Self.FFields      :=FFields;
  end
  else inherited;
end;

Destructor TDBLayout.Destroy;
begin
  FFormat.Free;
  FHeaderFormat.Free;
  DataSet:=nil;
  inherited;
end;

Procedure TDBLayout.AddNodeText(ANode:TTreeNodeShape; Var AFields:TDBTreeFields);
var t : Integer;
begin
  With ANode.Text do
  for t:=1 to AFields.Count-1 do
  if DisplayMode=ldMultiLine then Add(AFields.Field[t].DisplayText)
  else
  begin
    if (Count=0) or (Strings[0]='') then
       Add(AFields.Field[t].DisplayText)
    else
       Strings[0]:=Strings[0]+' '+AFields.Field[t].DisplayText
  end;
end;

procedure TDBLayout.Run(ARoot:TTreeNodeShape);

  // Find a children node with AText (group field text)
  Function GetParentFieldNode( ARoot:TTreeNodeShape;
                               Const AText:String):TTreeNodeShape;
  Var t       : Integer;
      tmpList : TNodeShapeList;
  begin
    if Assigned(ARoot) then tmpList:=ARoot.Children
                       else tmpList:=Tree.Roots;

    for t:=tmpList.Count-1 downto 0 do
    begin
      result:=tmpList[t];
      if result.SimpleText=AText then Exit;
    end;

    result:=nil;
  end;

  Function NewRoot:TTreeNodeShape;
  begin
    result:=AddNode(nil);
    FinishAddingText(result);
  end;

var b         : TBookMark;
    tmpChild  : TTreeNodeShape;
    tmpDetail : TTreeNodeShape;
    tmpChild2 : TTreeNodeShape;
    t         : Integer;
    tmpSt     : String;
    tmpRecCount : Integer;
begin
  if Assigned(DataSet) then
  with DataSet do
  if Active then
  begin
    b:=GetBookMark; // Backup current dataset position (current record)
    try
      IDetails:={$IFDEF CLR}TObjectList{$ELSE}TList{$ENDIF}.Create;
      try
        GetDetailDataSets(IDetails);

        // Header ?
        if Assigned(FHeaderFormat) and (FHeaderFormat.SimpleText<>'') then
        begin
          if Assigned(ARoot) then ARoot:=ARoot.Add('')
                             else ARoot:=Tree.Add('');
          ARoot.AssignFormat(FHeaderFormat);
          ARoot.Text:=FHeaderFormat.Text;
        end;

        tmpRecCount:=0;

        if Assigned(FFormat) then FFormat.Text:=nil;

        // Traverse dataset
        First;
        while not eof do
        begin

          tmpDetail:=nil;

          if Assigned(ICodeField) then  // situation 1 (Parent->Code)
          begin
            if Assigned(ARoot) then
            begin
              tmpChild:=Tree.FindNodeCode(IParents.Field[0].AsInteger);
              if Assigned(tmpChild) then tmpDetail:=AddText(tmpChild)
                                    else tmpDetail:=NewRoot;
            end
            else ARoot:=NewRoot
          end
          else
          if IParents.Count>0 then  // Group by  (situation 2 and 3)
          begin
            tmpChild:=ARoot;
            for t:=0 to IParents.Count-1 do
            begin
              tmpSt:=IParents.Field[t].DisplayText;
              tmpChild2:=GetParentFieldNode(tmpChild,tmpSt);
              if not Assigned(tmpChild2) then
              begin
                if Assigned(tmpChild) then tmpChild:=tmpChild.AddChild(tmpSt)
                                      else tmpChild:=Tree.Add(tmpSt);
                if Assigned(FFormat) then tmpChild.AssignFormat(FFormat);
              end
              else tmpChild:=tmpChild2;
            end;

            tmpDetail:=AddText(tmpChild);  // add detail fields

          end
          else tmpDetail:=AddText(ARoot);  // add detail fields

          // Process next layouts
          RunNextLayouts(tmpDetail);

          // In "Preview" mode, stop when processed enough records
          if Tree.IPreviewRecords<>-1 then
          begin
            if tmpRecCount>=Tree.IPreviewRecords then break;
            Inc(tmpRecCount);
          end;

          Next;
        end;
      finally
        IDetails.Free;
      end;
    finally
      // Restore dataset current record
      GotoBookMark(b);
      FreeBookmark(b);
    end;
  end;
end;

procedure TDBLayout.SetDataSet(const Value: TDataSet);
begin
  Tree.CheckDataSet(FDataSet,Value);
end;

procedure TDBLayout.SetFields(const Value: String);
begin
  FFields:=Value;
end;

procedure TDBLayout.SetFormat(const Value: TTreeNodeShape);
begin
  if Assigned(Value) then Format.Assign(Value)
                     else FreeAndNil(FFormat);
end;

function TDBLayout.GetFormat: TTreeNodeShape;
begin
  if not Assigned(FFormat) then
  begin
    FFormat:=TTreeNodeShape.Create(nil);
    FFormat.AutoSize:=False;
    FFormat.Border.Visible:=False;
    FFormat.Transparent:=True;
  end;
  result:=FFormat;
end;

function TDBLayout.GetHeaderFormat: TTreeNodeShape;
begin
  if not Assigned(FHeaderFormat) then
  begin
    FHeaderFormat:=TTreeNodeShape.Create(nil);
    FHeaderFormat.AutoSize:=False;
    FHeaderFormat.Border.Visible:=False;
    FHeaderFormat.Transparent:=True;
  end;
  result:=FHeaderFormat;
end;

procedure TDBLayout.SetHeaderFormat(const Value: TTreeNodeShape);
begin
  if Assigned(Value) then HeaderFormat.Assign(Value)
                     else FreeAndNil(FHeaderFormat);
end;

procedure TDBLayout.ReadFormat(Reader: TStream);
begin
  FFormat:=TTreeNodeShape(Reader.ReadComponent(nil));
end;

procedure TDBLayout.WriteFormat(Writer: TStream);
begin
  Writer.WriteComponent(FFormat);
end;

procedure TDBLayout.ReadHeaderFormat(Reader: TStream);
begin
  FHeaderFormat:=TTreeNodeShape(Reader.ReadComponent(nil));
end;

procedure TDBLayout.WriteHeaderFormat(Writer: TStream);
begin
  Writer.WriteComponent(FHeaderFormat);
end;

procedure TDBLayout.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('IFormat',ReadFormat,WriteFormat,Assigned(FFormat));
  Filer.DefineBinaryProperty('IHeaderFormat',ReadHeaderFormat,WriteHeaderFormat,Assigned(FHeaderFormat));
end;

{ TDBTreeLayout }

function TDBTreeLayout.Add: TDBLayout;
begin
  result:=TDBLayout(inherited Add);
end;

function TDBTreeLayout.Get(Index: Integer): TDBLayout;
begin
  result:=TDBLayout(inherited Items[Index]);
end;

procedure TDBTreeLayout.Put(Index: Integer; const Value: TDBLayout);
begin
  Items[Index].Assign(Value);
end;

end.