⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frxcross.pas

📁 报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin
💻 PAS
📖 第 1 页 / 共 3 页
字号:
        Report.Engine.NewPage;
      CurY:= Report.Engine.CurY;
      Inc(Page, FRowBands.Count);

      Application.ProcessMessages;
      if Report.Terminated then break;
    end
  else
    for i:= 0 to FRowBands.Count-1 do
    begin
      for j:= 0 to FColumnBands.Count-1 do
      begin
        Report.PreviewPages.CurPage:= Page+j;
        DoPagination(i, j);
        if j<>FColumnBands.Count-1 then
        begin
          Report.PreviewPages.AddPageAction:= apWriteOver;
          Report.Engine.NewPage;
        end;
      end;

      if i<>FRowBands.Count-1 then
      begin
        Report.PreviewPages.AddPageAction:= apAdd;
        Report.Engine.NewPage;
        Page:= Report.PreviewPages.CurPage;
      end
      else
        Inc(Page, FColumnBands.Count);
      CurY:= Report.Engine.CurY;

      Application.ProcessMessages;
      if Report.Terminated then break;
    end;

  if Parent is TfrxBand then
    CurY:= CurY-Height;
  { print last page footers }
  if FColumnBands.Count > 1 then
    Report.Engine.EndPage;
  { position to last row, first column page }
  Report.PreviewPages.CurPage:= Page-FColumnBands.Count;
  Report.PreviewPages.AddPageAction:= apAdd;
  Report.Engine.CurY:= CurY;

  ColumnItems.Free;
  ClearColumnBands;
  ClearRowBands;
end;

procedure TfrxCustomCrossView.ClearColumnBands;
var
  i:Integer;
begin
  for i:= 0 to FColumnBands.Count-1 do
    TObject(FColumnBands[i]).Free;
  FColumnBands.Clear;
end;

procedure TfrxCustomCrossView.ClearRowBands;
var
  i:Integer;
begin
  for i:= 0 to FRowBands.Count-1 do
    TObject(FRowBands[i]).Free;
  FRowBands.Clear;
end;

procedure TfrxCustomCrossView.AddSourceObjects;
var
  i:Integer;
begin
  for i:= 0 to CellLevels-1 do
    Report.PreviewPages.AddToSourcePage(CellMemos[i]);
  for i:= 0 to ColumnLevels-1 do
  begin
    Report.PreviewPages.AddToSourcePage(ColumnMemos[i]);
    Report.PreviewPages.AddToSourcePage(ColumnTotalMemos[i]);
  end;
  for i:= 0 to RowLevels-1 do
  begin
    Report.PreviewPages.AddToSourcePage(RowMemos[i]);
    Report.PreviewPages.AddToSourcePage(RowTotalMemos[i]);
  end;
end;

procedure TfrxCustomCrossView.SetupOriginalComponent(Obj1, Obj2:TfrxComponent);
begin
  THackComponent(Obj1).FOriginalComponent:= THackComponent(Obj2).FOriginalComponent;
  THackComponent(Obj1).FAliasName:= THackComponent(Obj2).FAliasName;
end;

procedure TfrxCustomCrossView.BuildColumnBands;
var
  i, LeftIndex, RightIndex:Integer;
  Items:TList;
  Item:TfrxCrossHeader;
  Memo:TfrxCustomMemoView;
  LargeBand:TfrxNullBand;
  CurWidth, AddWidth, LeftMargin, RightMargin:Extended;

  procedure CreateBand;
  var
    i:Integer;
    Band:TfrxNullBand;
    Memo, CutMemo:TfrxCustomMemoView;
    CutSize:Extended;
  begin
    Band:= TfrxNullBand.Create(Report);
    Band.Left:= AddWidth;
    Band.Tag:= LeftIndex+RightIndex * 65536;

    { move in-bounds memos to the new band }
    i:= 0;
    while i < LargeBand.Objects.Count do
    begin
      Memo:= LargeBand.Objects[i];
      if Memo.Left < RightMargin then
      begin
        if Memo.Left+Memo.Width <= RightMargin+5 then
        begin
          Memo.Parent:= Band;
          Memo.Visible:= Memo.Width > 0;
          Dec(i);
        end
        else { cut off the memo }
        begin
          CutSize:= RightMargin-Memo.Left;
          CutMemo:= CreateMemo(Band);
          CutMemo.Assign(Memo);
          CutMemo.Width:= CutSize;
          SetupOriginalComponent(CutMemo, Memo);
          Memo.Width:= Memo.Width-CutSize;
          Memo.Left:= Memo.Left+CutSize;
          if Memo is TfrxDMPMemoView then
          begin
            Memo.Left:= Memo.Left+fr1CharX;
            Memo.Width:= Memo.Width-fr1CharX;
          end;
          CutMemo.Frame.Typ:= CutMemo.Frame.Typ-[ftRight];
          Memo.Frame.Typ:= Memo.Frame.Typ-[ftLeft];
          Memo:= CutMemo;
        end;

        Memo.Left:= Memo.Left-LeftMargin;
      end;
      Inc(i);
    end;

    FColumnBands.Add(Band);
  end;

begin
  ClearColumnBands;
  LargeBand:= TfrxNullBand.Create(nil);
  Items:= FMatrix.ColumnHeader.AllItems;

  { create one large band }
  for i:= 0 to Items.Count-1 do
  begin
    Item:= Items[i];
    Memo:= CreateMemo(LargeBand);
    Memo.Assign(Item.Memo);
    SetupOriginalComponent(Memo, Item.Memo);
    Memo.Text:= Memo.FormatData(Item.Value);
    Memo.Highlight.Condition:= '';
    with Item.Bounds do
      Memo.SetBounds(Left, Top, Right, Bottom);
    CorrectDMPBounds(Memo);
    Memo.Visible:= (Memo.Width<>0) and (Memo.Height<>0);
    DoOnColumnHeader(Memo, Item);
  end;

  Items.Free;

  { cut it to small bands for each page }
  Items:= FMatrix.ColumnHeader.TerminalItems;
  AddWidth:= RowHeaderWidth;
  CurWidth:= Report.Engine.PageWidth-AddWidth;
  LeftMargin:=-Left;
  RightMargin:= LeftMargin+CurWidth;
  LeftIndex:= 0;
  RightIndex:= Items.Count-1;

  for i:= 0 to Items.Count-1 do
  begin
    Item:= Items[i];
    { find right terminal item }
    if Item.Bounds.Left+Item.Bounds.Right-LeftMargin > CurWidth then
    begin
      RightMargin:= Item.Bounds.Left;
      RightIndex:= i-1;
      CreateBand;
      LeftMargin:= RightMargin;
      if FRepeatHeaders then
        AddWidth:= RowHeaderWidth else
        AddWidth:= 0;
      CurWidth:= Report.Engine.PageWidth-AddWidth;
      RightMargin:= LeftMargin+CurWidth;
      LeftIndex:= RightIndex+1;
      RightIndex:= Items.Count-1;
    end;
  end;
  { add last band }
  CreateBand;

  LargeBand.Free;
  Items.Free;
end;

procedure TfrxCustomCrossView.BuildRowBands;
var
  i, TopIndex, BottomIndex:Integer;
  Items:TList;
  Item:TfrxCrossHeader;
  Memo:TfrxCustomMemoView;
  LargeBand:TfrxNullBand;
  CurHeight, AddHeight, TopMargin, BottomMargin:Extended;

  procedure CreateBand;
  var
    i:Integer;
    Band:TfrxNullBand;
    Memo, CutMemo:TfrxCustomMemoView;
    CutSize:Extended;
  begin
    Band:= TfrxNullBand.Create(Report);
    Band.Top:= AddHeight;
    Band.Tag:= TopIndex+BottomIndex * 65536;

    { move in-bounds memos to the new band }
    i:= 0;
    while i < LargeBand.Objects.Count do
    begin
      Memo:= LargeBand.Objects[i];
      if Memo.Top < BottomMargin then
      begin
        if Memo.Top+Memo.Height <= BottomMargin+5 then
        begin
          Memo.Parent:= Band;
          Dec(i);
        end
        else { cut off the memo }
        begin
          CutSize:= BottomMargin-Memo.Top;
          CutMemo:= CreateMemo(Band);
          CutMemo.Assign(Memo);
          CutMemo.Height:= CutSize;
          SetupOriginalComponent(CutMemo, Memo);
          Memo.Height:= Memo.Height-CutSize;
          Memo.Top:= Memo.Top+CutSize;
          if Memo is TfrxDMPMemoView then
          begin
            Memo.Top:= Memo.Top+fr1CharY;
            Memo.Height:= Memo.Height-fr1CharY;
          end;
          CutMemo.Frame.Typ:= CutMemo.Frame.Typ-[ftBottom];
          Memo.Frame.Typ:= Memo.Frame.Typ-[ftTop];
          Memo:= CutMemo;
        end;

        Memo.Top:= Memo.Top-TopMargin;
      end;
      Inc(i);
    end;

    FRowBands.Add(Band);
  end;

begin
  ClearRowBands;
  LargeBand:= TfrxNullBand.Create(nil);
  Items:= FMatrix.RowHeader.AllItems;

  { create one large band }
  for i:= 0 to Items.Count-1 do
  begin
    Item:= Items[i];
    Memo:= CreateMemo(LargeBand);
    Memo.Assign(Item.Memo);
    SetupOriginalComponent(Memo, Item.Memo);
    Memo.Text:= Memo.FormatData(Item.Value);
    Memo.Highlight.Condition:= '';
    with Item.Bounds do
      Memo.SetBounds(Left, Top, Right, Bottom);
    CorrectDMPBounds(Memo);
    Memo.Visible:= (Memo.Width<>0) and (Memo.Height<>0);
    DoOnRowHeader(Memo, Item);
  end;

  Items.Free;

  { cut it to small bands for each page }
  Items:= FMatrix.RowHeader.TerminalItems;
  AddHeight:= ColumnHeaderHeight;
  CurHeight:= Report.Engine.FreeSpace-AddHeight;
  TopMargin:= 0;
  BottomMargin:= TopMargin+CurHeight;
  TopIndex:= 0;
  BottomIndex:= Items.Count-1;

  for i:= 0 to Items.Count-1 do
  begin
    Item:= Items[i];
    { find right terminal item }
    if Item.Bounds.Top+Item.Bounds.Bottom-TopMargin > CurHeight then
    begin
      BottomMargin:= Item.Bounds.Top;
      BottomIndex:= i-1;
      CreateBand;
      TopMargin:= BottomMargin;
      if FRepeatHeaders then
        AddHeight:= ColumnHeaderHeight else
        AddHeight:= 0;
      CurHeight:= Report.Engine.PageHeight-Report.Engine.HeaderHeight-
        Report.Engine.FooterHeight-AddHeight;
      BottomMargin:= TopMargin+CurHeight;
      TopIndex:= BottomIndex+1;
      BottomIndex:= Items.Count-1;
    end;
  end;

  CreateBand;

  LargeBand.Free;
  Items.Free;
end;

{ TfrxCrossView }

class function TfrxCrossView.GetDescription:String;
begin
  Result:= frxResources.Get('obCross');
end;

function TfrxCrossView.IsCrossValid:Boolean;
begin
  Result:= (FCellLevels > 0) and (FRowLevels >= 0) and (FColumnLevels >= 0);
end;

procedure TfrxCrossView.SetCellLevels(const Value:Integer);
var
  i:Integer;
begin
  inherited;
  FCellFields.Clear;
  for i:= 0 to Value-1 do
    FCellFields.Add('Cell');
end;

procedure TfrxCrossView.SetColumnLevels(const Value:Integer);
var
  i:Integer;
begin
  inherited;
  FColumnFields.Clear;
  for i:= 0 to Value-1 do
    FColumnFields.Add('Column');
end;

procedure TfrxCrossView.SetRowLevels(const Value:Integer);
var
  i:Integer;
begin
  inherited;
  FRowFields.Clear;
  for i:= 0 to Value-1 do
    FRowFields.Add('Row');
end;

{ TfrxDBCrossView }

class function TfrxDBCrossView.GetDescription:String;
begin
  Result:= frxResources.Get('obDBCross');
end;

function TfrxDBCrossView.IsCrossValid:Boolean;
begin
  Result:= (DataSet<>nil) and (FCellLevels > 0) and
    (FRowFields.Count = FRowLevels) and (FColumnFields.Count = FColumnLevels) and
    (FCellFields.Count = FCellLevels);
end;

procedure TfrxDBCrossView.FillMatrix;
var
  i:Integer;
  RowValues, ColumnValues, CellValues:array of Variant;
  sl:TStringList;
begin
  SetLength(RowValues, FRowLevels);
  SetLength(ColumnValues, FColumnLevels);
  SetLength(CellValues, FCellLevels);
  sl:= TStringList.Create;
  DataSet.GetFieldList(sl);
  sl.Sorted:= True;

  DataSet.First;
  while not DataSet.Eof do
  begin
    for i:= 0 to FRowLevels-1 do
    begin
      if sl.IndexOf(FRowFields[i])<>-1 then
        RowValues[i]:= DataSet.Value[FRowFields[i]]
      else
        RowValues[i]:= Report.Calc(FRowFields[i])
    end;
    for i:= 0 to FColumnLevels-1 do
    begin
      if sl.IndexOf(FColumnFields[i])<>-1 then
        ColumnValues[i]:= DataSet.Value[FColumnFields[i]]
      else
        ColumnValues[i]:= Report.Calc(FColumnFields[i])
    end;
    for i:= 0 to FCellLevels-1 do
    begin
      if sl.IndexOf(FCellFields[i])<>-1 then
        CellValues[i]:= DataSet.Value[FCellFields[i]]
      else
        CellValues[i]:= Report.Calc(FCellFields[i])
    end;
    AddValue(RowValues, ColumnValues, CellValues);
    DataSet.Next;
  end;

  sl.Free;
  RowValues:= nil;
  ColumnValues:= nil;
  CellValues:= nil;
end;

initialization
  frxObjects.RegisterObject1(TfrxCrossView, nil, '', 'Other', 0, 42);
  frxObjects.RegisterObject1(TfrxDBCrossView, nil, '', 'Other', 0, 49);
  frxResources.Add('TfrxPrintCellEvent',
    'PascalScript=(Memo:TfrxMemoView; RowIndex, ColumnIndex, CellIndex:Integer; RowValues, ColumnValues, Value:Variant);'+#13#10+
    'C++Script=(TfrxMemoView Memo, int RowIndex, int ColumnIndex, int CellIndex, variant RowValues, variant ColumnValues, variant Value)'+#13#10+
    'BasicScript=(Memo, RowIndex, ColumnIndex, CellIndex, RowValues, ColumnValues, Value)'+#13#10+
    'JScript=(Memo, RowIndex, ColumnIndex, CellIndex, RowValues, ColumnValues, Value)');
  frxResources.Add('TfrxPrintHeaderEvent',
    'PascalScript=(Memo:TfrxMemoView; HeaderIndexes, HeaderValues, Value:Variant);'+#13#10+
    'C++Script=(TfrxMemoView Memo, variant HeaderIndexes, variant HeaderValues, variant Value)'+#13#10+
    'BasicScript=(Memo, HeaderIndexes, HeaderValues, Value)'+#13#10+
    'JScript=(Memo, HeaderIndexes, HeaderValues, Value)');
  frxResources.Add('TfrxCalcWidthEvent',
    'PascalScript=(ColumnIndex:Integer; ColumnValues:Variant; var Width:Extended);'+#13#10+
    'C++Script=(int ColumnIndex, variant ColumnValues, float &Width)'+#13#10+
    'BasicScript=(ColumnIndex, ColumnValues, byref Width)'+#13#10+
    'JScript=(ColumnIndex, ColumnValues, &Width)');
  frxResources.Add('TfrxCalcHeightEvent',
    'PascalScript=(RowIndex:Integer; RowValues:Variant; var Height:Extended);'+#13#10+
    'C++Script=(int RowIndex, variant RowValues, float &Height)'+#13#10+
    'BasicScript=(RowIndex, RowValues, byref Height)'+#13#10+
    'JScript=(RowIndex, RowValues, &Height)');

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -