Einzelnen Beitrag anzeigen

norwegen60

Registriert seit: 23. Dez 2007
Ort: Schwarzwald
505 Beiträge
 
Delphi 12 Athens
 
#4

AW: Quickreport TQrShape in TQrChildBand kopieren

  Alt 28. Feb 2020, 13:17
Ziel war es ja, dass die Tabellenüberschriften bei einem Seitenumbruch am Seitenanfang angezeigt werden.
Hier der Code, der den Inhalt des Überschriften-Bands in das Band am Seitenanfang kopiert
Delphi-Quellcode:
procedure CloneProperties(const aSourceCtrl, aDestCtrl: TControl);
// *****************************************************************************************************************************************
// Setzt die Properties von aDestCtrl auf die gleichen Eigenschaften wie die von aSourceCtrl
var
  ms: TMemoryStream;
  OldName: String;
begin
  OldName := aSourceCtrl.Name;
  aSourceCtrl.Name := ''; // needed to avoid Name collision
  try
    ms := TMemoryStream.Create;
    try
      ms.WriteComponent(aSourceCtrl);
      ms.Position := 0;
      ms.ReadComponent(aDestCtrl);
    finally
      ms.Free;
    end;
  finally
    aSourceCtrl.Name := OldName;
  end;
end;

procedure DulicateBand(aSource, aDest: TQRCustomBand);
// *****************************************************************************************************************************************
// Leert das Band aDest, setzt die gleiche Höhe und erzeugt auf aDest die gleichen Components wie auf aSource
// Getestet mit TQrLabel und TQrShape
var
  i: Integer;
  lSourceCtrl, lDestCtrl: TControl;

begin
  // Zunächste Band leeren
  while (aDest.ControlCount > 0) do
    aDest.Controls[0].Free;

  // Gleiche Höhe
  aDest.Height := aSource.Height;

  // Components kopieren
  // ACHTUNG: Es muss AddPrintable verwendet werden da Create und Zuweisung von Parent bei TQrShape zu Access-Violation führt
  // Außerdem muss in QuickRep.Pas - TQRCustomBand.AddPrintable folgender Code am Ende der Procedure eingefügt werden
  // if Assigned(FParentReport) then aPrintable.FQRPrinter := FParentReport.QRPrinter;
  for i := 0 to aSource.ControlCount - 1 do
  begin
    lSourceCtrl := aSource.Controls[i];
    if (lSourceCtrl is TQRLabel) or (lSourceCtrl is TQRShape) then // nur um sicherzustellen, dass nur getestete Komponenten kopiert werden
    begin
      lDestCtrl := aDest.AddPrintable(TQRNewComponentClass(lSourceCtrl.ClassType)) as TQRNewComponentClass(lSourceCtrl.ClassType);
      CloneProperties(lSourceCtrl, lDestCtrl);
      lDestCtrl.Name := lSourceCtrl.Name + '_';
    end;
  end;
end;
Voraussetzung ist, dass an TQrBand.rbPageHeader ein TQrChildBand angehängt ist.
Am eigemtlichen Datenband hängt noch ein GroupFooter, der das TqrChildBand wieder deaktiviert sobald die Tabelle gedruckt ist

Und der Aufruf
Delphi-Quellcode:
procedure TrptTest2.qrbaTabelle1HeaderBeforePrint(Sender: TQRCustomBand; var PrintBand: Boolean);
begin
  qrcbHeader.Enabled := True;
  DulicateBand(Sender, qrcbHeader);
end;

procedure TrptTest2.qrbaTabell1FooterBeforePrint(Sender: TQRCustomBand; var PrintBand: Boolean);
begin
  qrcbHeader.Enabled := false;
end;

Geändert von norwegen60 (28. Feb 2020 um 14:32 Uhr)
  Mit Zitat antworten Zitat