📄 flist.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 + -