rm_pehgrid.pas

report machine 2.3 功能强大

{*****************************************}
{                                         }
{          Report Machine v2.0            }
{             EHLib report                }
{                                         }
{*****************************************}

unit RM_PEHGrid;

interface

{$I RM.INC}
{$IFDEF EHLib}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls,
  Grids, DBGrids, DBGridEh, Printers, Db, RM_Class, RM_dbset, RM_View, RM_Pars,
  RM_FormReport;

type
  TRMPrintEHLib = class(TComponent) // fake component
  end;

 { TRMPrintEHGrid }
  TRMPrintEHGrid = class(TRMFormReportObject)
  private
    FPrintDoubleFrame: Boolean;
    FFormReport: TRMFormReport;
    FPage: TRMPage;
    FDBGridEh: TCustomDBGridEh;
    procedure PrintMultiTitle;
    procedure OnBeforePrintBandEvent(Band: TRMBand; var PrintBand: Boolean);
    procedure PrintSimpleTitle;
  protected
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

{$ENDIF}
implementation

{$IFDEF EHLib}
uses RM_chbox, RM_Utils;

type
  THackGrid = class(TCustomDBGridEh)
  end;

  THackFormReport = class(TRMFormReport)
  end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMPrintEHGrid}

procedure TRMPrintEHGrid.PrintMultiTitle;
var
  liLeft0, liTop0: Integer;
  liNextX, liLastX, liNextY, liLeftX, liRightX: Integer;
  liPage: TRMPage;
  liNum: Integer;
  liSaveNode: THeadTreeNode;
  liFlagFirstColumn: Boolean;
  liLevel: Integer;
  liMinx: Integer;
  t, t1: TRMMemoView;
  i: Integer;

  procedure MakeOneHeader(aNode: THeadTreeNode);
  begin
    liSaveNode := aNode;
    t := TRMMemoView(RMCreateObject(gtMemo, ''));
    t.CreateUniqueName;
    if (rmgoGridLines in FFormReport.ReportOptions) and (dgColLines in THackGrid(FDBGridEh).Options) then
      t.Prop['FrameTyp'] := $F
    else
      t.Prop['FrameTyp'] := 0;
    t.PWordWrap := True;
    t.LineSpacing := 0;
    t.PLayout := rmtlCenter;
    if Assigned(aNode.Column) then
    begin
{$IFDEF EHLib20}
      t.PRotation90 := aNode.Column.Title.Orientation = tohVertical;
{$ENDIF}
      case aNode.Column.Title.Alignment of
        taLeftJustify: t.PAlignment := rmtaLeftJustify;
        taRightJustify: t.PAlignment := rmtaRightJustify;
        taCenter: t.PAlignment := rmtaCenterJustify;
      end;
    end
    else
      t.PAlignment := rmtaCenterJustify;

    if liNextX < liLeftX then
      t.SetBounds(liLeftX, liNextY, aNode.Width + 1 + (liNextX - liLeftX), aNode.Height)
    else
    begin
      if liNextX + aNode.Width + 1 > liRightX then
        t.SetBounds(liNextX, liNextY, (liRightX - liNextX), aNode.Height)
      else
        t.SetBounds(liNextX, liNextY, aNode.Width + 1, aNode.Height);
    end;

    t.Memo.Add(aNode.Text);
    if Assigned(aNode.Column) then
      FFormReport.AssignFont(t, aNode.Column.Title.Font)
    else
      FFormReport.AssignFont(t, THackGrid(FDBGridEh).TitleFont);

    liPage.Objects.Add(t);
    FFormReport.PageHeaderViews.Add(t);

    if (liLevel <= 0) and FPrintDoubleFrame then
			t.TopFrame.Width := 2;
    if FPrintDoubleFrame then
    begin
			if liFlagFirstColumn then liMinx := liNextX;
    	if liFlagFirstColumn or (liMinx >= liNextX) then
	    	t.LeftFrame.Width := 2;
    end;
    liFlagFirstColumn := False;

    liLastX := liNextX;
    liNextX := liNextX + aNode.Width + 1;
  end;

  procedure ShowParentNode(aNode: THeadTreeNode);
  var
    SaveY: Integer;
  begin
    SaveY := liNextY;
    while (aNode <> nil) and (aNode.Text <> 'Root') do
    begin
			Dec(liLevel);
      liNextY := liNextY - aNode.Height;
      liNextX := liLastX;
      MakeOneHeader(aNode);
      if FPrintDoubleFrame then
      	t.RightFrame.Width := 2;
      aNode := aNode.Host;
    end;
    liNextY := SaveY;
  end;


  procedure DrawHeader(aNode: THeadTreeNode; aCount: Integer);
  var
    htLast: THeadTreeNode;
    liCount: Integer;
    liFlag: Boolean;

    procedure ShowOneColumn(aNode: THeadTreeNode);
    var
      SaveY: Integer;
      SaveLevel: Integer;
    begin
      if (FFormReport.ScaleMode.ScaleMode <> rmsmFit) or (not FFormReport.ScaleMode.FitPageWidth) then
      begin
        if (liNum > 0) and (THackFormReport(FFormReport).CalcWidth(liNextX + aNode.Width + 1) > THackFormReport(FFormReport).PageWidth) then // 超宽
        begin
					SaveLevel := liLevel;
          liNum := 0;
          liRightX := liNextX;
  				if FPrintDoubleFrame then
  					t.RightFrame.Width := 2;

          if aNode.Host = liSaveNode.Host then
          	ShowParentNode(liSaveNode.Host);
          liRightX := 9999999;
          THackFormReport(FFormReport).FormWidth[FFormReport.Report.Pages.Count - 1] := IntToStr(liNextX);
          THackFormReport(FFormReport).AddPage;
          THackFormReport(FFormReport).FormWidth.Add('0');
          liPage := FFormReport.Report.Pages[FFormReport.Report.Pages.Count - 1];
          liNextX := liLeft0; liLeftX := liLeft0;

				  liFlagFirstColumn := True;
          if FFormReport.GridFixedCols > 0 then
          begin
            SaveY := liNextY; liNextY := liTop0;
						liLevel := 0;
            DrawHeader(FDBGridEh.HeadTree, FFormReport.GridFixedCols);
            liNextY := SaveY;
            liLeftX := liNextX;
          end;

	        liLevel := SaveLevel;
        end;
      end;

      MakeOneHeader(aNode);
      Inc(liNum);
    end;

  begin
    liCount := 0;
    htLast := aNode.Child;
    liFlag := True;
    while liFlag do
    begin
      if htLast.Child <> nil then
      begin
        liNextY := liNextY + htLast.Height;
        Inc(liLevel);
        DrawHeader(htLast, aCount);
        Dec(liLevel);
      end;

      if htLast <> nil then
      begin
        Inc(liCount);
        ShowOneColumn(htLast);
        if (aCount > 0) and (liCount >= aCount) then
          liFlag := False;
      end;

      if aNode.Child = htLast.Next then
      begin
        liNextY := liNextY - aNode.Height;
        liNextX := liNextX - aNode.Width - 1;
        Break;
      end;
      htLast := htLast.Next;
    end;
  end;

begin
  liSaveNode := nil;
  liLeft0 := FDBGridEh.Left + THackFormReport(FFormReport).OffsX;
  liTop0 := FDBGridEh.Top + THackFormReport(FFormReport).OffsY;
  liNextX := liLeft0; liNextY := liTop0; liLastX := liNextX;
  liLeftX := liLeft0;
  liRightX := 9999999; liNum := 0;
  liPage := FPage;
  liFlagFirstColumn := True;
  liLevel := 0;
  DrawHeader(FDBGridEh.HeadTree, -1);

  if FPrintDoubleFrame then
  begin
		t.RightFrame.Width := 2;
    for i := liPage.Objects.Count - 1 downto 0 do
    begin
			t1 := liPage.Objects[i];
      if t1.x + t1.dx = t.x + t.dx then
      	t1.RightFrame.Width := 2
      else
      	Break;  
    end;
  end;
end;

procedure TRMPrintEHGrid.PrintSimpleTitle;
var
  i, liTitleHeight: Integer;
  liNextX, liNextY: Integer;
  liPage: TRMPage;
  liNum: Integer;
  t: TRMMemoView;
  tmpx0: Integer;
  liFlagFirstColumn: Boolean;

  procedure MakeOneHeader(aIndex: Integer);
  begin
    t := TRMMemoView(RMCreateObject(gtMemo, ''));
    t.CreateUniqueName;
    if (rmgoGridLines in FFormReport.ReportOptions) and (dgColLines in THackGrid(FDBGridEh).Options) then
      t.Prop['FrameTyp'] := $F
    else
      t.Prop['FrameTyp'] := 0;
    t.PWordWrap := True;
    t.LineSpacing := 0;
{$IFDEF EHLib20}
    t.PRotation90 := FDBGridEh.Columns[aIndex].Title.Orientation = tohVertical;
{$ENDIF}
    t.PLayout := rmtlCenter;
    case THackGrid(FDBGridEh).Columns[aIndex].Title.Alignment of
      taLeftJustify: TRMMemoView(t).PAlignment := rmtaLeftJustify;
      taRightJustify: TRMMemoView(t).PAlignment := rmtaRightJustify;
      taCenter: TRMMemoView(t).PAlignment := rmtaCenterJustify;
    end;
    t.SetBounds(liNextX, liNextY, THackGrid(FDBGridEh).Columns[aIndex].Width + 1, liTitleHeight);
    t.Memo.Add(THackGrid(FDBGridEh).Columns[aIndex].Title.Caption);
    FFormReport.AssignFont(t, THackGrid(FDBGridEh).Columns[aIndex].Title.Font);

    liPage.Objects.Add(t);
    FFormReport.PageHeaderViews.Add(t);
    liNextX := liNextX + t.dx;

    if FPrintDoubleFrame then
    begin
      if liFlagFirstColumn then
        t.LeftFrame.Width := 2;
      t.TopFrame.Width := 2;
    end;
    liFlagFirstColumn := False;
  end;

  procedure DrawFixedColHeader;
  var
    i: Integer;
  begin
    for i := 0 to FFormReport.GridFixedCols - 1 do
    begin
      if not THackGrid(FDBGridEh).Columns[i].Visible then Continue;
      if i < THackGrid(FDBGridEh).Columns.Count then MakeOneHeader(i);
    end;
  end;

begin
  liNextX := FDBGridEh.Left + THackFormReport(FFormReport).OffsX;
  liNextY := FDBGridEh.Top + THackFormReport(FFormReport).OffsY;
  liTitleHeight := THackGrid(FDBGridEh).RowHeights[0] + 4;
  liPage := FPage;
  liNum := 0; tmpx0 := liNextX;
  liFlagFirstColumn := True;
  for i := 0 to THackGrid(FDBGridEh).Columns.Count - 1 do
  begin
    if not THackGrid(FDBGridEh).Columns[i].Visible then Continue;

    if (FFormReport.ScaleMode.ScaleMode <> rmsmFit) or (not FFormReport.ScaleMode.FitPageWidth) then
    begin
      if (liNum > 0) and (THackFormReport(FFormReport).CalcWidth(liNextX + (THackGrid(FDBGridEh).Columns[i].Width + 1)) > THackFormReport(FFormReport).PageWidth) then // 超宽
      begin
        liNum := 0;
        liFlagFirstColumn := True;
        if FPrintDoubleFrame then
          t.RightFrame.Width := 2;