{*******************************************************}
{                                                       }
{  Responsive Software     http://www.responsive.co.nz  }
{                                                       }
{  Copyright (c) 2003-2006 Responsive Software Limited  }
{                                                       }
{*******************************************************}

unit SalesReportFormat;

interface

uses
  DatabaseObjects, GeneralUtilities, Utilities;

procedure FormatSalesReportDetails
  (Parameters : TSalesReportParameters;
   ReportData : TReportData);

implementation

uses
  SysUtils, DatabaseManager, Globals, Progress;

type
  TLineType = (ltHeading,ltDetail,ltTotal,ltSubtotal);

var
  // this is a global reference to the parameters so they
  // can be referred to from the global compare function
  GlobalParameters : TSalesReportParameters;

function CompareSalesForSalesReport
  (Item1, Item2 : pointer) : integer;
var
  Sale1,
  Sale2 : TSale;
begin
  Sale1 := TSale(Item1);
  Sale2 := TSale(Item2);
  if (Sale1 = nil) and (Sale2 = nil) then
    Result := 0
  else if (Sale1 = nil) and (Sale2 <> nil) then
    Result := -1
  else if (Sale1 <> nil) and (Sale2 = nil) then
    Result := 1
  else begin
    if GlobalParameters.OrderBy = diSaleDate then
    begin
      // compare on sale date
      Result := Round((Sale2.DateTime - Sale1.DateTime) * 100000);
      // compare on salesperson name
      if Result = 0 then
        Result := CompareText(SalespersonName(Sale1.SalespersonId),
          SalespersonName(Sale2.SalespersonId));
    end else if GlobalParameters.OrderBy = diSalesperson then
    begin
      // compare on salesperson name
      Result := CompareText(SalespersonName(Sale1.SalespersonId),
        SalespersonName(Sale2.SalespersonId));
      // compare on sale date
      if Result = 0 then
        Result := Round((Sale2.DateTime - Sale1.DateTime) * 100000);
    end else
      Result := 0;
  end;
end;

function CompareSaleItemsForSalesReport
  (Item1, Item2 : pointer) : integer;
var
  SaleItem1,
  SaleItem2 : TSaleItem;
begin
  SaleItem1 := TSaleItem(Item1);
  SaleItem2 := TSaleItem(Item2);
  if (SaleItem1 = nil) and (SaleItem2 = nil) then
    Result := 0
  else if (SaleItem1 = nil) and (SaleItem2 <> nil) then
    Result := -1
  else if (SaleItem1 <> nil) and (SaleItem2 = nil) then
    Result := 1
  else begin
    // compare on item name
    Result := CompareText(ItemName(SaleItem1.ItemId),
      ItemName(SaleItem2.ItemId));
    // compare on sale date
    if Result = 0 then
      Result := Round((SaleItem2.Sale.DateTime - SaleItem1.Sale.DateTime) * 100000);
  end;
end;

function ComparePaymentItemsForSalesReport
  (Item1, Item2 : pointer) : integer;
var
  PaymentItem1,
  PaymentItem2 : TPaymentItem;
begin
  PaymentItem1 := TPaymentItem(Item1);
  PaymentItem2 := TPaymentItem(Item2);
  if (PaymentItem1 = nil) and (PaymentItem2 = nil) then
    Result := 0
  else if (PaymentItem1 = nil) and (PaymentItem2 <> nil) then
    Result := -1
  else if (PaymentItem1 <> nil) and (PaymentItem2 = nil) then
    Result := 1
  else begin
    // compare on payment type name
    Result := CompareText(PaymentTypeName(PaymentItem1.PaymentTypeId),
      PaymentTypeName(PaymentItem2.PaymentTypeId));
    // compare on sale date
    if Result = 0 then
      Result := Round((PaymentItem2.Sale.DateTime - PaymentItem1.Sale.DateTime) * 100000);
  end;
end;

procedure FormatSalesReportDetails
  (Parameters : TSalesReportParameters;
   ReportData : TReportData);
var
  SelectionString : string;
  Sales : TDatabaseObjectCollection;
  SaleItems : TDatabaseObjectCollection;
  PaymentItems : TDatabaseObjectCollection;
  i,j : integer;
  BeginDate, EndDate : TDateTime;
  Sale : TSale;
  SaleItem : TSaleItem;
  PaymentItem : TPaymentItem;

  SubtotalTotalPrice : int64;
  TotalTotalPrice : int64;

  SubtotalQuantity : double;
  SubtotalFullPrice : int64;
  SubtotalDiscount : int64;
  SubtotalNetPrice : int64;
  TotalQuantity : double;
  TotalFullPrice : int64;
  TotalDiscount : int64;
  TotalNetPrice : int64;

  SubtotalAmount : int64;
  TotalAmount : int64;

  // used to determine when to print subtotals
  PreviousSale : TSale;
  PreviousSaleItem : TSaleItem;
  PreviousPaymentItem : TPaymentItem;
  PreviousSubtotalKey : string;

  procedure PrintSaleLine
    (LineType : TLineType;
     Sale : TSale);
  var
    Str : string;
  begin
    if LineType = ltHeading then
    begin
      TSale.ShowHeadingsOnSalesReport(ReportData);
      ReportData.WriteLine('');
    end else if LineType = ltDetail then
    begin
      if not Parameters.TotalsOnly then
        Sale.ShowOnSalesReport(ReportData);
      SubtotalTotalPrice := SubtotalTotalPrice + Sale.TotalPrice;
      TotalTotalPrice := TotalTotalPrice + Sale.TotalPrice;
    end
    else if LineType = ltSubtotal then
    begin
      Str := '';
      if Parameters.OrderBy = diSaleDate then
        Str := Str + Format('%-8.8s ',[ShortFormatDate(Trunc(Sale.DateTime))])
      else
        Str := Str + '         ';
      Str := Str + '         ';
      if Parameters.OrderBy = diSalesperson then
        Str := Str + Format('%-15.15s ',[SalespersonName(Sale.SalespersonId)])
      else
        Str := Str + '                ';
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(SubtotalTotalPrice)]);
      ReportData.WriteBoldLine(Str);
      ReportData.WriteLine('');
    end
    else if LineType = ltTotal then
    begin
      Str := '';
      Str := Str + 'TOTALS   ';
      Str := Str + '         ';
      Str := Str + '                ';
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(TotalTotalPrice)]);
      ReportData.WriteBoldLine(Str);
    end;
  end;

  procedure PrintSaleSubtotals
    (Sale : TSale);
  var
    SubtotalKey : string;
  begin
    // check if key has changed and if so then print subtotals
    if Sale <> nil then
    begin
      if Parameters.OrderBy = diSaleDate then
        SubtotalKey := Format('%-8.8s',[ShortFormatDate(Trunc(Sale.DateTime))])
      else if Parameters.OrderBy = diSalesperson then
        SubtotalKey := SalespersonName(Sale.SalespersonId);
    end else
      SubtotalKey := '';
    if (PreviousSale <> nil) and
      (PreviousSubtotalKey <> SubtotalKey) then
    begin
      PrintSaleLine(ltSubtotal,PreviousSale);
      // reinitialise subtotal accumulators
      SubtotalTotalPrice := 0;
    end;
    PreviousSale := Sale;
    PreviousSubtotalKey := SubtotalKey;
  end;

  procedure PrintSaleItemLine
    (LineType : TLineType;
     SaleItem : TSaleItem);
  var
    Str : string;
  begin
    if LineType = ltHeading then
    begin
      TSaleItem.ShowHeadingsOnSalesReport(ReportData);
      ReportData.WriteLine('');
    end else if LineType = ltDetail then
    begin
      if not Parameters.TotalsOnly then
        SaleItem.ShowOnSalesReport(ReportData);
      SubtotalQuantity := SubtotalQuantity + SaleItem.Quantity;
      SubtotalFullPrice := SubtotalFullPrice + SaleItem.FullPrice;
      SubtotalDiscount := SubtotalDiscount + SaleItem.Discount;
      SubtotalNetPrice := SubtotalNetPrice + SaleItem.NetPrice;
      TotalQuantity := TotalQuantity + SaleItem.Quantity;
      TotalFullPrice := TotalFullPrice + SaleItem.FullPrice;
      TotalDiscount := TotalDiscount + SaleItem.Discount;
      TotalNetPrice := TotalNetPrice + SaleItem.NetPrice;
    end
    else if LineType = ltSubtotal then
    begin
      Str := '';
      Str := Str + Format(' %-5s ',[FloatToStr(SubtotalQuantity)]);
      Str := Str + Format('  %-30.30s ',[ItemName(SaleItem.ItemId)]);
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(SubtotalFullPrice)]);
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(SubtotalDiscount)]);
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(SubtotalNetPrice)]);
      ReportData.WriteBoldLine(Str);
      ReportData.WriteLine('');
    end
    else if LineType = ltTotal then
    begin
      Str := '';
      Str := Str + Format(' %-5s ',[FloatToStr(TotalQuantity)]);
      Str := Str + '  TOTAL ITEMS                    ';
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(TotalFullPrice)]);
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(TotalDiscount)]);
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(TotalNetPrice)]);
      ReportData.WriteBoldLine(Str);
    end;
  end;

  procedure PrintSaleItemSubtotals
    (SaleItem : TSaleItem);
  var
    SubtotalKey : string;
  begin
    // check if key has changed and if so then print subtotals
    if SaleItem <> nil then
      SubtotalKey := ItemName(SaleItem.ItemId)
    else
      SubtotalKey := '';
    if (PreviousSaleItem <> nil) and
      (PreviousSubtotalKey <> SubtotalKey) then
    begin
      PrintSaleItemLine(ltSubtotal,PreviousSaleItem);
      // reinitialise subtotal accumulators
      SubtotalQuantity := 0;
      SubtotalFullPrice := 0;
      SubtotalDiscount := 0;
      SubtotalNetPrice := 0;
    end;
    PreviousSaleItem := SaleItem;
    PreviousSubtotalKey := SubtotalKey;
  end;

  function TotalChange : int64;
  var
    i : integer;
  begin
    Result := 0;
    for i := 0 to Sales.Count - 1 do
      Result := Result + TSale(Sales[i]).Change;
  end;

  procedure PrintPaymentItemLine
    (LineType : TLineType;
     PaymentItem : TPaymentItem);
  var
    Str : string;
  begin
    if LineType = ltHeading then
    begin
      TPaymentItem.ShowHeadingsOnSalesReport(ReportData);
      ReportData.WriteLine('');
    end else if LineType = ltDetail then
    begin
      if not Parameters.TotalsOnly then
        PaymentItem.ShowOnSalesReport(ReportData);
      SubtotalAmount := SubtotalAmount + PaymentItem.Amount;
      TotalAmount := TotalAmount + PaymentItem.Amount;
    end
    else if LineType = ltSubtotal then
    begin
      Str := '';
      Str := Str + Format('  %-25.25s ',[PaymentTypeName(PaymentItem.PaymentTypeId)]);
      Str := Str + '                            ';
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(SubtotalAmount)]);
      ReportData.WriteBoldLine(Str);
      ReportData.WriteLine('');
    end
    else if LineType = ltTotal then
    begin
      Str := '';
      Str := Str + '  TOTAL                     ';
      Str := Str + '                            ';
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(TotalAmount)]);
      Str := Str + '         ';
      Str := Str + '  CHANGE ';
      Str := Str + Format(' %15.15s',[FormatCurrencyForDisplay(TotalChange)]);
      ReportData.WriteBoldLine(Str);
    end;
  end;

  procedure PrintPaymentItemSubtotals
    (PaymentItem : TPaymentItem);
  var
    SubtotalKey : string;
  begin
    // check if key has changed and if so then print subtotals
    if PaymentItem <> nil then
      SubtotalKey := PaymentTypeName(PaymentItem.PaymentTypeId)
    else
      SubtotalKey := '';
    if (PreviousPaymentItem <> nil) and
      (PreviousSubtotalKey <> SubtotalKey) then
    begin
      PrintPaymentItemLine(ltSubtotal,PreviousPaymentItem);
      // reinitialise subtotal accumulators
      SubtotalAmount := 0;
    end;
    PreviousPaymentItem := PaymentItem;
    PreviousSubtotalKey := SubtotalKey;
  end;

begin
  ProgressForm.SetStep(1);
  ProgressForm.SetCaption('Generating Sales report.  Please wait...');
  ProgressForm.Show;
  ProgressForm.StepIt;

try
  // allow parameters to be referenced from the compare function
  GlobalParameters := Parameters;
  // initialise detail collections
  SaleItems := nil;
  PaymentItems := nil;
  // create the collection to hold the sales
  Sales := TDatabaseObjectCollection.Create;
  Sales.Owned := true;
  // load collection of sales
  BeginDate := Date + Parameters.BeginSaleDate;
  EndDate := Date + Parameters.EndSaleDate;
  if Firebird then
    SelectionString := 'WHERE ' + DelimitSQLFieldName('Date') + ' >= ' + DelimitSQLStringValue(ConvertDateToDatabaseString(BeginDate))
      + ' AND ' + DelimitSQLFieldName('Date') + ' <= ' + DelimitSQLStringValue(ConvertDateToDatabaseString(EndDate))
  else
    SelectionString := 'WHERE Sale."Date" >= ' + DelimitSQLStringValue(ConvertDateToDatabaseString(BeginDate))
      + ' AND Sale."Date" <= ' + DelimitSQLStringValue(ConvertDateToDatabaseString(EndDate));
  if Parameters.SalespersonId <> 0 then
    SelectionString := SelectionString + ' AND ' + DelimitSQLFieldName('SalespersonId') + ' = ' + IntToStr(Parameters.SalespersonId); 

  Sales.LoadSomeObjects(TSale,SelectionString);

  // if an item was specified go through the sales and remove those
  // which do not contain this item
  if Parameters.ItemId <> 0 then
    // do it in reverse order as items will be deleted as we go
    for i := Sales.Count - 1 downto 0 do
    begin
      Sale := TSale(Sales[i]);
      if not Sale.IncludesItem(Parameters.ItemId) then
        Sales.Delete(i);
    end;
  // if a payment type was specified go through the sales and remove those
  // which do not contain this payment type
  if Parameters.PaymentTypeId <> 0 then
    // do it in reverse order as items will be deleted as we go
    for i := Sales.Count - 1 downto 0 do
    begin
      Sale := TSale(Sales[i]);
      if not Sale.IncludesPaymentType(Parameters.PaymentTypeId) then
        Sales.Delete(i);
    end;

  ProgressForm.StepIt;

  // if sorting on item then populate sale items collection
  if Parameters.OrderBy = diItem then
  begin
    SaleItems := TDatabaseObjectCollection.Create;
    SaleItems.Owned := false;
    for i := 0 to Sales.Count - 1 do
    begin
      Sale := TSale(Sales[i]);
      for j := 0 to Sale.SaleItems.Count - 1 do
      begin
        SaleItem := TSaleItem(Sale.SaleItems[j]);
        SaleItems.Add(SaleItem);
        SaleItem.SetSale(Sale);
      end;
    end;
    SaleItems.Sort(CompareSaleItemsForSalesReport);
  // if sorting on payment type then populate payment items collection
  end else if Parameters.OrderBy = diPaymentType then
  begin
    PaymentItems := TDatabaseObjectCollection.Create;
    PaymentItems.Owned := false;
    for i := 0 to Sales.Count - 1 do
    begin
      Sale := TSale(Sales[i]);
      for j := 0 to Sale.PaymentItems.Count - 1 do
      begin
        PaymentItem := TPaymentItem(Sale.PaymentItems[j]);
        PaymentItems.Add(PaymentItem);
        PaymentItem.SetSale(Sale);
      end;
    end;
    PaymentItems.Sort(ComparePaymentItemsForSalesReport);
  // otherwise sort sale collection
  end else
    Sales.Sort(CompareSalesForSalesReport);

  if Parameters.OrderBy = diItem then
  begin
    // if no data then show message on report
    if SaleItems.Count = 0 then
      ReportData.WriteLine('No data found which meets selection criteria')
    else begin
      // otherwise work through the sale items in turn
      SubtotalQuantity := 0;
      SubtotalFullPrice := 0;
      SubtotalDiscount := 0;
      SubtotalNetPrice := 0;
      TotalQuantity := 0;
      TotalFullPrice := 0;
      TotalDiscount := 0;
      TotalNetPrice := 0;
      PreviousSale := nil;
      PreviousSubtotalKey := '';
      PrintSaleItemLine(ltHeading,nil);
      for i := 0 to SaleItems.Count - 1 do
      begin
        PrintSaleItemSubtotals(TSaleItem(SaleItems[i]));
        PrintSaleItemLine(ltDetail,TSaleItem(SaleItems[i]));
        ProgressForm.SetPosition(i * 100 div SaleItems.Count);
      end;
      PrintSaleItemSubtotals(nil);
      PrintSaleItemLine(ltTotal,nil);
    end;
  end else if Parameters.OrderBy = diPaymentType then
  begin
    // if no data then show message on report
    if PaymentItems.Count = 0 then
      ReportData.WriteLine('No data found which meets selection criteria')
    else begin
      // otherwise work through the payment items in turn
      SubtotalAmount := 0;
      TotalAmount := 0;
      PreviousPaymentItem := nil;
      PreviousSubtotalKey := '';
      PrintPaymentItemLine(ltHeading,nil);
      for i := 0 to PaymentItems.Count - 1 do
      begin
        PrintPaymentItemSubtotals(TPaymentItem(PaymentItems[i]));
        PrintPaymentItemLine(ltDetail,TPaymentItem(PaymentItems[i]));
        ProgressForm.SetPosition(i * 100 div PaymentItems.Count);
      end;
      PrintPaymentItemSubtotals(nil);
      PrintPaymentItemLine(ltTotal,nil);
    end;
  end else
  begin
    // if no data then show message on report
    if Sales.Count = 0 then
      ReportData.WriteLine('No data found which meets selection criteria')
    else begin
      // otherwise work through the sales in turn
      SubtotalTotalPrice := 0;
      TotalTotalPrice := 0;
      PreviousSale := nil;
      PreviousSubtotalKey := '';
      PrintSaleLine(ltHeading,nil);
      for i := 0 to Sales.Count - 1 do
      begin
        PrintSaleSubtotals(TSale(Sales[i]));
        PrintSaleLine(ltDetail,TSale(Sales[i]));
        ProgressForm.SetPosition(i * 100 div Sales.Count);
      end;
      PrintSaleSubtotals(nil);
      PrintSaleLine(ltTotal,nil);
    end;
  end;

  ProgressForm.SetPosition(100);

  // free collections
  SaleItems.Free;
  PaymentItems.Free;
  Sales.Free;

finally
  ProgressForm.Hide;
end;

end;

end.