⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dsr.pas

📁 suite component ace report
💻 PAS
字号:
unit DSR;

interface

uses
{$ifdef win32}
  Windows,
{$else}
wintypes,winprocs,
{$endif}
  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SctVar, ExtCtrls, SctRep,db, sctctrl, sctdata;

type
  TDataSourceReportForm = class(TForm)
    AutoReport: TSctReport;
    ReportPage: TSctGrouppage;
    ReportHeaderBand: TSctBand;
    ReportHeaderBandlevel: TSctLevel;
    PageHeaderBand: TSctBand;
    PageHeaderBandlevel: TSctLevel;
    DetailBand: TSctBand;
    DetailBandlevel: TSctLevel;
    PageFooterBand: TSctBand;
    PageFooterBandlevel: TSctLevel;
    ReportFooterBand: TSctBand;
    ReportFooterBandlevel: TSctLevel;
  private
    { Private declarations }
    procedure CreateReport;
    function CreateVarLabel(DBVar:TSctDBVar; DataField: TField): TSctLabel;
    function GetDataType(f: TField): TSctDataTypes;
  public
    { Public declarations }
  end;

  procedure GenerateReport(DataSource: TDataSource);

var
  DataSourceReportForm: TDataSourceReportForm;

implementation

{$R *.DFM}

uses sctutil, psetup;

procedure GenerateReport(DataSource: TDataSource);
var
  rf: TDatasourceReportForm;
begin
  if DataSource.DataSet <> nil then
  begin
    if Not DataSource.DataSet.Active then DataSource.DataSet.Active := True;
    rf := TDataSourceReportForm.Create(Application);
    rf.ReportPage.Datasource := DataSource;
    rf.CreateReport;
    rf.AutoReport.Run;
    rf.Free;
  end else raise Exception.Create('Fill in Dataset.');
end;

procedure TDataSourceReportForm.CreateReport;
var
  LeftSpot, Spot, Ave: Integer;
  MyVar: TSctDbVar;
  MyLabel: TSctLabel;
  TextLabel: TSctVarLabel;
  DataSet: TDataset;
begin
  DataSet := ReportPage.DataSource.DataSet;

  LeftSpot := 10;
  DetailBand.Stretch := True;

  for Spot := 0 to DataSet.FieldCount -1 do
  {   This sets up Dataset.FieldCount labels in the DetailBand, with one
      label for each of the fields in the dataset. This also sets up one
      TextLabel in the PageHeaderBand for each field. This TextLabel has
      its Caption set to the corresponding field's displayname.  }
  begin
    MyVar := TSctDbVar.Create(Self);
    SctAutoSetComponentName(MyVar, 'Auto', True);

        { You will probably see an exception here }
        {You need to turn off Break on Exception to run from IDE}

    MyVar.Parent := ReportPage;
    MyVar.DataSource := ReportPage.DataSource;
    MyVar.DataField := DataSet.Fields[Spot].FieldName;
    MyVar.UpdateLevel := DetailBand.UpdateLevel;

    {    CreateVarLabel makes the varlabel of the correct type to handle
         images and booleans as well as text.    }
    MyLabel := CreateVarLabel(MyVar, DataSet.Fields[Spot]);
    {    If you want to change a label's font or color, etc., this is
         where you should do it.   }
    MyLabel.Parent := DetailBand;
    SctAutoSetComponentName(MyLabel, 'AutoLabel', True);
    {You need to turn off Break on Exception to run from IDE}
    MyLabel.Left := LeftSpot;
    MyLabel.Top := 3;

    Ave := MyLabel.Canvas.TextWidth('M');
    {    this next line sets the width of the label to the number of pixels
         in the letter M in the current font times the number of characters
         the database has stored for each record in this field. This is not
         100% accurate but comes pretty close in most situations.  }
    if Not (MyLabel is TSctImageLabel) And
       Not (MyLabel is TSctCheckLabel) then
      MyLabel.Width := (Ave * Dataset.Fields[Spot].DisplayWidth);

    TextLabel := TSctVarLabel.Create(Self);
    with TextLabel do
    begin
      SctAutoSetComponentName(TextLabel, 'AutoText', True);
      Parent := PageHeaderBand;
      Caption := Dataset.Fields[Spot].DisplayLabel;
      AutoSize := True;
      Left := LeftSpot;
      Top := 0;
      Width := ( Ave * Dataset.Fields[Spot].DisplayWidth);

      if Width > MyLabel.Width then Inc(LeftSpot, (Width  + 10))
      else Inc(LeftSpot, (MyLabel.Width + 10));
    end;
  end;
  PageHeaderBand.BorderType := btUnderLine;
  if (LeftSpot-10) > Round(7.5*PixelsPerInch) then ReportPage.PageSetup.Orientation := poLandscape
  else ReportPage.PageSetup.Orientation := poPortrait;
end;

function TDataSourceReportForm.CreateVarLabel(DBVar:TSctDBVar; DataField: TField): TSctLabel;
var
  dt: TSctDataTypes;
begin
  dt := GetDataType(DataField);
  if (dt in [dtypegraphic, dtypeblob]) then
  begin
    Result := TSctImageLabel.create(Self);
    TSctImageLabel(Result).Variable := DBVar;
    Result.Stretch := False;
    {This stretches the image to the size of the label. This can be set
    to False to let the image display itself in its full size. Note that
    doing this will not make the imagelabel grow, however. Alternatively,
    if the size of all of the images is known at design-time, the size of
    the label can be set here.}

  end else if dt = dtypeboolean then
  begin
    Result := TSctCheckLabel.Create(Self);
    TSctChecklabel(Result).Variable := DBVar;
    Result.BorderType := btSingle;
  end else
  begin
    Result := tsctvarlabel.create(Self);
    Result.AutoSize := True;
    TSctVarLabel(Result).Variable := DBVar;
  end;
end;

function TDataSourceReportForm.GetDataType(f: TField): TSctDataTypes;
begin
  Result := dtypeUnknown;
  case f.DataType of
    ftString: Result := dtypeString;
    ftInteger, ftSmallInt, ftWord: Result := dtypeInteger;
    ftFloat,ftCurrency,ftBCD: Result := dtypeFloat;
    ftDateTime, ftDate, ftTime: Result := dtypeDateTime;
    ftBoolean: Result := dtypeBoolean;
    ftBlob: Result := dtypeBlob;
    ftMemo: Result := dtypeMemo;
    ftGraphic: Result := dtypeGraphic;
    {$ifdef WIN32}
    ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary: Result := dtypeBlob;
    ftAutoInc: Result := dtypeInteger;
    {$ENDIF}
  end;
end;




end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -