glreportsform.pas

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

unit GLReportsForm;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, 
  Buttons, ExtCtrls, Mask, Dialogs, DBTables, DB, Grids, DBGrids, Menus, BDE;

type
  TfrmGLReports = class(TForm)
    panelBottom: TPanel;
    btnBack: TButton;
    btnNext: TButton;
    btnCancel: TButton;
    PanelReports: TPanel;
    PanelOptions: TPanel;
    lboReports: TListBox;
    PanelStmts: TPanel;
    btnNew: TButton;
    btnEdit: TButton;
    btnDelete: TButton;
    Label1: TLabel;
    lblHeading: TLabel;
    Image1: TImage;
    Label2: TLabel;
    Image2: TImage;
    lblReportTitle: TLabel;
    editGLPeriod: TEdit;
    editGLYear: TEdit;
    tblFStmt: TTable;
    dsFStmt: TDataSource;
    tblFStmtLin: TTable;
    tblFStmtStmtID: TIntegerField;
    tblFStmtStmtTitle: TStringField;
    tblFStmtLinStmtID: TIntegerField;
    grdStmts: TDBGrid;
    popStmts: TPopupMenu;
    New1: TMenuItem;
    Edit1: TMenuItem;
    popDelete: TMenuItem;
    tblFStmtLAc: TTable;
    tblFStmtLTo: TTable;
    tblFStmtLAcStmtID: TIntegerField;
    tblFStmtLToStmtID: TIntegerField;
    tblFStmtColumnFormat: TStringField;
    procedure btnNextClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnBackClick(Sender: TObject);
    procedure lboReportsDblClick(Sender: TObject);
    procedure lboStmtsDblClick(Sender: TObject);
    procedure editGLPeriodEnter(Sender: TObject);
    procedure editGLPeriodExit(Sender: TObject);
    procedure editGLYearEnter(Sender: TObject);
    procedure editGLYearExit(Sender: TObject);
    procedure btnNewClick(Sender: TObject);
    procedure btnEditClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tblFStmtBeforeDelete(DataSet: TDataSet);
    procedure btnCancelClick(Sender: TObject);
  private
    procedure SetGLPeriod(GLPeriod: integer);
    function GetGLPeriod: integer;
    procedure SetGLYear(GLYear: integer);
    function GetGLYear: integer;
  public
    property GLPeriod: integer read GetGLPeriod write SetGLPeriod;
    property GLYear: integer read GetGLYear write SetGLYear;
  end;

var
  frmGLReports: TfrmGLReports;

implementation

uses BS1Form, TrialBalanceReport, GeneralLedgerReport, FinancialStmtForm,
  FinancialStmtReport;

{$R *.DFM}

var
  intGLPeriod, intGLYear: integer;

procedure TfrmGLReports.SetGLPeriod(GLPeriod: integer);
begin
  intGLPeriod := GLPeriod;
end;

function TfrmGLReports.GetGLPeriod: integer;
begin
  Result := intGLPeriod;
end;

procedure TfrmGLReports.SetGLYear(GLYear: integer);
begin
  intGLYear := GLYear;
end;

function TfrmGLReports.GetGLYear: integer;
begin
  Result := intGLYear;
end;

procedure SetintGLPeriod(var intGLPeriod: integer; var editGLPeriod: TEdit);
var
  intWork: integer;
begin
  try intWork := StrToInt(editGLPeriod.text); except; editGLPeriod.text := '0'; end;   //Prevent error if can't convert text to integer.
  if (StrToInt(editGLPeriod.text) > 0) and (StrToInt(editGLPeriod.text) <= 12) then intGLPeriod := StrToInt(editGLPeriod.text)
  else begin
    editGLPeriod.setfocus;
    editGLPeriod.SelectAll;
    raise(exception.create('Period must be between 1 and 12'));
  end;
end;

procedure SetintGLYear(var intGLYear: integer; var editGLYear: TEdit);
var
  intWork: integer;
begin
  try intWork := StrToInt(editGLYear.text); except; editGLYear.text := '0'; end;   //Prevent error if can't convert text to integer.
  if (StrToInt(editGLYear.text) < 0) or (StrToInt(editGLYear.text) > 99) then begin
    editGLYear.setfocus;
    editGLYear.SelectAll;
    raise(exception.create('Period invalid...' + #13 + 'Enter year as 2 digits'));
  end else if StrToInt(editGLYear.text) < 50 then intGLYear := StrToInt(editGLYear.text) + 2000   //Convert 2 digit year to 4.
  else intGLYear := StrToInt(editGLYear.text) + 1900;
end;

procedure TfrmGLReports.btnNextClick(Sender: TObject);
begin
  if panelReports.visible = true then begin
    panelReports.visible := false;
    btnBack.enabled := true;
    if lboReports.ItemIndex = 2 then begin
      //if tblFStmt.active = false then begin
      //  tblFStmt.Active := true;
      //  tblFStmt.Database.TransIsolation := tiDirtyRead;
      //end;
      panelStmts.visible := true;
      grdStmts.setfocus;
    end else begin
      panelOptions.visible := true;
      editGLPeriod.setfocus;
      btnNext.caption := '&Preview';
      lblReportTitle.caption := lboReports.Items[lboReports.ItemIndex];
    end;
  //end else if (panelStmts.visible = true) and (lboStmts.Items.Count > 0) then begin
  end else if (panelStmts.visible = true) and (tblFStmtStmtTitle.AsVariant <> null) then begin
    panelStmts.visible := false;
    panelOptions.visible := true;
    editGLPeriod.setfocus;
    btnNext.caption := '&Preview';
    //lblReportTitle.caption := lboStmts.Items[lboStmts.ItemIndex];
    lblReportTitle.caption := tblFStmtStmtTitle.value;
  end else if panelOptions.visible = true then begin
    if screen.ActiveControl.name = 'editGLPeriod' then SetintGLPeriod(intGLPeriod, editGLPeriod);   //If Enter was pressed, this hasn't been done yet.
    if screen.ActiveControl.name = 'editGLYear' then SetintGLYear(intGLYear, editGLYear);   //If Enter was pressed, this hasn't been done yet.
    modalResult := mrOK;
    //if license = '' then begin frmBS1.FreewareMessage; exit; end;
    if lboReports.ItemIndex = 0 then begin
      screen.cursor := crHourglass;
      application.createform (TrptGeneralLedger,rptGeneralLedger);
      self.hide;
      screen.cursor := crDefault;
      rptGeneralLedger.QuickReport.Preview;
    end else if lboReports.ItemIndex = 1 then begin
      screen.cursor := crHourglass;
      application.createform (TrptTrialBalance,rptTrialBalance);
      self.hide;
      screen.cursor := crDefault;
      rptTrialBalance.QuickReport.Preview;
    end else if lboReports.ItemIndex = 2 then begin
      screen.cursor := crHourglass;
      application.createform (TrptFinancialStmt,rptFinancialStmt);
      self.hide;
      screen.cursor := crDefault;
      rptFinancialStmt.QuickReport.Preview;
    end;
  end;
end;

procedure TfrmGLReports.FormShow(Sender: TObject);
var
  Year, Month, Day: word;
begin
  panelReports.visible := true;
  panelStmts.visible := false;
  panelOptions.visible := false;
  btnBack.enabled := false;
  btnNext.caption := '&Next >';
  lboReports.setfocus;
  lboReports.ItemIndex := 0;
  //lboStmts.ItemIndex := 0;
  tblFStmt.refresh;
  tblFStmt.First;

  DecodeDate(Date, Year, Month, Day);
  if frmBS1.tblCompanyDefaultPeriodPP.value > 0 then GLPeriod := frmBS1.tblCompanyDefaultPeriodPP.value
  else GLPeriod := Month;
  if frmBS1.tblCompanyDefaultPeriodYYYY.value > 0 then GLYear := frmBS1.tblCompanyDefaultPeriodYYYY.value
  //else if frmBS1.tblCompanyFiscalYear.value > 0 then GLYear := frmBS1.tblCompanyFiscalYear.value
  else GLYear := Year;
  editGLPeriod.text := IntToStr(GLPeriod);
  editGLYear.text := IntToStr(GLYear);  
end;

procedure TfrmGLReports.btnBackClick(Sender: TObject);
begin
  if panelOptions.visible = true then begin
    panelOptions.visible := false;
    btnNext.caption := '&Next >';
    if lboReports.ItemIndex = 2 then begin
      panelStmts.visible := true;
      grdStmts.setfocus;
    end else begin
      panelReports.visible := true;
      lboReports.setfocus;
      btnBack.enabled := false;
    end;
  end else if panelStmts.visible = true then begin
    panelStmts.visible := false;
    panelReports.visible := true;
    lboReports.setfocus;
    btnBack.enabled := false;
  end;
end;

procedure TfrmGLReports.lboReportsDblClick(Sender: TObject);
begin
  btnNextClick(sender);
end;

procedure TfrmGLReports.lboStmtsDblClick(Sender: TObject);
begin
  btnNextClick(sender);
end;

procedure TfrmGLReports.editGLPeriodEnter(Sender: TObject);
begin
  editGLPeriod.text := IntToStr(GLPeriod);
  editGLPeriod.SelectAll;
end;

procedure TfrmGLReports.editGLPeriodExit(Sender: TObject);
begin
  SetintGLPeriod(intGLPeriod, editGLPeriod);
end;

procedure TfrmGLReports.editGLYearEnter(Sender: TObject);
begin
  editGLYear.text := Copy(IntToStr(GLYear),3,2);   //If editing, show last 2 digits of year.
  editGLYear.SelectAll;
end;

procedure TfrmGLReports.editGLYearExit(Sender: TObject);
begin
  SetintGLYear(intGLYear, editGLYear);
  editGLYear.text := IntToStr(GLYear);
end;

procedure TfrmGLReports.btnNewClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  application.createform (TfrmFinancialStmt,frmFinancialStmt);
  frmFinancialStmt.tblFStmt.Insert;
  frmFinancialStmt.Show;
  screen.cursor := crDefault;
end;

procedure TfrmGLReports.btnEditClick(Sender: TObject);
begin
  if tblFStmtStmtID.AsVariant = null then btnNewClick(sender)   //Can happen if no stmts yet.
  else begin
    screen.cursor := crHourglass;
    application.createform (TfrmFinancialStmt,frmFinancialStmt);
    frmFinancialStmt.tblFStmt.Locate('StmtID', tblFStmtStmtID.value, []);
    frmFinancialStmt.ShowModal;   //Modal because frmFinancialStmtLine uses tables on frmFinancialStmt (if multiple instances of frmFinancialStmt, then frmFinancialStmtLine uses wrong tables).
    screen.cursor := crDefault;
  end;
end;

procedure TfrmGLReports.btnDeleteClick(Sender: TObject);
begin
  if tblFStmtStmtID.AsVariant = null then exit;   //Can happen if no stmts yet.
  tblFStmt.delete;
  tblFStmt.Database.ApplyUpdates([tblFStmtLAc, tblFStmtLTo, tblFStmtLin, tblFStmt]);
  DbiSaveChanges(tblFStmtLAc.handle);
  DbiSaveChanges(tblFStmtLTo.handle);
  DbiSaveChanges(tblFStmtLin.handle);
  DbiSaveChanges(tblFStmt.handle);
  screen.cursor := crDefault;
end;

procedure TfrmGLReports.FormCreate(Sender: TObject);
begin
  tblFStmt.DatabaseName := strDatabaseName;
  tblFStmtLin.DatabaseName := strDatabaseName;
  tblFStmtLAc.DatabaseName := strDatabaseName;
  tblFStmtLTo.DatabaseName := strDatabaseName;
  tblFStmt.Active := true;
  tblFStmt.Database.TransIsolation := tiDirtyRead;
  //tblFStmtLin.Active := true;   ...pospone until required (delete).
  //tblFStmtLAc.Active := true;   ...pospone until required (delete).
  //tblFStmtLTo.Active := true;   ...pospone until required (delete).
end;

procedure TfrmGLReports.tblFStmtBeforeDelete(DataSet: TDataSet);
begin
  if MessageDlg('Delete statement ' + '''' + tblFStmtStmtTitle.value + '''' + '?',mtConfirmation,mbOKCancel,0) <> mrOK then raise(EAbort.create(''));  //Silent Exception: "abort;" replaced by "raise etc" since abort conflicts with BDE (required by DbiSaveChanges).
  repaint;
  screen.cursor := crHourglass;

  tblFStmt.edit;   //Put lock on master table.
  with tblFStmtLAc do begin   //Delete detail for this stmt.
    Active := true;
    First;
    while not eof do Delete;
  end;
  with tblFStmtLTo do begin
    Active := true;
    First;
    while not eof do Delete;
  end;
  with tblFStmtLin do begin
    Active := true;
    First;
    while not eof do Delete;
  end;
end;

procedure TfrmGLReports.btnCancelClick(Sender: TObject);
begin
  Close;
end;

end.