home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / mastapp.pak / BRMODAL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  3.6 KB  |  142 lines
  1. unit Brmodal;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, DBTables, DB, StdCtrls, ExtCtrls, Grids, DBGrids, Buttons;
  8.  
  9. type
  10.   TPickDlg = class(TForm)
  11.     DataSource: TDataSource;
  12.     Parts: TTable;
  13.     Cust: TTable;
  14.     CustCustNo: TFloatField;
  15.     CustCompany: TStringField;
  16.     PartsPartNo: TFloatField;
  17.     PartsDescription: TStringField;
  18.     DBGrid1: TDBGrid;
  19.     OKBtn: TButton;
  20.     CancelBtn: TButton;
  21.     SearchEd: TEdit;
  22.     OrderCombo: TComboBox;
  23.     Label1: TLabel;
  24.     FindBut: TSpeedButton;
  25.     Label2: TLabel;
  26.     NearestBut: TSpeedButton;
  27.     procedure DBGrid1DblClick(Sender: TObject);
  28.     procedure FindButClick(Sender: TObject);
  29.     procedure OrderComboChange(Sender: TObject);
  30.     procedure NearestButClick(Sender: TObject);
  31.   private
  32.     function GetCustNo: Double;
  33.     procedure SetCustNo(NewCustNo: Double);
  34.     function GetPartNo: Double;
  35.     procedure SetPartNo(NewPartNo: Double);
  36.   public
  37.     property PartNo: Double read GetPartNo write SetPartNo;
  38.     property CustNo: Double read GetCustNo write SetCustNo;
  39.     function ShowModalCust: Integer;
  40.     function ShowModalParts: Integer;
  41.   end;
  42.  
  43. var
  44.   PickDlg: TPickDlg;
  45.  
  46. implementation
  47.  
  48. {$R *.DFM}
  49.  
  50. function TPickDlg.GetCustNo: Double;
  51. begin
  52.   Result := CustCustNo.Value;
  53. end;
  54.  
  55. procedure TPickDlg.SetCustNo(NewCustNo: Double);
  56. begin
  57.   Cust.IndexFieldNames := 'CustNo';
  58.   Cust.FindKey([NewCustNo]);
  59. end;
  60.  
  61. function TPickDlg.GetPartNo: Double;
  62. begin
  63.   Result := PartsPartNo.Value;
  64. end;
  65.  
  66. procedure TPickDlg.SetPartNo(NewPartNo: Double);
  67. begin
  68.   Parts.IndexFieldNames := 'PartNo';
  69.   Parts.FindKey([NewPartNo]);
  70. end;
  71.  
  72. function TPickDlg.ShowModalCust: Integer;
  73. begin
  74.   OrderCombo.Items.Clear;
  75.   OrderCombo.Items.Add('Company');
  76.   OrderCombo.Items.Add('CustNo');
  77.   OrderCombo.ItemIndex := 0;
  78.   Cust.IndexFieldNames := 'Company';
  79.   Datasource.Dataset := Cust;
  80.   Caption := 'Select a Customer';
  81.   Result := ShowModal;
  82. end;
  83.  
  84. function TPickDlg.ShowModalParts: Integer;
  85. begin
  86.   OrderCombo.Items.Clear;
  87.   OrderCombo.Items.Add('Description');
  88.   OrderCombo.Items.Add('PartNo');
  89.   OrderCombo.ItemIndex := 0;
  90.   Parts.IndexFieldNames := 'Description';
  91.   Datasource.Dataset := Parts;
  92.   Caption := 'Select a Part';
  93.   Result := ShowModal;
  94. end;
  95.  
  96. procedure TPickDlg.DBGrid1DblClick(Sender: TObject);
  97. begin
  98.   ModalResult := mrOK;
  99. end;
  100.  
  101. procedure TPickDlg.FindButClick(Sender: TObject);
  102. {search for a match}
  103. begin
  104.   if (SearchEd.Text = '') then
  105.     MessageDlg('No search text specified!', mtError, [mbOK], 0)
  106.   else
  107.   begin
  108.     try
  109.       if not (Datasource.Dataset as TTable).Findkey([SearchEd.Text]) then
  110.         MessageDlg('No matches found. Try the other button for a "nearest" search',
  111.           mtInformation, [mbOK], 0);
  112.     except
  113.       on exception do   { probably caused by searching for an invalid value on float field }
  114.         MessageDlg('The search is on the List Order column. Try entering a number! ',
  115.           mtError, [mbOK], 0);
  116.     end;
  117.   end;
  118. end;
  119.  
  120. procedure TPickDlg.NearestButClick(Sender: TObject);
  121. begin
  122.   if (SearchEd.Text = '') then
  123.     MessageDlg('No search text specified!', mtError, [mbOK], 0)
  124.   else
  125.   begin
  126.     try
  127.       (Datasource.Dataset as TTable).FindNearest([SearchEd.Text]);
  128.     except
  129.       on exception do
  130.         MessageDlg('The search is on order-by column. Try entering a number! ',
  131.           mtError, [mbOK], 0);
  132.     end;
  133.   end;
  134. end;
  135.  
  136. procedure TPickDlg.OrderComboChange(Sender: TObject);
  137. begin
  138.   (Datasource.Dataset as TTable).IndexFieldNames := OrderCombo.Text;
  139. end;
  140.  
  141. end.
  142.