reportunit.pas

该控件是一个带表格线的打印构件

  FDataLink.Free;
  FHeaderLine.Free;
  FDataLine.Free;
  FPage.Free;
  inherited Destroy;
end;

procedure TReportSource.SetHeaderLine(Value: TReportLine);
begin
  FHeaderLine.Assign(Value);
end;

procedure TReportSource.SetDataLine(Value: TReportLine);
begin
  FDataLine.Assign(Value);
end;

procedure TReportSource.SetDataSource(Value: TDataSource);
begin
  FDataSource := Value;
  FDataLink.DataSource := Value;
end;

procedure TReportSource.RegisterReportLink(AReportCustom: TReportCustom);
begin
  FLinks.Add(AReportCustom);
end;

procedure TReportSource.UnregisterReportLink(AReportCustom: TReportCustom);
begin
  FLinks.Remove(AReportCustom);
end;

procedure TReportSource.ReportSourceChanged(Sender: TObject; ChangeType: TChangeType);
var
  I: Integer;
begin
  for I := 0 to FLinks.Count - 1 do
    TReportCustom(FLinks.Items[I]).Changed(Sender, ChangeType);
end;

procedure TReportSource.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FDataSource then FDataSource := nil;
    if AComponent is TReportCustom then UnregisterReportLink(TReportCustom(AComponent));
  end;
end;

function TReportSource.GetReportWidth: Integer;
var
  I: Integer;
  ImageWidth: Integer;
  tw, th: Integer;
begin
  ImageWidth := 0;
  for I := 0 to FDataSource.DataSet.FieldCount - 1 do
    if FDataSource.DataSet.Fields[I].Visible then
      ImageWidth := ImageWidth + FDataSource.DataSet.Fields[I].DisplayWidth;
  TextInfo(FDataLine.FFont, 'X', tw, th);
  Result := ImageWidth*tw;
end;

function TReportSource.GetReportHeight: Integer;
begin
  Result := FDataLine.FHeight*(FLastRecord - FFirstRecord + 1) + FHeaderLine.FHeight;
end;

function TReportSource.GetRecordCount: Integer;
begin
  if FDataSource <> nil then Result := GetRecCount(FDataSource)
                        else Result := 0;
end;

procedure TReportSource.Generate;

  procedure ResetSize;
  begin
    FPage.Width := GetReportWidth;
    FPage.Height := GetReportHeight;
  end;

  function IsNumber(AFieldType: TFieldType): Boolean;
  begin
    Result := False;
    case AFieldType of
      ftSmallint: Result := True;
      ftInteger: Result := True;
      ftWord: Result := True;
      ftFloat: Result := True;
      ftCurrency: Result := True;
      ftBytes: Result := True;
      ftLargeint: Result := True;
      ftVarBytes: Result := True;
    end;
  end;

  procedure DrawGrid;

    procedure InitializeCanvas;
    begin
      FPage.Canvas.Brush.Color := clWhite;
      FPage.Canvas.Pen.Color := clBlack;
      FPage.Canvas.Brush.Style := bsSolid;
      FPage.Canvas.Pen.Style := psSolid;
    end;

    procedure DrawOutLine;
    begin
      FPage.Canvas.Rectangle(0, 0, FPage.Width, FPage.Height);
    end;

    procedure DrawInLine;
    var
      I: Integer;
      tw, th, LeftWidth: Integer;
    begin
      FPage.Canvas.MoveTo(1, FHeaderLine.FHeight);
      FPage.Canvas.LineTo(FPage.Width - 1, FHeaderLine.FHeight);
      FPage.Canvas.Pen.Color := clSilver;
      for I := 1 to FLastRecord - FFirstRecord do
      begin
        FPage.Canvas.MoveTo(1, FHeaderLine.FHeight + I*FDataLine.FHeight);
        FPage.Canvas.LineTo(FPage.Width - 1, FHeaderLine.FHeight + I*FDataLine.FHeight);
      end;
      TextInfo(FDataLine.FFont, 'X', tw, th);
      LeftWidth := 0;
      for I := 0 to FDataSource.DataSet.FieldCount - 1 do
        if FDataSource.DataSet.Fields[I].Visible then
        begin
          LeftWidth := LeftWidth + FDataSource.DataSet.Fields[I].DisplayWidth*tw;
          FPage.Canvas.MoveTo(LeftWidth, 1);
          FPage.Canvas.LineTo(LeftWidth, FPage.Height - 1);
        end;
      FPage.Canvas.Pen.Color := clBlack;
    end;

  begin
    InitializeCanvas;
    DrawOutLine;
    DrawInLine;
  end;

  procedure DrawData;

    procedure InitializeCanvas;
    begin
      FPage.Canvas.Brush.Color := clWhite;
      FPage.Canvas.Pen.Color := clBlack;
      FPage.Canvas.Brush.Style := bsSolid;
      FPage.Canvas.Pen.Style := psSolid;
    end;

    procedure DrawHeader;
    var
      I: Integer;
      tw, th: Integer;
      LeftWidth: Integer;
      LeftOffset: Integer;
      FieldWidth, FieldHeight: Integer;
    begin
      FPage.Canvas.Font.Assign(FHeaderLine.FFont);
      TextInfo(FDataLine.FFont, 'X', tw, th);
      LeftWidth := 0;
      for I := 0 to FDataSource.DataSet.FieldCount - 1 do
        if FDataSource.DataSet.Fields[I].Visible then
        begin
          if not FHeaderLine.FRightAlign then
            FPage.Canvas.TextOut(LeftWidth + FHeaderLine.FLeft, FHeaderLine.FTop,
              FDataSource.DataSet.Fields[I].DisplayLabel)
          else
          begin
            TextInfo(FDataLine.FFont, FDataSource.DataSet.Fields[I].DisplayLabel, FieldWidth, FieldHeight);
            LeftOffset := FDataSource.DataSet.Fields[I].DisplayWidth*tw - FieldWidth - FHeaderLine.FLeft;
            FPage.Canvas.TextOut(LeftWidth + LeftOffset, FHeaderLine.FTop,
              FDataSource.DataSet.Fields[I].DisplayLabel);
          end;
          LeftWidth := LeftWidth + FDataSource.DataSet.Fields[I].DisplayWidth*tw;
        end;
    end;

    procedure DrawData;
    var
      I, J: Integer;
      tw, th: Integer;
      LeftWidth: Integer;
      LeftOffset: Integer;
      FieldWidth, FieldHeight: Integer;
    begin
      GotoRecord(FDataSource, FFirstRecord);
      if not FDataSource.DataSet.EOF then
      begin
        FPage.Canvas.Font.Assign(FDataLine.FFont);
        FDataSource.DataSet.DisableControls;
        TextInfo(FDataLine.FFont, 'X', tw, th);
        try
          for I := 0 to FLastRecord - FFirstRecord do
          begin
            if Assigned(FOnGenerate) then FOnGenerate(Self, I);
            LeftWidth := 0;
            for J := 0 to FDataSource.DataSet.FieldCount - 1 do
              if FDataSource.DataSet.Fields[J].Visible then
              begin
                if (not FDataLine.FRightAlign) or
                   (not IsNumber(FDataSource.DataSet.Fields[J].DataType)) then
                  FPage.Canvas.TextOut(LeftWidth + FDataLine.FLeft,
                    FDataLine.FTop + FHeaderLine.FHeight + I*FDataLine.FHeight,
                    FDataSource.DataSet.Fields[J].DisplayText)
                else
                begin
                  TextInfo(FDataLine.FFont, FDataSource.DataSet.Fields[J].DisplayText,
                    FieldWidth, FieldHeight);
                  LeftOffset := FDataSource.DataSet.Fields[J].DisplayWidth*tw -
                    FieldWidth - FDataLine.FLeft;
                  FPage.Canvas.TextOut(LeftWidth + LeftOffset,
                    FDataLine.FTop + FHeaderLine.FHeight + I*FDataLine.FHeight,
                    FDataSource.DataSet.Fields[J].DisplayText);
                end;
                LeftWidth := LeftWidth + FDataSource.DataSet.Fields[J].DisplayWidth*tw;
              end;
            FDataSource.DataSet.Next;
            if FDataSource.DataSet.EOF then Break;
          end;
        finally
          FDataSource.DataSet.EnableControls;
        end;
      end;
    end;

  begin
    InitializeCanvas;
    DrawHeader;
    if FDataSource.DataSet.Active = True then DrawData;
  end;

begin
  if FDataSource.DataSet <> nil then
  begin
    ResetSize;
    DrawGrid;
    DrawData;
  end;
end;

function TReportSingle.GetDetailBitmap: TBitmap;
var
  OldLastRecord: Integer;
begin
  OldLastRecord := 0;
  ReportSource.FFirstRecord := (CurrentPage - 1)*PageRecord + 1;
  ReportSource.FLastRecord := CurrentPage*PageRecord;
  if (CurrentPage = PageCount) and (not GenEmptyGrid) then
  begin
    OldLastRecord := ReportSource.FLastRecord;
    ReportSource.FLastRecord := ReportSource.GetRecordCount;
  end;
  ReportSource.Generate;
  if OldLastRecord <> 0 then ReportSource.FLastRecord := OldLastRecord;
  Result := ReportSource.FPage;
end;

constructor TReportDataLink.Create(AReportSource: TReportSource);
begin
  inherited Create;
  FReportSource := AReportSource;
end;

procedure TReportDataLink.ActiveChanged;
begin
  FReportSource.ReportSourceChanged(Self, ctActiveChanged);
end;

procedure TReportDataLink.DataSetChanged;
begin
  FReportSource.ReportSourceChanged(Self, ctDataSetChanged);
end;

constructor TReportPreview.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];
  Width := 100;
  Height := 100;
end;

procedure TReportPreview.SetReportCustom(Value: TReportCustom);
begin
  FReportCustom := Value;
  if Value <> nil then
  begin
    Value.UnregisterPreviewLink(Self);
    Value.RegisterPreviewLink(Self);
  end;
  Changed(Self);
end;

procedure TReportPreview.SetAutoSize(Value: Boolean);
begin
  if Value <> FAutoSize then
  begin
    FAutoSize := Value;
    Repaint;
  end;
end;

procedure TReportPreview.Paint;
begin
  inherited Paint;
  if (FReportCustom <> nil) and FReportCustom.Linked then
    PaintReport
  else
  begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clBtnFace;
    Canvas.Pen.Color := clBtnFace;
    Canvas.Rectangle(0, 0, Width, Height);
  end;
  if csDesigning in ComponentState then PaintRectangle;
end;

procedure TReportPreview.PaintRectangle;
begin
  Canvas.Pen.Color := clBlack;
  Canvas.Pen.Style := psDash;
  Canvas.Brush.Style := bsClear;
  Canvas.Rectangle(0, 0, Width, Height);
end;

procedure TReportPreview.PaintReport;
begin
  if FReportBitmap = nil then FReportBitmap := FReportCustom.ReportBitmap;
  if FReportBitmap <> nil then
  begin
    if FAutoSize then
    begin
      Width := FReportBitmap.Width + 100;
      Height := FReportBitmap.Height;
    end;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clWhite;
    Canvas.Pen.Color := clWhite;
    Canvas.Rectangle(0, 0, Width, Height);
    Canvas.Draw(50, 0, FReportBitmap);
  end;
end;

procedure TReportPreview.Changed(Sender: TObject);
begin
  if FReportCustom <> nil then FReportBitmap := FReportCustom.ReportBitmap
                          else FReportBitmap := nil;
  if FReportBitmap <> nil then Repaint;
end;

procedure TReportPreview.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FReportCustom) then
  begin
    FReportCustom := nil;
    Changed(Self);
  end;
end;

procedure TReportPreview.ReGenerate;
begin
  Changed(Self);
end;

end.