fr_ptabl.pas

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

end;

procedure TfrPrintTable.OnEnterRect(Memo: TStringList; View: TfrView);
var
{$IFDEF IBO}
  f: TIB_Column;
{$ELSE}
  f: TField;
{$ENDIF}
  s: TfrDataSection;

begin
  s:=frOther;

  if Memo[0] = '[Cell]' then
  begin
    f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)];

{$IFDEF IBO}
    if f.InheritsFrom(TIB_ColumnBlob) then
{$ELSE}
    if f.InheritsFrom(TBLOBField) then
{$ENDIF}
      Memo[0] := Trim(f.AsString)
    else
      Memo[0] := Trim(f.DisplayText);

    s:=frData;

    View.dx := FWidth;
    case f.Alignment of
      taLeftJustify : TfrMemoView(View).Alignment := frtaLeft;
      taRightJustify: TfrMemoView(View).Alignment := frtaRight;
      taCenter      : TfrMemoView(View).Alignment := frtaCenter;
    end;
  end;
  if Memo[0] = '[Header]' then
  begin
    f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)];
    Memo[0] := f.DisplayLabel;
    s:=frHeader;

    View.dx := FWidth;
  end;

  if Memo[0] = '[Footer]' then
  begin
    Memo[0] := '';
    if FVisibleFields[FColumnDataSet.RecNo].AggregateType<>frAggNone then
{$IFDEF IBO}
      Memo[0]:=FormatFloat(TIB_ColumnNumBase(FVisibleFields[FColumnDataSet.RecNo].Field).DisplayFormat, FVisibleFields[FColumnDataSet.RecNo].Value);
{$ELSE}
      Memo[0]:=FormatFloat(TNumericField(FVisibleFields[FColumnDataSet.RecNo].Field).DisplayFormat, FVisibleFields[FColumnDataSet.RecNo].Value);
{$ENDIF}
    s:=frFooter;
    View.dx := FWidth;
  end;
  if Assigned(FOnPrintData) then
    FOnPrintData(FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)], Memo, View, s);
end;

procedure TfrPrintTable.OnPrintColumn_(ColNo: Integer; var Width: Integer);
var
  c: TCanvas;
  n, n1: Integer;
begin
  if FAutoWidth then
//    Width := FWidths[RealColumnIndex(ColNo - 1)]
    Width :=FWidths[ColNo-1]
  else
  begin
    c := TCanvas.Create;
    c.Handle := GetDC(0);
    c.Font := FBody.Font;
    n := FDataSet.Fields[RealColumnIndex(ColNo - 1)].DisplayWidth;
    n1 := Length(FDataSet.Fields[RealColumnIndex(ColNo - 1)].DisplayLabel);
    if n1 > n then
      n := n1;
    Width := c.TextWidth('0') * n + 8;
    c.Free;
  end;
  FWidth := Width;
  inherited OnPrintColumn_(ColNo, Width);
end;


{ TfrPrintGrid }

{$IFDEF IBO}
type
  THackDBGrid = class(TIB_Grid)
  end;
{$ELSE}
type
  THackDBGrid = class(TDBGrid)
  end;
{$ENDIF}


procedure TfrPrintGrid.CreateDS;
var
  i, n: Integer;
  s: String;
  c: TCanvas;
  b: TBitmap;
  CHandle: HDC;
  TextSize: TSize;
  nVisCount: integer;
  nCount: integer;
  cAggType: string;
{$IFDEF IBO}
  f: TIB_Column;
{$ELSE}
  f: TField;
{$ENDIF}
begin
  if (FDBGrid = nil) or (DBGrid.DataSource = nil) or
     (DBGrid.DataSource.Dataset = nil) then Exit;
  FDataSet := DBGrid.DataSource.Dataset;

  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;

{$IFDEF IBO}
    for i := 0 to DBGrid.GridFieldCount - 1 do
    begin
      f := DBGrid.GridFields[i];
{$ELSE}
    for i := 0 to DBGrid.Columns.Count - 1 do
    begin
      f := DBGrid.Fields[i];
{$ENDIF}
      if f.Visible then
      begin
        FVisibleFields[nVisCount].Field:=f;
        FVisibleFields[nVisCount].Value:=0;
        FVisibleFields[nVisCount].AggregateType:=frAggNone;

        cAggType:=UpperCase(FAggFields.Values[f.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 TfrPrintGrid.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = DBGrid) then
    DBGrid := nil;
end;

function TfrPrintGrid.GetFieldCount: Integer;
var
  i: Integer;
begin
{$IFDEF IBO}
  if DBGrid.GridFieldCount = 0 then
    Result := inherited GetFieldCount
  else
  begin
    Result := 0; // marco menardi 28/04/02
    for i := 0 to DBGrid.GridFieldCount - 1 do
      if THackDBGrid(DBGrid).ColWidths[i] > 0 then
        Inc(Result);
  end;
{$ELSE}
  if DBGrid.Columns.Count = 0 then
    Result := inherited GetFieldCount
  else
  begin
    Result := 0;
    for i := 0 to DBGrid.Columns.Count - 1 do
      if DBGrid.Columns[i].Width > 0 then
        Inc(Result);
  end;
{$ENDIF}
end;

function TfrPrintGrid.RealGridIndex(Index: Integer): Integer;
var
  Y, I: Integer;
begin
  Result := 0;
  Y := -1;
{$IFDEF IBO}
  for I := 0 to DBGrid.GridFieldCount - 1 do
    if THackDBGrid(DBGrid).ColWidths[i] > 0 then
{$ELSE}
  for I := 0 to DBGrid.Columns.Count - 1 do
    if DBGrid.Columns[i].Width > 0 then
{$ENDIF}
    begin
      Inc(Y);
      if Y = Index then
      begin
        Result := I;
        break;
      end;
    end;
end;

procedure TfrPrintGrid.OnEnterRect(Memo: TStringList; View: TfrView);
var
{$IFDEF IBO}
  f: TIB_Column;
{$ELSE}
  f: TField;
{$ENDIF}
begin
  if Memo[0] = '[Cell]' then
  begin
{$IFDEF IBO}
    if DBGrid.GridFieldCount = 0 then
      f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)] else
      f := DBGrid.GridFields[RealGridIndex(FColumnDataSet.RecNo)];
{$ELSE}
    if DBGrid.Columns.Count = 0 then
      f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)] else
      f := DBGrid.Columns[RealGridIndex(FColumnDataSet.RecNo)].Field;
{$ENDIF}
    if Assigned(f.OnGetText) then
      Memo[0] := f.DisplayText else
      Memo[0] := f.AsString;
    View.dx := FWidth;
    case f.Alignment of
      taLeftJustify : TfrMemoView(View).Alignment := frtaLeft;
      taRightJustify: TfrMemoView(View).Alignment := frtaRight;
      taCenter      : TfrMemoView(View).Alignment := frtaCenter;
    end;
  end;
  if Memo[0] = '[Header]' then
  begin
{$IFDEF IBO}
    if DBGrid.GridFieldCount = 0 then
{$ELSE}
    if DBGrid.Columns.Count = 0 then
{$ENDIF}
    begin
      f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)];
      Memo[0] := f.DisplayLabel;
    end
    else
{$IFDEF IBO}
      Memo[0] := DBGrid.GridFields[RealGridIndex(FColumnDataSet.RecNo)].GridDisplayLabel;
{$ELSE}
      Memo[0] := DBGrid.Columns[RealGridIndex(FColumnDataSet.RecNo)].Title.Caption;
{$ENDIF}
    View.dx := FWidth;
  end;
end;

procedure TfrPrintGrid.OnPrintColumn_(ColNo: Integer; var Width: Integer);
var
  d: Integer;
begin
  if FAutoWidth then
    Width :=FWidths[ColNo-1]
  else
  begin
{$IFDEF IBO}
    if DBGrid.IndicateRow then
{$ELSE}
    if dgIndicator in DBGrid.Options then
{$ENDIF}
      d := 1 else
      d := 0;
{$IFDEF IBO}
    Width := THackDBGrid(DBGrid).ColWidths[RealGridIndex(ColNo - 1) + d];
{$ELSE}
    Width := THackDBGrid(DBGrid).ColWidths[RealGridIndex(ColNo - 1) + d];
{$ENDIF}
  end;
  inherited OnPrintColumn_(ColNo, Width);
end;

{ TfrAutoOrientation }

procedure TfrAutoOrientation.Assign(Source: TPersistent);
begin
  inherited;
  ResizePercent:=TfrAutoOrientation(Source).ResizePercent;
  Enabled:=TfrAutoOrientation(Source).Enabled;
end;

constructor TfrAutoOrientation.Create;
begin
  FEnabled := True;
  ResizePercent := 20;
end;

procedure TfrAutoOrientation.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;

end.