Quickreport TQrShape in TQrChildBand kopieren

[norwegen60]

Hallo zusammen,

ich versuche gerade die Elemente eines TQrBand.rbGroupHeader in ein TQrChildBand zu kopieren. Das funktioniert auch. Nur beim TQrShape kommt es beim Ausdruck zu einer Access-Violation. Der folgende Code wird noch fehlerfrei durchlaufen aber beim nachfolgenden PrintVorgang kracht es dann.

Delphi-Quellcode:

procedure DuplicateChildren(const aSource: TWinControl; aDest: TWinControl; const WithEvents: Boolean = True);
var
  i: Integer;
  lSourceCtrl, lDestCtrl: TControl;
  s1, s2:String;

begin
  aDest.Height := aSource.Height;

  s1:= aSource.ClassName;
  s2:= aDest.ClassName;

  for i := 0 to aSource.ControlCount - 1 do
  begin
    lSourceCtrl := aSource.Controls[i];

    if (lSourceCtrl is TQRShape) then
    begin
      lDestCtrl := TQRShape.Create(lSourceCtrl.Owner);
      lDestCtrl.Top := lSourceCtrl.Top;
      lDestCtrl.Left := lSourceCtrl.Left;
      lDestCtrl.Width := lSourceCtrl.Width;
      lDestCtrl.Height := lSourceCtrl.Height;
      TQRShape(lDestCtrl).Shape := TQRShape(lSourceCtrl).Shape;
      lDestCtrl.Parent := aDest;
      lDestCtrl.Name := lSourceCtrl.Name + '_';
    end
    else
    begin
      lDestCtrl := TControlClass(lSourceCtrl.ClassType).Create(lSourceCtrl.Owner);
      CloneProperties(lSourceCtrl, lDestCtrl);
      lDestCtrl.Parent := aDest;
      lDestCtrl.Name := lSourceCtrl.Name + '_';
    end;
  end;
end;

procedure TrptTest2.qrbaDetail1HeaderBeforePrint(Sender: TQRCustomBand; var PrintBand: Boolean);
begin
  DuplicateChildren(Sender, qrcbHeader);
  qrcHeader.Enabled := True;
end;

Lasse ich die Zuweisung  lDestCtrl.Parent := aDest; weg, funktioniert der Print, aber die Shapes werden natürlich nicht angezeigt.
Ich habe das TQrShape extrahiert um zu sehen, woher der Fehler kommt und eigentlich passiert hier ja nichts besonderes.

Hat jemand eine Idee

[BerndS]

Hallo
möglicher Weise hilft es, wenn bei den Controls QRPrinter vom Report gesetzt wird.
Wir machen das so.
Allerdings haben wir die Quellen gekauft und direkt die Methode function TQRCustomBand.AddPrintable entsprechend angepasst.
Die Controls werden dann direkt mit Band.AddPrintable(...) hinzugefügt.

Hier die Anpassung in der QuickRpt.pas:

Code:

function TQRCustomBand.AddPrintable(PrintableClass : TQRNewComponentClass) : TQRPrintable;
var
...
begin
  ...
  if Assigned(FParentReport) then
     aPrintable.FQRPrinter := FParentReport.QRPrinter;
end;

[norwegen60]

Zitat von BerndS;1458482
Hier die Anpassung in der QuickRpt.pas:
[CODE:

function TQRCustomBand.AddPrintable(PrintableClass : TQRNewComponentClass) : TQRPrintable;
var
...
begin
...
if Assigned(FParentReport) then
aPrintable.FQRPrinter := FParentReport.QRPrinter;
end;
[/CODE]

Danke für den Tip. Jetzt funktioniert es.

Ich habe festgestellt, dass es nichts mit meinem Vorgehen zu tun hat sondern eher ein QuickReport-Bug ist.

Folgender Code läuft einwandfrei, wenn man ihn im FormCreate ausführt.
Führt man ihn dagegen in OnBeforePrint aus, funtioniert es, wenn man den TQrShape Block auskommentiert. Sobald man auch den TQrShape aktiviert, kommt es wieder zur Access-Violation

Delphi-Quellcode:

procedure TrptTest2.qrbaAnalysisBeforePrint(Sender: TQRCustomBand; var PrintBand: Boolean);
var
  lShape: TQRShape;
  lLabel: TQRLabel;

begin
  // Funktioniert immer
  lLabel := TQRLabel.Create(self);
  lLabel.Name := 'QrLabel0001';
  lLabel.top := 5;
  lLabel.left := 10;
  lLabel.Caption := lLabel.Name;
  lLabel.Parent := qrbaAnalysis;

  // Funktioniert im FormCreate, nicht aber im OnBeforePrint
  lShape := TQRShape.Create(self);
  lShape.Name := 'QrShape0001';
  lShape.top := 5;
  lShape.left := 10;
  lShape.width := 300;
  lShape.Height := 30;
  lShape.Parent := qrbaAnalysis;
end;

Dieser Code funktioniert immer, vorausgesetzt man hat in QuickRpt.pas - TQRCustomBand.AddPrintable obige Änderung eingefügt

Delphi-Quellcode:

procedure TrptTest2.qrbaAnalysisBeforePrint(Sender: TQRCustomBand; var PrintBand: Boolean);
var
  lShape: TQRShape;
  lLabel: TQRLabel;

begin
  // Funktioniert immer
  lLabel := TQRLabel(qrbaAnalysis.AddPrintable(TQRLabel));
  lLabel.Name := 'QrLabel0001';
  lLabel.top := 5;
  lLabel.left := 10;
  lLabel.Caption := lLabel.Name;
  lLabel.Parent := qrbaAnalysis;

  // Funktioniert auch immer
  lShape := TQRShape(qrbaAnalysis.AddPrintable(TQRShape));
  lShape.Name := 'QrShape0001';
  lShape.top := 5;
  lShape.left := 10;
  lShape.width := 300;
  lShape.Height := 30;
end;

[norwegen60]

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;