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

📄 flist.pas

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

{ ----------------------------------------------------------------
  Ace Reporter Version 1.0
  Copyright 1995 SCT Accociates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Sctvar, StdCtrls, sctctrl, DB, DBTables,
  ExtCtrls, Sctrep, Grids, Outline, Buttons, AcePage;

type
  TformList = class(TForm)
    rband1: TSctBand;
    rband2: TSctBand;
    rband3: TSctBand;
    rband4: TSctBand;
    rband5: TSctBand;
    GroupPage: TSctGrouppage;
    employeelist: TSctReport;
    employeeSource: TDataSource;
    rsctvarlabel1: TSctvarlabel;
    rsctvarlabel2: TSctvarlabel;
    rsctvarlabel3: TSctvarlabel;
    rsctvarlabel4: TSctvarlabel;
    rsctvarlabel5: TSctvarlabel;
    totalSalary: TSctTotalvar;
    rsctline1: TSctLine;
    rscttextlabel6: TSctTextLabel;
    rscttextlabel7: TSctTextLabel;
    rscttextlabel8: TSctTextLabel;
    rscttextlabel9: TSctTextLabel;
    rsctTotalVarLabel1: TSctTotalvarLabel;
    rsctTotalVarLabel2: TSctTotalvarLabel;
    rsctTotalVarLabel3: TSctTotalvarLabel;
    rsctTotalVarLabel4: TSctTotalvarLabel;
    svarDateTime1: TSctDateTimeVar;
    svarPage: TSctPageVar;
    rsctvarlabel7: TSctvarlabel;
    rsctvarlabel6: TSctvarlabel;
    rscttextlabel10: TSctTextLabel;
    rscttextlabel11: TSctTextLabel;
    MaxMinAvgSal: TSctExprvar;
    rsctvarlabel8: TSctvarlabel;
    ReportHeaderLevel: TSctLevel;
    PageHeaderLevel: TSctLevel;
    DetailLevel: TSctLevel;
    PageFooterLevel: TSctLevel;
    ReportFooterLevel: TSctLevel;
    TSctDataSourceGuide2: TSctDataSourceGuide;
    logo: TSctExprvar;
    employee: TTable;
    employeeEMPNO: TSctdbvar;
    employeeLASTNAME: TSctdbvar;
    employeeFIRSTNAME: TSctdbvar;
    employeePHONEEXT: TSctdbvar;
    employeeHIREDATE: TSctdbvar;
    employeeSALARY: TSctdbvar;
    SctLine1: TSctLine;
    Disclaimer: TSctExprvar;
    Sctvarlabel1: TSctvarlabel;
    employeeEmpNo2: TIntegerField;
    employeeLastName2: TStringField;
    employeeFirstName2: TStringField;
    employeePhoneExt2: TStringField;
    employeeHireDate2: TDateTimeField;
    employeeSalary2: TFloatField;
    SctVerticalDivider1: TSctVerticalDivider;
    SctVerticalDivider2: TSctVerticalDivider;
    SctVerticalDivider3: TSctVerticalDivider;
    SctVerticalDivider4: TSctVerticalDivider;
    TSctTotalvarLabel: TSctTotalvarLabel;
    Disclaimer2: TSctExprvar;
    Sctvarlabel2: TSctvarlabel;
    Disclaimer3: TSctExprvar;
    Sctvarlabel3: TSctvarlabel;
    Sctvarlabel4: TSctvarlabel;
    MemoExample: TSctExprvar;
    Sctvarlabel5: TSctvarlabel;
    SctImageLabel2: TSctImageLabel;
    SctImageLabel1: TSctImageLabel;
    procedure MaxMinAvgSalGetData(oVar: TSctvar);
    procedure TSctGrouppage1DataSkip(Sender: TObject);
    procedure TSctGrouppage1DataFinish(Sender: TObject);
    procedure TSctGrouppage1DataStart(Sender: TObject);
    procedure logoGetData(oVar: TSctvar);
    procedure DisclaimerGetData(oVar: TSctvar);
    procedure rband5PrintWhen(band: TSctBand; var Result: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Disclaimer3GetData(oVar: TSctvar);
    procedure MemoExampleGetData(oVar: TSctvar);
    procedure rsctvarlabel3LabelPrintWhen(lb: TSctLabel; var Result: Boolean);
  private
    { Private declarations }
    FCount: Integer;
    stream: TMemoryStream;
    procedure AddtoStream(str: String);
  public
    { Public declarations }
  end;

var
  formList: TformList;

implementation

uses sctdata, sctdest, sampdest;

{$R *.DFM}

procedure TformList.MaxMinAvgSalGetData(oVar: TSctvar);
begin
  oVar.AsFloat := (totalSalary.GetLevel(ReportFooterLevel,ttMax).AsFloat
                 + totalSalary.GetLevel(ReportFooterLevel,ttMin).asFloat ) /2 ;

end;


procedure TformList.TSctGrouppage1DataSkip(Sender: TObject);
var
  pg: TSctGrouppage;
begin
  pg := TSctGrouppage(Sender);
  pg.DataSet.Next;
  Inc(FCount);
  if pg.DataSet.Eof Or (FCount = 25) Then pg.DataIsFinished := True;
end;

procedure TformList.TSctGrouppage1DataFinish(Sender: TObject);
begin
  TSctGrouppage(Sender).DataSet.Active := False;
end;

procedure TformList.TSctGrouppage1DataStart(Sender: TObject);
begin
  FCount := 0;
  with TSctGrouppage(Sender) do
  begin
    if Dataset = nil then dataisfinished := True
    else
    begin
      if Not DataSet.Active Then DataSet.Active := True;
      DataSet.First;
    end;
  end;
end;

procedure TformList.logoGetData(oVar: TSctvar);
var
  stream: TMemoryStream;
  path: String;
begin
  path := ExtractFilePath(Application.ExeName);
  stream := TMemoryStream.Create;
  try
    stream.LoadFromFile(path + 'sctlogo.bmp');
    ovar.AsStream := stream;
  finally
    stream.Free;
  end;
end;

procedure TformList.DisclaimerGetData(oVar: TSctvar);
var
  text: String;
begin
  text := 'This is the disclaimer. This is the disclaimer.';
  oVar.AsString := text;
end;

procedure TFormList.AddtoStream(str: String);
var
  text: array[0..256] of Char;
  out: char;
begin
  strPCopy(text, str);
  Stream.Write(text, length(str));
  out := Chr(10);
  Stream.Write(out, 1);
end;

procedure TformList.rband5PrintWhen(band: TSctBand; var Result: Boolean);
begin
  stream.Clear;
  AddtoStream('this is line 1');
  AddtoStream('this is line 2');
  AddtoStream('this is line 3');
  AddtoStream('THIS IS LINE 4');
  disclaimer2.AsStream := stream;
  result := True;
end;

procedure TformList.FormCreate(Sender: TObject);
begin
  stream := TMemoryStream.Create;
end;

procedure TformList.FormDestroy(Sender: TObject);
begin
  if stream <> nil then stream.free;
end;

procedure TformList.Disclaimer3GetData(oVar: TSctvar);
var
  str: String;
begin
  str := 'This is a string that should wrap.';

  oVar.AsString := str;
end;

procedure TformList.MemoExampleGetData(oVar: TSctvar);
var
  s: TMemoryStream;
  text: array[0..256] of Char;
  lf: char;
  procedure AddStream(str: String);
  begin
    strPCopy(text, str);
    s.Write(text, length(str));
    s.Write(lf, 1);
  end;
begin
  lf := Chr(10);
  s := TMemoryStream.Create;
  try
    AddStream('THIS IS LINE 1');
    AddStream('THIS IS LINE 2');
    AddStream('This is line 3');
    oVar.AsStream := s;
  finally
    s.Free;
  end;

end;

procedure TformList.rsctvarlabel3LabelPrintWhen(lb: TSctLabel; var Result: Boolean);
begin
  result := employeeHireDate.AsFloat > 0;
end;

end.

⌨️ 快捷键说明

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