arpaymentform.pas

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

    if not (ActiveControl is TDBGrid) then begin   //Move to 1st record on grid.
      DBGrid1.Setfocus;
      tblARInvPmt.First;
      DBGrid1.SelectedIndex := 0;
    end else begin
      tblARInvPmt.append;   //Move to new record on grid.
      DBGrid1.SelectedIndex := 0;
    end;  
  end;
end;

procedure TfrmARPayment.DBGrid1Exit(Sender: TObject);
begin
  tblARInvPmt.First;
  DBGrid1.SelectedIndex := 0;
end;

procedure TfrmARPayment.DBGrid1Enter(Sender: TObject);
begin
  DBGrid1.SelectedIndex := 0;   //Fix problem caused when ColExit event causes exit from grid with pending Enter setting selected index to 2nd column.
end;

procedure TfrmARPayment.tblCustomerCalcFields(DataSet: TDataSet);
begin
  tblCustomerAddress.value := tblCustomerAddressLine1.value;
  if tblCustomerAddressLine2.value <> '' then tblCustomerAddress.value := tblCustomerAddress.value + ', ' + tblCustomerAddressLine2.value;
  if tblCustomerCity.value <> '' then tblCustomerAddress.value := tblCustomerAddress.value + ', ' + tblCustomerCity.value;
  if tblCustomerStateProv.value <> '' then tblCustomerAddress.value := tblCustomerAddress.value + ', ' + tblCustomerStateProv.value;
  if tblCustomerZipCode.value <> '' then tblCustomerAddress.value := tblCustomerAddress.value + ', ' + tblCustomerZipCode.value;
  if tblCustomerCountry.value <> '' then tblCustomerAddress.value := tblCustomerAddress.value + ', ' + tblCustomerCountry.value;
end;

procedure TfrmARPayment.editPaymentDateKeyPress(Sender: TObject;
  var Key: Char);
begin
  if Key = ^J then begin   //Ctrl+Enter show calendar.
    btnPaymentDateClick(sender);
    Key := #0;
  end else if Key = '+' then begin   //Increase/decrease date via +/- keys.
    tblARPmt.Edit;
    if editPaymentDate.field.AsVariant = null then editPaymentDate.field.AsDateTime := Date;
    editPaymentDate.field.AsDateTime := editPaymentDate.field.AsDateTime + 1;
    key := #0;
  end else if Key = '-' then begin
    tblARPmt.Edit;
    if editPaymentDate.field.AsVariant = null then editPaymentDate.field.AsDateTime := Date;
    editPaymentDate.field.AsDateTime := editPaymentDate.field.AsDateTime - 1;
    key := #0;
  end;
end;

procedure TfrmARPayment.dsARPmtDataChange(Sender: TObject; Field: TField);
begin
  if (tblARPmt.state = dsInsert) and (tblARPmtChequeNo.AsVariant = null) then self.Caption := 'New Payment'
  else self.Caption := 'Payment Cheque ' + tblARPmtChequeNo.AsString;

  editBillToNo.text := tblARPmtBillToNo.value;
  editBillToNo.ReadOnly := tblARPmtPosted.value;
  lblPosted.visible := tblARPmtPosted.value;
  if tblARPmtPosted.value = true then DBGrid1.Options := [dgTitles,dgIndicator,dgColumnResize,dgColLines,dgRowLines,dgTabs,dgConfirmDelete,dgCancelOnExit]   //If posted: set dgAlwaysShowEditor to false.
  else DBGrid1.Options := [dgEditing,dgAlwaysShowEditor,dgTitles,dgIndicator,dgColumnResize,dgColLines,dgRowLines,dgTabs,dgConfirmDelete,dgCancelOnExit];

  if tblARPmtBillToID.AsVariant = null then txtAddress.visible := false
  else txtAddress.visible := true;
end;

procedure TfrmARPayment.DBGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (shift = [ssShift]) and (key = VK_Tab) and (DBGrid1.SelectedIndex = 0) then begin
    if (tblARInvPmt.bof = true) or (tblARInvPmt.Recno = 1) then begin
      key := 0;
      editGLYear.setfocus;
    end;
  end;
end;

procedure TfrmARPayment.tblARInvPmtNewRecord(DataSet: TDataSet);
begin
  tblARInvPmtPaymentID.value := tblARPmtPaymentID.value;
end;

procedure TfrmARPayment.tblARPmtNewRecord(DataSet: TDataSet);
var
  Year, Month, Day: word;
begin
  with tblARPmtCtl do begin
      Open;
      try
        Edit;
        tblARPmtPaymentID.Value := tblARPmtCtlNextPaymentID.Value;
        tblARPmtCtlNextPaymentID.Value := tblARPmtCtlNextPaymentID.Value + 1;
        Post;
      finally
        DbiSaveChanges(tblARPmtCtl.handle);
        Close;
      end;
    end;
  tblARPmtPaymentDate.value := Date;
  tblARPmtPosted.value := false;
  DecodeDate(Date, Year, Month, Day);
  if frmBS1.tblCompanyDefaultPeriodPP.value > 0 then tblARPmtGLPeriod.value := frmBS1.tblCompanyDefaultPeriodPP.value
  else                                               tblARPmtGLPeriod.value := Month;
  if frmBS1.tblCompanyDefaultPeriodYYYY.value > 0 then tblARPmtGLYear.value := frmBS1.tblCompanyDefaultPeriodYYYY.value
  else                                                 tblARPmtGLYear.value := Year;
end;

procedure TfrmARPayment.tblARPmtUpdateError(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 editChequeNo do begin Show; SetFocus; end;
        //Application.MessageBox(PChar('Cheque no. already exists.'), PChar(Application.Title), mb_OK + mb_DefButton1 + mb_IconStop);   //Suppressed: cheque no. isn't unique.
        //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 TfrmARPayment.tblARInvPmtUpdateError(DataSet: TDataSet;
  E: EDatabaseError; UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
begin
  if (tblARPmt.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 = 9729) then begin   //Key violation (key already exists).
        Application.MessageBox(PChar('An invoice is specified more than once on this payment.'), PChar(Application.Title), mb_OK + mb_DefButton1 + mb_IconStop);
        UpdateAction := uaAbort;
      end else if (Errors[ErrorCount - 1].ErrorCode = 9733) then begin    //Master record missing.
        if (tblARInvPmtWriteOffGLAccount.value <> '') and (tblARInvPmtAccountName.value = '') then Application.MessageBox(PChar('GL Account does not exist.'), PChar(Application.Title), mb_OK + mb_DefButton1 + mb_IconStop)
        else Application.MessageBox(PChar('Invoice 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 TfrmARPayment.tblARPmtBeforeEdit(DataSet: TDataSet);
begin
  if (tblARPmtPosted.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".

  TotalPaymentAmount := tblARPmtChequeAmount.value;   //Assume Cheque Amount was in balance with total of Payment Amounts.

  qryLastDetailLineNo.close;
  qryLastDetailLineNo.open;
  with qryLastDetailLineNo.Fields[0] do
    if IsNull then NextDetailLineNo := 1
    else NextDetailLineNo := AsInteger + 1;

  ARInvoiceIDs.Clear;
  Seqs.Clear;
  if NextDetailLineNo > 1 then begin
    tblARInvPmt2.Active := true;
    tblARInvPmt2.First;
    while not tblARInvPmt2.EOF do begin
      ARInvoiceIDs.Add(tblARInvPmt2['ARInvoiceID']);
      Seqs.Add(tblARInvPmt2['Seq']);
      tblARInvPmt2.Next;
    end;
  end;
end;

procedure TfrmARPayment.tblARInvPmtBeforeEdit(DataSet: TDataSet);
begin
  tblARPmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
  OldPaymentAmount := tblARInvPmtPaymentAmount.value;
end;

procedure TfrmARPayment.tblARInvPmtBeforeInsert(DataSet: TDataSet);
begin
  tblARPmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state) & get next detail line no (if not already got).
  OldPaymentAmount := 0;
end;

procedure TfrmARPayment.tblARInvPmtBeforeDelete(DataSet: TDataSet);
begin
  tblARPmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
  if not (tblARInvPmt.state in [dsInsert, dsEdit]) then OldPaymentAmount := tblARInvPmtPaymentAmount.value;
  OldSeq := tblARInvPmtSeq.value;
end;

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

procedure TfrmARPayment.tblARPmtGLYearSetText(Sender: TField;
  const Text: string);
begin
  if Text = '' then tblARPmtGLYear.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 tblARPmtGLYear.value := StrToInt(Text) + 2000
    else tblARPmtGLYear.value := StrToInt(Text) + 1900;
  end;
end;

procedure TfrmARPayment.tblARPmtBeforePost(DataSet: TDataSet);
var
  GLDiff: currency;
  JVGLPeriodYYYYPP, EPeriodFromYYYYPP, EPeriodToYYYYPP, WPeriodFromYYYYPP, WPeriodToYYYYPP: integer;
begin
  if tblARPmtPosted.value = false then begin
    if tblARPmtBillToID.AsVariant = null then begin
      with editBillToNo do begin Show; SetFocus; end;
      raise(exception.create('Field ' + '''Bill-to''' + ' must have a value'));
    end;
    dmLookUps.tblBank.Active := true;
    if dmLookUps.tblBank.Locate('BankID', tblARPmtBankID.value, []) <> true then begin
      with cboBank do begin Show; SetFocus; end;
      raise(exception.create('Bank no longer exists'));   //Deleted by another user since this user selected.
    end;
    if (tblARPmtBankID.AsVariant <> null) and (tblARPmtCurrencyIDofBank.value <> tblARPmtCurrencyIDofBillTo.value) then begin
      cboBank.SetFocus;
      raise(exception.create('Bank must be same currency as bill-to'));
    end;
    if tblARPmtPaymentDate.AsVariant = null then begin
      with editPaymentDate do begin Show; SetFocus; end;
      raise(exception.create('Field ' + '''Cheque Date''' + ' must have a value'));
    end;
    JVGLPeriodYYYYPP := (tblARPmtGLYear.value * 100) + tblARPmtGLPeriod.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 tblARPmtGLYear.AsVariant = null then begin
      with editGLYear do begin Show; SetFocus; end;
      raise(exception.create('Field ' + '''' + 'Year of Period' + '''' + ' must have a value'));
    end;
    if tblARPmtGLYear.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 tblARPmtGLPeriod.AsVariant = null then begin
      with editGLPeriod do begin Show; SetFocus; end;
      raise(exception.create('Field ' + '''' + 'Period' + '''' + ' must have a value'));
    end;
    if (JVGLPeriodYYYYPP < EPeriodFromYYYYPP) or ((EPeriodToYYYYPP > 0) and (JVGLPeriodYYYYPP > 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 (JVGLPeriodYYYYPP < WPeriodFromYYYYPP) or ((WPeriodToYYYYPP > 0) and (JVGLPeriodYYYYPP > 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 tblARInvPmt.RecordCount = 0 then begin
      with DBGrid1 do begin Show; SetFocus; end;
      raise(exception.create('Invoices have not been entered'));
    end;

    GLDiff := tblARPmtChequeAmount.value - TotalPaymentAmount;
    //if TotalPaymentAmount <> tblARPmtChequeAmount.value then begin   //Sometimes this doesn't work.  eg. if both 1 cent.
    if GLDiff <> 0 then begin
      with DBGrid1 do begin Show; SetFocus; end;
      raise(exception.create('Payment total is ' + FloatToStrF(TotalPaymentAmount,ffCurrency,18,2) + #13 + FloatToStrF(GLDiff,ffCurrency,18,2) + ' has yet to be allocated'));
    end;
  end;
end;

procedure TfrmARPayment.tblARInvPmtAfterPost(DataSet: TDataSet);
begin
  TotalPaymentAmount := TotalPaymentAmount - OldPaymentAmount + tblARInvPmtPaymentAmount.value;   //Remove old & add new.

  if (Seqs.IndexOf(IntToStr(tblARInvPmtSeq.value)) > -1) then ARInvoiceIDs[Seqs.IndexOf(IntToStr(tblARInvPmtSeq.value))] := tblARInvPmtARInvoiceID.AsString
  else begin
    ARInvoiceIDs.Add(tblARInvPmtARInvoiceID.AsString);
    Seqs.Add(tblARInvPmtSeq.AsString);
  end;
end;

procedure TfrmARPayment.tblARInvPmtAfterDelete(DataSet: TDataSet);
begin
  TotalPaymentAmount := TotalPaymentAmount - OldPaymentAmount;   //Remove old.
  if tblARInvPmt.RecordCount = 0 then TotalPaymentAmount := 0;

  if (Seqs.IndexOf(IntToStr(OldSeq)) > -1) then begin
    ARInvoiceIDs.Delete(Seqs.IndexOf(IntToStr(OldSeq)));
    Seqs.Delete(Seqs.IndexOf(IntToStr(OldSeq)));
  end;
end;

procedure TfrmARPayment.btnPaymentDateClick(Sender: TObject);
begin
  frmCalendar.caption := 'Payment Date';
  if tblARPmtPaymentDate.AsVariant <> null then frmCalendar.date := tblARPmtPaymentDate.value
  else frmCalendar.date := Date;
  if frmCalendar.ShowModal = mrOk then begin
    tblARPmt.Edit;
    tblARPmtPaymentDate.value := frmCalendar.Date;