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

📄 acediag.pas

📁 suite component ace report
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit acediag;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}

uses
  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SctVar, ExtCtrls, SctRep, DB, StdCtrls, SctCtrl, DBCtrls,
  Grids, DBGrids, Buttons, sctdata, Menus, Printers, AceUtil, AceOut,
  SctBtn, pageman
  {$ifdef AceDesignTime}, dsgnintf  {$endif}
  {$ifndef VCL130PLUS} , dbtables   {$endif}
  ;
  

type
  TAceDiagForm = class(TForm)
    SctReport1: TSctReport;
    ReportPage: TSctGrouppage;
    ReportHeaderBand: TSctBand;
    ReportHeaderBandlevel: TSctLevel;
    PageHeaderBand: TSctBand;
    PageHeaderBandlevel: TSctLevel;
    DetailBand: TSctBand;
    DetailBandlevel: TSctLevel;
    PageFooterBand: TSctBand;
    PageFooterBandlevel: TSctLevel;
    ReportFooterBand: TSctBand;
    ReportFooterBandlevel: TSctLevel;
    SctTextLabel1: TSctTextLabel;
    svarDateTime: TSctDateTimeVar;
    svarPage: TSctPageVar;
    AceVersion: TSctExprVar;
    SctTextLabel67: TSctTextLabel;
    SctTextLabel68: TSctTextLabel;
    SctTextLabel69: TSctTextLabel;
    SctTextLabel55: TSctTextLabel;
    SctTextLabel66: TSctTextLabel;
    SctShape7: TSctShape;
    SctTextLabel2: TSctTextLabel;
    ReportOwner: TSctExprVar;
    Sctvarlabel18: TSctvarlabel;
    SctTextLabel5: TSctTextLabel;
    Sctvarlabel5: TSctvarlabel;
    Sctvarlabel16: TSctvarlabel;
    Sctvarlabel17: TSctvarlabel;
    SctTextLabel16: TSctTextLabel;
    Sctvarlabel10: TSctvarlabel;
    Update: TSctSubDataBand;
    DataLevel: TSctLevel;
    Blank: TSctSubDataBand;
    Data1Level: TSctLevel;
    Misc: TSctSubDataBand;
    Data2Level: TSctLevel;
    UpdateHeader: TSctDataHeadBand;
    UpdateHeaderLevel: TSctLevel;
    BlankHeader: TSctDataHeadBand;
    BlankHeaderLevel: TSctLevel;
    MiscHeader: TSctDataHeadBand;
    MiscHeaderLevel: TSctLevel;
    MiscFooter: TSctDataFootBand;
    MiscFooterLevel: TSctLevel;
    SctTextLabel3: TSctTextLabel;
    SctTextLabel4: TSctTextLabel;
    SctTextLabel7: TSctTextLabel;
    Sctvarlabel2: TSctvarlabel;
    Sctvarlabel4: TSctvarlabel;
    Sctvarlabel7: TSctvarlabel;
    Sctvarlabel8: TSctvarlabel;
    UpdateVar: TSctExprVar;
    BlankVar: TSctExprVar;
    MiscVar: TSctExprVar;
    MiscSumVar: TSctExprVar;
    Button1: TButton;
    Update1: TSctExprVar;
    BlankLabels: TSctSubDataBand;
    DataLevel1: TSctLevel;
    BlankLabelsFooter: TSctDataFootBand;
    BlankLabelsFooterLevel: TSctLevel;
    BlankLabelsHeader: TSctDataHeadBand;
    BlankLabelsHeaderLevel: TSctLevel;
    SctTextLabel6: TSctTextLabel;
    Sctvarlabel11: TSctvarlabel;
    Sctvarlabel12: TSctvarlabel;
    BlanklabVar: TSctExprVar;
    SctLine2: TSctLine;
    SctLine4: TSctLine;
    blanklabsum: TSctExprVar;
    subsevere: TSctSubBand;
    ReportFooterBandSub1: TSctSubBand;
    ReportFooterBandSub2: TSctSubBand;
    Sctvarlabel9: TSctvarlabel;
    Sctvarlabel14: TSctvarlabel;
    Sctvarlabel15: TSctvarlabel;
    SctShape4: TSctShape;
    SctShape1: TSctShape;
    SctShape2: TSctShape;
    SctShape3: TSctShape;
    UpdateFooter: TSctDataFootBand;
    UpdateFooterLevel: TSctLevel;
    UpdateLevelSum: TSctvarlabel;
    SctLine1: TSctLine;
    procedure DiagProc(Rep: TSctReport);
    procedure Button1Click(Sender: TObject);
    procedure ReportPageDataStart(Sender: TObject);
    procedure UpdateDataSkip(Sender: TObject);
    procedure BlankDataSkip(Sender: TObject);
    procedure MiscDataSkip(Sender: TObject);
    procedure UpdateDataStart(Sender: TObject);
    procedure BlankDataStart(Sender: TObject);
    procedure MiscDataStart(Sender: TObject);
    procedure UpdateDataFilter(Sender: TObject; var Result: Boolean);
    procedure BlankDataFilter(Sender: TObject; var Result: Boolean);
    procedure MiscDataFilter(Sender: TObject; var Result: Boolean);
    procedure BlankLabelsDataSkip(Sender: TObject);
    procedure BlankLabelsDataFilter(Sender: TObject; var Result: Boolean);
    procedure BlankLabelsDataStart(Sender: TObject);
    procedure blanklabsumGetData(oVar: TSctVar);
  private
    { Private declarations }
    Spot: Integer;

    Report: TSctReport;
    RPage: TSctGroupPage;
    MiscError, BlankLabError: Boolean;
    m, bl: Integer;
    DSG: TSctDataSourceGuide;

    function GetDSG(DS: TDataSource): TSctDataSourceGuide;

  public
{$ifdef VCL120PLUS}
    PageDesigner: IFormDesigner;
{$else}
    PageDesigner: TFormDesigner;
{$endif}
  end;
var
  AceDiagForm: TAceDiagForm;
implementation

uses sctutil;

{$R *.DFM}

procedure TAceDiagForm.DiagProc(Rep: TSctReport);
begin
  Report := Rep;
  RPage := TSctGroupPage(Report.Page);
  MiscError := False;

  SctReport1.Run
end;

procedure TAceDiagForm.Button1Click(Sender: TObject);
begin
  DiagProc(SctReport1);
end;

procedure TAceDiagForm.ReportPageDataStart(Sender: TObject);
begin
  AceVersion.AsString := AceUtil.AceVersion;
  ReportOwner.AsString := RPage.Owner.Name;
  TSctGroupPage(Sender).DataIsFinished := True;
end;

procedure TAceDiagForm.UpdateDataStart(Sender: TObject);
begin
  Spot := -1;
  if RPage.Labels = nil then TSctSubDataBand(Sender).DataIsFinished := True
  else if Spot >= RPage.Labels.Count then TSctSubDataBand(Sender).DataIsFinished := True;
end;

procedure TAceDiagForm.UpdateDataSkip(Sender: TObject);
begin
  Inc(Spot);
  if RPage.Labels = nil then TSctSubDataBand(Sender).DataIsFinished := True
  else if Spot >= RPage.Labels.Count then TSctSubDataBand(Sender).DataIsFinished := True;
end;

procedure TAceDiagForm.UpdateDataFilter(Sender: TObject; var Result: Boolean);
var
  Lab: TSctLabel;

  procedure Check(MyVar: TSctVar);
  begin
    Result := False;
    if MyVar <> nil then
    begin
      if MyVar.UpdateLevel <> TSctBand(Lab.Parent).UpdateLevel then
      begin
        if Not TSctBand(Lab.Parent).UpdateLevel.IsHeader then
        begin
          { These will commonly be shown on bands with different updatelevels
            so I exclude them here }
          if Not ((MyVar is TSctDateTimeVar) or (MyVar is TSctPageVar)) then
          begin
            Result := True;
            UpdateVar.AsString := Lab.Name
            + '''s variable, ' + MyVar.Name
            + ', has a different UpdateLevel than '+ Lab.Name
            + '''s parent, ' + TSctBand(Lab.Parent).Name;
          end;
        end;  
      end;
    end;
  end;
begin
  Result := False;

  if Spot = -1 then
  begin
    DSG := GetDSG(RPage.DataSource);
    if DSG <> nil then
    begin
      if DSG.UpdateLevel <> RPage.Detail.UpdateLevel then
      begin
        UpdateVar.AsString := 'The DataSources updatelevel is different than '+
             'the Detail bands updatelevel';
        Result := True;
      end;
    end;
  end else
  begin
    Lab := TSctLabel(RPage.Labels[Spot]);
    if Lab is TSctVarLabel then
    begin
      Check(TSctVarLabel(lab).Variable);
    end else if lab is TSctCheckLabel then
    begin
      Check(TSctCheckLabel(lab).Variable);
    end else if lab is TSctBarCodeLabel then
    begin
      Check(TSctBarCodeLabel(lab).Variable);
    end else if lab is TSctImageLabel then
    begin
      Check(TSctImageLabel(lab).Variable);
    end else if lab is TSctTotalVarLabel then
    begin

      if TSctTotalVarLabel(lab).TotalVariable <> nil then
      begin
        if TSctTotalVarLabel(lab).TotalVariable.Variable <> nil then
        begin
          if TSctTotalVarLabel(lab).TotalVariable.Variable.UpdateLevel <>
          TSctTotalVarLabel(lab).TotalVariable.UpdateLevel then
          begin
            UpdateVar.AsString := Lab.Name
            + '''s TotalVariable, ' + TSctTotalVarLabel(lab).TotalVariable.Name
            + ', has a different UpdateLevel than '+ TSctTotalVarLabel(lab).Name
            + '''s TotalVariable ''s variable''s UpdateLevel. '
            + Lab.Name + '''s TotalVariable''s variable is '
            + TSctTotalVarLabel(lab).TotalVariable.Variable.Name;
            Result := True;
          end;
        end;
      end;
    end;
  end;
end;

procedure TAceDiagForm.BlankDataStart(Sender: TObject);
begin
  Spot := -1;
  TSctSubDataBand(Sender).DataIsFinished := False;
end;

procedure TAceDiagForm.BlankDataSkip(Sender: TObject);
begin
  Inc(Spot);
  if RPage.SubDataBands = nil then
    TSctSubDataBand(Sender).DataIsFinished := True
  else if Spot >= RPage.SubDataBands.Count then
    TSctSubDataBand(Sender).DataIsFinished := True;
end;

procedure TAceDiagForm.BlankDataFilter(Sender: TObject; var Result: Boolean);
var
  sdb: TSctSubDataBand;
begin
  Result := False;
  if (Spot = -1) then
  begin
    if (RPage.DataSource = nil) And
      ((AceGetMethodValue(RPage, 'OnDataSkip', PageDesigner) = '') or
      (AceGetMethodValue(RPage, 'OnDataStart', PageDesigner) = '')) then
    begin
      BlankVar.AsString := 'The TSctGroupPage, ' + RPage.Name + ', has a nil '
        +'DataSource and one or both of the OnDataStart and OnDataSkip events are not filled in.';
      Result := True;
    end;
  end else
  begin
    sdb := TSctSubDataBand(RPage.SubDataBands[Spot]);
    if (sdb.DataSource = nil) And
      ((AceGetMethodValue(sdb, 'OnDataSkip', PageDesigner) = '') or
      (AceGetMethodValue(sdb, 'OnDataStart', PageDesigner) = '')) then
    begin
      BlankVar.AsString := 'The TSctSubDataBand, ' + sdb.Name + ', has a nil '
        +'DataSource and one or both of the OnDataStart and OnDataSkip events are not filled in.';
      Result := True;
    end;
  end;
end;

procedure TAceDiagForm.BlankLabelsDataStart(Sender: TObject);
begin
  bl := 0;
  if RPage.Labels = nil then

⌨️ 快捷键说明

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