home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Help / Examples / Batchmv2 / MAIN.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  6.7 KB  |  247 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Db, DBTables, ComCtrls;
  8.  
  9. type
  10.   TFormMain = class(TForm)
  11.     BatchMove1: TBatchMove;
  12.     tblSource: TTable;
  13.     tblDest: TTable;
  14.     Bevel1: TBevel ;
  15.     Label6: TLabel;
  16.     cmbxDestAlias: TComboBox;
  17.     Label7: TLabel;
  18.     cmbxDestTable: TComboBox;
  19.     Label8: TLabel;
  20.     cmbxDestIndex: TComboBox;
  21.     Bevel2: TBevel;
  22.     cmbxSourceAlias: TComboBox;
  23.     cmbxSourceTable: TComboBox;
  24.     cmbxSourceIndex: TComboBox;
  25.     Label5: TLabel;
  26.     Label4: TLabel;
  27.     Label3: TLabel;
  28.     cmbxMode: TComboBox;
  29.     Button1: TButton;
  30.     Bevel3: TBevel;
  31.     chkbxAbortKey: TCheckBox;
  32.     chkbxAbortProblem: TCheckBox;
  33.     chkbxTrans: TCheckBox;
  34.     Label1: TLabel;
  35.     Label2: TLabel;
  36.     Label10: TLabel;
  37.     Label9: TLabel;
  38.     Label12: TLabel;
  39.     edtChangedTable: TEdit;
  40.     Label13: TLabel;
  41.     edtKeyVioTbl: TEdit;
  42.     Label14: TLabel;
  43.     edtProbTbl: TEdit;
  44.     Label11: TLabel;
  45.     edtRecCount: TEdit;
  46.     procedure FormCreate(Sender: TObject);
  47.     procedure cmbxSourceAliasChange(Sender: TObject);
  48.     procedure cmbxDestAliasChange(Sender: TObject);
  49.     procedure cmbxSourceTableChange(Sender: TObject);
  50.     procedure cmbxDestTableChange(Sender: TObject);
  51.     procedure cmbxSourceIndexChange(Sender: TObject);
  52.     procedure cmbxDestIndexChange(Sender: TObject);
  53.     procedure Button1Click(Sender: TObject);
  54.     procedure chkbxAbortKeyClick(Sender: TObject);
  55.     procedure chkbxAbortProblemClick(Sender: TObject);
  56.     procedure chkbxTransClick(Sender: TObject);
  57.     procedure cmbxModeChange(Sender: TObject);
  58.     procedure edtRecCountKeyPress(Sender: TObject; var Key: Char);
  59.     procedure FormShow(Sender: TObject);
  60.   private
  61.     { Private declarations }
  62.     function IsStringsEqual(const s1,s2 : string): boolean;
  63.   public
  64.     { Public declarations }
  65.   end;
  66.  
  67. var
  68.   FormMain: TFormMain;
  69.  
  70. implementation
  71.  
  72. {$R *.DFM}
  73.  
  74. resourcestring
  75.   sIncomplete = 'Incomplete input.';
  76.   sCompleted = 'BatchMove complete. Number of records applied: ';
  77.  
  78. procedure TFormMain.FormCreate(Sender: TObject); // Get alias names
  79. begin
  80.   if Session.Active = false then
  81.     Session.Open;
  82.   Session.GetAliasNames(CmbxSourceAlias.Items);
  83.   cmbxDestAlias.Items := cmbxSourceAlias.Items;
  84. end;
  85.  
  86. procedure TFormMain.cmbxSourceAliasChange(Sender: TObject);
  87. begin
  88.   if cmbxSourceAlias.ItemIndex <> -1 then
  89.   begin
  90.      tblSource.DatabaseName := cmbxSourceAlias.Items[cmbxSourceAlias.ItemIndex];
  91.      Session.GetTableNames(tblSource.DatabaseName,'',true,false,cmbxSourceTable.Items);
  92.   end
  93.   else
  94.   begin
  95.     tblSource.DatabaseName := '';
  96.     cmbxSourceTable.Items.Clear;
  97.   end;
  98. end;
  99.  
  100. procedure TFormMain.cmbxDestAliasChange(Sender: TObject);
  101. begin
  102.   if cmbxDestAlias.ItemIndex <> -1 then
  103.   begin
  104.      tblDest.DatabaseName := cmbxDestAlias.Items[cmbxDestAlias.ItemIndex];
  105.      Session.GetTableNames(tblDest.DatabaseName,'',true,false,cmbxDestTable.Items);
  106.   end
  107.   else
  108.   begin
  109.     tblDest.DatabaseName := '';
  110.     cmbxDestTable.Items.Clear;
  111.   end;
  112. end;
  113.  
  114. procedure TFormMain.cmbxSourceTableChange(Sender: TObject);
  115. begin
  116.   if cmbxSourceTable.ItemIndex <> -1 then
  117.   begin
  118.      tblSource.TableName := cmbxSourceTable.Items[cmbxSourceTable.ItemIndex];
  119.      tblSource.GetIndexNames(cmbxSourceIndex.Items);
  120.   end
  121.   else
  122.   begin
  123.     tblSource.TableName := '';
  124.     cmbxSourceIndex.Items.Clear;
  125.   end;
  126.  
  127. end;
  128.  
  129. procedure TFormMain.cmbxDestTableChange(Sender: TObject);
  130. begin
  131.   if cmbxDestTable.ItemIndex <> -1 then
  132.   begin
  133.      tblDest.TableName := cmbxDestTable.Items[cmbxDestTable.ItemIndex];
  134.      tblDest.GetIndexNames(cmbxDestIndex.Items);
  135.   end
  136.   else
  137.   begin
  138.     tblDest.TableName := '';
  139.     cmbxDestIndex.Items.Clear;
  140.   end;
  141. end;
  142.  
  143. procedure TFormMain.cmbxSourceIndexChange(Sender: TObject);
  144. begin
  145.   if cmbxSourceIndex.ItemIndex <> -1 then
  146.   begin
  147.     tblSource.IndexName := cmbxSourceIndex.Items[cmbxSourceIndex.ItemIndex];
  148.   end
  149.   else
  150.   begin
  151.      tblSource.IndexName := '';
  152.   end;
  153. end;
  154.  
  155. procedure TFormMain.cmbxDestIndexChange(Sender: TObject);
  156. begin
  157.   if cmbxDestIndex.ItemIndex <> -1 then
  158.   begin
  159.     tblDest.IndexName := cmbxDestIndex.Items[cmbxDestIndex.ItemIndex];
  160.   end
  161.   else
  162.   begin
  163.      tblDest.IndexName := '';
  164.   end;
  165.  
  166. end;
  167.  
  168. procedure TFormMain.Button1Click(Sender: TObject);
  169. begin
  170.   if tblDest.TableName = '' then
  171.     tblDest.TableName := cmbxDestTable.Text;
  172.   if ((tblSource.DatabaseName <> '') and // test for enough input
  173.      (tblSource.TableName <> '') and
  174.      (tblDest.DatabaseName <> '') and
  175.      (tblDest.TableName <> '') and
  176.      (cmbxMode.items[cmbxMode.ItemIndex] <> '')) then
  177.   begin
  178.     BatchMove1.ChangedTableName := edtChangedTable.Text;  // more batchmove setup
  179.     BatchMove1.KeyViolTableName := edtKeyVioTbl.Text;
  180.     BatchMove1.ProblemTableName := edtProbTbl.Text;
  181.     BatchMove1.RecordCount := StrToInt(edtRecCount.Text);
  182.   end
  183.   else
  184.   begin
  185.     MessageDlg(sIncomplete, mtError, [mbOK], 0);
  186.     exit;
  187.   end;
  188.   BatchMove1.Execute;  // run the batchmove
  189.   MessageDlg(sCompleted + IntToStr(BatchMove1.MovedCount),mtInformation,[mbOK],0);
  190. end;
  191.  
  192. procedure TFormMain.chkbxAbortKeyClick(Sender: TObject);
  193. begin
  194.   BatchMove1.AbortOnKeyViol := chkbxAbortKey.Checked;
  195. end;
  196.  
  197. procedure TFormMain.chkbxAbortProblemClick(Sender: TObject);
  198. begin
  199.   BatchMove1.AbortOnProblem := chkbxAbortProblem.Checked;
  200. end;
  201.  
  202. procedure TFormMain.chkbxTransClick(Sender: TObject);
  203. begin
  204.   BatchMove1.Transliterate := chkbxTrans.Checked;
  205. end;
  206.  
  207. function TFormMain.IsStringsEqual(const s1,s2 : string): boolean;
  208. begin
  209.    Result := UpperCase(s1) = UpperCase(s2);
  210. end;
  211.  
  212.  
  213. // set the batch mode
  214. procedure TFormMain.cmbxModeChange(Sender: TObject);
  215. begin
  216.   if cmbxMode.ItemIndex <> -1 then
  217.   begin
  218.     if IsStringsEqual(cmbxMode.Items[cmbxMode.ItemIndex],'Append') then
  219.       BatchMove1.Mode := batAppend
  220.     else if IsStringsEqual(cmbxMode.Items[cmbxMode.ItemIndex],'Copy') then
  221.       BatchMove1.Mode := batCopy
  222.     else if IsStringsEqual(cmbxMode.Items[cmbxMode.ItemIndex],'Append Update') then
  223.       BatchMove1.Mode := batAppendUpdate
  224.     else if IsStringsEqual(cmbxMode.Items[cmbxMode.ItemIndex],'Delete') then
  225.       BatchMove1.Mode := batDelete
  226.     else if IsStringsEqual(cmbxMode.Items[cmbxMode.ItemIndex],'Update') then
  227.       BatchMove1.Mode := batUpdate
  228.     else
  229.       MessageDlg('Batch mode not found',mtError,[mbOK],0);
  230.   end;
  231. end;
  232.  
  233.  
  234. // only allow numbers to be typed in
  235. procedure TFormMain.edtRecCountKeyPress(Sender: TObject; var Key: Char);
  236. begin
  237.   if ((key in ['0'..'9'] = false) and (word(key) <> VK_BACK)) then
  238.     key := #0;
  239. end;
  240.  
  241. procedure TFormMain.FormShow(Sender: TObject);
  242. begin
  243.   cmbxSourceAlias.SetFocus;
  244. end;
  245.  
  246. end.
  247.