rm_reportmaster.pas

这是一个功能强大

      Result := ParentNode;
      if Result <> nil then
        Result := Result.GetNextSibling;
    end;
  end;
end;

function TRMTreeNode.GetFirstSibling: TRMTreeNode;
var
  lIndex: Integer;
begin
  lIndex := Self.Index;
  if FParentNode <> nil then
    Result := FParentNode.Item[lIndex]
  else
    Result := FOwnerTree.Items[lIndex];
end;

function TRMTreeNode.GetLastSibling: TRMTreeNode;
begin
  if FParentNode <> nil then
    Result := FParentNode.Item[FParentNode.Count - 1]
  else
    Result := FOwnerTree.Items[FOwnerTree.Count - 1];
end;

function TRMTreeNode.GetNextSibling: TRMTreeNode;
var
  lIndex: Integer;
begin
  lIndex := Self.Index;
  if FParentNode <> nil then
  begin
    if lIndex < FParentNode.Count - 1 then
      Result := FParentNode.Item[lIndex + 1]
    else
      Result := nil;
  end
  else
  begin
    if lIndex < FOwnerTree.Count - 1 then
      Result := FOwnerTree.Items[lIndex + 1]
    else
      Result := nil;
  end;
end;

function TRMTreeNode.GetPrevSibling: TRMTreeNode;
var
  lIndex: Integer;
begin
  lIndex := Self.Index;
  if lIndex = 0 then
    Result := nil
  else
  begin
    if FParentNode <> nil then
      Result := FParentNode.Item[lIndex - 1]
    else
      Result := FOwnerTree.Items[lIndex - 1];
  end;
end;

function TRMTreeNode.IndexOf(aNode: TRMTreeNode): Integer;
begin
  Result := FList.IndexOf(aNode);
end;

procedure TRMTreeNode.SetItem(aIndex: Integer; aValue: TRMTreeNode);
begin
  FList[aIndex] := aValue;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMTree }

constructor TRMTree.Create;
begin
  inherited Create;

  FList := TList.Create;
end;

destructor TRMTree.Destroy;
begin
  Clear;
  FList.Free;

  inherited Destroy;
end;

procedure TRMTree.Assign(aSource: TRMTree);
var
  i: Integer;
begin
  if aSource = nil then Exit;

  Clear;
  for i := 0 to aSource.Count - 1 do
    Add(nil, '').Assign(aSource.Items[I]);
end;

procedure TRMTree.Clear;
var
  i: Integer;
begin
  for i := Count - 1 downto 0 do
    DeleteChild(i);
end;

procedure TRMTree.DeleteChild(aIndex: Integer);
var
  lNode: TRMTreeNode;
begin
  lNode := Items[aIndex];
  if lNode <> nil then
  begin
    lNode.Delete;
    lNode.Free;
  end;
end;

function TRMTree.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TRMTree.GetItem(aIndex: Integer): TRMTreeNode;
begin
  if _InEffectListIndex(FList, aIndex) then
    Result := TRMTreeNode(FList[aIndex])
  else
    Result := nil;
end;

function TRMTree.IndexOf(aNode: TRMTreeNode): Integer;
begin
  Result := FList.IndexOf(aNode);
end;

procedure TRMTree.SetItem(aIndex: Integer; aValue: TRMTreeNode);
begin
  FList[aIndex] := aValue;
end;

function TRMTree.Add(aSibling: TRMTreeNode; const aText: string): TRMTreeNode;
begin
  Result := AddObject(aSibling, aText);
end;

function TRMTree.AddChild(aParent: TRMTreeNode; const aText: string): TRMTreeNode;
begin
  if aParent = nil then
    Result := Add(nil, aText)
  else
    Result := AddChildObject(aParent, aText);
end;

function TRMTree.AddChildObject(aParent: TRMTreeNode; const aText: string): TRMTreeNode;
begin
  if aParent <> nil then
  begin
    Result := TRMTreeNode.Create(Self, aParent);
    Result.FText := aText;
    aParent.FList.Add(Result);
  end
  else
    Result := nil;
end;

function TRMTree.AddObject(aSibling: TRMTreeNode; const aText: string): TRMTreeNode;
var
  lParentNode: TRMTreeNode;
begin
  if aSibling <> nil then
    lParentNode := aSibling.ParentNode
  else
    lParentNode := nil;

  Result := TRMTreeNode.Create(Self, lParentNode);
  Result.FText := aText;
  if lParentNode = nil then
    FList.Add(Result)
  else
    lParentNode.FList.Add(Result);
end;

function TRMTree.Insert(aTarget: TRMTreeNode; const aText: string): TRMTreeNode;
begin
  Result := InsertObject(aTarget, aText);
end;

function TRMTree.InsertObject(aTarget: TRMTreeNode; const aText: string): TRMTreeNode;
var
  lIndex: Integer;
begin
  if aTarget = nil then
    Result := AddObject(nil, aText)
  else
  begin
    lIndex := aTarget.Index;
    aTarget := aTarget.ParentNode;
    if aTarget = nil then
    begin
      Result := TRMTreeNode.Create(Self, nil);
      FList.Insert(lIndex, Result);
    end
    else
    begin
      Result := TRMTreeNode.Create(Self, aTarget);
      ATarget.FList.Insert(lIndex, Result);
    end;

    Result.FText := aText;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMCustomReportMaster }

constructor TRMCustomReportMaster.Create(aOwner: TComponent);
begin
  inherited;

  FReport := nil;
  FReportDataTree := TRMTree.Create;
  FDefaultFont := TFont.Create;
end;

destructor TRMCustomReportMaster.Destroy;
begin
  FreeAndNil(FReport);
  FreeAndNil(FReportDataTree);
  FreeAndNil(FDefaultFont);

  inherited;
end;

function TRMCustomReportMaster.CreateReport: Boolean;
begin
  Result := False;
end;

function TRMCustomReportMaster.DesignTemplate: Boolean;
var
  tmp: TRMFormReportMaster;
begin
  tmp := TRMFormReportMaster.Create(nil);
  try
    Result := tmp.Execute(Self);
  finally
    tmp.Free;
  end;
end;

procedure TRMCustomReportMaster.DesignReport;
begin
  if CreateReport then
    FReport.DesignReport;
end;

procedure TRMCustomReportMaster.ShowReport;
begin
  if CreateReport then
    FReport.ShowReport;
end;

procedure TRMCustomReportMaster.PrintReport;
begin
  if CreateReport then
    FReport.PrintReport;
end;

procedure TRMCustomReportMaster.LoadFromStream(aStream: TStream);

  procedure _LoadOneNode(aParentNode: TRMTreeNode);
  var
    i: Integer;
    lNode: TRMTreeNode;
    lChildCount, lCount: Integer;
  begin
    lCount := RMReadInt32(aStream);
    for i := 0 to lCount - 1 do
    begin
      lChildCount := RMReadInt32(aStream);
      lNode := ReportDataTree.AddChild(aParentNode, '');
      lNode.ColumnInfo.TitleCaption := RMReadString(aStream);
      RMReadFont(aStream, lNode.ColumnInfo.TitleFont);
      lNode.ColumnInfo.TitleHAlign := TRMHAlign(RMReadByte(aStream));
      lNode.ColumnInfo.TitleVAlign := TRMVAlign(RMReadByte(aStream));
      lNode.ColumnInfo.TitleFillColor := RMReadInt32(aStream);

      lNode.ColumnInfo.DataFieldName := RMReadString(aStream);
      RMReadFont(aStream, lNode.ColumnInfo.DataFont);
      lNode.ColumnInfo.DataHAlign := TRMHAlign(RMReadByte(aStream));
      lNode.ColumnInfo.DataVAlign := TRMVAlign(RMReadByte(aStream));
      lNode.ColumnInfo.DataFillColor := RMReadInt32(aStream);

      lNode.ColumnInfo.Width := RMReadInt32(aStream);
      if lChildCount > 0 then
        _LoadOneNode(lNode);
    end;
  end;

begin
  FReportDataTree.Clear;
  if RMReadByte(aStream) = 1 then
  begin
    _LoadOneNode(nil);
  end;
end;

procedure TRMCustomReportMaster.SaveToStream(aStream: TStream);

  procedure _SaveOneNode(aNode: TRMTreeNode);
  begin
    RMWriteInt32(aStream, aNode.GetSiblingCount);
    while aNode <> nil do
    begin
      RMWriteInt32(aStream, aNode.Count);
      RMWriteString(aStream, aNode.ColumnInfo.TitleCaption);
      RMWriteFont(aStream, aNode.ColumnInfo.TitleFont);
      RMWriteByte(aStream, Byte(aNode.ColumnInfo.TitleHAlign));
      RMWriteByte(aStream, Byte(aNode.ColumnInfo.TitleVAlign));
      RMWriteInt32(aStream, aNode.ColumnInfo.TitleFillColor);

      RMWriteString(aStream, aNode.ColumnInfo.DataFieldName);
      RMWriteFont(aStream, aNode.ColumnInfo.DataFont);
      RMWriteByte(aStream, Byte(aNode.ColumnInfo.DataHAlign));
      RMWriteByte(aStream, Byte(aNode.ColumnInfo.DataVAlign));
      RMWriteInt32(aStream, aNode.ColumnInfo.DataFillColor);

      RMWriteInt32(aStream, aNode.ColumnInfo.Width);
      if aNode.Count > 0 then
        _SaveOneNode(aNode[0]);

      aNode := aNode.GetNextSibling;
    end;
  end;

begin
  if ReportDataTree.Count > 0 then
  begin
    RMWriteByte(aStream, 1);
    _SaveOneNode(ReportDataTree.Items[0]);
  end
  else
  begin
    RMWriteByte(aStream, 0);
  end;
end;

procedure TRMCustomReportMaster.LoadFromFile(aFileName: string);
var
  lStream: TFileStream;
begin
  if ExtractFileExt(aFileName) = '' then
    aFileName := aFileName + '.rmm';

  if FileExists(aFileName) then
  begin
    lStream := TFileStream.Create(aFileName, fmOpenRead);
    try
      LoadFromStream(lStream);
    finally
      lStream.Free;
    end;
  end;
end;

procedure TRMCustomReportMaster.SaveToFile(aFileName: string);
var
  lStream: TFileStream;
begin
  if ExtractFileExt(aFileName) = '' then
    aFileName := aFileName + '.rmm';

  lStream := TFileStream.Create(aFileName, fmCreate);
  try
    SaveToStream(lStream);
  finally
    lStream.Free;
  end;
end;

procedure TRMCustomReportMaster.SetDefaultFont(Value: TFont);
begin
	FDefaultFont.Assign(Value);
end;

end.