jvform.pas

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

  tblJVDetJVID.value := tblJVJVID.value;
end;

procedure TfrmJV.tblJVNewRecord(DataSet: TDataSet);
var
  Year, Month, Day: word;
begin
  with tblJVCtl do begin
    Open;
    try
      Edit;
      tblJVJVID.Value := tblJVCtlNextJVID.Value;
      tblJVCtlNextJVID.Value := tblJVCtlNextJVID.Value + 1;
      if (tblJVCtlNextJVNumber.Value < 1001) or (tblJVCtlNextJVNumber.Value > 10000000) then tblJVCtlNextJVNumber.Value := 1001;   //Start auto-assigned numbers here.
      tblJVJVNumber.Value := tblJVCtlNextJVNumber.Value;
      tblJVCtlNextJVNumber.Value := tblJVCtlNextJVNumber.Value + 1;
      Post;
    finally
      DbiSaveChanges(tblJVCtl.handle);
      Close;
    end;
  end;
  tblJVTransDate.value := Date;
  tblJVAutoReverse.value := false;
  tblJVPosted.value := false;
  tblJVSource.value := 'GL';
  tblJVTransType.value := 'JV';
  DecodeDate(Date, Year, Month, Day);
  if frmBS1.tblCompanyDefaultPeriodPP.value > 0 then tblJVGLPeriod.value := frmBS1.tblCompanyDefaultPeriodPP.value
  else                                               tblJVGLPeriod.value := Month;
  if frmBS1.tblCompanyDefaultPeriodYYYY.value > 0 then tblJVGLYear.value := frmBS1.tblCompanyDefaultPeriodYYYY.value
  else                                                 tblJVGLYear.value := Year;
end;

procedure TfrmJV.tblJVUpdateError(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 editJVNumber do begin Show; SetFocus; end;
        Application.MessageBox(PChar('JV no. already exists for this period.'), 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 TfrmJV.tblJVDetUpdateError(DataSet: TDataSet;
  E: EDatabaseError; UpdateKind: TUpdateKind;
  var UpdateAction: TUpdateAction);
begin
  if (tblJV.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('GL Account 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 TfrmJV.tblJVDetGLAccountValidate(Sender: TField);
var
  LookupResults: Variant;
begin
  if DBGrid1.SelectedIndex = 1 then begin
    if DBGrid1.SelectedField.value = '' then exit;
    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 TfrmJV.tblJVBeforeInsert(DataSet: TDataSet);
begin
  TotalCredits := 0;
  TotalDebits := 0;
  NextDetailLineNo := 1;
  lblTotals.caption := 'Debits: ' + FloatToStrF(TotalDebits,ffCurrency,18,2) + '   Credits: ' + FloatToStrF(TotalCredits,ffCurrency,18,2);
end;

procedure TfrmJV.tblJVBeforeEdit(DataSet: TDataSet);
begin
  if (tblJVPosted.value = true) or (tblJVSource.value <> 'GL') 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".
  
  TotalCredits := 0 - tblJVJVAmount.value;
  TotalDebits := tblJVJVAmount.value;
  lblTotals.caption := 'Debits: ' + FloatToStrF(TotalDebits,ffCurrency,18,2) + '   Credits: ' + FloatToStrF(TotalCredits,ffCurrency,18,2);

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

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

procedure TfrmJV.tblJVDetBeforeEdit(DataSet: TDataSet);
begin
  tblJV.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
  OldGLAmount := tblJVDetGLAmount.value;
end;

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

procedure TfrmJV.tblJVDetBeforeDelete(DataSet: TDataSet);
begin
  tblJV.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
  if not (tblJVDet.state in [dsInsert, dsEdit]) then OldGLAmount := tblJVDetGLAmount.value;
end;

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

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

procedure TfrmJV.tblJVBeforePost(DataSet: TDataSet);
var
  GLNet: currency;
  JVGLPeriodYYYYPP, EPeriodFromYYYYPP, EPeriodToYYYYPP, WPeriodFromYYYYPP, WPeriodToYYYYPP: integer;
begin
  if tblJVPosted.value = false then begin
    JVGLPeriodYYYYPP := (tblJVGLYear.value * 100) + tblJVGLPeriod.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 tblJVGLYear.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 (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;

    GLNet := TotalDebits + TotalCredits;
    if GLNet <> 0 then begin
      with DBGrid1 do begin Show; SetFocus; end;
      raise(exception.create('Debits and Credits are out of balance by ' + FloatToStrF(GLNet,ffCurrency,18,2)));
    end;
    if TotalDebits = 0 then begin
      with DBGrid1 do begin Show; SetFocus; end;
      raise(exception.create('GL Amounts have not been entered'));
    end;
  end;
end;

procedure TfrmJV.tblJVDetAfterPost(DataSet: TDataSet);
begin
  if OldGLAmount >0 then TotalDebits := TotalDebits - OldGLAmount   //Remove old.
  else                   TotalCredits := TotalCredits - OldGLAmount;
  if tblJVDetGLAmount.value >0 then TotalDebits := TotalDebits + tblJVDetGLAmount.value   //Add new.
  else                              TotalCredits := TotalCredits + tblJVDetGLAmount.value;
  lblTotals.caption := 'Debits: ' + FloatToStrF(TotalDebits,ffCurrency,18,2) + '   Credits: ' + FloatToStrF(TotalCredits,ffCurrency,18,2);
  tblJVJVAmount.AsCurrency := TotalDebits;
end;

procedure TfrmJV.tblJVDetAfterDelete(DataSet: TDataSet);
begin
  if OldGLAmount >0 then TotalDebits := TotalDebits - OldGLAmount   //Remove old.
  else                   TotalCredits := TotalCredits - OldGLAmount;
  lblTotals.caption := 'Debits: ' + FloatToStrF(TotalDebits,ffCurrency,18,2) + '   Credits: ' + FloatToStrF(TotalCredits,ffCurrency,18,2);
  tblJVJVAmount.AsCurrency := TotalDebits;
end;

procedure TfrmJV.btnTransDateClick(Sender: TObject);
begin
  frmCalendar.caption := 'Transaction Date';
  if tblJVTransDate.AsVariant <> null then frmCalendar.date := tblJVTransDate.value
  else frmCalendar.date := Date;
  if frmCalendar.ShowModal = mrOk then begin
    tblJV.Edit;
    tblJVTransDate.value := frmCalendar.Date;
  end;
  editTransDate.setfocus;
  editTransDate.SelectAll;
end;

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

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

procedure TfrmJV.mnuDeleteClick(Sender: TObject);
begin
  try tblJVDet.delete; except; end;
end;

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

procedure TfrmJV.DBGrid1ColEnter(Sender: TObject);
begin
  if (DBGrid1.Focused = true)   //Prevent problem when Shift Tab out of grid, ColEnter (on last column) fires after GridExit. 
  and (DBGrid1.SelectedIndex >0) then DBGrid1.Options := [dgEditing,dgAlwaysShowEditor,dgTitles,dgIndicator,dgColumnResize,dgColLines,dgRowLines,dgTabs,dgConfirmDelete,dgCancelOnExit];   //Toggle dgAlwaysShowEditor to prevent 1st field from being left-justified if always dgAlwaysShowEditor.
end;

procedure TfrmJV.tblJVTransDescriptionGetText(Sender: TField;
  var Text: string; DisplayText: Boolean);
var
  LookupResults: variant;
begin
  if tblJVSource.value = 'AP' then begin
    LookupResults := dmLookUps.tblVendor.Lookup('VendorID', tblJVVendorID.value, 'VendorName;VendorNo');
    if LookupResults[0] <> null then Text := tblJVTransDescription.value + ' for ' + LookupResults[0] + ' (' + LookupResults[1] + ')'
    else Text := tblJVTransDescription.value;
  end else if tblJVSource.value = 'AR' then begin
    LookupResults := dmLookUps.tblCustomer.Lookup('CustomerID', tblJVCustomerID.value, 'CustomerName;CustomerNo');
    if LookupResults[0] <> null then Text := tblJVTransDescription.value + ' for ' + LookupResults[0] + ' (' + LookupResults[1] + ')'
    else Text := tblJVTransDescription.value;
  end else Text := tblJVTransDescription.value;
end;

procedure TfrmJV.tblJVTransDateSetText(Sender: TField; const Text: string);
begin
  tblJVTransDate.value := frmBS1.Date2000(Text);
end;

end.