jvsform.pas

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

unit JVsForm;

interface

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

type
  TfrmJVs = class(TForm)
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    tblJV: TTable;
    dsJV: TDataSource;
    DBGrid1: TDBGrid;
    Label1: TLabel;
    mnuFile: TMenuItem;
    mnuView: TMenuItem;
    mnuHelp: TMenuItem;
    mnuFilter: TMenuItem;
    mnuSortBy: TMenuItem;
    N1: TMenuItem;
    mnuRefresh: TMenuItem;
    mnuAPInvoicesHelp: TMenuItem;
    mnuPrint: TMenuItem;
    N2: TMenuItem;
    mnuExit: TMenuItem;
    Bevel1: TBevel;
    mnuSortAmount: TMenuItem;
    mnuSortDate: TMenuItem;
    mnuSortPeriod: TMenuItem;
    btnNew: TSpeedButton;
    btnEdit: TSpeedButton;
    btnDelete: TSpeedButton;
    mnuRecords: TMenuItem;
    mnuNew: TMenuItem;
    mnuEdit: TMenuItem;
    mnuDelete: TMenuItem;
    qryJV: TQuery;
    tblJVDet: TTable;
    mnuSortDateAscending: TMenuItem;
    mnuSortDateDescending: TMenuItem;
    mnuSortPeriodAscending: TMenuItem;
    mnuSortPeriodDescending: TMenuItem;
    mnuSortJVno: TMenuItem;
    editFindJV: TEdit;
    tblJVJVID: TIntegerField;
    qryJVJVID: TIntegerField;
    qryJVGLYear: TSmallintField;
    qryJVGLPeriod: TSmallintField;
    qryJVJVNumber: TIntegerField;
    qryJVSource: TStringField;
    qryJVTransDate: TDateField;
    qryJVVendorID: TIntegerField;
    qryJVAPInvoiceID: TIntegerField;
    qryJVJVAmount: TCurrencyField;
    qryJVPosted: TBooleanField;
    qryJVAutoReverse: TBooleanField;
    tblJVDetJVID: TIntegerField;
    qryJVPeriodppyyyy: TStringField;
    qryJVTransType: TStringField;
    editFindPeriod: TMaskEdit;
    qryJVTransDescription: TStringField;
    N3: TMenuItem;
    mnuPost: TMenuItem;
    PopupMenu1: TPopupMenu;
    popNew: TMenuItem;
    popEdit: TMenuItem;
    popDelete: TMenuItem;
    qryJVSourceType: TStringField;
    btnFilter: TSpeedButton;
    procedure mnuRefreshClick(Sender: TObject);
    procedure tblJVBeforeDelete(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure Panel1DblClick(Sender: TObject);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure editFindPeriodKeyPress(Sender: TObject; var Key: Char);
    procedure mnuNewClick(Sender: TObject);
    procedure mnuEditClick(Sender: TObject);
    procedure mnuDeleteClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure qryJVCalcFields(DataSet: TDataSet);
    procedure mnuSortDateAscendingClick(Sender: TObject);
    procedure mnuSortDateDescendingClick(Sender: TObject);
    procedure mnuSortPeriodAscendingClick(Sender: TObject);
    procedure mnuSortPeriodDescendingClick(Sender: TObject);
    procedure mnuSortAmountClick(Sender: TObject);
    procedure mnuSortJVnoClick(Sender: TObject);
    procedure editFindJVKeyPress(Sender: TObject; var Key: Char);
    procedure FormResize(Sender: TObject);
    procedure mnuPostClick(Sender: TObject);
    procedure mnuFilterClick(Sender: TObject);
    procedure qryJVFilterRecord(DataSet: TDataSet; var Accept: Boolean);
    procedure mnuPrintClick(Sender: TObject);
    procedure mnuAPInvoicesHelpClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmJVs: TfrmJVs;

implementation

uses BS1Form, JVForm, JVsPostForm, JVsFilterForm, JVsReport;

var
  intClientHeight, intClientWidth: Integer;
  OldWindowState: TWindowState;

{$R *.DFM}

procedure TfrmJVs.mnuRefreshClick(Sender: TObject);
var
  Bookmark: TBookmark;
begin
  repaint;
  screen.cursor := crHourglass;
  Bookmark := qryJV.GetBookmark;
  with qryJV do begin close; open; end;   //Refresh.
  try qryJV.GotoBookmark(Bookmark); except; end;
  qryJV.FreeBookmark(BookMark);
  screen.cursor := crDefault;
end;

procedure TfrmJVs.tblJVBeforeDelete(DataSet: TDataSet);
begin
  if qryJVPosted.value = true then raise(Exception.Create('Unable to delete JV ' + '''' + qryJVJVNumber.AsString + '''' + '...' + #13 + 'It has already been posted'));
  if qryJVSource.value <> 'GL' then raise(Exception.Create('Unable to delete JV ' + '''' + qryJVJVNumber.AsString + '''' + '...' + #13 + 'Its source is not GL'));
  if MessageDlg('Delete JV ' + '''' + qryJVJVNumber.AsString + '''' + '?',mtConfirmation,mbOKCancel,0) <> mrOK then raise(EAbort.create(''));   //Silent Exception: "abort;" replaced by "raise etc" since abort conflicts with BDE (required by DbiSaveChanges).
  repaint;

  tblJV.edit;   //Put lock on master table.
  with tblJVDet do begin   //Delete detail for this JV.
    Active := true;
    First;
    while not eof do Delete;
  end;
end;

procedure TfrmJVs.FormCreate(Sender: TObject);
var
  x: integer;
begin
  qryJV.DatabaseName := strDatabaseName;
  tblJV.DatabaseName := strDatabaseName;
  tblJVDet.DatabaseName := strDatabaseName;
  qryJV.Active := true;
  //tblJV.Active := true;   ...pospone until required (delete).
  //tblJVDet.Active := true;

  if FontFactor <> 1 then begin   //If using large fonts, resize grid columns.
    intClientWidth := Trunc(20*FontFactor) + DBGrid1.Columns.Count -1;   //Scrollbar + grid lines.
    for x := 0 to DBGrid1.Columns.Count - 1 do begin
      DBGrid1.Columns[x].width := Trunc(DBGrid1.Columns[x].width*FontFactor);
      intClientWidth := intClientWidth + DBGrid1.Columns[x].width;
    end;
    ClientWidth := intClientWidth;
  end;  
  intClientHeight := ClientHeight;   //Store form size.
  intClientWidth := ClientWidth;
end;

procedure TfrmJVs.Panel1DblClick(Sender: TObject);
begin
  ClientHeight := intClientHeight;   //Resize form.
  ClientWidth := intClientWidth;
end;

procedure TfrmJVs.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then begin
    mnuEditClick(Sender);
    Key := #0;   //Cancel Enter key.
  end;
end;

procedure TfrmJVs.FormShow(Sender: TObject);
begin
  editFindPeriod.text := '  /    ';
  editFindJV.text := '<JV no.>';
  editFindPeriod.setfocus;
  editFindPeriod.SelectAll;
  qryJV.First;   //Reset grid to start at 1st record.
  if mnuFilter.checked = true then caption := 'Journal Vouchers (Filtered)'
  else                             caption := 'Journal Vouchers';
end;

procedure TfrmJVs.editFindPeriodKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then begin
    Key := #0;   //Cancel Enter key.
    Perform(WM_NEXTDLGCTL, 0, 0);   //Advance to next control.
  end;
end;

procedure TfrmJVs.mnuNewClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  application.createform (TfrmJV,frmJV);
  frmJV.tblJV.Insert;
  frmJV.lblTotals.caption := 'Debits: ' + FloatToStrF(0,ffCurrency,18,2) + '   Credits: ' + FloatToStrF(0,ffCurrency,18,2);
  frmJV.Show;
  screen.cursor := crDefault;
end;

procedure TfrmJVs.mnuEditClick(Sender: TObject);
begin
  if qryJVJVID.AsVariant = null then mnuNewClick(sender)   //Can happen if no JVs yet.
  else begin
    screen.cursor := crHourglass;
    application.createform (TfrmJV,frmJV);
    frmJV.tblJV.Locate('JVID', qryJVJVID.value, []);
    frmJV.lblTotals.caption := 'Debits: ' + FloatToStrF(frmJV.tblJVJVAmount.value,ffCurrency,18,2) + '   Credits: ' + FloatToStrF((0 - frmJV.tblJVJVAmount.value),ffCurrency,18,2);
    frmJV.Show;
    screen.cursor := crDefault;
  end;
end;

procedure TfrmJVs.mnuDeleteClick(Sender: TObject);
var
  Bookmark: TBookmark;
begin
  tblJV.Active := true;
  tblJV.Database.TransIsolation := tiDirtyRead;
  if tblJV.Locate('JVID', qryJVJVID.value, []) = true then begin
    tblJV.delete;   //Delete from table as query is read-only.
    tblJV.Database.ApplyUpdates([tblJVDet, tblJV]);
    DbiSaveChanges(tblJVDet.handle);
    DbiSaveChanges(tblJV.handle);
    Bookmark := qryJV.GetBookmark;
    with qryJV do begin close; open; end;   //Refresh.
    try qryJV.GotoBookmark(Bookmark); except; end;
    qryJV.FreeBookmark(BookMark);
    if qryJVJVID.AsVariant = null then qryJV.first;   //If deleting last record, prevent blank record with focus after last record (move to 1st record as per other grids).
  end;  
end;

procedure TfrmJVs.mnuExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmJVs.qryJVCalcFields(DataSet: TDataSet);
begin
  qryJVPeriodppyyyy.value := qryJVGLPeriod.AsString + '/' + qryJVGLYear.AsString;
  qryJVSourceType.value := qryJVSource.value + ' ' + qryJVTransType.value;
end;

procedure TfrmJVs.mnuSortDateAscendingClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortDate.checked := true;
  mnuSortDateAscending.checked := true;
  mnuSortPeriodAscending.checked := false;
  mnuSortPeriodDescending.checked := false;
  qryJV.close;
  qryJV.sql.clear;
  qryJV.sql.add('SELECT * FROM JV');
  qryJV.sql.add('ORDER BY TransDate, JVNumber');
  qryJV.open;
  screen.cursor := crDefault;
end;

procedure TfrmJVs.mnuSortDateDescendingClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortDate.checked := true;
  mnuSortDateDescending.checked := true;
  mnuSortPeriodAscending.checked := false;
  mnuSortPeriodDescending.checked := false;
  qryJV.close;
  qryJV.sql.clear;
  qryJV.sql.add('SELECT * FROM JV');
  qryJV.sql.add('ORDER BY TransDate DESC, JVNumber');
  qryJV.open;
  screen.cursor := crDefault;
end;

procedure TfrmJVs.mnuSortPeriodAscendingClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortPeriod.checked := true;
  mnuSortPeriodAscending.checked := true;
  mnuSortDateAscending.checked := false;
  mnuSortDateDescending.checked := false;
  qryJV.close;
  qryJV.sql.clear;
  qryJV.sql.add('SELECT * FROM JV');
  qryJV.sql.add('ORDER BY GLYear, GLPeriod, JVNumber');
  qryJV.open;
  screen.cursor := crDefault;
end;

procedure TfrmJVs.mnuSortPeriodDescendingClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortPeriod.checked := true;
  mnuSortPeriodDescending.checked := true;
  mnuSortDateAscending.checked := false;
  mnuSortDateDescending.checked := false;
  qryJV.close;
  qryJV.sql.clear;
  qryJV.sql.add('SELECT * FROM JV');
  qryJV.sql.add('ORDER BY GLYear DESC, GLPeriod DESC, JVNumber DESC');
  qryJV.open;
  screen.cursor := crDefault;
end;

procedure TfrmJVs.mnuSortAmountClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortAmount.checked := true;
  mnuSortDateAscending.checked := false;
  mnuSortDateDescending.checked := false;
  mnuSortPeriodAscending.checked := false;
  mnuSortPeriodDescending.checked := false;
  qryJV.close;
  qryJV.sql.clear;
  qryJV.sql.add('SELECT * FROM JV');
  qryJV.sql.add('ORDER BY JVAmount DESC, TransDate');
  qryJV.open;
  screen.cursor := crDefault;
end;

procedure TfrmJVs.mnuSortJVnoClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortJVno.checked := true;
  mnuSortDateAscending.checked := false;
  mnuSortDateDescending.checked := false;
  mnuSortPeriodAscending.checked := false;
  mnuSortPeriodDescending.checked := false;
  qryJV.close;
  qryJV.sql.clear;
  qryJV.sql.add('SELECT * FROM JV');
  qryJV.sql.add('ORDER BY JVNumber');
  qryJV.open;
  screen.cursor := crDefault;
end;

procedure TfrmJVs.editFindJVKeyPress(Sender: TObject; var Key: Char);
var
  strYear, strPeriod: string;
begin
  if key = #13 then begin
    Key := #0;   //Cancel Enter key.
    if (editFindJV.Text = '') or (editFindJV.Text = '<JV no.>') then begin
      Perform(WM_NEXTDLGCTL, 0, 0);   //Advance to next control.
      exit;
    end;
    if editFindPeriod.Text <> '  /    ' then begin
      strPeriod := Copy(editFindPeriod.Text,1,2);
      strYear := Copy(editFindPeriod.Text,4,4);
      if qryJV.Locate('GLYear;GLPeriod;JVNumber', VarArrayOf([strYear,strPeriod,editFindJV.Text]), []) <> true then begin
        editFindJV.SelectAll;
        raise(Exception.Create('JV ' + '''' + editFindJV.Text + '''' + ' not found in period ' + '''' + editFindPeriod.Text + ''''));
      end else DBGrid1.setfocus;
    end else begin
      if qryJV.Locate('JVNumber', editFindJV.Text, []) <> true then begin
        editFindJV.SelectAll;
        raise(Exception.Create('JV ' + '''' + editFindJV.Text + '''' + ' not found'));
      end else DBGrid1.setfocus;
    end;
  end;
end;

procedure TfrmJVs.FormResize(Sender: TObject);
begin
  if (WindowState <> OldWindowState)   //Prevent grid resize bugs.
  and (WindowState <> wsMinimized)
  and (OldWindowState <> wsMinimized)
  then mnuRefreshClick(sender);
  OldWindowState := WindowState;
end;

procedure TfrmJVs.mnuPostClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  application.createform (TfrmJVsPost,frmJVsPost);
  screen.cursor := crDefault;
  if frmJVsPost.ShowModal = mrOk then mnuRefreshClick(sender);
end;

procedure TfrmJVs.mnuFilterClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  aComponent := Application.FindComponent('frmJVsFilter');
  if not Assigned (aComponent) then frmJVsFilter := TfrmJVsFilter.Create(Application);
  frmJVsFilter.ShowModal;
end;

procedure TfrmJVs.qryJVFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept := true;   //Default.
  try  //Try in case filter form not loaded.
    if (frmJVsFilter.optPostedYes.checked = true) and (qryJVPosted.value <> true) then Accept := false
    else if (frmJVsFilter.optPostedNo.checked = true) and (qryJVPosted.value <> false) then Accept := false;
    if (frmJVsFilter.cboSource.text <> '<All>') and (qryJVSource.value <> frmJVsFilter.cboSource.text) then Accept := false;
  except; end;
end;

procedure TfrmJVs.mnuPrintClick(Sender: TObject);
var
  strWHERE: string;
begin
  //if license = '' then begin frmBS1.FreewareMessage; exit; end;
  screen.cursor := crHourglass;
  application.createform (TrptJVs,rptJVs);
  rptJVs.qryJV.SQL := frmJVs.qryJV.SQL;
  if mnuFilter.checked = true then begin
    strWHERE := ' WHERE (1 = 1)';
    try  //Try in case filter form not loaded.
      if (frmJVsFilter.optPostedYes.checked = true) then strWHERE := strWHERE + ' AND (Posted = true)'
      else if (frmJVsFilter.optPostedNo.checked = true) then strWHERE := strWHERE + ' AND (Posted = false)';
      if (frmJVsFilter.cboSource.text <> '<All>') then strWHERE := strWHERE + ' AND (Source = ' + '''' + frmJVsFilter.cboSource.text + '''' + ')';
    except; end;
    rptJVs.qryJV.SQL[0] := rptJVs.qryJV.SQL[0] + strWHERE;
  end;
  rptJVs.qryJV.Active := true;
  screen.cursor := crDefault;
  rptJVs.QuickReport.Preview;
end;

procedure TfrmJVs.mnuAPInvoicesHelpClick(Sender: TObject);
begin
  Application.HelpContext(320);
end;

procedure TfrmJVs.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  screen.cursor := crHourglass;
  application.createform (TfrmJVsPost,frmJVsPost);
  screen.cursor := crDefault;
  if frmJVsPost.qryJV.RecordCount = 0 then begin
    frmJVsPost.close;
    exit;
  end;
  if frmJVsPost.ShowModal = mrOk then mnuRefreshClick(sender);
end;

end.