financialstmtform.pas

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

      //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 TfrmFinancialStmt.tblFStmtLinBeforeEdit(DataSet: TDataSet);
begin
  tblFStmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
  OldLineType := tblFStmtLinLineType.value;
end;

procedure TfrmFinancialStmt.tblFStmtLinBeforeInsert(DataSet: TDataSet);
begin
  if tblFStmt.state = dsInsert then tblFStmt.post;
  tblFStmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state) & get next detail line no (if not already got).
  OldLineType := '';
end;

procedure TfrmFinancialStmt.tblFStmtLinBeforeDelete(DataSet: TDataSet);
begin
  tblFStmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).

  with tblFStmtLAc do begin   //Delete accounts for this line.
    Active := true;
    First;
    while not eof do Delete;
  end;
  with tblFStmtLTo do begin   //Delete totals for this line.
    Active := true;
    First;
    while not eof do Delete;
  end;

  if tblFStmtLinLineType.value = 'Total' then begin   //Delete tblFStmtLTo accumulating to this total line.
    with tblFStmtLTo2 do begin
      Active := true;
      First;
      while not eof do begin
        if tblFStmtLTo2TotalLineSeq.value = tblFStmtLinSeq.value then delete
        else next;
      end;
    end;
  end;
end;

procedure TfrmFinancialStmt.popDeleteClick(Sender: TObject);
begin
  //try tblFStmtLin.delete; except; end;
  //tblFStmtLAc.active := true;
  //tblFStmtLTo.active := true;
  tblFStmtLin.delete;
end;

procedure TfrmFinancialStmt.popNewClick(Sender: TObject);
begin
  tblFStmtLin.append;
  DBGrid1.SelectedIndex := 0;
end;

procedure TfrmFinancialStmt.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 TfrmFinancialStmt.tblFStmtBeforeEdit(DataSet: TDataSet);
begin
  qryLastDetailLineNo.close;
  qryLastDetailLineNo.open;
  with qryLastDetailLineNo.Fields[0] do
    if IsNull then NextDetailSeq := 1
    else NextDetailSeq := AsInteger + 1;
  with qryLastDetailLineNo.Fields[1] do
    if IsNull then NextDetailLineNo := 1
    else NextDetailLineNo := AsInteger + 1;
end;

procedure TfrmFinancialStmt.tblFStmtBeforeInsert(DataSet: TDataSet);
begin
  NextDetailSeq := 1;
  NextDetailLineNo := 1;
end;

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

procedure TfrmFinancialStmt.btnUpClick(Sender: TObject);
var
  OldLineNo, NewLineNo: integer;
begin
  if tblFStmtLin.state in [dsInsert, dsEdit] then tblFStmtLin.post;
  if tblFStmtLinLineNo.AsVariant = null then exit;   //No current record.

  tblFStmtLin.DisableControls;
  try
    OldLineNo := tblFStmtLinLineNo.value;   //Store line no. of current record to be moved.

    tblFStmtLin.Prior;   //Move to previous record: get line no. & move it to line 0 (so we can use it's line no.).
    if tblFStmtLinLineNo.value = OldLineNo then exit;   //No previous record.
    NewLineNo := tblFStmtLinLineNo.value;
    tblFStmtLin.Edit;
    tblFStmtLinLineNo.value := 0;
    tblFStmtLin.Post;

    tblFStmtLin.Locate('StmtID;LineNo', VarArrayOf([tblFStmtStmtID.value,OldLineNo]), []);   //Assign previous record's line no. to record to be moved.
    tblFStmtLin.Edit;
    tblFStmtLinLineNo.value := NewLineNo;
    tblFStmtLin.Post;

    tblFStmtLin.Locate('StmtID;LineNo', VarArrayOf([tblFStmtStmtID.value,0]), []);   //Assign record to be moved's line no. to previous record.
    tblFStmtLin.Edit;
    tblFStmtLinLineNo.value := OldLineNo;
    tblFStmtLin.Post;

    tblFStmtLin.Locate('StmtID;LineNo', VarArrayOf([tblFStmtStmtID.value,NewLineNo]), []);   //Move to the moved record.
  finally
    tblFStmtLin.EnableControls;
  end;
end;

procedure TfrmFinancialStmt.btnDownClick(Sender: TObject);
var
  OldLineNo, NewLineNo: integer;
begin
  if tblFStmtLin.state in [dsInsert, dsEdit] then tblFStmtLin.post;
  if tblFStmtLinLineNo.AsVariant = null then exit;   //No current record.

  tblFStmtLin.DisableControls;
  try
    OldLineNo := tblFStmtLinLineNo.value;   //Store line no. of current record to be moved.

    tblFStmtLin.Next;   //Move to next record: get line no. & move it to line 0 (so we can use it's line no.).
    if tblFStmtLinLineNo.value = OldLineNo then exit;   //No next record.
    NewLineNo := tblFStmtLinLineNo.value;
    tblFStmtLin.Edit;
    tblFStmtLinLineNo.value := 0;
    tblFStmtLin.Post;

    tblFStmtLin.Locate('StmtID;LineNo', VarArrayOf([tblFStmtStmtID.value,OldLineNo]), []);   //Assign next record's line no. to record to be moved.
    tblFStmtLin.Edit;
    tblFStmtLinLineNo.value := NewLineNo;
    tblFStmtLin.Post;

    tblFStmtLin.Locate('StmtID;LineNo', VarArrayOf([tblFStmtStmtID.value,0]), []);   //Assign record to be moved's line no. to next record.
    tblFStmtLin.Edit;
    tblFStmtLinLineNo.value := OldLineNo;
    tblFStmtLin.Post;

    tblFStmtLin.Locate('StmtID;LineNo', VarArrayOf([tblFStmtStmtID.value,NewLineNo]), []);   //Move to the moved record.
  finally
    tblFStmtLin.EnableControls;
  end;
end;

procedure TfrmFinancialStmt.tblFStmtLinLineTypeValidate(Sender: TField);
begin
  if (tblFStmtLinLineType.value <> 'Heading')
  and (tblFStmtLinLineType.value <> 'Detail')
  and (tblFStmtLinLineType.value <> 'Total')
  then raise(exception.create('Choose an item from the list'));

  if (OldLineType = 'Detail') and (tblFStmtLinLineType.value <> 'Detail') then begin
    tblFStmtLAc.Active := true;
    if tblFStmtLAc.RecordCount >0 then raise(exception.create('Cannot change from line type Detail...' + #13 + 'Please undo Detail Properties (accounts and totals) first'));
    tblFStmtLTo.Active := true;
    if tblFStmtLTo.RecordCount >0 then raise(exception.create('Cannot change from line type Detail...' + #13 + 'Please undo Detail Properties (accounts and totals) first'));
  end;
end;

procedure TfrmFinancialStmt.DBGrid1KeyPress(Sender: TObject;
  var Key: Char);
begin
  if DBGrid1.SelectedField = tblFStmtLinLineType then begin
    tblFStmtLin.edit;
    if          (Key = 'h') or (Key = 'H') then begin DBGrid1.SelectedField.text := 'Heading'; key := #0;
    end else if (Key = 'd') or (Key = 'D') then begin DBGrid1.SelectedField.text := 'Detail'; key := #0;
    end else if (Key = 't') or (Key = 'T') then begin DBGrid1.SelectedField.text := 'Total'; key := #0;
    end;
  end;
end;

procedure TfrmFinancialStmt.PopupMenu1Popup(Sender: TObject);
begin
  if tblFStmtLinLineType.value = 'Detail' then popProperties.enabled := true
  else popProperties.enabled := false;
end;

procedure TfrmFinancialStmt.popPropertiesClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  tblFStmtLAc.Active := true;
  tblFStmtLTo.Active := true;
  tblFStmtLinT.Active := true;
  aComponent := Application.FindComponent('frmFinancialStmtLine');
  if not Assigned (aComponent) then frmFinancialStmtLine := TfrmFinancialStmtLine.Create(Application);
  frmFinancialStmtLine.btnCancel.enabled := true;
  frmFinancialStmtLine.caption := tblFStmtLinLineHeading.value;
  frmFinancialStmtLine.PageControl1.visible := true;
  frmFinancialStmtLine.Show;
  if frmFinancialStmtLine.WindowState = wsMinimized then begin
    frmFinancialStmtLine.WindowState := wsNormal;
    frmFinancialStmtLine.FormShow(sender);
  end;
  screen.cursor := crDefault;
end;

procedure TfrmFinancialStmt.tblFStmtAfterPost(DataSet: TDataSet);
begin
  btnCancel.enabled := false;
end;

procedure TfrmFinancialStmt.tblFStmtLinAfterPost(DataSet: TDataSet);
begin
  btnCancel.enabled := false;
end;

procedure TfrmFinancialStmt.tblFStmtLinAfterDelete(DataSet: TDataSet);
begin
  btnCancel.enabled := false;
end;

procedure TfrmFinancialStmt.DBGrid1DblClick(Sender: TObject);
begin
  if tblFStmtLinLineType.value = 'Detail' then popPropertiesClick(sender);
end;

procedure TfrmFinancialStmt.tblFStmtLinTFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  if (tblFStmtLinTStmtID.value = tblFStmtStmtID.value) and (tblFStmtLinTLineType.value = 'Total') then accept := true
  else accept := false;
end;

procedure TfrmFinancialStmt.dsFStmtLinDataChange(Sender: TObject;
  Field: TField);
var
  aComponent: TComponent;
begin
  if tblFStmtLinLineType.value <> 'Detail' then btnProperties.enabled := false
  else btnProperties.enabled := true;

  aComponent := Application.FindComponent('frmFinancialStmtLine');
  if (Assigned (aComponent)) and (frmFinancialStmtLine.visible = true) then begin
    frmFinancialStmtLine.caption := tblFStmtLinLineHeading.value;
    if tblFStmtLinLineType.value <> 'Detail' then frmFinancialStmtLine.PageControl1.visible := false
    else frmFinancialStmtLine.PageControl1.visible := true;
    frmFinancialStmtLine.btnCancel.enabled := true;
  end;
end;

procedure TfrmFinancialStmt.tblFStmtLAcAfterPost(DataSet: TDataSet);
begin
  frmFinancialStmtLine.btnCancel.enabled := false;
end;

procedure TfrmFinancialStmt.tblFStmtLAcAfterDelete(DataSet: TDataSet);
begin
  try frmFinancialStmtLine.btnCancel.enabled := false; except; end;
end;

procedure TfrmFinancialStmt.tblFStmtLToAfterDelete(DataSet: TDataSet);
begin
  try frmFinancialStmtLine.btnCancel.enabled := false; except; end;
end;

procedure TfrmFinancialStmt.tblFStmtLToAfterPost(DataSet: TDataSet);
begin
  frmFinancialStmtLine.btnCancel.enabled := false;
end;

procedure TfrmFinancialStmt.tblFStmtLAcBeforeEdit(DataSet: TDataSet);
begin
  tblFStmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
end;

procedure TfrmFinancialStmt.tblFStmtLAcBeforeInsert(DataSet: TDataSet);
begin
  if tblFStmtLin.state in [dsInsert, dsEdit] then tblFStmtLin.post;
  tblFStmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
end;

procedure TfrmFinancialStmt.tblFStmtLAcBeforeDelete(DataSet: TDataSet);
begin
  tblFStmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
end;

procedure TfrmFinancialStmt.tblFStmtLToBeforeDelete(DataSet: TDataSet);
begin
  tblFStmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
end;

procedure TfrmFinancialStmt.tblFStmtLToBeforeEdit(DataSet: TDataSet);
begin
  tblFStmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
end;

procedure TfrmFinancialStmt.tblFStmtLToBeforeInsert(DataSet: TDataSet);
begin
  if tblFStmtLin.state in [dsInsert, dsEdit] then tblFStmtLin.post;
  tblFStmt.edit;   //Put lock on master table (if not already in dsInsert or dsEdit state).
end;

procedure TfrmFinancialStmt.tblFStmtLAcPostError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
begin
  with frmFinancialStmtLine.gridAccounts do begin Show; SetFocus; SelectedIndex := 0; end;
  if E.HelpContext = 0 then raise(exception.create('''' + 'From Account' + '''' + ' has already been specified'))
  else raise(exception.create(E.Message));
end;

procedure TfrmFinancialStmt.tblFStmtLToPostError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
begin
  with frmFinancialStmtLine.gridTotals do begin Show; SetFocus; SelectedIndex := 0; end;
  if E.HelpContext = 0 then raise(exception.create('''' + 'Total' + '''' + ' has already been specified'))
  else raise(exception.create(E.Message));
end;

procedure TfrmFinancialStmt.btnHelpClick(Sender: TObject);
begin
  Application.HelpContext(360);
end;

end.