fr_ptabl.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

  if FDataSet = nil then Exit;

  FReport.OnBeforePrint := OnEnterRect;
  FReport.OnPrintColumn := OnPrintColumn_;
  FReport.Preview := FPreview;

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

  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(Integer(FpgSize), FpgWidth * 10, FpgHeight * 10, -1, FOrientation);
  end;

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

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

// 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);
  end;
end;

procedure TfrCustomPrintDataSet.ShowReport;
begin
  try
    BuildReport;
    FDataSet.DisableControls;
    FReport.ShowReport;
  finally
    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;

{ TfrPrintTable }

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

procedure TfrPrintTable.CreateDS;
var
  i, n: Integer;
  s: String;
  b: TBitmap;
  c: TCanvas;
{$IFDEF IBO}
  f: TIB_Column;
{$ELSE}
  f: TField;
{$ENDIF}

begin
  if FDataSet = nil then Exit;
  if FAutoWidth then
  begin
    FDataSet.DisableControls;

    b := TBitmap.Create;
    c := b.Canvas;

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

    for i := 0 to FDataSet.FieldCount - 1 do
      FWidths[i] := c.TextWidth(FDataSet.Fields[RealColumnIndex(i)].DisplayLabel) + 8;

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

    FDataSet.First;
    while not FDataSet.EOF do
    begin
      for i := 0 to FDataSet.FieldCount - 1 do
      begin
        f := FDataSet.Fields[RealColumnIndex(i)];

        if f.InheritsFrom(TBLOBField) then
          s:=Trim(f.AsString)
        else
          s:=Trim(f.DisplayText);

        n := c.TextWidth(s) + 8;

        if n > FWidths[i] then
          FWidths[i] := n;
      end;
      FDataSet.Next;
    end;
    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;
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)];
    if f.InheritsFrom(TBLOBField) then
      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] := '';
    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
  b: TBitmap;
  c: TCanvas;
  n, n1: Integer;
begin
  if FAutoWidth then
//    Width := FWidths[RealColumnIndex(ColNo - 1)]
    Width :=FWidths[ColNo-1]
  else
  begin
    b := TBitmap.Create;
    c := b.Canvas;
    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;
    b.Free;
  end;
  FWidth := Width;
  inherited OnPrintColumn_(ColNo, Width);
end;


{ TfrPrintGrid }

{$IFNDEF IBO}
type
  THackDBGrid = class(TDBGrid)
  end;

procedure TfrPrintGrid.CreateDS;
begin
  if (FDBGrid = nil) or (DBGrid.DataSource = nil) or
     (DBGrid.DataSource.Dataset = nil) then Exit;
  FDataSet := DBGrid.DataSource.Dataset;
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
  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;
end;

function TfrPrintGrid.RealGridIndex(Index: Integer): Integer;
var
  Y, I: Integer;
begin
  Result := 0;
  Y := -1;
  for I := 0 to DBGrid.Columns.Count - 1 do
    if DBGrid.Columns[i].Width > 0 then
    begin
      Inc(Y);
      if Y = Index then
      begin
        Result := I;
        break;
      end;
    end;
end;

procedure TfrPrintGrid.OnEnterRect(Memo: TStringList; View: TfrView);
var
  f: TField;
begin
  if Memo[0] = '[Cell]' then
  begin
    if DBGrid.Columns.Count = 0 then
      f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)] else
      f := DBGrid.Columns[RealGridIndex(FColumnDataSet.RecNo)].Field;
    Memo[0] := f.DisplayText;
    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
    if DBGrid.Columns.Count = 0 then
    begin
      f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)];
      Memo[0] := f.DisplayLabel;
    end
    else
      Memo[0] := DBGrid.Columns[RealGridIndex(FColumnDataSet.RecNo)].Title.Caption;
    View.dx := FWidth;
  end;
end;

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


end.