quickrpt.pas

delphi7报表打印控件源码 可以设计报表

begin
  NotifyList.Add(Value);
end;

procedure TQRCustomController.NotifyClients(Operation : TQRNotifyOperation);
var
  I : integer;
begin
  for I := 0 to NotifyList.Count - 1 do
    TQRPrintable(NotifyList[I]).QRNotification(Self, Operation);
end;


{ TQRController }

procedure TQRController.RegisterBands;
var
  I : integer;
begin
  inherited RegisterBands;
  if assigned(FHeader) then ParentReport.RegisterBand(Header);
  for I := 0 to GroupList.Count - 1 do
    ParentReport.RegisterBand(TQRGroup(GroupList[I]));
  for I := 0 to PrintBeforeList.Count - 1 do
    TQRController(PrintBeforeList[I]).RegisterBands;
  if assigned(FDetail) then ParentReport.RegisterBand(Detail);
  for I := 0 to PrintAfterList.Count - 1 do
    TQRController(PrintAfterList[I]).RegisterBands;
  for I := GroupList.Count - 1 downto 0 do
    if TQRGroup(GroupList[I]).FooterBand <> nil then
      ParentReport.RegisterBand(TQRGroup(GroupList[I]).FooterBand);
  if assigned(FFooter) then ParentReport.RegisterBand(Footer);
end;

procedure TQRController.RegisterDatasets;
begin
  if DataSetOK(FDataSet) and (ParentReport.AllDataSets <> nil) then
    ParentReport.AllDataSets.Add(DataSet);
end;

procedure TQRController.Notification(AComponent : TComponent; Operation : TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
  begin
    if AComponent = Header then
      Header := nil;
    if AComponent = Detail then
      Detail := nil;
    if AComponent = Footer then
      Footer := nil;
    if AComponent = DataSet then
      DataSet := nil;
    if AComponent = Master then
      Master := nil;
  end
end;

procedure TQRController.PrintEmptyController;
begin
  if assigned(FHeader) then
  begin
    ParentReport.PrintBand(FHeader);
  end;
  PrintBeforeControllers;
  if assigned(FDetail) then
  begin
    ParentReport.PrintBand(FDetail);
  end;
  PrintAfterControllers;
  if assigned(FFooter) then
  begin
    ParentReport.PrintBand(FFooter);
  end;
end;

procedure TQRController.Prepare;
var
  I : integer;
begin
  inherited Prepare;
  UpdateSQLParams := false;
  if (Dataset <> nil) and (Dataset is TQuery) and (TQuery(Dataset).ParamCount > 0) then
  begin
    for I := 0 to TQuery(Dataset).ParamCount - 1 do
      UpdateSQLParams := UpdateSQLParams or
        (ParentReport.Functions.IndexOf(AnsiUpperCase(TQuery(Dataset).Params.Items[I].Name)) >= 0);
  end;
end;


procedure TQRController.Execute;
var
  MoreData : boolean;
  RecCount : integer;
  DSOK : boolean;
  I : integer;
begin
  RecCount := 1;
  for I := 0 to GroupList.Count - 1 do
    TQRGroup(GroupList[I]).HasResult := False ;
  if (DataSetOK(FDataSet) or assigned(FOnNeedDataEvent)) and
  assigned(FParentReport) then
  begin
    MoreData := true;
    DSOK := DataSetOK(FDataSet);
    if DSOK then
    begin
      if UpdateSQLParams then
        PerformSQLParamsUpdate(TQuery(Dataset), ParentReport.Functions);
      FDataSet.First;
      MoreData := not FDataSet.Eof;
        if ParentReport is TQuickRep then RecCount := TQuickRep(ParentReport).GetRecordCount;
      if (not Moredata) and PrintIfEmpty then
        PrintEmptyController;
    end else
    begin
      if assigned(FOnNeedDataEvent) and not (csDesigning in ComponentState) then
        OnNeedData(SelfCheck, MoreData);
    end;
    FDetailNumber := 0;
    if FDetail <> nil then
      FDetail.NotifyController := Self;
    if MoreData then
    begin
      Application.ProcessMessages;
      if Parentreport.Cancelled then exit;
      if assigned(FHeader) then
      begin
        ParentReport.PrintBand(FHeader);
        if (SelfCheck is TCustomQuickRep) then
          ParentReport.NoForceNewPage := true;
      end;
      if ((ParentReport.PageNumber <= 1) or GlobalCompositeFlag ) and
         (SelfCheck is TCustomQuickRep) then
      begin
         if (ParentReport.Bands.ColumnHeaderBand <> nil) and
            (ParentReport.Bands.ColumnHeaderBand.Enabled) then
         begin
           ParentReport.PrintBand(ParentReport.Bands.ColumnHeaderBand);
           ParentReport.NoForceNewPage := true;
         end;
      end;
      CheckGroups;
      while MoreData do
      begin
        Application.ProcessMessages;
        if ParentReport.QRPrinter.Cancelled then
          Exit;
        if ParentReport.PreparingDesignTime and (ParentReport.FPageCount > 1) then Exit;
        inc(FDetailNumber);
        PrintGroupHeaders;
        PrintBeforeControllers;
        ParentReport.PrintBand(FDetail);
        PrintAfterControllers;
        if DSOK then
        begin
          DataSet.Next;
          MoreData := not FDataSet.Eof
        end else
        begin
          MoreData := false;
          if assigned(FOnNeedDataEvent) and not (csDesigning in ComponentState) then
            OnNeedData(SelfCheck, MoreData);
        end;
        if CheckGroups then
          begin
            if DSOK then
              DataSet.Prior;
            PrintGroupFooters;
            if DSOK then
              DataSet.Next;
        end;
        if ParentReport is TQuickRep and
          DSOK and  (TQuickRep(ParentReport).DataSet = DataSet) and (RecCount <> 0) then
            ParentReport.QRPrinter.Progress := (Longint(DetailNumber) * 100) div RecCount;
      end;
      CheckLastGroupFooters;
      PrintGroupFooters;
      if assigned(FFooter) then // this the summary band
      begin
        if (SelfCheck is TCustomQuickRep) and FFooter.AlignToBottom then;
                                      // ParentReport.FPageFooterSize := 0;
        if (FFooter <> nil) and (ParentReport.PageNumber = 0) then
               ParentReport.NewPage;
        // will the summary band fit ? PrintBand only checks for space
        // if AlignToBottom is true.
        if ParentReport.AvailableSpace < FFooter.Size.Height then
                ParentReport.NewColumn;
        ParentReport.PrintBand(FFooter);
      end;
    end;
  end
  else
    if PrintIfEmpty then
      PrintEmptyController;
end;

procedure TQRController.SetDataSet(Value : TDataSet);
begin
  FDataSet := Value;
  if Value <> nil then
    FDataSet.FreeNotification(self);
end;

{ TQRGroup }

constructor TQRGroup.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Evaluator := TQREvaluator.Create;
  BandType := rbGroupHeader;
  InGroup := false;
end;

destructor TQRGroup.Destroy;
begin
  Evaluator.Free;
  inherited Destroy;
end;

procedure TQRGroup.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
  begin
    if AComponent = FFooterBand then
      FFooterBand := nil;
    if AComponent = FMaster then
      FMaster := nil;
  end
end;

procedure TQRGroup.SetExpression(Value : string);
begin
  FExpression := Value;
end;

procedure TQRGroup.PrintGroupHeader;
begin
  ParentReport.PrintBand(Self);
  InGroup := true;
  PrintPageNumber := ParentReport.PageNumber;
end;

procedure TQRGroup.PrintGroupFooter;
begin
  if FooterBand <> nil then
  begin
    ParentReport.PrintBand(FooterBand);
  end;
  InGroup := false;
end;

procedure TQRGroup.NewPageCheck;
begin
  if ReprintOnNewPage and InGroup and (PrintPageNumber <> ParentReport.PageNumber) then
  begin
    Reprint := true;
    PrintPageNumber := ParentReport.PageNumber;
  end else
    Reprint := false;
end;

procedure TQRGroup.Check;
var
  aValue : TQREvResult;
begin
  Reprint := false;
  if not HasResult then
  begin
    GroupValue := Evaluator.Value;
    Reprint := true;
    HasResult := true;
  end else
  begin
    aValue := Evaluator.Value;
    if aValue.Kind <> GroupValue.Kind then
      Reprint := true
    else
    begin
      case aValue.Kind of
        resString : Reprint := aValue.StrResult <> GroupValue.StrResult;
        resInt : Reprint := aValue.IntResult <> GroupValue.IntResult;
        resDouble : Reprint := aValue.dblResult <> GroupValue.dblResult;
        resBool : Reprint := aValue.booResult <> GroupValue.booResult;
      end
    end;
    if Reprint then GroupValue := aValue;
  end;
end;

procedure TQRGroup.SetFooterBand(Value : TQRBand);
begin
  FFooterBand := Value;
  if FFooterBand <> nil then
  begin
    FFooterBand.BandType := rbGroupFooter;
    FFooterBand.FreeNotification(self);
  end;
end;

procedure TQRGroup.SetMaster(Value : TComponent);
begin
  if (Value is TQRControllerBand) or
     (Value is TCustomQuickRep) then
  begin
    FMaster := Value;
    ParentReport.RebuildBandList;
    ParentReport.SetBandValues;
    FMaster.FreeNotification(self);
  end;
end;

procedure TQRGroup.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if (Master = nil) and (AParent is TCustomQuickRep) then
    Master := AParent;
end;

procedure TQRGroup.Prepare;
begin
  Evaluator.DataSets := ParentReport.AllDataSets;
  Evaluator.Environment := ParentReport.Functions;
  Evaluator.Prepare(Expression);
  HasResult := false;
  PrintPageNumber := 1;
end;

procedure TQRGroup.Unprepare;
begin
  Evaluator.Unprepare;
end;

{ TQRFrame }

constructor TQRFrame.Create;
begin
  FWidth := 1;
  FTop := false;
  FBottom := false;
  FLeft := false;
  FRight := false;
  FPenStyle := psSolid;
end;

procedure TQRFrame.PaintIt(ACanvas : TCanvas; ARect : TRect; XFact, YFact : extended);
var
  FWX, FWY : integer;
  // frames export
  framebit : TQRShape;
  parentrep : TCustomquickrep;
  parentband : TQRCustomband;
  parentcontrol : TQRPrintable;
  fbackcolor : TColor;
  PaintBackground : boolean;
begin
  FWX := round(XFact / 72 * 254 * FWidth);
  if ((FWX < 1) and (FWidth >= 1)) or (FWidth = -1) then
    FWX := 1;
  FWY := round(YFact / 72 * 254 * FWidth);
  if ((FWY < 1) and (FWidth >= 1)) or (FWidth = -1) then
    FWY := 1;
  ACanvas.Brus