📄 cross.pas
字号:
unit Cross;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, DBTables, Grids, DBGrids, Sctvar, Sctrep, DB, ExtCtrls,
sctctrl, StdCtrls, Buttons, Sctbtn, AcePage;
type
TCrossForm = class(TForm)
ReportHeaderBand: TSctBand;
ReportHeaderBandlevel: TSctLevel;
PageHeaderBand: TSctBand;
PageHeaderBandlevel: TSctLevel;
DetailBand: TSctBand;
DetailBandlevel: TSctLevel;
PageFooterBand: TSctBand;
PageFooterBandlevel: TSctLevel;
ReportFooterBand: TSctBand;
ReportFooterBandlevel: TSctLevel;
CrossPage: TSctGrouppage;
CrossReport: TSctReport;
svarDateTime: TSctDateTimeVar;
svarPage: TSctPageVar;
parts: TTable;
partsSource: TDataSource;
DataSourceGuide4: TSctDataSourceGuide;
PartTotal: TQuery;
PartTotalSource: TDataSource;
DataSourceGuide5: TSctDataSourceGuide;
parttotalCUSTNO: TSctdbvar;
parttotalPARTNO: TSctdbvar;
parttotalQTY: TSctdbvar;
parttotalLISTPRICE: TSctdbvar;
parttotalTOTAL: TSctdbvar;
pCustNo: TFloatField;
pPartNo: TFloatField;
PartTotalQty2: TIntegerField;
plistPrice: TCurrencyField;
pTotal: TCurrencyField;
Part1: TSctExprvar;
Part2: TSctExprvar;
Part3: TSctExprvar;
Part4: TSctExprvar;
Part5: TSctExprvar;
Part6: TSctExprvar;
Part7: TSctExprvar;
Part8: TSctExprvar;
Part9: TSctExprvar;
Part10: TSctExprvar;
Part11: TSctExprvar;
TSctvarlabel27: TSctvarlabel;
TSctVerticalDivider: TSctVerticalDivider;
TSctvarlabel1: TSctvarlabel;
TSctVerticalDivider1: TSctVerticalDivider;
TSctvarlabel2: TSctvarlabel;
TSctVerticalDivider2: TSctVerticalDivider;
TSctvarlabel3: TSctvarlabel;
TSctVerticalDivider3: TSctVerticalDivider;
TSctvarlabel4: TSctvarlabel;
TSctVerticalDivider4: TSctVerticalDivider;
TSctvarlabel5: TSctvarlabel;
TSctVerticalDivider5: TSctVerticalDivider;
TSctvarlabel6: TSctvarlabel;
TSctVerticalDivider6: TSctVerticalDivider;
TSctvarlabel7: TSctvarlabel;
TSctVerticalDivider7: TSctVerticalDivider;
TSctvarlabel8: TSctvarlabel;
TSctVerticalDivider8: TSctVerticalDivider;
TSctvarlabel9: TSctvarlabel;
TSctVerticalDivider9: TSctVerticalDivider;
TSctvarlabel10: TSctvarlabel;
SctTextLabel1: TSctTextLabel;
SctVerticalDivider1: TSctVerticalDivider;
PartTotal1: TSctExprvar;
PartTotal2: TSctExprvar;
PartTotal3: TSctExprvar;
PartTotal4: TSctExprvar;
PartTotal5: TSctExprvar;
PartTotal6: TSctExprvar;
PartTotal7: TSctExprvar;
PartTotal8: TSctExprvar;
PartTotal9: TSctExprvar;
PartTotal10: TSctExprvar;
PartTotal11: TSctExprvar;
TSctvarlabel11: TSctvarlabel;
TSctVerticalDivider10: TSctVerticalDivider;
TSctvarlabel12: TSctvarlabel;
TSctVerticalDivider11: TSctVerticalDivider;
TSctvarlabel13: TSctvarlabel;
TSctVerticalDivider12: TSctVerticalDivider;
TSctvarlabel14: TSctvarlabel;
TSctVerticalDivider13: TSctVerticalDivider;
TSctvarlabel15: TSctvarlabel;
TSctVerticalDivider14: TSctVerticalDivider;
TSctvarlabel16: TSctvarlabel;
TSctVerticalDivider15: TSctVerticalDivider;
TSctvarlabel17: TSctvarlabel;
TSctVerticalDivider16: TSctVerticalDivider;
TSctvarlabel18: TSctvarlabel;
TSctVerticalDivider17: TSctVerticalDivider;
TSctvarlabel19: TSctvarlabel;
TSctVerticalDivider18: TSctVerticalDivider;
TSctvarlabel20: TSctvarlabel;
TSctVerticalDivider19: TSctVerticalDivider;
TSctvarlabel21: TSctvarlabel;
TSctVerticalDivider20: TSctVerticalDivider;
TSctvarlabel22: TSctvarlabel;
SctReportButton1: TSctReportButton;
CustList: TQuery;
CustListSource: TDataSource;
DataSourceGuide: TSctDataSourceGuide;
CustListCustNo: TFloatField;
custlistCUSTNO1: TSctdbvar;
partsPartNo: TFloatField;
partsVendorNo: TFloatField;
partsDescription: TStringField;
partsOnHand: TFloatField;
partsOnOrder: TFloatField;
partsCost: TCurrencyField;
partsListPrice: TCurrencyField;
Customer: TTable;
CustomerSource: TDataSource;
DataSourceGuide1: TSctDataSourceGuide;
customerCUSTNO: TSctdbvar;
customerCOMPANY: TSctdbvar;
customerADDR1: TSctdbvar;
customerADDR2: TSctdbvar;
customerCITY: TSctdbvar;
customerSTATE: TSctdbvar;
customerZIP: TSctdbvar;
customerCOUNTRY: TSctdbvar;
customerPHONE: TSctdbvar;
customerFAX: TSctdbvar;
customerTAXRATE: TSctdbvar;
customerCONTACT: TSctdbvar;
customerLASTINVOICEDATE: TSctdbvar;
procedure CrossPageDataStart(Sender: TObject);
procedure CrossPageDataSkip(Sender: TObject);
procedure CrossPageDataFinish(Sender: TObject);
procedure CrossReportBeforePrint(report: TSctReport);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PartTotal1GetData(oVar: TSctvar);
procedure TSctvarlabel12LabelPrintWhen(lb: TSctLabel; var Result: Boolean);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
partspot, partcount: Integer;
PartList: TStringList;
values: array[0..10] of Double;
total: Double;
SaveCust: Double;
RowCount,Row: Integer;
procedure GoLastCust;
procedure ReadData;
public
{ Public declarations }
end;
var
CrossForm: TCrossForm;
implementation
uses sctutil;
{$R *.DFM}
procedure TCrossForm.CrossPageDataStart(Sender: TObject);
begin
{ limit the number of rows because if the report goes to another
page it will have data as the first customer that should not belong
there because the data is skipped prior to knowing if the report
will go to another page or not.
You must limit the number of row to be small enough to not exceed a
page.
}
Row := 0;
RowCount := 26;
if Not PartTotal.Active then PartTotal.Active := True;
if Not CustList.Active then CustList.Active := True;
TSctGroupPage(Sender).Records := CustList.RecordCount * (PartCount div 11);
PartTotal.First;
CustList.First;
if CustList.Eof then CrossPage.DataIsFinished := True
else
begin
{ save the first customer, so that when I go to a new page I can
skip the data back to that first customer because he is not finished
printing yet }
SaveCust := pCustno.AsFloat;
ReadData;
end;
end;
procedure TCrossForm.CrossPageDataSkip(Sender: TObject);
begin
Inc(Row);
if Row > RowCount then
begin
Row := 0;
{ force the page position to exceed the height causing a page
break before the next band is printed and then position the
data to the approiate position depending on whether all of
its parts have printed or not }
CrossPage.yPos := 10000;
{ increment part position, only 11 accross per page at least
for this report }
PartSpot := PartSpot + 11;
if PartSpot >= PartCount then
begin
PartSpot := 0;
CustList.Next;
SaveCust := pCustno.AsFloat;
end else
begin
GoLastCust;
end;
end else CustList.Next;
if CustList.Eof then
begin
if(PartSpot = 0) And (Row = 0) then
begin
{ because all the data is finished printing for each customer
I should tell the report its done }
CrossPage.DataIsFinished := True;
end else
begin
GoLastCust;
PartSpot := PartSpot + 11;
if PartSpot >= PartCount then CrossPage.DataIsFinished := True
else
begin
GoLastCust;
Row := 0;
CrossPage.yPos := 10000;
end;
end;
end;
if Not CrossPage.DataIsFinished then ReadData;
end;
procedure TCrossForm.CrossPageDataFinish(Sender: TObject);
begin
PartTotal.Active := False;
CustList.Active := False;
end;
procedure TCrossForm.CrossReportBeforePrint(report: TSctReport);
begin
{ make a list of all the parts so all the values for a customers
parts go in the same columns as another customers parts.
Or so the same parts line up vertically }
PartSpot := 0;
PartCount := parts.RecordCount;
PartList.Clear;
parts.First;
while Not parts.eof do
begin
PartList.Add( parts.FieldByName('partno').AsString );
parts.next;
end;
end;
procedure TCrossForm.ReadData;
var
custno, partno: String;
Done: Boolean;
pos, count: Integer;
begin
if Not CrossPage.DataIsFinished then
begin
{ my query does not sum the values by cust,part so I must skip
thur the query and add up the part values manually. A better
query would allow me to this much easier and faster. So the
actual skipping occurs on a distinct customer query list that
ends up being the master table. After the master table is
positioned I go to my other query and total all of the part
values for a specific customer.
I used two queries to make the skipping process a little simpler
and summing query would make this function must easier
}
Done := False;
{ clear values }
for pos := 0 to 10 do values[pos] := 0;
parttotal.first;
while pCustNo.AsFloat <> CustListCustNo.AsFloat do parttotal.next;
while (pCustNo.AsFloat = CustListCustNo.AsFloat) And Not Done do
begin
custno := pCustNo.AsString;
partno := pPartNo.AsString;
total := 0;
while (custno = pCustNo.AsString) And (partno = pPartNo.AsString) And Not PartTotal.Eof do
begin
total := total + pTotal.AsFloat;
partTotal.Next;
end;
{ only fill in part values that will actually get printed on
the current page and ignore the rest }
count := 0;
while count < 11 do
begin
if (PartSpot + count) < partlist.Count then
begin
if partlist[PartSpot + count] = partno then
begin
values[count] := total;
Count := 11;
end else Inc(Count);
end else Count := 11;
end;
if parttotal.eof then Done := True;
end;
end;
end;
procedure TCrossForm.GoLastCust;
begin
custlist.first;
while CustListCustNo.AsFloat <> SaveCust do CustList.next;
end;
procedure TCrossForm.FormCreate(Sender: TObject);
begin
PartList := TStringList.Create;
end;
procedure TCrossForm.FormDestroy(Sender: TObject);
begin
if PartList <> nil then PartList.Free;
end;
procedure TCrossForm.PartTotal1GetData(oVar: TSctvar);
procedure FillString( v: TSctVar; pos: Integer);
var
spot: Integer;
begin
spot := PartSpot + pos;
if PartList.Count > spot then
begin
if parts.FindKey([StrToFloat(partlist[spot])]) then
v.AsString := partsDescription.AsString
else v.AsString := partlist[spot];
end else v.AsString := '';
end;
begin
{ for simplicity all of the expression variables can get filled
in within one function on one of the variables. The rest of
the variable's ongetdata events must be left blank then. }
parttotal1.AsFloat := values[0];
parttotal2.AsFloat := values[1];
parttotal3.AsFloat := values[2];
parttotal4.AsFloat := values[3];
parttotal5.AsFloat := values[4];
parttotal6.AsFloat := values[5];
parttotal7.AsFloat := values[6];
parttotal8.AsFloat := values[7];
parttotal9.AsFloat := values[8];
parttotal10.AsFloat := values[9];
parttotal11.AsFloat := values[10];
FillString( part1, 0 );
FillString( part2, 1 );
FillString( part3, 2 );
FillString( part4, 3 );
FillString( part5, 4 );
FillString( part6, 5 );
FillString( part7, 6 );
FillString( part8, 7 );
FillString( part9, 8 );
FillString( part10, 9 );
FillString( part11, 10 );
end;
procedure TCrossForm.TSctvarlabel12LabelPrintWhen(lb: TSctLabel; var Result: Boolean);
begin
{ all of the labels that print values can be assigned to this one
onprintwhen function to suppress the printing of zero values.
To do specific stuff for certain labels, make a seperate event for
them. }
result := ( TSctVarLabel(lb).Variable.AsFloat <> 0 );
end;
procedure TCrossForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -