reportunit.pas

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

procedure TReportLabel.SetVAlign(Value: TVAlign);
begin
  if FVAlign <> Value then
  begin
    FVAlign := Value;
    Changed(Self);
  end;
end;

procedure TReportLabel.SetHAlign(Value: THAlign);
begin
  if FHAlign <> Value then
  begin
    FHAlign := Value;
    Changed(Self);
  end;
end;

procedure TReportLabel.SetSysData(Value: TSysData);
begin
  if FSysData <> Value then
  begin
    FSysData := Value;
    Changed(Self);
  end;
end;

procedure TReportLabel.Changed(Sender: TObject);
begin
  FReportLabels.Changed(Sender);
end;

constructor TReportLabels.Create(ReportCustom: TReportCustom);
begin
  inherited Create(TReportLabel);
  FReportCustom := ReportCustom;
end;

procedure TReportLabels.SetItem(Index: Integer; Value: TReportLabel);
begin
  inherited SetItem(Index, Value);
end;

procedure TReportLabels.Changed(Sender: TObject);
begin
  FReportCustom.Changed(Sender, ctReportLabelChanged);
end;

procedure TReportLabels.Update(Item: TCollectionItem);
begin
  Changed(Self);
end;

function TReportLabels.GetItem(Index: Integer): TReportLabel;
begin
  Result := TReportLabel(inherited GetItem(Index));
end;

function TReportLabels.Add: TReportLabel;
begin
  Result := TReportLabel(inherited Add);
end;

function TReportLabels.GetOwner: TPersistent;
begin
  Result := FReportCustom;
end;

constructor TReportCustom.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FReportLabels := TReportLabels.Create(Self);
  FTitleHeight := 50;
  FFootHeight := 50;
  FPageRecord := 40;
  FCurrentPage := 1;
  FPreviewLinks := TList.Create;
end;

destructor TReportCustom.Destroy;
begin
  FPreviewLinks.Free;
  FReportLabels.Free;
  inherited Destroy;
end;

procedure TReportCustom.SetReportSource(Value: TReportSource);
begin
  FReportSource := Value;
  if Value <> nil then
  begin
    Value.UnregisterReportLink(Self);
    Value.RegisterReportLink(Self);
  end;
  Changed(Self, ctReportSourceChanged);
end;

procedure TReportCustom.SetReportLabels(Value: TReportLabels);
begin
  FReportLabels.Assign(Value);
  Changed(Self, ctReportCustomChanged);
end;

procedure TReportCustom.SetTitleHeight(Value: Integer);
begin
  if (Value > 0) and (FTitleHeight <> Value) then FTitleHeight := Value;
  Changed(Self, ctReportCustomChanged);
end;

procedure TReportCustom.SetFootHeight(Value: Integer);
begin
  if (Value > 0) and (FFootHeight <> Value) then FFootHeight := Value;
  Changed(Self, ctReportCustomChanged);
end;

procedure TReportCustom.SetCurrentPage(Value: Integer);
begin
  if (Value >= 1) and (Value <= GetPageCount) and (FCurrentPage <> Value) then
    FCurrentPage := Value;
  Changed(Self, ctReportCustomChanged);
end;

procedure TReportCustom.SetPageRecord(Value: Integer);
begin
  if (Value > 0) and (FPageRecord <> Value) then FPageRecord := Value;
  FCurrentPage := 1;
  Changed(Self, ctReportCustomChanged);
end;

procedure TReportCustom.SetGenEmptyGrid(Value: Boolean);
begin
  if FGenEmptyGrid <> Value then
  begin
    FGenEmptyGrid := Value;
    Changed(Self, ctReportCustomChanged);
  end;
end;

procedure TReportCustom.RegisterPreviewLink(Value: TReportPreview);
begin
  FPreviewLinks.Add(Value);
end;

procedure TReportCustom.UnregisterPreviewLink(Value: TReportPreview);
begin
  FPreviewLinks.Remove(Value);
end;

procedure TReportCustom.Changed(Sender: TObject; ChangeType: TChangeType);
var
  I: Integer;
begin
  if ChangeType <> ctDataSetChanged then
  begin
    if ChangeType = ctActiveChanged then FCurrentPage := 1;
    for I := 0 to FPreviewLinks.Count - 1 do TReportPreview(FPreviewLinks.Items[I]).Changed(Sender);
  end;
end;

procedure TReportCustom.Prev;
begin
  if FCurrentPage > 1 then FCurrentPage := FCurrentPage - 1;
  Changed(Self, ctReportCustomChanged);
end;

procedure TReportCustom.Next;
begin
  if FCurrentPage < GetPageCount then FCurrentPage := FCurrentPage + 1;
  Changed(Self, ctReportCustomChanged);
end;

procedure TReportCustom.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FReportSource then FReportSource := nil;
    if AComponent is TReportPreview then UnregisterPreviewLink(TReportPreview(AComponent));
  end;
end;

function TReportCustom.GetReportBitmap: TBitmap;

  procedure AlignPosition(DetailBitmap: TBitmap; AReportLabel: TReportLabel; var LabelLeft, LabelTop: Integer);
  var
    FontHeight, FontWidth: Integer;
    LabelText: string;
  begin
    case AReportLabel.SysData of
      sdNone: LabelText := AReportLabel.Text;
      sdDate: LabelText := DateToStr(Now);
      sdTime: LabelText := TimeToStr(Now);
      sdDateTime: LabelText := DateTimeToStr(Now);
      sdPageNo: LabelText := '第 ' + IntToStr(FCurrentPage) + ' 页';
    end;
    TextInfo(AReportLabel.Font, LabelText, FontWidth, FontHeight);
    if AReportLabel.VAlign = vaNone then LabelTop := AReportLabel.Top
    else
    begin
      case AReportLabel.VAlign of
        vaTop:
          LabelTop := 0;
        vaBottom:
          if AReportLabel.Bitmap.Height > FontHeight then
            LabelTop := FTitleHeight + DetailBitmap.Height + FFootHeight - AReportLabel.Bitmap.Height
          else
            LabelTop := FTitleHeight + DetailBitmap.Height + FFootHeight - FontHeight;
        vaTitleBottom:
          if AReportLabel.Bitmap.Height > FontHeight then
            LabelTop := FTitleHeight - AReportLabel.Bitmap.Height - 3
          else
            LabelTop := FTitleHeight - FontHeight;
        vaFootTop:
            LabelTop := FTitleHeight + DetailBitmap.Height + 3;
      end;
    end;
    if AReportLabel.HAlign = haNone then LabelLeft := AReportLabel.Left
    else
    begin
      case AReportLabel.HAlign of
        haLeft:
          LabelLeft := 0;
        haRight:
          if AReportLabel.Bitmap.Width > FontWidth then
            LabelLeft := DetailBitmap.Width - AReportLabel.Bitmap.Width
          else
            LabelLeft := DetailBitmap.Width - FontWidth;
        haCenter:
          if AReportLabel.Bitmap.Width > FontWidth then
            LabelLeft := (DetailBitmap.Width - AReportLabel.Bitmap.Width) div 2
          else
            LabelLeft := (DetailBitmap.Width - FontWidth) div 2;
      end;
    end;
  end;

var
  DetailBitmap: TBitmap;
  ABitmap: TBitmap;
  I: Integer;
  LabelLeft, LabelTop: Integer;
  LabelText: string;
begin
  if Linked then
  begin
    if Assigned(FOnBeginGenerate) then FOnBeginGenerate(Self);
    ABitmap := TBitmap.Create;
    ABitmap.PixelFormat := pf4bit;
    DetailBitmap := GetDetailBitmap;
    ABitmap.Width := DetailBitmap.Width;
    ABitmap.Height := FTitleHeight + DetailBitmap.Height + FFootHeight;
    ABitmap.Canvas.Draw(0, FTitleHeight, DetailBitmap);
    for I := 0 to FReportLabels.Count - 1 do
    begin
      LabelTop := FReportLabels.Items[I].Top;
      LabelLeft := FReportLabels.Items[I].Left;
      LabelText := FReportLabels.Items[I].Text;
      AlignPosition(DetailBitmap, FReportLabels.Items[I], LabelLeft, LabelTop);
      if FReportLabels.Items[I].Bitmap <> nil then
        ABitmap.Canvas.Draw(LabelLeft, LabelTop, FReportLabels.Items[I].Bitmap);
      ABitmap.Canvas.Font.Assign(FReportLabels.Items[I].Font);
      case FReportLabels.Items[I].SysData of
        sdNone: LabelText := FReportLabels.Items[I].Text;
        sdDate: LabelText := DateToStr(Now);
        sdTime: LabelText := TimeToStr(Now);
        sdDateTime: LabelText := DateTimeToStr(Now);
        sdPageNo: LabelText := '第 ' + IntToStr(FCurrentPage) + ' 页';
      end;
      if Assigned(FReportLabels.Items[I].OnDraw) then FReportLabels.Items[I].OnDraw(Self);
      ABitmap.Canvas.TextOut(LabelLeft, LabelTop, LabelText);
    end;
    if Assigned(FOnEndGenerate) then FOnEndGenerate(Self);
    Result := ABitmap;
  end else Result := nil;
end;

function TReportCustom.GetPageCount: Integer;
var
  RecordCount: Integer;
begin
  RecordCount := FReportSource.GetRecordCount;
  if RecordCount mod FPageRecord = 0 then Result := RecordCount div FPageRecord
                                     else Result := RecordCount div FPageRecord + 1;
end;

function TReportCustom.Linked: Boolean;
begin
  if (FReportSource <> nil) and (FReportSource.DataSource <> nil) and
     (FReportSource.DataSource.DataSet <> nil) and (FReportSource.DataSource.DataSet.Active)
    then Result := True
    else Result := False;
end;

constructor TReportLine.Create(AOwner: TReportSource);
begin
  inherited Create;
  FReportSource := AOwner;
  FFont := TFont.Create;
  FFont.OnChange := Changed;
  FHeight := 20;
  FLeft := 3;
  FTop := 3;
end;

destructor TReportLine.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TReportLine.Assign(Source: TPersistent);
begin
  if Source is TReportLine then
  begin
    FFont.Assign(TReportLine(Source).Font);
    FHeight := TReportLine(Source).Height;
    FLeft := TReportLine(Source).Left;
    FTop := TReportLine(Source).Top;
  end;
  inherited Assign(Source);
end;

procedure TReportLine.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
  Changed(Self);
end;

procedure TReportLine.SetHeight(Value: Integer);
begin
  FHeight := Value;
  Changed(Self);
end;

procedure TReportLine.SetLeft(Value: Integer);
begin
  FLeft := Value;
  Changed(Self);
end;

procedure TReportLine.SetTop(Value: Integer);
begin
  FTop := Value;
  Changed(Self);
end;

procedure TReportLine.SetRightAlign(Value: Boolean);
begin
  FRightAlign := Value;
  Changed(Self);
end;

procedure TReportLine.Changed(Sender: TObject);
begin
  if FReportSource <> nil then
    FReportSource.ReportSourceChanged(Sender, ctReportSourceChanged);
end;

constructor TReportSource.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPage := TBitmap.Create;
  FPage.PixelFormat := pf4bit;
  FHeaderLine := TReportLine.Create(Self);
  FDataLine := TReportLine.Create(Self);
  FFirstRecord := 1;
  FLastRecord := 40;
  FDataLink := TReportDataLink.Create(Self);
  FLinks := TList.Create;
end;

destructor TReportSource.Destroy;
begin
  FLinks.Free;