fr_ptabl.pas

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

  end;
end;

procedure TfrCustomPrintDataSet.ShowReport;
var
  r: TfrCompositeReport;
begin
  r:=TfrCompositeReport.Create(nil);
  try
    BuildReport;
    FDataSet.DisableControls;

    FReport.Pages[0].PrintToPrevPage:=True;

    if Assigned(FReportBefore) then
      r.Reports.Add(FReportBefore);
    r.Reports.Add(FReport);
    if Assigned(FReportAfter) then
      r.Reports.Add(FReportAfter);

    r.ShowReport;
  finally
    r.Free;
    FDataSet.EnableControls;
  end;
end;

procedure TfrCustomPrintDataSet.OnEnterRect(Memo: TStringList; View: TfrView);
begin
// empty method
end;

procedure TfrCustomPrintDataSet.OnPrintColumn_(ColNo: Integer; var Width: Integer);
begin
//--  Width := FWidths[ColNo]; - do not set here. It will be set in descendants
  if Assigned(FOnPrintColumn) then
    FOnPrintColumn(ColNo, Width);
  FWidth := Width;
end;


procedure TfrCustomPrintDataSet.SetFooter(const Value: TfrSectionParams);
begin
  FFooter := Value;
end;

function TfrCustomPrintDataSet.GetColWidths(Index: Integer): word;
begin
  if (Index>=0) and (Index<=High(FWidths)) then
    Result:=FWidths[Index]
  else
    Result:=0;
end;

procedure TfrCustomPrintDataSet.SetColWidths(Index: Integer;
  const Value: word);
begin
  if (Index>=0) and (Index<=High(FWidths)) then
    FWidths[Index]:=Value;
end;

function TfrCustomPrintDataSet.GetColCount: integer;
begin
  Result:=FColumnDataSet.RangeEndCount;
end;

procedure TfrCustomPrintDataSet.SetSummary(
  const Value: TfrAdvSectionParams);
begin
  FSummary := Value;
end;

function TfrCustomPrintDataSet.ColumnIndexByName(AField: string): integer;
var
  i: integer;
  Y: integer;

begin
  Result:=-1;
  Y:=0;

  for i:=0 to FDataSet.FieldCount-1 do
    if FDataSet.Fields[i].Visible then
    begin
{$IFDEF IBO}  // marco menardi patch 06 april 2002
      if AField=FDataSet.Fields[i].FieldName then
{$ELSE}

{$IFDEF Delphi4}
      if AField=FDataSet.Fields[i].FullName then
{$ELSE}
      if AField=FDataSet.Fields[i].{Full}Name then
{$ENDIF}

{$ENDIF}
      begin
        Result := Y;
        Break;
      end;
      inc(Y);
    end;
end;

{$IFDEF IBO}
function TfrCustomPrintDataSet.FieldByColumIndex(AIndex: integer): TIB_Column;
{$ELSE}
function TfrCustomPrintDataSet.FieldByColumIndex(AIndex: integer): TField;
{$ENDIF}
begin
  Result:=FDataSet.Fields[RealColumnIndex(AIndex)];
end;

function TfrCustomPrintDataSet.TextExtentInSection(AText: string;
  ADataSection: TfrDataSection): TSize;
var
  c: TCanvas;
  b: TBitmap;
begin
  b := TBitmap.Create;
  b.Width:=16; b.Height:=16;

  c:=b.Canvas;

  case ADataSection of
    frHeader: c.Font:=FHeader.Font;
    frData: c.Font:=FBody.Font;
    frFooter: c.Font:=FFooter.Font;
    frTitle: c.Font:=FTitle.Font;
    frSummary: c.Font:=FSummary.Font;
    frPageHeader: c.Font:=FPageHeader.Font;
    frPageFooter: c.Font:=FPageFooter.Font;
  else
    c.Font:=FBody.Font; //--- default
  end;
  c.Font.Height := -Round(c.Font.Size * 96 / 72); //--- go to FR coords

  Result.cx:=c.TextWidth(AText);
  Result.cy:=c.TextHeight(AText);

  b.Free;
end;

function TfrCustomPrintDataSet.TryToFitWidth(var Widths: TfrWidthsArray; DataColumns, ADesiredWidth, AThresold: integer; AFields: string; AOptions: TfrShrinkOptions): boolean;
var
  mCols: TfrWidthsArray;
  mColsLen: integer;
  w: integer;
  nDiff: integer;
  i: integer;
  nPos: integer;
  nRep: double;
  nCol: integer;

begin
  Result:=False;
  w:=0;
  for i:=0 to DataColumns-1 do
    w:=w+Widths[i];

  nDiff:=ADesiredWidth - w;

  if (Abs(nDiff) > AThresold) or (nDiff=0) then Exit;

  if (frsoShrinkOnly in AOptions) and (nDiff>0) then Exit;

  //----->>> make the elastic columns
  if AFields='' then //--- we'll put all columns
  begin
    mColsLen:=DataColumns;
    nRep:=ADesiredWidth / w;
    for i:=0 to DataColumns-1 do
      mCols[i]:=i;
  end
  else
  begin
    mColsLen:=0;
    nPos := 1;
    nRep:=0;
    while nPos <= Length(AFields) do
    begin
      nCol:=ColumnIndexByName(ExtractFieldName(AFields, nPos));
      if nCol<>-1 then
      begin
        mCols[mColsLen]:=nCol;
        nRep:=nRep+Widths[mCols[mColsLen]];
        inc(mColsLen);
      end;
    end;

    if (nRep = 0) or (w - ADesiredWidth > nRep) then
    begin
      Result:=False;
      Exit;
    end;

    nRep:=1 + (ADesiredWidth - w)/nRep;
  end;

  if frsoProportional in AOptions then
  begin
    for i:=0 to mColsLen-1 do
      Widths[mCols[i]]:=Trunc(nRep * Widths[mCols[i]])-1;
  end
  else
  begin
    nDiff := nDiff div mColsLen;
    for i:=0 to mColsLen-1 do
      Widths[mCols[i]]:=Widths[mCols[i]] + nDiff - 1;
  end;

  Result:=True;
end;

function TfrCustomPrintDataSet.TextHeightInSection(AText: string;
  ADataSection: TfrDataSection): integer;
begin
  Result:=TextExtentInSection(AText, ADataSection).cY;
end;

function TfrCustomPrintDataSet.TextWidthInSection(AText: string;
  ADataSection: TfrDataSection): integer;
begin
  Result:=TextExtentInSection(AText, ADataSection).cX;
end;

procedure TfrCustomPrintDataSet.SetAggFields(const Value: TStringList);
begin
  FAggFields.Assign(Value);
end;

function TfrCustomPrintDataSet.SuggestedOrientation: TPrinterOrientation;
var
  i: Integer;
  w: Integer;
  Page: TfrPage;

begin
  Result:=Orientation;
  if FAutoOrientation.Enabled and (PageWidth=0) and (PageHeight=0) then
    begin
      FReport.Clear;
      FReport.Pages.Add;
      Page := FReport.Pages[0];

      w:=0;
      for I := 0 to FColumnDataSet.RangeEndCount-1 do
        w:=w+FWidths[i];

      if w<>0 then
      begin
        if (w > Page.RightMargin-Page.LeftMargin) and (Orientation=poPortrait) then
          if (Page.RightMargin-Page.LeftMargin)*100/w > (100 - FAutoOrientation.ResizePercent) then
            Result:=poLandscape;

        if (w < Page.BottomMargin-Page.TopMargin) and (Orientation=poLandscape) then
          if w*100/(Page.RightMargin-Page.LeftMargin) < (100 - FAutoOrientation.ResizePercent) then
            Result:=poPortrait;
      end;
      Freport.Clear;
    end;

end;

{ TfrPrintTable }

constructor TfrPrintTable.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

procedure TfrPrintTable.CreateDS;
var
  i, n: Integer;
  s: String;
  c: TCanvas;
  b: TBitmap;
  CHandle: HDC;
  TextSize: TSize;
  nVisCount: integer;
  nCount: integer;
  cAggType: string;
begin
  if FDataSet = nil then Exit;
  if FAutoWidth or (FAggFields.Count>0) then
  begin
    FDataSet.DisableControls;

    b := TBitmap.Create;
    b.Width:=16; b.Height:=16;

    c := b.Canvas;

    c.Font := FHeader.Font;
    c.Font.Height := -Round(FHeader.Font.Size * 96 / 72); //--- go to FR coords

    FDataSet.First;

    nVisCount:=0;
    for i := 0 to FDataSet.FieldCount - 1 do
    begin
      if FDataSet.Fields[i].Visible then
      begin
        FVisibleFields[nVisCount].Field:=FDataSet.Fields[i];
        FVisibleFields[nVisCount].Value:=0;
        FVisibleFields[nVisCount].AggregateType:=frAggNone;

        cAggType:=UpperCase(FAggFields.Values[FDataSet.Fields[i].FieldName]);
        if cAggType<>'' then
          FHasAggregates:=True;

        if cAggType='SUM' then
          FVisibleFields[nVisCount].AggregateType:=frAggSum
        else
          if cAggType='MIN' then
            FVisibleFields[nVisCount].AggregateType:=frAggMin
          else
            if cAggType='MAX' then
              FVisibleFields[nVisCount].AggregateType:=frAggMax
            else
              if cAggType='COUNT' then
                FVisibleFields[nVisCount].AggregateType:=frAggCount
              else
                if cAggType='AVG' then
                  FVisibleFields[nVisCount].AggregateType:=frAggAvg;

        if (FVisibleFields[nVisCount].AggregateType=frAggMax) or (FVisibleFields[nVisCount].AggregateType=frAggMin) then
          FVisibleFields[nVisCount].Value:=FVisibleFields[nVisCount].Field.AsFloat;
{$IFDEF IBO}    // marco menardi patch 27 april 2002
        FWidths[nVisCount] := Round(FVisibleFields[nVisCount].Field.DisplayWidth / 8 * c.TextWidth('0')) + 8;
{$ELSE}
        FWidths[nVisCount] := c.TextWidth(FVisibleFields[nVisCount].Field.DisplayLabel) + 8;
{$ENDIF}
        inc(nVisCount);
      end;
    end;

    c.Font := FBody.Font;
    c.Font.Height := -Round(FBody.Font.Size * 96 / 72); //--- go to FR coords

    CHandle:=c.Handle;

    nCount:=0;
    while not FDataSet.EOF do
    begin
      for i := 0 to nVisCount-1 do
      begin
        // marco menardi patch 27 april 2002
{$IFDEF IBO}
        if FVisibleFields[i].Field.InheritsFrom(TIB_ColumnBlob) then
{$ELSE}
        if FVisibleFields[i].Field.InheritsFrom(TBLOBField) then
{$ENDIF}
        begin
          s:=Trim(FVisibleFields[i].Field.AsString);
          Windows.GetTextExtentPoint32(CHandle, PChar(s), Length(s), TextSize);
          n:=TextSize.cx+8;
        end
        else
        begin
          s:=Trim(FVisibleFields[i].Field.DisplayText);
          n:=c.TextWidth(s)+8;
        end;
        if n > FWidths[i] then
          FWidths[i]:=n;

        if FHasAggregates then
          case FVisibleFields[i].AggregateType of
            frAggSum:
              FVisibleFields[i].Value:=FVisibleFields[i].Value+FVisibleFields[i].Field.AsFloat;
            frAggAvg:
              FVisibleFields[i].Value:=FVisibleFields[i].Value+FVisibleFields[i].Field.AsFloat;
            frAggMin:
              if FVisibleFields[i].Value<FVisibleFields[i].Field.AsFloat then
                FVisibleFields[i].Value:=FVisibleFields[i].Field.AsFloat;
            frAggMax:
              if FVisibleFields[i].Value>FVisibleFields[i].Field.AsFloat then
                FVisibleFields[i].Value:=FVisibleFields[i].Field.AsFloat;
          end;
      end;

      inc(nCount);
      FDataSet.Next;
    end;

    if FHasAggregates then
    begin
      for i := 0 to nVisCount-1 do
      begin
        case FVisibleFields[i].AggregateType of
          frAggAvg:
            FVisibleFields[i].Value:=FVisibleFields[i].Value / nCount;
          frAggCount:
            FVisibleFields[i].Value:=nCount;
        end;
        if FVisibleFields[i].AggregateType<>frAggNone then
        begin
{$IFDEF IBO}
          if FVisibleFields[i].Field.InheritsFrom(TIB_ColumnNumBase) then
            s:=FormatFloat(TIB_ColumnNumBase(FVisibleFields[i].Field).DisplayFormat, FVisibleFields[i].Value)
{$ELSE}
          if FVisibleFields[i].Field.InheritsFrom(TNumericField) then
            s:=FormatFloat(TNumericField(FVisibleFields[i].Field).DisplayFormat, FVisibleFields[i].Value)
{$ENDIF}
          else
            s:=FloatToStr(FVisibleFields[i].Value);
          // marco menardi patch 27 april 2002
          n:=c.TextWidth(s)+8;
          if n > FWidths[i] then
            FWidths[i]:=n;
        end;
      end;
    end;

    //--- AutoChange page orientation
    Orientation:=SuggestedOrientation;

    b.Free;

    FDataSet.EnableControls;
  end;
end;

procedure TfrPrintTable.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = DataSet) then
    DataSet := nil;