bs1form.pas

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

unit BS1Form;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, Buttons, ExtCtrls, StdCtrls, DBCtrls, DB, DBTables, IniFiles, SHELLAPI;

type
  TfrmBS1 = class(TForm)
    MainMenu1: TMainMenu;
    mnuFile: TMenuItem;
    mnuAP: TMenuItem;
    mnuAR: TMenuItem;
    mnuGL: TMenuItem;
    mnuHelp: TMenuItem;
    mnuHelpTopics: TMenuItem;
    mnuAbout: TMenuItem;
    mnuExit: TMenuItem;
    N1: TMenuItem;
    mnuVendors: TMenuItem;
    mnuAPInvoices: TMenuItem;
    mnuCheques: TMenuItem;
    N2: TMenuItem;
    mnuAPReports: TMenuItem;
    mnuCustomers: TMenuItem;
    mnuARInvoices: TMenuItem;
    mnuPayments: TMenuItem;
    mnuAROther: TMenuItem;
    N3: TMenuItem;
    mnuARReports: TMenuItem;
    mnuAccounts: TMenuItem;
    mnuJVs: TMenuItem;
    mnuBudget: TMenuItem;
    N4: TMenuItem;
    mnuGLReports: TMenuItem;
    mnuSalesmen: TMenuItem;
    N5: TMenuItem;
    mnuTechnicalSupport: TMenuItem;
    mnuView: TMenuItem;
    mnuToolbar: TMenuItem;
    panelToolbar: TPanel;
    btnVendors: TSpeedButton;
    btnAPInvoices: TSpeedButton;
    btnCheques: TSpeedButton;
    btnReports: TSpeedButton;
    cboSystem: TComboBox;
    tblCompany: TTable;
    dsCompany: TDataSource;
    panelCompanyName: TPanel;
    DBText1: TDBText;
    mnuCompanyName: TMenuItem;
    mnuCustomerTypes: TMenuItem;
    mnuGeneral: TMenuItem;
    mnuYourCompany: TMenuItem;
    btnPayments: TSpeedButton;
    btnARInvoices: TSpeedButton;
    btnBudget: TSpeedButton;
    btnJVs: TSpeedButton;
    btnCustomers: TSpeedButton;
    btnAccounts: TSpeedButton;
    tblCompanyCompanyName: TStringField;
    tblCompanyFiscalYear: TSmallintField;
    tblCompanyDefaultPeriodYYYY: TSmallintField;
    tblCompanyDefaultPeriodPP: TSmallintField;
    tblCompanyWPeriodToYYYY: TSmallintField;
    tblCompanyWPeriodToPP: TSmallintField;
    tblCompanyEPeriodFromYYYY: TSmallintField;
    tblCompanyEPeriodFromPP: TSmallintField;
    tblCompanyEPeriodToYYYY: TSmallintField;
    tblCompanyEPeriodToPP: TSmallintField;
    tblCompanyWPeriodFromYYYY: TSmallintField;
    tblCompanyWPeriodFromPP: TSmallintField;
    mnuConfirmExit: TMenuItem;
    tblCompanyDefaultCurrencyID: TIntegerField;
    tblCompanyAPInvDescriptions: TBooleanField;
    tblCompanyAPInvPONumbers: TBooleanField;
    mnuBanks: TMenuItem;
    mnuCurrencies: TMenuItem;
    mnuGLBalances: TMenuItem;
    mnuGLHistory: TMenuItem;
    N6: TMenuItem;
    mnuItems: TMenuItem;
    tblCompanyDfltSalesGLAccount: TStringField;
    mnuTaxes: TMenuItem;
    mnuPackRepair: TMenuItem;
    N7: TMenuItem;
    mnuHowtoRegister: TMenuItem;
    mnuImport: TMenuItem;
    mnuBankBook: TMenuItem;
    tblCompanyAddressLine1: TStringField;
    tblCompanyAddressLine2: TStringField;
    tblCompanyAddressLine3: TStringField;
    mnuSourceCode: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure mnuToolbarClick(Sender: TObject);
    procedure cboSystemClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuCompanyNameClick(Sender: TObject);
    procedure mnuVendorsClick(Sender: TObject);
    procedure mnuCustomersClick(Sender: TObject);
    procedure mnuAccountsClick(Sender: TObject);
    procedure mnuAPInvoicesClick(Sender: TObject);
    procedure mnuYourCompanyClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure mnuChequesClick(Sender: TObject);
    procedure mnuPaymentsClick(Sender: TObject);
    procedure mnuBudgetClick(Sender: TObject);
    procedure mnuARInvoicesClick(Sender: TObject);
    procedure mnuJVsClick(Sender: TObject);
    procedure btnReportsClick(Sender: TObject);
    procedure mnuConfirmExitClick(Sender: TObject);
    procedure mnuBanksClick(Sender: TObject);
    procedure mnuCurrenciesClick(Sender: TObject);
    procedure mnuCustomerTypesClick(Sender: TObject);
    procedure mnuSalesmenClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure mnuTechnicalSupportClick(Sender: TObject);
    procedure mnuHelpTopicsClick(Sender: TObject);
    procedure mnuGLReportsClick(Sender: TObject);
    procedure mnuAPReportsClick(Sender: TObject);
    procedure mnuARReportsClick(Sender: TObject);
    procedure mnuGLBalancesClick(Sender: TObject);
    procedure mnuGLHistoryClick(Sender: TObject);
    procedure mnuItemsClick(Sender: TObject);
    procedure mnuTaxesClick(Sender: TObject);
    procedure mnuPackRepairClick(Sender: TObject);
    procedure mnuHowtoRegisterClick(Sender: TObject);
    procedure mnuImportClick(Sender: TObject);
    procedure mnuBankBookClick(Sender: TObject);
    //procedure ShowPreview;
    procedure mnuSourceCodeClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function RoundIt(work: double): integer;   //Workaround for Delphi 2 rounding bugs ("Round" & currency calcs round .5 down).
    function Date2000(Text: string): TDateTime;   //Year 2000 date conversion.
    //procedure DemoMessage;
    function DemoLimitExceeded(intcount: integer; strTransactionType: string): boolean;
    procedure DemoLimitWarning(intcount: integer; strTransactionType: string);
end;

var
  frmBS1: TfrmBS1;
  License, RegisteredTo, strDatabaseName: string;
  MaxUsers: integer;
  frmAPInvoices_cboFindVendor_RequeryRequired: boolean;   //Declare these global variables here rather than on the forms which use them to avoid having to add the "using" forms to the uses section of the forms which set the variables.
  frmARInvoices_cboFindCustomer_RequeryRequired: boolean;
  frmARPayments_cboFindCustomer_RequeryRequired: boolean;
  frmBankBook_cboFind_RequeryRequired: boolean;
  frmCustomers_cboFind_RequeryRequired: boolean;
  frmGLAccounts_cboFind_RequeryRequired: boolean;
  frmGLBalances_cboFind_RequeryRequired: boolean;
  frmGLBudget_cboFind_RequeryRequired: boolean;
  frmGLHistory_cboFind_RequeryRequired: boolean;
  frmItems_cboFind_RequeryRequired: boolean;
  frmVendors_cboFind_RequeryRequired: boolean;
  FontFactor: real;

implementation

uses VendorsForm, CustomersForm, CurrenciesForm, BanksForm, GLAccountsForm, APInvoicesForm, CompanyForm,
  CusTypesForm, SalesmenForm, JVsForm, GLAccountsFilterForm,
  VendorsFilterForm, CustomersFilterForm, APInvoicesFilterForm,
  JVsFilterForm, APChequesForm, APChequesFilterForm, AboutForm,
  GLReportsForm, APReportsForm, ARReportsForm, GLBalancesForm,
  GLBalancesFilterForm, GLHistoryForm, GLHistoryFilterForm, ARInvoicesForm,
  ARInvoicesFilterForm, ItemsForm, ItemsFilterForm, TaxesForm,
  ARPaymentsForm, ARPaymentsFilterForm, GLBudgetForm, GLBudgetFilterForm, PackForm,
  WelcomeForm, GettingStartedForm, ImportForm, BankBookForm;   //PreviewForm;
  
{$R *.DFM}

function TfrmBS1.RoundIt(work: double): integer;
begin   //Workaround for Delphi 2 rounding bugs ("Round" & currency calcs round .5 down).
//Currency fields are stored with 4 decimals, so need to be rounded to 2 decimals when multiplying by exchange rates, etc.
//example: frmBS1.RoundIt(amount * rate * 100)/100;  
  if work >0 then begin
    if trunc(work + 0.5) > trunc(work) then result := trunc(work) + 1
    else result := trunc(work);
  end else begin
    if trunc(work - 0.5) < trunc(work) then result := trunc(work) - 1
    else result := trunc(work);
  end;
end;

function TfrmBS1.Date2000(Text: string): TDateTime;
var
  Year, Month, Day: Word;
begin
  if Text = '02' + DateSeparator + '29' + DateSeparator + '00' then result := StrToDate('02' + DateSeparator + '29' + DateSeparator + '2000')
  else if Text = '29' + DateSeparator + '02' + DateSeparator + '00' then result := StrToDate('29' + DateSeparator + '02' + DateSeparator + '2000')
  else begin
    DecodeDate(StrToDate(Text), Year, Month, Day);
    if (Year < 1950) and (Year > 1899) then begin
      Year := Year + 100;
      if Copy(ShortDateFormat,1,1) = 'd' then result := StrToDate(IntToStr(Day) + DateSeparator + IntToStr(Month) + DateSeparator + IntToStr(Year))
      else result := StrToDate(IntToStr(Month) + DateSeparator + IntToStr(Day) + DateSeparator + IntToStr(Year));
    end else if (Year > 2050) then begin
      Year := Year - 100;
      if Copy(ShortDateFormat,1,1) = 'd' then result := StrToDate(IntToStr(Day) + DateSeparator + IntToStr(Month) + DateSeparator + IntToStr(Year))
      else result := StrToDate(IntToStr(Month) + DateSeparator + IntToStr(Day) + DateSeparator + IntToStr(Year));
    end else result := StrToDate(Text);
  end;
end;

function TfrmBS1.DemoLimitExceeded(intCount: integer; strTransactionType: string): boolean;
var
  strLimitMessage: string;
begin
  result := false;

  if tblCompanyCompanyName.value = 'Sample Data' then begin
    if intCount > 1000 then begin
      result := true;
      if Application.MessageBox(PChar('This program allows a limited number of invoices and JVs to be posted until it is registered. ' +
                                      'No more ' + strTransactionType + 's can be posted in the Sample Data company.' + #13 +#13 +
                                      'You can delete the Sample Data company and set up your own by restarting the program and choosing the appropriate option.' + #13 + #13 +
                                      'Would you like to see how to register?'), PChar(Application.Title), mb_YESNO + mb_DefButton1 + mb_IconStop) = IDYES then Application.HelpContext(500);
    end;
  end else begin
    if intCount > 30 then begin
      strLimitMessage := 'This program allows a limited number of invoices and JVs to be posted until it is registered. ' +
                         'You have already posted ' + IntToStr(intCount) + ' ' + strTransactionType + '(s) and can post 0 more.' +#13 +#13 +
                         'Would you like to see how to register?';
      result := true;
      if Application.MessageBox(PChar(strLimitMessage), PChar(Application.Title), mb_YESNO + mb_DefButton1 + mb_IconStop) = IDYES then Application.HelpContext(500);
    end;
  end;
end;

procedure TfrmBS1.DemoLimitWarning(intCount: integer; strTransactionType: string);
var
  intLimit, intRemaining: integer;
  strLimitMessage: string;
begin
  intLimit := 30;
  if intCount < intLimit then intRemaining := intLimit - intCount
  else intRemaining := 0;
  strLimitMessage := 'This program allows a limited number of invoices and JVs to be posted until it is registered. ' +
                     'You have already posted ' + IntToStr(intCount) + ' ' + strTransactionType + '(s) and can post ' + IntToStr(intRemaining) + ' more.' +#13 +#13 +
                     'Would you like to see how to register?';
  if MessageDlg(strLimitMessage, mtWarning, [mbYes, mbNo], 0) = mrYes then Application.HelpContext(500);
end;

{procedure TfrmBS1.DemoMessage;
begin
  showmessage('Demo\Evaluation Version transaction limit exceeded... ' + #13 + #13 +
              'The evaluation version of this program allows a limited number of invoices and JVs to be posted.' +
              'To continue using the program you need to register (purchase) either a single-user or network license.' + #13 + #13 +
              'Details are available at www.dbsonline.com' + #13 +
              'Or e-mail: [e-mail]' + #13 +
              'Or fax: [phone]');
end;}

//procedure TfrmBS1.ShowPreview;
//begin
//  frmPreview.ShowModal;
//end;

procedure SetToolBarButtons;
begin
  if frmBS1.cboSystem.text = 'AP' then begin
    frmBS1.btnVendors.Visible := true;
    frmBS1.btnCustomers.Visible := false;
    frmBS1.btnAccounts.Visible := false;
    frmBS1.btnAPInvoices.Visible := true;
    frmBS1.btnARInvoices.Visible := false;
    frmBS1.btnJVs.Visible := false;
    frmBS1.btnCheques.Visible := true;
    frmBS1.btnPayments.Visible := false;
    frmBS1.btnBudget.Visible := false;
  end else if frmBS1.cboSystem.text = 'AR' then begin
    frmBS1.btnVendors.Visible := false;
    frmBS1.btnCustomers.Visible := true;
    frmBS1.btnAccounts.Visible := false;
    frmBS1.btnAPInvoices.Visible := false;
    frmBS1.btnARInvoices.Visible := true;
    frmBS1.btnJVs.Visible := false;
    frmBS1.btnCheques.Visible := false;
    frmBS1.btnPayments.Visible := true;
    frmBS1.btnBudget.Visible := false;
  end else if frmBS1.cboSystem.text = 'GL' then begin
    frmBS1.btnVendors.Visible := false;
    frmBS1.btnCustomers.Visible := false;
    frmBS1.btnAccounts.Visible := true;
    frmBS1.btnAPInvoices.Visible := false;
    frmBS1.btnARInvoices.Visible := false;
    frmBS1.btnJVs.Visible := true;
    frmBS1.btnCheques.Visible := false;
    frmBS1.btnPayments.Visible := false;
    frmBS1.btnBudget.Visible := true;
  end;
end;

procedure TfrmBS1.FormCreate(Sender: TObject);
var
  BS1Ini, UsersIni: TIniFile;
  CurrentUsers: integer;
begin
  BS1Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'BS1.ini');
  with BS1Ini do begin
    mnuToolbar.checked := ReadBool('General', 'ViewToolbar', true);
    panelToolbar.visible := mnuToolbar.checked;
    mnuCompanyName.checked := ReadBool('General', 'ViewCompanyName', true);
    panelCompanyName.visible := mnuCompanyName.checked;
    mnuConfirmExit.checked := ReadBool('General', 'ViewConfirmExit', false);
    cboSystem.text := ReadString('General', 'System', 'AP');
    if ParamStr(1) <> '' then strDatabaseName := ParamStr(1)   //Command line parameter 1 (if present) = database name
    else strDatabaseName := ReadString('General', 'Database', '');   //Otherwise get from ini file (if specified there)
    if strDatabaseName = '' then strDatabaseName := ExtractFilePath(ParamStr(0)) + 'Data';   //Default: Set path for data files to be subdirectory "data" off program directory.  eg. c:\BS1\Data