itemsform.pas

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

unit ItemsForm;

interface

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

type
  TfrmItems = class(TForm)
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    tblItem: TTable;
    dsItem: TDataSource;
    DBGrid1: TDBGrid;
    cboFind: TComboBox;
    Label1: TLabel;
    mnuFile: TMenuItem;
    mnuView: TMenuItem;
    mnuHelp: TMenuItem;
    mnuFilter: TMenuItem;
    mnuSortBy: TMenuItem;
    N1: TMenuItem;
    mnuRefresh: TMenuItem;
    mnuItemsHelp: TMenuItem;
    mnuPrint: TMenuItem;
    N2: TMenuItem;
    mnuExit: TMenuItem;
    Bevel1: TBevel;
    mnuSortDescription: TMenuItem;
    mnuSortItemNo: TMenuItem;
    btnNew: TSpeedButton;
    btnEdit: TSpeedButton;
    btnDelete: TSpeedButton;
    editFind: TEdit;
    mnuRecords: TMenuItem;
    mnuNew: TMenuItem;
    mnuEdit: TMenuItem;
    mnuDelete: TMenuItem;
    qryItem: TQuery;
    PopupMenu1: TPopupMenu;
    popNew: TMenuItem;
    popEdit: TMenuItem;
    popDelete: TMenuItem;
    tblItemItemNo: TStringField;
    tblItemItemDescription: TStringField;
    tblItemSuspended: TBooleanField;
    qryItemSuspended: TBooleanField;
    qryItemItemNo: TStringField;
    qryItemItemDescription: TStringField;
    qryItemUnitPrice: TCurrencyField;
    tblARInvDet: TTable;
    tblARInvDetItemNo: TStringField;
    procedure mnuRefreshClick(Sender: TObject);
    procedure tblItemBeforeDelete(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure Panel1DblClick(Sender: TObject);
    procedure cboFindDropDown(Sender: TObject);
    procedure cboFindKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cboFindClick(Sender: TObject);
    procedure cboFindKeyPress(Sender: TObject; var Key: Char);
    procedure tblItemAfterDelete(DataSet: TDataSet);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure editFindKeyPress(Sender: TObject; var Key: Char);
    procedure mnuNewClick(Sender: TObject);
    procedure mnuEditClick(Sender: TObject);
    procedure mnuDeleteClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuSortItemNoClick(Sender: TObject);
    procedure mnuSortDescriptionClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure mnuPrintClick(Sender: TObject);
    procedure mnuFilterClick(Sender: TObject);
    procedure qryItemFilterRecord(DataSet: TDataSet;
      var Accept: Boolean);
    procedure tblItemFilterRecord(DataSet: TDataSet;
      var Accept: Boolean);
    procedure mnuItemsHelpClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmItems: TfrmItems;
  
implementation

uses BS1Form, ItemForm, ItemsFilterForm, ItemsReport;

var
  intClientHeight, intClientWidth: Integer;
  cboFind_ItemNos: TStringList;
  OldWindowState: TWindowState;

{$R *.DFM}

procedure cboFind_Load(const Tbl: TTable; const Cbo: TCombobox);
begin
  Cbo.Items.Clear;   //Populate "find" combobox.
  cboFind_ItemNos.Clear;
  Tbl.First;
  while not Tbl.EOF do begin
    Cbo.Items.Add(Tbl['ItemDescription']);
    cboFind_ItemNos.Add(Tbl['ItemNo']);
    Tbl.Next;
  end;
  frmItems_cboFind_RequeryRequired := false;
end;

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

procedure TfrmItems.tblItemBeforeDelete(DataSet: TDataSet);
begin
  if MessageDlg('Delete ' + '''' + tblItemItemNo.AsString + ': ' + tblItemItemDescription.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;

  tblARInvDet.Active := true;
  if tblARInvDet.RecordCount >0 then raise(Exception.Create('Unable to delete item ' + '''' + tblItemItemNo.AsString + ': ' + tblItemItemDescription.AsString + '''' + '...' + #13 + 'Invoice(s) exist'));
end;

procedure TfrmItems.FormCreate(Sender: TObject);
var
  x: integer;
begin
  qryItem.DatabaseName := strDatabaseName;
  tblItem.DatabaseName := strDatabaseName;
  tblARInvDet.DatabaseName := strDatabaseName;
  qryItem.Active := true;
  tblItem.Active := true;
  //tblARInvDet.Active := true;   ...pospone until required (delete).

  cboFind_ItemNos := TStringList.create;   //Create a TStringList to store Items for the "find" combobox.
  cboFind_Load(tblItem, cboFind);   //Populate "find" combobox.

  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 TfrmItems.Panel1DblClick(Sender: TObject);
begin
  ClientHeight := intClientHeight;   //Resize form.
  ClientWidth := intClientWidth;
end;

procedure TfrmItems.cboFindDropDown(Sender: TObject);
begin
  if frmItems_cboFind_RequeryRequired = true then cboFind_Load(tblItem, cboFind);   //Populate "find" combobox.
end;

procedure TfrmItems.cboFindKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if frmItems_cboFind_RequeryRequired = true then cboFind_Load(tblItem, cboFind);   //Populate "find" combobox.
end;

procedure TfrmItems.cboFindClick(Sender: TObject);
begin
  if cboFind.Text = '' then exit;
  editFind.text := '';
  if cboFind.Items.IndexOf(cboFind.Text) < 0 then raise(Exception.Create('Choose an item from the list'));
  if qryItem.Locate('ItemNo', cboFind_ItemNos[cboFind.ItemIndex], []) <> true then raise(Exception.Create('''' + cboFind.Text + '''' + ' not found'));
end;

procedure TfrmItems.cboFindKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then begin
    Key := #0;   //Cancel Enter key.
    if (cboFind.Text = '') or (cboFind.Text = '<Description>') then begin
      Perform(WM_NEXTDLGCTL, 0, 0);   //Advance to next control.
      exit;
    end;
    cboFindClick(Sender);   //Trigger click event (in case partial text was entered then combobox opened: item would show as selected, but Enter wouldn't process it).
    Perform(WM_NEXTDLGCTL, 0, 0);   //Advance to next control.
  end;
end;

procedure TfrmItems.tblItemAfterDelete(DataSet: TDataSet);
begin
  frmItems_cboFind_RequeryRequired := true;
  cboFind.text := '';
end;

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

procedure TfrmItems.FormShow(Sender: TObject);
begin
  cboFind.ItemIndex := 0;   //Reset selected item to 1st (so down arrow scrolls from start).
  cboFind.text := '<Description>';   //Clear selection.
  editFind.text := '<Item no.>';
  editFind.setfocus;
  editFind.SelectAll;
  qryItem.First;   //Reset grid to start at 1st record.
  if mnuFilter.checked = true then caption := 'Items (Filtered)'
  else                             caption := 'Items';
end;

procedure TfrmItems.editFindKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then begin
    Key := #0;   //Cancel Enter key.
    if (editFind.Text = '') or (editFind.Text = '<Item no.>') then begin
      Perform(WM_NEXTDLGCTL, 0, 0);   //Advance to next control.
      exit;
    end;
    cboFind.text := '';
    if qryItem.Locate('ItemNo', editFind.Text, []) <> true then begin
      editFind.SelectAll;
      raise(Exception.Create('Item ' + '''' + editFind.Text + '''' + ' not found'));
    end else DBGrid1.setfocus;
  end;
end;

procedure TfrmItems.mnuNewClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  application.createform (TfrmItem,frmItem);
  frmItem.tblItem.Insert;
  frmItem.Show;
  screen.cursor := crDefault;
end;

procedure TfrmItems.mnuEditClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  application.createform (TfrmItem,frmItem);
  frmItem.tblItem.Locate('ItemNo', qryItemItemNo.AsString, []);
  frmItem.Show;
  screen.cursor := crDefault;
end;

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

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

procedure TfrmItems.mnuSortItemNoClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortItemNo.checked := true;
  qryItem.close;
  qryItem.sql.clear;
  qryItem.sql.add('SELECT Suspended, ItemNo, ItemDescription, UnitPrice FROM Item');
  qryItem.sql.add('ORDER BY ItemNo');
  qryItem.open;
  screen.cursor := crDefault;
end;

procedure TfrmItems.mnuSortDescriptionClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortDescription.checked := true;
  qryItem.close;
  qryItem.sql.clear;
  qryItem.sql.add('SELECT Suspended, ItemNo, ItemDescription, UnitPrice FROM Item');
  qryItem.sql.add('ORDER BY ItemDescription');
  qryItem.open;
  screen.cursor := crDefault;
end;

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

procedure TfrmItems.mnuPrintClick(Sender: TObject);
var
  strWHERE: string;
begin
  screen.cursor := crHourglass;
  application.createform (TrptItems,rptItems);
  rptItems.qryItem.SQL := frmItems.qryItem.SQL;
  rptItems.qryItem.SQL[0] := 'SELECT Item.* FROM Item';   //Replace 1st line to include "notes", etc.
  if mnuFilter.checked = true then begin
    strWHERE := ' WHERE (1 = 1)';
    try  //Try in case filter form not loaded.
      if (frmItemsFilter.optSuspendedYes.checked = true) then strWHERE := strWHERE + ' AND (Suspended = true)'
      else if (frmItemsFilter.optSuspendedNo.checked = true) then strWHERE := strWHERE + ' AND (Suspended = false)';
    except; end;
    rptItems.qryItem.SQL[0] := rptItems.qryItem.SQL[0] + strWHERE;
  end;
  rptItems.qryItem.Active := true;
  screen.cursor := crDefault;
  rptItems.QuickReport.Preview;
end;

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

procedure TfrmItems.qryItemFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept := true;   //Default.
  try  //Try in case filter form not loaded.
    if (frmItemsFilter.optSuspendedYes.checked = true) and (qryItemSuspended.value <> true) then Accept := false
    else if (frmItemsFilter.optSuspendedNo.checked = true) and (qryItemSuspended.value <> false) then Accept := false;
  except; end;
end;

procedure TfrmItems.tblItemFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept := true;   //Default.
  try  //Try in case filter form not loaded.
    if (frmItemsFilter.optSuspendedYes.checked = true) and (tblItemSuspended.value <> true) then Accept := false
    else if (frmItemsFilter.optSuspendedNo.checked = true) and (tblItemSuspended.value <> false) then Accept := false;
  except; end;
end;

procedure TfrmItems.mnuItemsHelpClick(Sender: TObject);
begin
  Application.HelpContext(260);
end;

end.