arpaymentform.pas

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

  end;
  editPaymentDate.setfocus;
  editPaymentDate.SelectAll;
end;

procedure TfrmARPayment.mnuDeleteClick(Sender: TObject);
begin
  try tblARInvPmt.delete; except; end;
end;

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

procedure TfrmARPayment.tblARPmtBeforeInsert(DataSet: TDataSet);
begin
  TotalPaymentAmount := 0;
  NextDetailLineNo := 1;
end;

procedure TfrmARPayment.tblARInvPmtBeforePost(DataSet: TDataSet);
var
  WorkAmount: currency;
begin
  if (tblARInvPmtWriteOffAmount.value <> 0) and (tblARInvPmtWriteOffGLAccount.value = '') then begin
    DBGrid1.Setfocus;
    DBGrid1.SelectedIndex := 6;
    raise(exception.create('Field ' + '''Write-off GL Account''' + ' must have a value...' +#13 + 'Make changes or press Esc to undo'));
  end;

  if (tblARInvPmtWriteOffGLAccount.value <> '') and (tblARInvPmtAccountName.value = '') then begin
    DBGrid1.Setfocus;
    DBGrid1.SelectedIndex := 6;
    raise(exception.create('GL Account '  + '''' + tblARInvPmtWriteOffGLAccount.value + '''' + ' not found...' +#13 + 'Make changes or press Esc to undo'));
  end;

  if (tblARInvPmtDiscTakenAmount.value <> 0) then begin
    //if (tblARInvPmtOwing.value <> (tblARInvPmtPaymentAmount.value + tblARInvPmtDiscTakenAmount.value + tblARInvPmtWriteOffAmount.value)) then begin   //Prevent Delphi bug where it says amounts are different, yet they are the same... gave error in office, but not kitchen.
    WorkAmount := tblARInvPmtOwing.value - tblARInvPmtPaymentAmount.value - tblARInvPmtDiscTakenAmount.value - tblARInvPmtWriteOffAmount.value;
    if WorkAmount <> 0 then begin
      DBGrid1.Setfocus;
      DBGrid1.SelectedIndex := 4;
      raise(exception.create('Discount can only be taken if invoice is fully paid...' +#13 + 'Make changes or press Esc to undo'));
    end;
  end;

  if (tblARInvPmtWriteOffAmount.value <> 0) then begin
    //if (tblARInvPmtOwing.value <> (tblARInvPmtPaymentAmount.value + tblARInvPmtDiscTakenAmount.value + tblARInvPmtWriteOffAmount.value)) then begin   //Prevent Delphi bug where it says amounts are different, yet they are the same... gave error in office, but not kitchen.
    WorkAmount := tblARInvPmtOwing.value - tblARInvPmtPaymentAmount.value - tblARInvPmtDiscTakenAmount.value - tblARInvPmtWriteOffAmount.value;
    if WorkAmount <> 0 then begin
      WorkAmount := tblARInvPmtOwing.value - tblARInvPmtPaymentAmount.value - tblARInvPmtDiscTakenAmount.value;
      DBGrid1.Setfocus;
      DBGrid1.SelectedIndex := 5;
      raise(exception.create('Write-off must equal balance of invoice: ' + FloatToStrF(WorkAmount,ffCurrency,18,2) +#13 + 'Make changes or press Esc to undo'));
    end;
  end;

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

procedure TfrmARPayment.tblARInvPmtARInvoiceIDValidate(Sender: TField);
begin
  if tblARInvPosted.value <> true then raise(exception.create('Invoice ' + '''' + tblARInvInvoiceNo.value + '''' + ' has not been posted'));

  if (ARInvoiceIDs.IndexOf(IntToStr(tblARInvPmtARInvoiceID.value)) > -1) then   //Error if invoice is already on cheque and it's not this invoice.
    if (tblARInvPmtSeq.AsString <> Seqs[ARInvoiceIDs.IndexOf(IntToStr(tblARInvPmtARInvoiceID.value))]) then
      raise(exception.create('Invoice ' + '''' + tblARInvInvoiceNo.value + '''' + ' is already on this payment'));
end;

procedure TfrmARPayment.tblARInvPmtARInvoiceIDChange(Sender: TField);
begin
  popPayDiscIfClick(sender);
end;

procedure TfrmARPayment.editBillToNoExit(Sender: TObject);
begin
  if editBillToNo.text <> tblARPmtBillToNo.value then begin
    if tblARInvPmt.RecordCount >0 then begin
      editBillToNo.setfocus;
      raise(exception.create('Bill-to cannot be changed unless invoices are removed first'));
    end;
    if editBillToNo.text <> '' then begin
      if tblCustomer.Locate('CustomerNo', editBillToNo.Text, []) <> true then begin
        editBillToNo.setfocus;
        raise(Exception.Create('Bill-to no. ' + '''' + editBillToNo.Text + '''' + ' not found'));
      end else begin
        if tblARPmt.state <> dsInsert then tblARPmt.edit;
        tblARPmtBillToID.value := tblCustomerCustomerID.value;
      end;
    end else begin
      if tblARPmt.state <> dsInsert then tblARPmt.edit;
      tblARPmtBillToID.AsVariant := null;
    end;
  end;
end;

procedure TfrmARPayment.editBillToNoKeyPress(Sender: TObject;
  var Key: Char);
begin
  if key = #27 then begin   //Esc.
    key := #0;
    editBillToNo.text := tblARPmtBillToNo.value;
  end;
end;

procedure TfrmARPayment.cboBillToKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_Delete then begin
    tblARPmt.Edit;
    tblARPmtBillToID.AsVariant := null;
  end;
end;

procedure TfrmARPayment.btnBillToClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmCustomers');
  if Assigned (aComponent) then try frmCustomers.qryCustomer.close; frmCustomers.qryCustomer.open; except; end
  else frmCustomers := TfrmCustomers.Create(Application);

  aComponent := Application.FindComponent('frmCustomersFilter');
  if Assigned (aComponent) then try frmCustomersFilter.btnResetClick(sender); except; end;
  frmCustomers.mnuFilter.Checked := false;
  frmCustomers.qryCustomer.Filtered := false;
  frmCustomers.tblCustomer.Filtered := false;

  if frmCustomers.WindowState = wsMinimized then frmCustomers.WindowState := wsNormal;
  if frmCustomers.visible = true then frmCustomers.FormShow(sender)
  else frmCustomers.Show;
  if not frmCustomers.qryCustomer.Locate('CustomerID', tblARPmtBillToID.value, []) then frmCustomers.qryCustomer.First;
  screen.cursor := crDefault;
end;

procedure TfrmARPayment.cboBankKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_Delete then begin
    tblARPmt.Edit;
    tblARPmtBankID.AsVariant := null;
  end;
end;

procedure TfrmARPayment.btnBankClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmBanks');
  if not Assigned (aComponent) then frmBanks := TfrmBanks.Create(Application);
  if frmBanks.WindowState = wsMinimized then frmBanks.WindowState := wsNormal;
  if frmBanks.visible = true then frmBanks.FormShow(sender)
  else frmBanks.Show;
  if not frmBanks.tblBank.Locate('BankID', tblARPmtBankID.value, []) then frmBanks.tblBank.First;
  screen.cursor := crDefault;
end;

procedure TfrmARPayment.tblARInvFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
var
  Owing: currency;
begin
  Accept := true;
  if tblARInvBillToID.value <> tblARPmtBillToID.value then Accept := false
  else begin
    Owing := tblARInvOwing.value;   //Prevent Delphi bug where 0 owing invoices show (0 stored as -7.21E-16).
    if (tblARInvPmtARInvoiceID.AsVariant = null) and (Owing = 0) then Accept := false   //New invoice: don't show zero balance invoices (in combobox).
    else if (tblARInvPmtARInvoiceID.value <> tblARInvARInvoiceID.value) and (Owing = 0) then Accept := false;   //Unless this invoice exists from before, don't show zero balance invoices (in combobox).
  end;
end;

procedure TfrmARPayment.tblARPmtBillToIDValidate(Sender: TField);
begin
  if tblARInvPmt.RecordCount >0 then raise(exception.create('Bill-to cannot be changed unless invoices are removed first'));
end;

procedure TfrmARPayment.tblARPmtBillToIDChange(Sender: TField);
begin
  if tblARPmtBillToID.AsVariant <> null then begin   //Set bank if not yet entered or currency doesn't match.
    if (tblARPmtBankID.AsVariant = null) or (tblARPmtCurrencyIDofBank.value <> tblARPmtCurrencyIDofBillTo.value) then begin
      dmLookUps.tblBank.first;
      while not dmLookUps.tblBank.eof do begin
        if dmLookUps.tblBankCurrencyID.value = tblARPmtCurrencyIDofBillTo.value then begin
          tblARPmt.Edit;
          tblARPmtBankID.value := dmLookUps.tblBankBankID.value;
        end;
      dmLookUps.tblBank.next;
      end;
    end;
  end;
end;

procedure TfrmARPayment.dsARPmtUpdateData(Sender: TObject);
begin
  if tblARPmtBankID.AsVariant = null then begin   //Validate here rather than BeforePost otherwise setfocus won't work (BankID is a mandatory field).
    with cboBank do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Bank''' + ' must have a value'));
  end;
end;

procedure TfrmARPayment.tblARInvPmtWriteOffGLAccountValidate(
  Sender: TField);
var
  LookupResults: Variant;
begin
  if (DBGrid1.SelectedIndex = 6) and (DBGrid1.SelectedField.value = '') then exit;
  if (DBGrid1.SelectedIndex = 6) then begin
    LookupResults := dmLookUps.tblGLAccnt.Lookup('GLAccount', DBGrid1.SelectedField.value, 'Suspended');
    if LookupResults = null then raise(exception.create('GL Account '  + '''' + DBGrid1.SelectedField.value + '''' + ' not found...' +#13 + 'Press Esc or enter a different account no'))
    else if LookupResults = true then raise(exception.create('GL Account '  + '''' + DBGrid1.SelectedField.value + '''' + ' has been suspended'));
  end else begin
    if dmLookUps.tblGLAccntSuspended.value = true then raise(exception.create('GL Account '  + '''' + dmLookUps.tblGLAccntGLAccount.value + ': ' + dmLookUps.tblGLAccntAccountName.value + '''' + ' has been suspended'));
  end
end;

procedure TfrmARPayment.DBGrid1EditButtonClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  if DBGrid1.SelectedField = tblARInvPmtWriteOffGLAccount then begin
    screen.cursor := crHourglass;
    aComponent := Application.FindComponent('frmGLAccountSearch');
    if not Assigned (aComponent) then frmGLAccountSearch := TfrmGLAccountSearch.Create(Application);
    frmGLAccountSearch.GLAccount := tblARInvPmtWriteOffGLAccount.value;
    screen.cursor := crDefault;
    if frmGLAccountSearch.ShowModal = mrOk then begin
      tblARInvPmt.Edit;
      tblARInvPmtWriteOffGLAccount.value := frmGLAccountSearch.GLAccount;
    end;
  end;
end;

procedure TfrmARPayment.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = ^J) and (DBGrid1.SelectedField = tblARInvPmtWriteOffGLAccount) then begin   //Ctrl+Enter show GLAccount Search.
    Key := #0;
    try DBGrid1EditButtonClick(sender); except; end;
  end;
end;

procedure TfrmARPayment.tblARInvPmtWriteOffAmountChange(Sender: TField);
begin
  if tblARInvPmtWriteOffAmount.value = 0 then tblARInvPmtWriteOffGLAccount.AsVariant := null
  else if tblARInvPmtWriteOffGLAccount.value = '' then tblARInvPmtWriteOffGLAccount.AsVariant := dmLookUps.tblCurrency.Lookup('CurrencyID', tblARPmtCurrencyIDofBillTo.value, 'DfltWriteOffGLAccount');
end;

procedure TfrmARPayment.popWriteOffClick(Sender: TObject);
begin
  tblARInvPmt.edit;
  tblARInvPmtPaymentAmount.AsVariant := null;
  tblARInvPmtDiscTakenAmount.AsVariant := null;
  tblARInvPmtWriteOffAmount.AsCurrency := tblARInvPmtOwing.value;
end;

procedure TfrmARPayment.popPayDiscNoClick(Sender: TObject);
begin
  tblARInvPmt.edit;
  tblARInvPmtPaymentAmount.AsCurrency := tblARInvPmtOwing.value;
  tblARInvPmtDiscTakenAmount.AsVariant := null;
  tblARInvPmtWriteOffAmount.AsVariant := null;
end;

procedure TfrmARPayment.tblARInvPmtCalcFields(DataSet: TDataSet);
begin
  if tblARInvPmtDiscPC.value = 0 then begin
    tblARInvPmtDiscountAmount.AsVariant := null;
    tblARInvPmtDiscountDate.AsVariant := null;
  end else begin
    tblARInvPmtDiscountAmount.AsCurrency := frmBS1.RoundIt(tblARInvPmtDiscPC.value * tblARInvPmtInvoiceAmount.value)/100;
    tblARInvPmtDiscountDate.AsDateTime := tblARInvPmtInvoiceDate.AsDateTime + tblARInvPmtDiscDays.value;
  end;
end;

procedure TfrmARPayment.popPayDiscYesClick(Sender: TObject);
begin
  tblARInvPmt.edit;
  tblARInvPmtPaymentAmount.AsCurrency := tblARInvPmtOwing.value - tblARInvPmtDiscountAmount.value;
  tblARInvPmtDiscTakenAmount.AsVariant := tblARInvPmtDiscountAmount.AsVariant;
  tblARInvPmtWriteOffAmount.AsVariant := null;
end;

procedure TfrmARPayment.popPayDiscIfClick(Sender: TObject);
begin
  tblARInvPmt.edit;
  if tblARPmtPaymentDate.value <= tblARInvPmtDiscountDate.value then popPayDiscYesClick(sender)
  else popPayDiscNoClick(sender);
end;

procedure TfrmARPayment.tblARPmtPaymentDateSetText(Sender: TField;
  const Text: string);
begin
  tblARPmtPaymentDate.value := frmBS1.Date2000(Text);
end;

end.