fr_ptabl.pas

FASTREPORT报表工具,可以迅速制作报表.

begin
  Result := 0;
  if FAlign = taLeftJustify then
    Result := frtaLeft
  else if FAlign = taRightJustify then
    Result := frtaRight
  else if FAlign = taCenter then
    Result := frtaCenter
end;

{ TfrFitWidth }

procedure TfrFitWidth.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  FEnabled := TfrFitWidth(Source).Enabled;
  FFields := TfrFitWidth(Source).Fields;
  FShrinkOptions := TfrFitWidth(Source).ShrinkOptions;
  FResizePercent := TfrFitWidth(Source).ResizePercent;
  FApplyBeforeOnCustomize := TfrFitWidth(Source).ApplyBeforeOnCustomize;
end;

constructor TfrFitWidth.Create;
begin
  FEnabled:=False;
  FFields:='';
  FShrinkOptions:=[frsoProportional, frsoShrinkOnly];
  FResizePercent:=30;
  FApplyBeforeOnCustomize:=False;
end;

procedure TfrFitWidth.SetApplyBeforeOnCustomize(const Value: boolean);
begin
  FApplyBeforeOnCustomize := Value;
end;

procedure TfrFitWidth.SetEnabled(const Value: Boolean);
begin
  FEnabled := Value;
end;

procedure TfrFitWidth.SetFields(const Value: string);
begin
  FFields := Value;
end;

procedure TfrFitWidth.SetResizePercent(const Value: integer);
begin
  if (Value<1) or (Value>100) then
    ShowMessage('The percent must be between 1 and 100')
  else
    FResizePercent := Value;
end;

{ TfrPageMargins }

constructor TfrPageMargins.Create;
begin
  inherited Create;
  FLeft   := 0;
  FTop    := 0;
  FRight  := 0;
  FBottom := 0;
end;

procedure TfrPageMargins.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  FLeft   := TfrPageMargins(Source).Left;
  FTop    := TfrPageMargins(Source).Top;
  FRight  := TfrPageMargins(Source).Right;
  FBottom := TfrPageMargins(Source).Bottom;
end;


{ TfrCustomPrintDataSet }

constructor TfrCustomPrintDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPageMargins := TfrPageMargins.Create;
  FpgSize := 9;
  FTitle := TfrAdvSectionParams.Create;
  FTitle.Font.Style := [fsBold];
  FTitle.Font.Size := 12;

  FPageHeader := TfrAdvSectionParams.Create;

  FPageFooter := TfrAdvSectionParams.Create;

  FSummary := TfrAdvSectionParams.Create;
  FSummary.Font.Style := [fsItalic];
  FSummary.Font.Size := 12;

  FHeader := TfrSectionParams.Create;
  FHeader.Font.Style := [fsBold];
  FHeader.Font.Color := clWhite;
  FHeader.Color := clNavy;

  FFooter := TfrSectionParams.Create;
  FFooter.Font.Style := [fsItalic];
  FFooter.Color := clSilver;


  FBody := TfrSectionParams.Create;
  FReport := TfrReport.Create(Self);
  FReport.PreviewButtons := [pbZoom, pbSave, pbPrint, pbFind, pbHelp, pbExit, pbPageSetup];

  FReportDataSet := TfrDBDataSet.Create(Self);
  FReportDataSet.Name := 'frGridDBDataSet1';

  FColumnDataSet := TfrUserDataSet.Create(Self);
  FColumnDataSet.Name := 'frGridUserDataSet1';
  FColumnDataSet.RangeEnd := reCount;

  FPrintOptions:=[frpoHeader, frpoHeaderOnEveryPage];

  FAutoWidth := True;
  FFitWidth := TfrFitWidth.Create;
  FAutoOrientation := TfrAutoOrientation.Create;

  FAggFields := TStringList.Create;
end;

destructor TfrCustomPrintDataSet.Destroy;
begin
  FAutoOrientation.Free;
  FFitWidth.Free;
  FReportDataSet.Free;
  FColumnDataSet.Free;
  FReport.Free;
  FTitle.Free;
  FPageHeader.Free;
  FPageFooter.Free;
  FSummary.Free;
  FHeader.Free;
  FFooter.Free;
  FBody.Free;
  FPageMargins.Free;
  FAggFields.Free;
  inherited Destroy;
end;

procedure TfrCustomPrintDataSet.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FPreview) then
    FPreview := nil;
  if (Operation = opRemove) and (AComponent = FReportBefore) then
    FReportBefore := nil;
  if (Operation = opRemove) and (AComponent = FReportAfter) then
    FReportAfter := nil;
end;

function TfrCustomPrintDataSet.RealColumnIndex(Index: Integer): Integer;
var
  Y, I: Integer;
begin
  Result := 0;
  Y := -1;
  for I := 0 to FDataSet.FieldCount - 1 do
    if FDataSet.Fields[I].Visible then
    begin
      Inc(Y);
      if Y = Index then
      begin
        Result := I;
        break;
      end;
    end;
end;

procedure TfrCustomPrintDataSet.SetPageMargins(Value: TfrPageMargins);
begin
  FPageMargins.Assign(Value);
end;

procedure TfrCustomPrintDataSet.SetTitle(Value: TfrAdvSectionParams);
begin
  FTitle.Assign(Value);
end;

procedure TfrCustomPrintDataSet.SetPageHeader(Value: TfrAdvSectionParams);
begin
  FPageHeader.Assign(Value);
end;

procedure TfrCustomPrintDataSet.SetPageFooter(Value: TfrAdvSectionParams);
begin
  FPageFooter.Assign(Value);
end;

procedure TfrCustomPrintDataSet.SetHeader(Value: TfrSectionParams);
begin
  FHeader.Assign(Value);
end;

procedure TfrCustomPrintDataSet.SetBody(Value: TfrSectionParams);
begin
  FBody.Assign(Value);
end;

procedure TfrCustomPrintDataSet.CreateDS;
begin
end;

function TfrCustomPrintDataSet.GetFieldCount: Integer;
var
  i: Integer;
  b: Boolean;
begin
  Result := FDataSet.FieldCount;
  b := True;
  for i := 0 to FDataSet.FieldCount - 1 do
    if (FDataSet.Fields[i] <> nil) and FDataSet.Fields[i].Visible then
    begin
      if b then
      begin
        b := False;
        Result := 0;
      end;
      Inc(Result);
    end;
end;

procedure TfrCustomPrintDataSet.BuildReport;
var
  v: TfrView;
  b: TfrBandView;
  Page: TfrPage;
  LeftMargin: Integer;
begin
  CreateDS;

  if FDataSet = nil then Exit;

  FReport.OnBeforePrint := OnEnterRect;
  FReport.OnPrintColumn := OnPrintColumn_;
  FReport.Preview := FPreview;
  FReport.OnBeginDoc := FOnBeginDoc;
  FReport.OnEndDoc := FOnEndDoc;
  FReport.OnBeginPage := FOnBeginPage;
  FReport.OnEndPage := FOnEndPage;

  FReportDataSet.DataSet := FDataSet;
  FColumnDataSet.RangeEndCount := GetFieldCount;

  FReportDataSet.OnCheckEOF:=FOnCheckEOF;
  FReportDataSet.OnFirst:=FOnFirst;
  FReportDataSet.OnNext:=FOnNext;
  FReportDataSet.OnPrior:=FOnPrior;

  FReport.Clear;
  FReport.Pages.Add;
  Page := FReport.Pages[0];
  with Page do
  begin
    pgMargins.Left   := Round(FPageMargins.Left   * 18 / 5);
    pgMargins.Top    := Round(FPageMargins.Top    * 18 / 5);
    pgMargins.Right  := Round(FPageMargins.Right  * 18 / 5);
    pgMargins.Bottom := Round(FPageMargins.Bottom * 18 / 5);
    ChangePaper(FpgSize, FpgWidth * 10, FpgHeight * 10, -1, FOrientation);
  end;

  LeftMargin := Page.PrnInfo.Ofx;
  if Page.pgMargins.Left <> 0 then
    LeftMargin := Page.pgMargins.Left;

  with FFitWidth do
    if Enabled and ApplyBeforeOnCustomize then
      TryToFitWidth(FWidths, FColumnDataSet.RangeEndCount, Page.RightMargin-Page.LeftMargin,
        Trunc((Page.RightMargin-Page.LeftMargin)/(ResizePercent / 100)), Fields, ShrinkOptions);

  if Assigned(FCustomizeWidths) then FCustomizeWidths(FWidths, FColumnDataSet.RangeEndCount, Page.RightMargin-Page.LeftMargin);

  with FFitWidth do
    if Enabled and not ApplyBeforeOnCustomize then
      TryToFitWidth(FWidths, FColumnDataSet.RangeEndCount, Page.RightMargin-Page.LeftMargin,
        Trunc((Page.RightMargin-Page.LeftMargin)/(ResizePercent / 100)), Fields, ShrinkOptions);

// Title
  if FTitle.Text <> '' then
  begin
    b := TfrBandView(frCreateObject(gtBand, ''));
    b.SetBounds(0, 20, 1000, 30);
    b.Flags := b.Flags or flStretched;
    b.BandType := btReportTitle;
    Page.Objects.Add(b);
    v := frCreateObject(gtMemo, '');
    v.SetBounds(0, 20, 20, 20);
    v.BandAlign := baWidth;
    TfrMemoView(v).Alignment:= FTitle.GetAlign + frtaMiddle;
    TfrMemoView(v).Font := FTitle.Font;
    v.FrameTyp := FTitle.GetFrameTyp;
    v.FrameWidth := FTitle.FrameWidth;
    v.FillColor := FTitle.Color;
    v.Memo.Add(FTitle.Text);
    Page.Objects.Add(v);
  end;

// Summary
  if FSummary.Text <> '' then
  begin
    b := TfrBandView(frCreateObject(gtBand, ''));
    b.SetBounds(0, 20, 1000, 30);
    b.Flags := b.Flags or flStretched;
    b.BandType := btReportSummary;
    Page.Objects.Add(b);
    v := frCreateObject(gtMemo, '');
    v.SetBounds(0, 20, 20, 20);
    v.BandAlign := baWidth;
    TfrMemoView(v).Alignment:= FSummary.GetAlign + frtaMiddle;
    TfrMemoView(v).Font := FSummary.Font;
    v.FrameTyp := FSummary.GetFrameTyp;
    v.FrameWidth := FSummary.FrameWidth;
    v.FillColor := FSummary.Color;
    v.Memo.Add(FSummary.Text);
    Page.Objects.Add(v);
  end;

// Header
  if frpoHeader in FPrintOptions then
  begin
    b := TfrBandView(frCreateObject(gtBand, ''));
    b.BandType := btMasterHeader;
    b.SetBounds(0, 60, 1000, 30);
    b.Flags := b.Flags or flStretched;
    if frpoHeaderOnEveryPage in FPrintOptions then
      b.Flags := b.Flags or flBandRepeatHeader;
    Page.Objects.Add(b);

    v := frCreateObject(gtMemo, '');
    v.SetBounds(LeftMargin, 60, 20, 30);
    TfrMemoView(v).Alignment := frtaCenter + frtaMiddle;
    TfrMemoView(v).Font := FHeader.Font;
    v.FillColor := FHeader.Color;
    v.FrameTyp := FHeader.GetFrameTyp;
    v.FrameWidth := FHeader.FrameWidth;
    v.Flags := v.Flags or flWordWrap or flStretched;
    v.Memo.Add('[Header]');
    Page.Objects.Add(v);
  end;

// Body
  b := TfrBandView(frCreateObject(gtBand, ''));
  b.BandType := btMasterData;
  b.Dataset := FReportDataSet.Name;
  b.SetBounds(0, 100, 1000, 18);
  b.Flags := b.Flags or flStretched;
  Page.Objects.Add(b);

  b := TfrBandView(frCreateObject(gtBand, ''));
  b.BandType := btCrossData;
  b.Dataset := FColumnDataSet.Name;
  b.SetBounds(LeftMargin, 0, 20, 1000);
  Page.Objects.Add(b);

  v := frCreateObject(gtMemo, '');
  v.SetBounds(LeftMargin, 100, 20, 18);
  TfrMemoView(v).Font := FBody.Font;
  v.FillColor := FBody.Color;
  v.FrameTyp := FBody.GetFrameTyp;
  v.FrameWidth := FBody.FrameWidth;
  TfrMemoView(v).GapX := 3;
  v.Flags := v.Flags or flWordWrap or flStretched;
  v.Memo.Add('[Cell]');
  Page.Objects.Add(v);


// Footer
  if frpoFooter in FPrintOptions then
  begin
    b:=TfrBandView(frCreateObject(gtBand, ''));
    b.BandType := btMasterFooter;
    b.SetBounds(0, 140, 1000, 30);
    Page.Objects.Add(b);

    v := frCreateObject(gtMemo, '');
    v.SetBounds(LeftMargin, 140, 20, 30);
    TfrMemoView(v).Alignment := frtaCenter + frtaMiddle;
    TfrMemoView(v).Font := FFooter.Font;
    v.FillColor := FFooter.Color;
    v.FrameTyp := FFooter.GetFrameTyp;
    v.FrameWidth := FFooter.FrameWidth;
    v.Flags := v.Flags or flWordWrap or flStretched;
    v.Memo.Add('[Footer]');
    Page.Objects.Add(v);
  end;

// Page header
  if FPageHeader.Text <> '' then
  begin
    b := TfrBandView(frCreateObject(gtBand, ''));
    b.BandType := btPageHeader;
    b.SetBounds(0, 160, 1000, 30);
    Page.Objects.Add(b);

    v := frCreateObject(gtMemo, '');
    v.SetBounds(0, 160, 20, 20);
    v.BandAlign := baWidth;
    TfrMemoView(v).Alignment := FPageHeader.GetAlign;
    TfrMemoView(v).Font := FPageHeader.Font;
    v.FillColor := FPageHeader.Color;
    v.FrameTyp := FPageHeader.GetFrameTyp;
    v.FrameWidth := FPageHeader.FrameWidth;
    v.Memo.Add(FPageHeader.Text);
    Page.Objects.Add(v);
  end;

// Page footer
  if FPageFooter.Text <> '' then
  begin
    b := TfrBandView(frCreateObject(gtBand, ''));
    b.BandType := btPageFooter;
    b.SetBounds(0, 260, 1000, 30);
    Page.Objects.Add(b);

    v := frCreateObject(gtMemo, '');
    v.SetBounds(0, 270, 20, 20);
    v.BandAlign := baWidth;
    TfrMemoView(v).Alignment := FPageFooter.GetAlign;
    TfrMemoView(v).Font := FPageFooter.Font;
    v.FillColor := FPageFooter.Color;
    v.FrameTyp := FPageFooter.GetFrameTyp;
    v.FrameWidth := FPageFooter.FrameWidth;
    v.Memo.Add(FPageFooter.Text);
    Page.Objects.Add(v);