arinvoiceform.pas

功能全面的商业财会系统源码,清晰,很有参考价值.扩展性强.

  if (shift = [ssShift]) and (key = VK_Tab) and (DBGrid1.SelectedIndex = 0) then begin
    //if (tblARInvDet.bof = true) or (tblARInvDet.Recno = 1) then editDiscountAmount.setfocus;
    if (tblARInvDet.bof = true) or (tblARInvDet.Recno = 1) then editOriginalInvNo.setfocus;
  end;
end;

procedure TfrmARInvoice.tblARInvDetNewRecord(DataSet: TDataSet);
begin
  tblARInvDetARInvoiceID.value := tblARInvARInvoiceID.value;
end;

procedure TfrmARInvoice.tblARInvNewRecord(DataSet: TDataSet);
var
  Year, Month, Day: word;
begin
  with tblARInvCtl do begin
      Open;
      try
        Edit;
        tblARInvARInvoiceID.Value := tblARInvCtlNextInvoiceID.Value;
        tblARInvCtlNextInvoiceID.Value := tblARInvCtlNextInvoiceID.Value + 1;
        if (tblARInvCtlNextInvoiceNo.Value < 1001) or (tblARInvCtlNextInvoiceNo.Value > 10000000) then tblARInvCtlNextInvoiceNo.Value := 10001;   //Start auto-assigned numbers here.
        tblARInvInvoiceNo.Value := tblARInvCtlNextInvoiceNo.AsString;
        tblARInvCtlNextInvoiceNo.Value := tblARInvCtlNextInvoiceNo.Value + 1;
        Post;
      finally
        DbiSaveChanges(tblARInvCtl.handle);
        Close;
      end;
    end;
  tblARInvInvoiceDate.value := Date;
  tblARInvPrinted.value := false;
  tblARInvPosted.value := false;
  DecodeDate(Date, Year, Month, Day);
  if frmBS1.tblCompanyDefaultPeriodPP.value > 0 then tblARInvGLPeriod.value := frmBS1.tblCompanyDefaultPeriodPP.value
  else tblARInvGLPeriod.value := Month;
  if frmBS1.tblCompanyDefaultPeriodYYYY.value > 0 then tblARInvGLYear.value := frmBS1.tblCompanyDefaultPeriodYYYY.value
  else tblARInvGLYear.value := Year;
end;

procedure TfrmARInvoice.tblARInvUpdateError(DataSet: TDataSet;
  E: EDatabaseError; UpdateKind: TUpdateKind;
  var UpdateAction: TUpdateAction);
begin
  if E is EDBEngineError then
    with EDBEngineError(E) do
    begin
      if Errors[ErrorCount - 1].ErrorCode = 9729 then begin   //Key violation (key already exists).
        with editInvoiceNo do begin Show; SetFocus; end;
        Application.MessageBox(PChar('Invoice no. already exists.'), PChar(Application.Title), mb_OK + mb_DefButton1 + mb_IconStop);
        UpdateAction := uaAbort;
      end else begin
        Application.MessageBox(PChar(IntToStr(Errors[ErrorCount - 1].ErrorCode) + ': ' + E.Message + '.'), PChar(Application.Title), mb_OK + mb_DefButton1 + mb_IconStop);
        UpdateAction := uaAbort;
      end;
    end;
end;

procedure TfrmARInvoice.tblARInvDetUpdateError(DataSet: TDataSet;
  E: EDatabaseError; UpdateKind: TUpdateKind;
  var UpdateAction: TUpdateAction);
begin
  if (tblARInv.UpdatesPending = true) then UpdateAction := uaAbort   //Master record not posted yet (had error).
  else if E is EDBEngineError then
    with EDBEngineError(E) do begin
      if (Errors[ErrorCount - 1].ErrorCode = 9733) then begin    //Master record missing.
        Application.MessageBox(PChar('Item does not exist.'), PChar(Application.Title), mb_OK + mb_DefButton1 + mb_IconStop);
        UpdateAction := uaAbort;
      end else begin
        Application.MessageBox(PChar(IntToStr(Errors[ErrorCount - 1].ErrorCode) + ': ' + E.Message + '.'), PChar(Application.Title), mb_OK + mb_DefButton1 + mb_IconStop);
        UpdateAction := uaSkip;
      end;
    end;
end;

procedure TfrmARInvoice.editCustomerNoExit(Sender: TObject);
var
  LocateSuccess: Boolean;
begin
  if editCustomerNo.text <> tblARInvCustomerNo.value then begin
    if editCustomerNo.text <> '' then begin
      //if dmLookUps.tblCustomer.Locate('CustomerNo', editCustomerNo.Text, []) <> true then begin
      LocateSuccess := dmLookUps.tblCustomer.Locate('CustomerNo', editCustomerNo.Text, []);
      if (LocateSuccess = true) and (dmLookUps.tblCustomerBillToNo.AsVariant <> null) then tblBillTo.open;   //Only open tblBillTo if required.
      if LocateSuccess <> true then begin
        editCustomerNo.setfocus;
        raise(Exception.Create('Ship-to no. ' + '''' + editCustomerNo.Text + '''' + ' not found'));
      end else if dmLookUps.tblCustomerSuspended.value = true then begin
        editCustomerNo.setfocus;
        raise(exception.create('Ship-to no. '  + '''' + editCustomerNo.Text + '''' + ' has been suspended'));
      end else if dmLookUps.tblCustomerBillToOnly.value = true then begin
        editCustomerNo.setfocus;
        raise(exception.create('Customer '  + '''' + dmLookUps.tblCustomerCustomerNo.value + ': ' + dmLookUps.tblCustomerCustomerName.value + '''' + ' is specified as a "Bill-to Only"'));
      end else if (dmLookUps.tblCustomerBillToNo.AsVariant <> null) and (tblBillTo.Lookup('CustomerNo', dmLookUps.tblCustomerBillToNo.value, 'Suspended') = true) then begin
        editCustomerNo.setfocus;
        raise(exception.create('Ship-to no. '  + '''' + editCustomerNo.Text + '''' + ' bill-to has been suspended'));
      end else begin
        if tblARInv.state <> dsInsert then tblARInv.edit;
        tblARInvCustomerID.value := dmLookUps.tblCustomerCustomerID.value;
      end;
    end else begin
      if tblARInv.state <> dsInsert then tblARInv.edit;
      tblARInvCustomerID.AsVariant := null;
    end;
  end;
end;

procedure TfrmARInvoice.editCustomerNoKeyPress(Sender: TObject;
  var Key: Char);
begin
  if key = #27 then begin   //Esc.
    key := #0;
    editCustomerNo.text := tblARInvCustomerNo.value;
  end;
end;

procedure TfrmARInvoice.tblARInvBeforeInsert(DataSet: TDataSet);
begin
  NextDetailLineNo := 1;
end;

procedure TfrmARInvoice.tblARInvBeforeEdit(DataSet: TDataSet);
begin
  if tblARInvPosted.value = true then raise(EAbort.create(''));  //Silent Exception: "abort;" replaced by "raise etc" since abort conflicts with BDE (required by DbiSaveChanges).   //Make tables read-only without having to reset "active".
  
  qryLastDetailLineNo.close;
  qryLastDetailLineNo.open;
  with qryLastDetailLineNo.Fields[0] do
    if IsNull then NextDetailLineNo := 1
    else NextDetailLineNo := AsInteger + 1;
end;

procedure TfrmARInvoice.tblARInvDetBeforePost(DataSet: TDataSet);
begin
  if tblARInvDetSeq.AsVariant = null then begin   //Assign Seq here rather than OnNewRecord so as not to upset grid "exit on blank record" feature.
    tblARInvDetSeq.value := NextDetailLineNo;
    Inc(NextDetailLineNo);
  end;
end;

procedure TfrmARInvoice.tblARInvDetBeforeEdit(DataSet: TDataSet);
begin
  tblARInv.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
  OldExtAmount := tblARInvDetExtAmount.value;
  OldTaxCodes := tblARInvDetTaxCodes.value;
end;

procedure TfrmARInvoice.tblARInvDetBeforeInsert(DataSet: TDataSet);
begin
  tblARInv.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state) & get next detail line no (if not already got).
  OldExtAmount := 0;
  OldTaxCodes := '';
end;

procedure TfrmARInvoice.tblARInvDetBeforeDelete(DataSet: TDataSet);
begin
  tblARInv.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
  if not (tblARInvDet.state in [dsInsert, dsEdit]) then begin
    OldExtAmount := tblARInvDetExtAmount.value;
    OldTaxCodes := tblARInvDetTaxCodes.value;
  end;
end;

procedure TfrmARInvoice.tblARInvGLYearGetText(Sender: TField;
  var Text: string; DisplayText: Boolean);
begin
  if DisplayText = false then Text := Copy(tblARInvGLYear.AsString,3,2)   //If editing, show last 2 digits of year.
  else Text := tblARInvGLYear.AsString;
end;

procedure TfrmARInvoice.tblARInvGLYearSetText(Sender: TField;
  const Text: string);
begin
  if Text = '' then tblARInvGLYear.AsVariant := null else begin   //Convert 2 digit year to 4.
    if (StrToInt(Text) < 0) or (StrToInt(Text) > 99) then raise(exception.create('Period invalid...' + #13 + 'Enter year as 2 digits'));
    if StrToInt(Text) < 50 then tblARInvGLYear.value := StrToInt(Text) + 2000
    else tblARInvGLYear.value := StrToInt(Text) + 1900;
  end;
end;

procedure TfrmARInvoice.tblARInvBeforePost(DataSet: TDataSet);
var
  ARInvGLPeriodYYYYPP, EPeriodFromYYYYPP, EPeriodToYYYYPP, WPeriodFromYYYYPP, WPeriodToYYYYPP: integer;
begin
  if tblARInvPosted.value = false then begin
    ARInvGLPeriodYYYYPP := (tblARInvGLYear.value * 100) + tblARInvGLPeriod.value;
    EPeriodFromYYYYPP := (frmBS1.tblCompanyEPeriodFromYYYY.value * 100) + frmBS1.tblCompanyEPeriodFromPP.value;
    EPeriodToYYYYPP := (frmBS1.tblCompanyEPeriodToYYYY.value * 100) + frmBS1.tblCompanyEPeriodToPP.value;
    WPeriodFromYYYYPP := (frmBS1.tblCompanyWPeriodFromYYYY.value * 100) + frmBS1.tblCompanyWPeriodFromPP.value;
    WPeriodToYYYYPP := (frmBS1.tblCompanyWPeriodToYYYY.value * 100) + frmBS1.tblCompanyWPeriodToPP.value;

    if frmBS1.tblCompanyFiscalYear.value = 0 then begin
      with editGLPeriod do begin Show; SetFocus; end;
      raise(exception.create('Current fiscal year is not yet defined...' + #13 + 'See "Your Company"'));
    end;
    if tblARInvGLYear.value < frmBS1.tblCompanyFiscalYear.value then begin
      with editGLPeriod do begin Show; SetFocus; end;
      raise(exception.create('GL Period is prior to current fiscal year ' + #13 + 'as defined by "Your Company"'));
    end;
    if (ARInvGLPeriodYYYYPP < EPeriodFromYYYYPP) or ((EPeriodToYYYYPP > 0) and (ARInvGLPeriodYYYYPP > EPeriodToYYYYPP)) then begin
      with editGLPeriod do begin Show; SetFocus; end;
      raise(exception.create('GL Period is not within allowed range ' + #13 + 'as defined by "Your Company"'));
    end;
    if (ARInvGLPeriodYYYYPP < WPeriodFromYYYYPP) or ((WPeriodToYYYYPP > 0) and (ARInvGLPeriodYYYYPP > WPeriodToYYYYPP)) then begin
      if Application.MessageBox(PChar('GL Period is not within expected range ' + #13 + 'as defined by "Your Company".'), PChar('Warning'), mb_OKCancel + mb_DefButton2 + mb_IconExclamation) <> IDOK then begin
        with editGLPeriod do begin Show; SetFocus; end;
        raise(EAbort.create(''));  //Silent Exception: "abort;" replaced by "raise etc" since abort conflicts with BDE (required by DbiSaveChanges).
      end;
    end;

    if tblARInvDet.RecordCount = 0 then begin
      with DBGrid1 do begin Show; SetFocus; end;
      raise(exception.create('Items have not been entered'));
    end;

    dmLookUps.tblCustomer.Active := true;
    if dmLookUps.tblCustomer.Locate('CustomerID', tblARInvCustomerID.value, []) <> true then begin
      with editCustomerNo do begin Show; SetFocus; end;
      raise(exception.create('Ship-to no longer exists'));   //Deleted by another user since this user selected.
    end;
    if dmLookUps.tblCustomer.Locate('CustomerID', tblARInvBillToID.value, []) <> true then begin
      with editCustomerNo do begin Show; SetFocus; end;
      raise(exception.create('Bill-to no longer exists'));   //Deleted by another user since this user selected.
    end;
  end;
end;

procedure TfrmARInvoice.tblARInvDetAfterPost(DataSet: TDataSet);
var
  TaxCode: string;
  OldTaxAmount: currency;
begin
  TaxCode := Copy(OldTaxCodes,1,1); if TaxCode <> '' then CalcTaxableAmount(TaxCode,-OldExtAmount, tblARInvTaxableAmtCode1, tblARInvTaxableAmtCode2, tblARInvTaxableAmtCode3, tblARInvTaxableAmount1, tblARInvTaxableAmount2, tblARInvTaxableAmount3);
  TaxCode := Copy(OldTaxCodes,2,1); if TaxCode <> '' then CalcTaxableAmount(TaxCode,-OldExtAmount, tblARInvTaxableAmtCode1, tblARInvTaxableAmtCode2, tblARInvTaxableAmtCode3, tblARInvTaxableAmount1, tblARInvTaxableAmount2, tblARInvTaxableAmount3);
  TaxCode := Copy(OldTaxCodes,3,1); if TaxCode <> '' then CalcTaxableAmount(TaxCode,-OldExtAmount, tblARInvTaxableAmtCode1, tblARInvTaxableAmtCode2, tblARInvTaxableAmtCode3, tblARInvTaxableAmount1, tblARInvTaxableAmount2, tblARInvTaxableAmount3);
  TaxCode := Copy(tblARInvDetTaxCodes.value,1,1); if TaxCode <> '' then CalcTaxableAmount(TaxCode,tblARInvDetExtAmount.value, tblARInvTaxableAmtCode1, tblARInvTaxableAmtCode2, tblARInvTaxableAmtCode3, tblARInvTaxableAmount1, tblARInvTaxableAmount2, tblARInvTaxableAmount3);
  TaxCode := Copy(tblARInvDetTaxCodes.value,2,1); if TaxCode <> '' then CalcTaxableAmount(TaxCode,tblARInvDetExtAmount.value, tblARInvTaxableAmtCode1, tblARInvTaxableAmtCode2, tblARInvTaxableAmtCode3, tblARInvTaxableAmount1, tblARInvTaxableAmount2, tblARInvTaxableAmount3);
  TaxCode := Copy(tblARInvDetTaxCodes.value,3,1); if TaxCode <> '' then CalcTaxableAmount(TaxCode,tblARInvDetExtAmount.value, tblARInvTaxableAmtCode1, tblARInvTaxableAmtCode2, tblARInvTaxableAmtCode3, tblARInvTaxableAmount1, tblARInvTaxableAmount2, tblARInvTaxableAmount3);

  OldTaxAmount := Tax1Amount + Tax2Amount;
  //calcTax(tblARInvTax1Code, tblARInvTax2Code, tblARInvTax1Description, tblARInvTax2Description, tblARInvTaxableAmtCode1, tblARInvTaxableAmtCode2, tblARInvTaxableAmtCode3, tblARInvTax1Rate, tblARInvTax2Rate, tblARInvTaxableAmount1, tblARInvTaxableAmount2, tblARInvTaxableAmount3);
  if tblARInvTax1Code.value = tblARInvTaxableAmtCode1.value then Tax1Amount := frmBS1.RoundIt(tblARInvTaxableAmount1.value * tblARInvTax1Rate.value)/100
  else if tblARInvTax1Code.value = tblARInvTaxableAmtCode2.value then Tax1Amount := frmBS1.RoundIt(tblARInvTaxableAmount2.value * tblARInvTax1Rate.value)/100
  else if tblARInvTax1Code.value = tblARInvTaxableAmtCode3.value then Tax1Amount := frmBS1.RoundIt(tblARInvTaxableAmount3.value * tblARInvTax1Rate.value)/100
  else Tax1Amount := 0;
  if tblARInvTax2Code.value = tblARInvTaxableAmtCode1.value then Tax2Amount := frmBS1.RoundIt(tblARInvTaxableAmount1.value * tblARInvTax2Rate.value)/100
  else if tblARInvTax2Code.value = tblARInvTaxableAmtCode2.value then Tax2Amount := frmBS1.RoundIt(tblARInvTaxableAmount2.value * tblARInvTax2Rate.value)/100
  else if tblARInvTax2Code.value = tblARInvTaxableAmtCode3.value then Tax2Amount := frmBS1.RoundIt(tblARInvTaxableAmount3.value * tblARInvTax2Rate.value)/100
  else Tax2Amount := 0;
  if Tax1Amount <> 0 then lblTaxes.caption := tblARInvTax1Description.value + ': ' + FloatToStrF(Tax1Amount,ffCurrency,18,2) + '     '
  else lblTaxes.caption := '';
  if Tax2Amount <> 0 then lblTaxes.caption := lblTaxes.caption + tblARInvTax2Description.value + ': ' + FloatToStrF(Tax2Amount,ffCurrency,18,2);