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

📄 cross.pas

📁 suite component ace report
💻 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 + -