rm_gridreport.pas

这是一个功能强大

unit RM_GridReport;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus, RM_Common, RM_Class, RM_Printer, RM_Grid, RM_Preview
  {$IFDEF USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants{$ENDIF};

type

  { TRMGridReportPage }
  TRMGridReportPage = class(TRMReportPage)
  private
    FAutoCreateName: Boolean;
    FAutoDeleteNoUseBand: Boolean;
    FGrid: TRMGridEx;
    FRowBands: TList;
    FInLoadSaveMode: Boolean;
    FFixed: TStringList;
    FObjectsList: TList;
    FUseHeaderFooter: Boolean;
    FPageHeaderMsg: TRMBandMsg;
    FPageFooterMsg: TRMBandMsg;
    FPageCaptionMsg: TRMPageCaptionMsg;
    FOnBeforeCreateObjects: TNotifyEvent;
    FOnAfterCreateObjects: TNotifyEvent;

	  procedure DeleteBand(aAryBandType: array of TRMBandType);
    function GetRowBandView(aIndex: Integer): TRMView;
    procedure SetRowBandView(aIndex: Integer; Value: TRMView);
    procedure SetUseHeaderFooter(Value: Boolean);

    procedure OnAfterInsertRow(aGrid: TRMGridEx; aRow: Integer);
    procedure OnAfterDeleteRow(aGrid: TRMGridEx; aRow: Integer);
    procedure OnAfterChangeRowCount(aGrid: TRMGridEx; aOldCount, aNewCount: Integer);
  protected
    procedure AddChildView(aStringList: TStringList; aDontAddBlankNameObject: Boolean); override;
    procedure BuildTmpObjects; override;
    procedure PreparePage; override;
    procedure UnPreparePage; override;
    procedure AfterLoaded; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
  public
    constructor CreatePage(aParentReport: TRMReport; aSize, aWidth, aHeight, aBin: Integer; aOr: TRMPrinterOrientation); override;
    destructor Destroy; override;
    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant; Args: array of Variant): Boolean; override;
    function SetPropValue(aObject: TObject; aPropName: string; aValue: Variant): Boolean; override;
    function FindObject(aObjectName: string): TRMView; override;
    function PageObjects: TList; override;

    property RowBandViews[Index: Integer]: TRMView read GetRowBandView write SetRowBandView;
    property PageHeaderMsg: TRMBandMsg read FPageHeaderMsg write FPageHeaderMsg;
    property PageFooterMsg: TRMBandMsg read FPageFooterMsg write FPageFooterMsg;
    property PageCaptionMsg: TRMPageCaptionMsg read FPageCaptionMsg write FPageCaptionMsg;
    property Grid: TRMGridEx read FGrid;
  published
    property UseHeaderFooter: Boolean read FUseHeaderFooter write SetUseHeaderFooter;
    property AutoCreateName: Boolean read FAutoCreateName write FAutoCreateName;
    property AutoDeleteNoUseBand: Boolean read FAutoDeleteNoUseBand write FAutoDeleteNoUseBand;
    property OnBeforeCreateObjects: TNotifyEvent read FOnBeforeCreateObjects write FOnBeforeCreateObjects;
    property OnAfterCreateObjects: TNotifyEvent read FOnAfterCreateObjects write FOnAfterCreateObjects;
  end;

  { TRMGridReport }
  TRMGridReport = class(TRMReport)
  private
  protected
  public
    class function DefaultPageClassName: string; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ReportClassType: Byte; override;
    function ReportCommon: string; override;
    function CreatePage(const aClassName: string): TRMCustomPage; override;
    function AddGridReportPage: TRMGridReportPage;
    function AddReportPage: TRMGridReportPage;
  end;

implementation

uses
  Math, RM_Const, RM_Const1, RM_Utils
{$IFDEF USE_INTERNAL_JVCL}
  , rm_JvInterpreter_Types
{$ELSE}
  , JvInterpreter_Types
{$ENDIF};

type
  THackReport = class(TRMReport)
  end;

  THackReportView = class(TRMReportView)
  end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMGridReportPage }

constructor TRMGridReportPage.CreatePage(aParentReport: TRMReport;
  aSize, aWidth, aHeight, aBin: Integer; aOr: TRMPrinterOrientation);
begin
  inherited;

  FRowBands := TList.Create;
  FFixed := nil;
  FObjectsList := nil;

  FInLoadSaveMode := True;
  FGrid := TRMGridEx.Create(nil);
  FGrid.ParentReport := aParentReport;
  FGrid.ParentPage := Self;
  FGrid.OnAfterInsertRow := OnAfterInsertRow;
  FGrid.OnAfterDeleteRow := OnAfterDeleteRow;
  FGrid.OnAfterChangeRowCount := OnAfterCHangeRowCount;
  FGrid.DefaultRowHeight := 24;
  FGrid.ColWidths[0] := 13;
  FGrid.RowHeights[0] := 14;
  FInLoadSaveMode := False;

  OnAfterChangeRowCount(FGrid, FGrid.RowCount, FGrid.RowCount);

  FAutoCreateName := True;
  FAutoDeleteNoUseBand := True;
  FUseHeaderFooter := False;
  FPageHeaderMsg := TRMBandMsg.Create;
  FPageFooterMsg := TRMBandMsg.Create;
  FPageCaptionMsg := TRMPageCaptionMsg.Create;
end;

destructor TRMGridReportPage.Destroy;
begin
  FreeAndNil(FFixed);
  FreeAndNil(FObjectsList);
  FreeAndNil(FGrid);
  FreeAndNil(FRowBands);

  FreeAndNil(FPageHeaderMsg);
  FreeAndNil(FPageFooterMsg);
  FreeAndNil(FPageCaptionMsg);
  inherited Destroy;
end;

function TRMGridReportPage.GetPropValue(aObject: TObject; aPropName: string;
	var aValue: Variant; Args: array of Variant): Boolean;
begin
  Result := True;
  if (aPropName = 'GRID') or (aPropName = 'GRIDEX') then
    aValue := O2V(FGrid)
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

function TRMGridReportPage.SetPropValue(aObject: TObject; aPropName: string; aValue: Variant): Boolean;
begin
  //  Result := True;
  Result := inherited SetPropValue(aObject, aPropName, aValue);
end;

function TRMGridReportPage.PageObjects: TList;
var
  i, j: Integer;
  lCell: TRMCellInfo;
begin
  if FObjectsList = nil then
    FObjectsList := TList.Create;

  FObjectsList.Clear;
  for i := 0 to Objects.Count - 1 do
    FObjectsList.Add(Objects[i]);

  for i := 1 to FGrid.RowCount - 1 do
  begin
    j := 1;
    while j < FGrid.ColCount do
    begin
      lCell := FGrid.Cells[j, i];
      if lCell.StartRow = i then
        FObjectsList.Add(lCell.View);
      j := lCell.EndCol + 1;
    end;
  end;

  Result := FObjectsList;
end;

function TRMGridReportPage.FindObject(aObjectName: string): TRMView;
var
  i, j: Integer;
  liCell: TRMCellInfo;
begin
  Result := inherited FindObject(aObjectName);
  if Result = nil then
  begin
    for i := 1 to FGrid.RowCount - 1 do
    begin
      j := 1;
      while j < FGrid.ColCount do
      begin
        liCell := FGrid.Cells[j, i];
        if liCell.StartRow = i then
        begin
          if AnsiCompareText(liCell.View.Name, aObjectName) = 0 then
          begin
            Result := liCell.View;
            Exit;
          end;
        end;
        j := liCell.EndCol + 1;
      end;
    end;
  end;
end;

  procedure TRMGridReportPage.DeleteBand(aAryBandType: array of TRMBandType);
  var
    i, j: Integer;
  begin
    for i := 0 to FRowBands.Count - 1 do
    begin
      if FRowBands[i] <> nil then
      begin
				for j := Low(aAryBandType) to High(aAryBandType) do
        begin
        	if TRMBand(FRowBands[i]).BandType = aAryBandType[j] then
          begin
		        Self.Delete(Self.IndexOf(TRMBand(FRowBands[i]).Name));
    		    RowBandViews[i] := nil;
            Break;
          end;
        end;
      end;
    end;
  end;

procedure TRMGridReportPage.SetUseHeaderFooter(Value: Boolean);
begin
  if FUseHeaderFooter = Value then Exit;

  FUseHeaderFooter := Value;
  if FUseHeaderFooter then
  begin
    DeleteBand([rmbtPageHeader, rmbtPageFooter]);
  end;
end;

function TRMGridReportPage.GetRowBandView(aIndex: Integer): TRMView;
begin
  Result := FRowBands[aIndex];
end;

procedure TRMGridReportPage.SetRowBandView(aIndex: Integer; Value: TRMView);
begin
  FRowBands[aIndex] := Value;
end;

procedure TRMGridReportPage.OnAfterInsertRow(aGrid: TRMGridEx; aRow: Integer);
begin
  if FInLoadSaveMode then Exit;

  FRowBands.Insert(aRow, FRowBands[aRow]);
end;

procedure TRMGridReportPage.OnAfterDeleteRow(aGrid: TRMGridEx; aRow: Integer);
begin
  if FInLoadSaveMode then Exit;

  FRowBands.Delete(aRow);
end;

procedure TRMGridReportPage.OnAfterChangeRowCount(aGrid: TRMGridEx; aOldCount, aNewCount: Integer);
var
  liOldCount: Integer;
begin
  if FInLoadSaveMode or (FRowBands.Count = aNewCount) then Exit;

  liOldCount := FRowBands.Count;
  if liOldCount > aNewCount then
  begin
    while FRowBands.Count > aNewCount do
      FRowBands.Delete(FRowBands.Count - 1);
  end
  else
  begin
    while FRowBands.Count < aNewCount do
      FRowBands.Add(nil);
  end;
end;

procedure TRMGridReportPage.BuildTmpObjects;
var
  i, j: Integer;
  lCell: TRMCellInfo;
  lTopOffset: Integer;

  procedure _DeleteNoUseBand(aDeleteFlag: Boolean);
	var
  	i: Integer;
    t: TRMView;
  begin
    if not FAutoDeleteNoUseBand then Exit;
    
  	for i := Objects.Count - 1 downto 0 do
    begin
    	t := Objects[i];
      if t.IsBand then
      begin
      	if aDeleteFlag then
        begin
        	if t.spTop < 0 then
          begin
          	t.Free;
            Objects.Delete(i);
          end;
        end
        else
        	t.spTop := - 1;
      end;
    end;
  end;

  function _TextWidth(aMemo: TStringList; aFont: TFont): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := 0 to aMemo.Count - 1 do
    begin
      Result := Max(Result, RMCanvasWidth(aMemo[i], aFont) + 4);
    end;
  end;

  function _TextHeight(aMemo: TStringList; aFont: TFont): Integer;
  begin
    Result := aMemo.Count * (RMCanvasHeight('1234', aFont) + 2);
    if Result > 0 then
      Result := Result + 4 + 6;
  end;

  procedure _CreateHeaderFooterBand;
  var
    t: TRMMemoView;
    lBand: TRMView;
    lPageWidth, lHeight, lSaveTopOffset: Integer;

    procedure _CreateOneBand(aBandMsg: TRMBandMsg; aBandType: TRMBandType);
    var
      t: TRMMemoView;
      lLeftWidth, lRightWidth, lHeight: Integer;
    begin
      if (aBandMsg.LeftMemo.Count > 0) or (aBandMsg.CenterMemo.Count > 0) or
        (aBandMsg.RightMemo.Count > 0) then
      begin
        lLeftWidth := _TextWidth(aBandMsg.LeftMemo, aBandMsg.Font);
        lRightWidth := _TextWidth(aBandMsg.RightMemo, aBandMsg.Font);
        lLeftWidth := Max(lLeftWidth, lRightWidth);
        lHeight := _TextHeight(aBandMsg.LeftMemo, aBandMsg.Font);
        lHeight := Max(lHeight, _TextHeight(aBandMsg.CenterMemo, aBandMsg.Font));
        lHeight := Max(lHeight, _TextHeight(aBandMsg.RightMemo, aBandMsg.Font));

        if lBand = nil then
        begin
          lBand := RMCreateBand(aBandType);
          lBand.ParentPage := Self;
          lBand.spTop := lTopOffset;
          lBand.spHeight := lHeight;
        end
        else
          lBand.spHeight := lBand.spHeight + lHeight;

        t := TRMMemoView.Create; // 左
        t.ParentPage := Self;
        t.SetspBounds(0, lTopOffset, lLeftWidth, lHeight);
        t.Font.Assign(aBandMsg.Font);
        t.Memo.Assign(aBandMsg.LeftMemo);
        t.LeftFrame.Visible := False;
        t.RightFrame.Visible := False;
        t.TopFrame.Visible := False;
        t.BottomFrame.Visible := False;
        t.HAlign := rmHLeft;
        t.VAlign := rmVCenter;

        t := TRMMemoView.Create; // 中
        t.ParentPage := Self;
        t.SetspBounds(lLeftWidth, lTopOffset, lPageWidth - lLeftWidth * 2, lHeight);
        t.Font.Assign(aBandMsg.Font);
        t.Memo.Assign(aBandMsg.CenterMemo);
        t.LeftFrame.Visible := False;
        t.RightFrame.Visible := False;
        t.TopFrame.Visible := False;
        t.BottomFrame.Visible := False;
        t.HAlign := rmHCenter;
        t.VAlign := rmVCenter;

        t := TRMMemoView.Create; // 右
        t.ParentPage := Self;
        t.SetspBounds(lPageWidth - lLeftWidth, lTopOffset, lLeftWidth, lHeight);
        t.Font.Assign(aBandMsg.Font);
        t.Memo.Assign(aBandMsg.RightMemo);
        t.LeftFrame.Visible := False;
        t.RightFrame.Visible := False;
        t.TopFrame.Visible := False;
        t.BottomFrame.Visible := False;
        t.HAlign := rmHRight;
        t.VAlign := rmVCenter;
      end;
    end;

  begin
    lPageWidth := Self.PrinterInfo.ScreenPageWidth - Self.spMarginLeft - Self.spMarginRight;
    lBand := nil;
    lSaveTopOffset := lTopOffset;
    _CreateOneBand(FPageHeaderMsg, rmbtPageHeader);
    if lBand <> nil then
      lTopOffset := lBand.spTop + lBand.spHeight;

    if FPageCaptionMsg.TitleMemo.Count > 0 then
    begin
      lHeight := _TextHeight(FPageCaptionMsg.TitleMemo, FPageCaptionMsg.TitleFont);
      if lBand = nil then
      begin
        lBand := RMCreateBand(rmbtPageHeader);
        lBand.ParentPage := Self;
        lBand.spTop := lTopOffset;
        lBand.spHeight := lHeight;
      end
      else
        lBand.spHeight := lBand.spHeight + lHeight;

      t := TRMMemoView.Create;
      t.ParentPage := Self;
      t.SetspBounds(0, lTopOffset, lPageWidth, lHeight);
      t.Font.Assign(FPageCaptionMsg.TitleFont);
      t.Memo.Assign(FPageCaptionMsg.TitleMemo);
      t.LeftFrame.Visible := False;
      t.RightFrame.Visible := False;
      t.TopFrame.Visible := False;
      t.BottomFrame.Visible := False;
      t.HAlign := rmHCenter;
      t.VAlign := rmVCenter;

      lTopOffset := lTopOffset + lHeight;
    end;

    _CreateOneBand(FPageCaptionMsg.CaptionMsg, rmbtPageHeader);
    lTopOffset := lSaveTopOffset;
    if lBand <> nil then
      lTopOffset := lBand.spTop + lBand.spHeight;

    lBand := nil;
    _CreateOneBand(FPageFooterMsg, rmbtPageFooter);
    if lBand <> nil then
      lTopOffset := lBand.spTop + lBand.spHeight;
  end;

  procedure _SetBands; // 设置各个Band的位置信息
  var
    i, j: Integer;
    t: TRMReportView;
  begin
    t := TRMReportView(RowBandViews[1]);
    if t <> nil then
    begin
      t.spTop := 0 + lTopOffset;
      t.spHeight := FGrid.RowHeights[1] + 1;
    end;

    for i := 2 to FGrid.RowCount - 1 do