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

📄 rm_gridreport.pas

📁 这是一个功能强大
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    begin
      if RowBandViews[i] = t then
      begin
        if t <> nil then
          t.spHeight := t.spHeight + FGrid.RowHeights[i] + 1;
      end
      else
      begin
        t := TRMReportView(RowBandViews[i]);
        if t <> nil then
        begin
          t.spTop := 0 + lTopOffset;
          for j := 1 to i - 1 do
            t.spTop := t.spTop + FGrid.RowHeights[j] + 1;
          t.spHeight := FGrid.RowHeights[i] + 1;
        end;
      end;
    end;
  end;

  procedure _SetCellInfo;
  var
    t, t1: TRMReportView;
    i: Integer;
    lSize: Integer;
  begin
    t := TRMReportView(RMCreateObject(lCell.View.ObjectType, lCell.View.ClassName));
    t.NeedCreateName := False;
    t.ParentPage := Self;
    t.Assign(lCell.View);

    lSize := 0;
    for i := 1 to lCell.StartCol - 1 do
      lSize := lSize + FGrid.ColWidths[i] + 1;
    t.spLeft := lSize;

    lSize := 0;
    for i := lCell.StartCol to lCell.EndCol do
      lSize := lSize + FGrid.ColWidths[i] + 1;
    t.spWidth := lSize;

    lSize := 0;
    for i := 1 to lCell.StartRow - 1 do
      lSize := lSize + FGrid.RowHeights[i] + 1;
    t.spTop := lSize + lTopOffset;

    lSize := 0;
    for i := lCell.StartRow to lCell.EndRow do
      lSize := lSize + FGrid.RowHeights[i] + 1;

    t.spHeight := lSize;
    if lCell.FillColor = FGrid.Color then
      t.FillColor := clNone
    else
      t.FillColor := lCell.FillColor;

    if t is TRMMemoView then
    begin
      TRMMemoView(t).Font.Assign(lCell.Font);
      TRMMemoView(t).HAlign := lCell.HAlign;
      TRMMemoView(t).VAlign := lCell.VAlign;
    end;

    THackReportView(t).BandAlign := rmbaNone;
    if (t is TRMSubReportView) and
    	(t.LeftFrame.Visible or t.RightFrame.Visible or t.TopFrame.Visible or
      	t.BottomFrame.Visible) then
		begin
	    t1 := TRMReportView(RMCreateObject(rmgtMemo, ''));
  	  t1.NeedCreateName := False;
    	t1.ParentPage := Self;
			t1.mmLeft := t.mmLeft;
      t1.mmTop := t.mmTop;
      t1.mmWidth := t.mmWidth;
      t1.mmHeight := t.mmHeight;
      t1.LeftFrame.Assign(t.LeftFrame);
      t1.RightFrame.Assign(t.RightFrame);
      t1.TopFrame.Assign(t.TopFrame);
      t1.BottomFrame.Assign(t.BottomFrame);
    end;
  end;

begin
  SetObjectEvent(EventList, THackReport(ParentReport.MasterReport).FScriptEngine);

  FGrid.AutoCreateName := AutoCreateName;
	if Assigned(FOnBeforeCreateObjects) then
  	FOnBeforeCreateObjects(Self);

  lTopOffset := 0;
  _DeleteNoUseBand(False);
  if FUseHeaderFooter then
  begin
    DeleteBand([rmbtPageHeader, rmbtPageFooter]);
    _CreateHeaderFooterBand;
  end;

  //lTopOffset := RMToMMThousandths(lTopOffset, rmutScreenPixels);
  _SetBands;
  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
      begin
        _SetCellInfo;
      end;
      j := lCell.EndCol + 1;
    end;
  end;

  _DeleteNoUseBand(True);
  SetObjectsEvent;
	if Assigned(FOnAfterCreateObjects) then
  	FOnAfterCreateObjects(Self);
end;

procedure TRMGridReportPage.PreparePage;
begin
  inherited PreparePage;
end;

procedure TRMGridReportPage.UnPreparePage;
begin
  inherited UnPreparePage;
end;

procedure TRMGridReportPage.AddChildView(aStringList: TStringList; aDontAddBlankNameObject: Boolean);
var
  i, j: Integer;
  lCell: TRMCellInfo;
begin
  inherited AddChildView(aStringList, aDontAddBlankNameObject);
  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
      begin
        if not (aDontAddBlankNameObject and (lCell.View.Name = '')) then
          aStringList.Add(UpperCase(lCell.View.Name));
      end;
      j := lCell.EndCol + 1;
    end;
  end;
end;

procedure TRMGridReportPage.AfterLoaded;
var
  i: Integer;
  t: TRMView;
begin
  for i := 0 to FGrid.RowCount - 1 do
    RowBandViews[i] := nil;

  if FFixed = nil then Exit;

  for i := 0 to FFixed.Count - 1 do
  begin
    if FFixed[i] <> '' then
    begin
      t := FindObject(FFixed[i]);
      RowBandViews[i + 1] := t;
    end;
  end;
  FreeAndNil(FFixed);
end;

procedure TRMGridReportPage.LoadFromStream(aStream: TStream);
var
  i: Integer;
  lVersion: Word;

  procedure _ReadBandMsg(aBandMsg: TRMBandMsg);
  begin
    RMReadFont(aStream, aBandMsg.Font);
    RMReadMemo(aStream, aBandMsg.LeftMemo);
    RMReadMemo(aStream, aBandMsg.CenterMemo);
    RMReadMemo(aStream, aBandMsg.RightMemo);
  end;

begin
  FAutoDeleteNoUseBand := False;
  FGrid.AutoCreateName := AutoCreateName;
  FInLoadSaveMode := True;
  inherited LoadFromStream(aStream);
  lVersion := RMReadWord(aStream);
  FGrid.LoadFromStream(aStream);

  if FFixed = nil then
    FFixed := TStringList.Create;
  FFixed.Clear;
  for i := 1 to FGrid.RowCount - 1 do
  begin
    FFixed.Add(RMReadString(aStream));
  end;

  FUseHeaderFooter := False;
  if lVersion >= 1 then
  begin
    FUseHeaderFooter := RMReadBoolean(aStream);
    _ReadBandMsg(FPageHeaderMsg);
    _ReadBandMsg(FPageFooterMsg);
    RMReadFont(aStream, FPageCaptionMsg.TitleFont);
    RMReadMemo(aStream, FPageCaptionMsg.TitleMemo);
    _ReadBandMsg(FPageCaptionMsg.CaptionMsg);
  end;
  if lVersion >= 2 then
  begin
    FAutoCreateName := RMReadBoolean(aStream);
  end;
  if lVersion >= 3 then
  begin
    FAutoDeleteNoUseBand := RMReadBoolean(aStream);
  end;

  FInLoadSaveMode := False;
  OnAfterChangeRowCount(FGrid, FGrid.RowCount, FGrid.RowCount);
end;

procedure TRMGridReportPage.SaveToStream(aStream: TStream);
var
  i: Integer;
  t: TRMView;

  procedure _WriteBandMsg(aBandMsg: TRMBandMsg);
  begin
    RMWriteFont(aStream, aBandMsg.Font);
    RMWriteMemo(aStream, aBandMsg.LeftMemo);
    RMWriteMemo(aStream, aBandMsg.CenterMemo);
    RMWriteMemo(aStream, aBandMsg.RightMemo);
  end;

begin
  FInLoadSaveMode := True;
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 3);
  FGrid.SaveToStream(aStream);
  for i := 1 to FGrid.RowCount - 1 do
  begin
    t := RowBandViews[i];
    if t <> nil then
      RMWriteString(aStream, t.Name)
    else
      RMWriteString(aStream, '');
  end;

  RMWriteBoolean(aStream, FUseHeaderFooter);
  _WriteBandMsg(FPageHeaderMsg);
  _WriteBandMsg(FPageFooterMsg);
  RMWriteFont(aStream, FPageCaptionMsg.TitleFont);
  RMWriteMemo(aStream, FPageCaptionMsg.TitleMemo);
  _WriteBandMsg(FPageCaptionMsg.CaptionMsg);
  RMWriteBoolean(aStream, FAutoCreateName);
  RMWriteBoolean(aStream, FAutoDeleteNoUseBand);

  FInLoadSaveMode := False;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMGridReport }

class function TRMGridReport.DefaultPageClassName: string;
begin
  Result := 'TRMGridReportPage';
end;

constructor TRMGridReport.Create(AOwner: TComponent);
begin
  inherited Create(aOwner);
//  CanPreviewDesign := False;
end;

destructor TRMGridReport.Destroy;
begin
  inherited Destroy;
end;

function TRMGridReport.ReportClassType: Byte;
begin
  Result := 2;
end;

function TRMGridReport.ReportCommon: string;
begin
  Result := 'GridReport';
end;

function TRMGridReport.CreatePage(const aClassName: string): TRMCustomPage;
begin
  if AnsiCompareText(aClassName, 'TRMGridReportPage') = 0 then
  begin
    with ReportPrinter do
      Result := TRMGridReportPage.CreatePage(Self, DefaultPaper, DefaultPaperWidth, DefaultPaperHeight, $FFFF, rmpoPortrait);
  end
  else
    Result := inherited CreatePage(aClassName);
end;

function TRMGridReport.AddGridReportPage: TRMGridReportPage;
begin
  with ReportPrinter do
    Result := TRMGridReportPage.CreatePage(Self, DefaultPaper, DefaultPaperWidth,
    	DefaultPaperHeight, $FFFF, rmpoPortrait);
      
  Pages.PagesList.Add(Result);
end;

function TRMGridReport.AddReportPage: TRMGridReportPage;
begin
	Result := AddGridReportPage;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TRMGridEx_Read_Cells(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TRMGridEx(Args.Obj).Cells[Args.Values[0], Args.Values[1]]);
end;

procedure TRMGridEx_Write_Cells(const Value: Variant; Args: TJvInterpreterArgs);
begin
end;

procedure TRMGridEx_Read_ColWidths(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TRMGridEx(Args.Obj).ColWidths[Args.Values[0]];
end;

procedure TRMGridEx_Write_ColWidths(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMGridEx(Args.Obj).ColWidths[Args.Values[0]] := Value;
end;

procedure TRMGridEx_Read_RowHeights(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TRMGridEx(Args.Obj).RowHeights[Args.Values[0]];
end;

procedure TRMGridEx_Write_RowHeights(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMGridEx(Args.Obj).RowHeights[Args.Values[0]] := Value;
end;

procedure TRMGridEx_CreateViewsName(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMGridEx(Args.Obj).CreateViewsName;
end;

procedure TRMGridEx_GetCellInfo(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TRMGridEx(Args.Obj).GetCellInfo(Args.Values[0], Args.Values[1]));
end;

procedure TRMGridEx_MergeCell(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMGridEx(Args.Obj).MergeCell(Args.Values[0], Args.Values[1], Args.Values[2], Args.Values[3]);
end;

procedure TRMGridEx_SplitCell(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMGridEx(Args.Obj).SplitCell(Args.Values[0], Args.Values[1], Args.Values[2], Args.Values[3]);
end;

procedure TRMGridEx_GetCellRect(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := Rect2Var(TRMGridEx(Args.Obj).GetCellRect(TRMCellInfo(V2O(Args.Values[0]))));
end;

procedure TRMGridEx_InsertColumn(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMGridEx(Args.Obj).InsertColumn(Args.Values[0], Args.Values[1]);
end;

procedure TRMGridEx_InsertRow(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMGridEx(Args.Obj).InsertRow(Args.Values[0], Args.Values[1]);
end;

procedure TRMGridEx_DeleteColumn(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMGridEx(Args.Obj).DeleteColumn(Args.Values[0], Args.Values[1]);
end;

procedure TRMGridEx_DeleteRow(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMGridEx(Args.Obj).DeleteRow(Args.Values[0], Args.Values[1]);
end;

procedure TRMGridReportPage_Read_RowBandViews(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TRMGridReportPage(Args.Obj).RowBandViews[Args.Values[0]]);
end;

procedure TRMGridReportPage_Write_RowBandViews(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMGridReportPage(Args.Obj).RowBandViews[Args.Values[0]] := TRMView(V2O(Value));
end;

procedure TRMGridReportPage_PageHeaderMsg(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TRMGridReportPage(Args.Obj).PageHeaderMsg);
end;

procedure TRMGridReportPage_PageFooterMsg(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TRMGridReportPage(Args.Obj).PageFooterMsg);
end;

procedure TRMGridReportPage_PageCaptionMsg(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TRMGridReportPage(Args.Obj).PageCaptionMsg);
end;

const
  cReportMachine = 'RM_GridReport';
  cRM_Grid = 'RM_Grid';

procedure RM_RegisterRAI2Adapter(RAI2Adapter: TJvInterpreterAdapter);
begin
  with RAI2Adapter do
  begin
    AddClass(cRM_Grid, TRMGridEx, 'TRMGridEx');
    AddClass(cRM_Grid, TRMBandMsg, 'TRMBandMsg');
    AddClass(cRM_Grid, TRMPageCaptionMsg, 'TRMPageCaptionMsg');

    { TRMGridEx }
    AddIGet(TRMGridEx, 'Cells', TRMGridEx_Read_Cells, 2, [0], varEmpty);
    AddIDGet(TRMGridEx, TRMGridEx_Read_Cells, 2, [0], varEmpty);
    AddISet(TRMGridEx, 'Cells', TRMGridEx_Write_Cells, 2, [1]);
    AddIDSet(TRMGridEx, TRMGridEx_Write_Cells, 2, [1]);
    AddIGet(TRMGridEx, 'ColWidths', TRMGridEx_Read_ColWidths, 1, [0], varEmpty);
    AddISet(TRMGridEx, 'ColWidths', TRMGridEx_Write_ColWidths, 1, [1]);
    AddIGet(TRMGridEx, 'RowHeights', TRMGridEx_Read_RowHeights, 1, [0], varEmpty);
    AddISet(TRMGridEx, 'RowHeights', TRMGridEx_Write_RowHeights, 1, [1]);

    AddGet(TRMGridEx, 'CreateViewsName', TRMGridEx_CreateViewsName, 0, [0], varEmpty);
    AddGet(TRMGridEx, 'GetCellInfo', TRMGridEx_GetCellInfo, 2, [0], varEmpty);
    AddGet(TRMGridEx, 'MergeCell', TRMGridEx_MergeCell, 4, [0], varEmpty);
    AddGet(TRMGridEx, 'SplitCell', TRMGridEx_SplitCell, 4, [0], varEmpty);
    AddGet(TRMGridEx, 'GetCellRect', TRMGridEx_GetCellRect, 1, [0], varEmpty);
    AddGet(TRMGridEx, 'InsertColumn', TRMGridEx_InsertColumn, 2, [0], varEmpty);
    AddGet(TRMGridEx, 'InsertRow', TRMGridEx_InsertRow, 2, [0], varEmpty);
    AddGet(TRMGridEx, 'DeleteColumn', TRMGridEx_DeleteColumn, 2, [0], varEmpty);
    AddGet(TRMGridEx, 'DeleteRow', TRMGridEx_DeleteRow, 2, [0], varEmpty);

    { TRMGridReportPage }
    AddClass(cReportMachine, TRMGridReportPage, 'TRMGridReportPage');
    AddIGet(TRMGridReportPage, 'RowBandViews', TRMGridReportPage_Read_RowBandViews, 1, [0], varEmpty);
    AddISet(TRMGridReportPage, 'RowBandViews', TRMGridReportPage_Write_RowBandViews, 1, [1]);
    AddGet(TRMGridReportPage, 'PageHeaderMsg', TRMGridReportPage_PageHeaderMsg, 0, [0], varEmpty);
    AddGet(TRMGridReportPage, 'PageFooterMsg', TRMGridReportPage_PageFooterMsg, 0, [0], varEmpty);
    AddGet(TRMGridReportPage, 'DeleteRow', TRMGridReportPage_PageCaptionMsg, 0, [0], varEmpty);

    { TRMGridReport }
    AddClass(cReportMachine, TRMGridReport, 'TRMGridReport');
  end;
end;

initialization
  RMResigerReportPageClass(TRMGridReportPage);

  RM_RegisterRAI2Adapter(GlobalJvInterpreterAdapter);

end.

⌨️ 快捷键说明

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