home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Delphi.5 / Samples / sourceD5 / browutil.exe / BROWSER / MENU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-03  |  38.2 KB  |  1,211 lines

  1. {***********Browser Utility 3.0***********
  2. _________________________________________
  3.  
  4.   Author : Veeranna Ronad
  5.          (Consultant)
  6.   E-Mail : vyronad@hotmail.com, vyronad2@bol.net.in
  7.  
  8.   This is a Freeware utility.
  9.   Developed in Delphi 5, utility to open all registered applications and
  10.   various operations on table.
  11.  
  12.   Components used :
  13.  
  14.   1) MSDBMemo.pas : Component to edit memo content with Zoomed window by double click on it.
  15.   2) MSRichEd.pas : Component to edit memo content with Zoomed window by double click on it.
  16.   3) FindDlg.pas  : Component search through out all columns in a table.
  17. }
  18.  
  19. unit Menu;
  20.  
  21. interface
  22.  
  23. uses
  24.   Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
  25.   ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables, StdCtrls, FileCtrl,
  26.   ComCtrls, Menus, msDBMemo, FindDlg, GenFunc, ShellAPI;
  27.  
  28. type
  29.   TFrmMenu = class(TForm)
  30.     tblTemp: TTable;
  31.     StatusBar1: TStatusBar;
  32.     FindDlg1: TFindDlg;
  33.     MainMenu1: TMainMenu;
  34.     File1: TMenuItem;
  35.     PrintStructure1: TMenuItem;
  36.     Close1: TMenuItem;
  37.     N1: TMenuItem;
  38.     Exit1: TMenuItem;
  39.     Edit1: TMenuItem;
  40.     Find1: TMenuItem;
  41.     Utility1: TMenuItem;
  42.     Filter1: TMenuItem;
  43.     Compare1: TMenuItem;
  44.     N3: TMenuItem;
  45.     AppendFrom1: TMenuItem;
  46.     CopyTable1: TMenuItem;
  47.     CopyStructure1: TMenuItem;
  48.     N4: TMenuItem;
  49.     CreateIndex1: TMenuItem;
  50.     ShowStructure1: TMenuItem;
  51.     ConfirmDelete1: TMenuItem;
  52.     Help1: TMenuItem;
  53.     About1: TMenuItem;
  54.     OpenTable1: TMenuItem;
  55.     Window1: TMenuItem;
  56.     Table1: TTable;
  57.     View1: TMenuItem;
  58.     ShowSelected1: TMenuItem;
  59.     ShowEdited1: TMenuItem;
  60.     Tile1: TMenuItem;
  61.     Cascade1: TMenuItem;
  62.     ArrangeIcons1: TMenuItem;
  63.     Save1: TMenuItem;
  64.     N2: TMenuItem;
  65.     SumColumn1: TMenuItem;
  66.     New1: TMenuItem;
  67.     File2: TMenuItem;
  68.     Query1: TMenuItem;
  69.     Table2: TMenuItem;
  70.     SelectIndex1: TMenuItem;
  71.     N5: TMenuItem;
  72.     MasterLink1: TMenuItem;
  73.     CarryFieldValues1: TMenuItem;
  74.     MultipleSelect1: TMenuItem;
  75.     OpenDialog1: TOpenDialog;
  76.     N6: TMenuItem;
  77.     Export1: TMenuItem;
  78.     Import1: TMenuItem;
  79.     N7: TMenuItem;
  80.     Replace1: TMenuItem;
  81.     All1: TMenuItem;
  82.     Rest1: TMenuItem;
  83.     Next1: TMenuItem;
  84.     MailingLetter1: TMenuItem;
  85.     MailingLabel1: TMenuItem;
  86.     Text1: TMenuItem;
  87.     Field1: TMenuItem;
  88.     All2: TMenuItem;
  89.     Rest2: TMenuItem;
  90.     Next2: TMenuItem;
  91.     FindFiles1: TMenuItem;
  92.     NetSessionPath1: TMenuItem;
  93.     LocateSearch1: TMenuItem;
  94.     ShowPassword1: TMenuItem;
  95.     N8: TMenuItem;
  96.     Run1: TMenuItem;
  97.     Tools1: TMenuItem;
  98.     Options1: TMenuItem;
  99.     DeleteRecords1: TMenuItem;
  100.     Rest3: TMenuItem;
  101.     Next3: TMenuItem;
  102.     ModifyStructure1: TMenuItem;
  103.     CompareFiles1: TMenuItem;
  104.     SaveDialog1: TSaveDialog;
  105.     PrivateDirectoryPath1: TMenuItem;
  106.     Zap1: TMenuItem;
  107.     SetRange1: TMenuItem;
  108.     procedure PrintStructure1Click(Sender: TObject);
  109.     procedure Exit1Click(Sender: TObject);
  110.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  111.     procedure Compare1Click(Sender: TObject);
  112.     procedure About1Click(Sender: TObject);
  113.     procedure AppendFrom1Click(Sender: TObject);
  114.     procedure Find1Click(Sender: TObject);
  115.     procedure CopyTable1Click(Sender: TObject);
  116.     procedure CopyStructure1Click(Sender: TObject);
  117.     procedure Filter1Click(Sender: TObject);
  118.     procedure CreateIndex1Click(Sender: TObject);
  119.     procedure FindDlg1Show(Sender: TObject);
  120.     procedure OpenTable1Click(Sender: TObject);
  121.     procedure FormPaint(Sender: TObject);
  122.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  123.     procedure Close1Click(Sender: TObject);
  124.     procedure ShowStructure1Click(Sender: TObject);
  125.     procedure ShowSelected1Click(Sender: TObject);
  126.     procedure ShowEdited1Click(Sender: TObject);
  127.     procedure ConfirmDelete1Click(Sender: TObject);
  128.     procedure ArrangeIcons1Click(Sender: TObject);
  129.     procedure Tile1Click(Sender: TObject);
  130.     procedure Cascade1Click(Sender: TObject);
  131.     procedure Save1Click(Sender: TObject);
  132.     procedure SumColumn1Click(Sender: TObject);
  133.     procedure File2Click(Sender: TObject);
  134.     procedure Query1Click(Sender: TObject);
  135.     procedure Table2Click(Sender: TObject);
  136.     procedure SelectIndex1Click(Sender: TObject);
  137.     procedure MasterLink1Click(Sender: TObject);
  138.     procedure CarryFieldValues1Click(Sender: TObject);
  139.     procedure MultipleSelect1Click(Sender: TObject);
  140.     procedure Export1Click(Sender: TObject);
  141.     procedure Import1Click(Sender: TObject);
  142.     procedure All1Click(Sender: TObject);
  143.     procedure Rest1Click(Sender: TObject);
  144.     procedure Next1Click(Sender: TObject);
  145.     procedure MailingLetter1Click(Sender: TObject);
  146.     procedure All2Click(Sender: TObject);
  147.     procedure Rest2Click(Sender: TObject);
  148.     procedure Next2Click(Sender: TObject);
  149.     procedure FindFiles1Click(Sender: TObject);
  150.     procedure NetSessionPath1Click(Sender: TObject);
  151.     procedure LocateSearch1Click(Sender: TObject);
  152.     procedure ShowPassword1Click(Sender: TObject);
  153.     procedure Options1Click(Sender: TObject);
  154.     procedure Run1Click(Sender: TObject);
  155.     procedure Rest3Click(Sender: TObject);
  156.     procedure Next3Click(Sender: TObject);
  157.     procedure ModifyStructure1Click(Sender: TObject);
  158.     procedure CompareFiles1Click(Sender: TObject);
  159.     procedure PrivateDirectoryPath1Click(Sender: TObject);
  160.     procedure Zap1Click(Sender: TObject);
  161.     procedure SetRange1Click(Sender: TObject);
  162.   private
  163.     { Private declarations }
  164.     lParamReceived : Boolean;
  165.     procedure CreateNDisplayFile(sDirectory, sFileName : String);
  166.     procedure ShowMDIChildForm(Sender : TObject);
  167.     function IsValidFileForAppend(sFileName : String) : Boolean;
  168.     procedure AppendRecords(tblSource,tblTarget : TTable);
  169.     procedure AppendTextFile(sSourceFileName : String; tblTarget : TTable);
  170.     function GetSelectedField : TField;
  171.     procedure ReplaceColumn(sFieldName, sValue, sReplaceType : String; lField : Boolean; nNextRecords : Integer);
  172.     function GetActiveTable : TTable;
  173.   public
  174.     { Public declarations }
  175.     aTableStructure, aFieldContent : array [0..500] of string;
  176.     TableRecords : TTableRecords;
  177.     lLoopBreak : Boolean;
  178.     procedure ShowTableMenuItem(lShow : Boolean);
  179.     procedure AddWindowItem(sItemName,sItemCaption : String);
  180.     procedure RemoveWindowItem(sItemName : String);
  181.     procedure ShowMenuWindowItemChecked(sItemName : String; lFlag : Boolean);
  182.     procedure ShowTextFileMenuItem(lShow : Boolean);
  183.     procedure ShowQueryMenuItem(lShow : Boolean);
  184.     procedure ResetLoopBreak;
  185.     procedure SetLoopBreak;
  186.     procedure ShowClose(lShow : Boolean);
  187.   end;
  188.  
  189. var
  190.   FrmMenu: TFrmMenu;
  191.  
  192. implementation
  193.  
  194. uses Compare, About, Filter, OpenFile, Browse, TextEdit, QryDsgn,
  195.   SelIndex, MastLink, Player, MedPlay, Literals, Mailing, {HtmlEdit,}
  196.   ModiStru, CompFile;
  197.  
  198. {$R *.DFM}
  199.  
  200. procedure TFrmMenu.PrintStructure1Click(Sender: TObject);
  201. var
  202.   I : Integer;
  203.   sFieldName, sFieldType : String;
  204.   RichEdit1 : TRichEdit;
  205. begin
  206.   RichEdit1 := TRichEdit.Create(Self);
  207.   RichEdit1.Parent := Self;
  208.   RichEdit1.PlainText := True;
  209.   RichEdit1.Visible := False;
  210.   RichEdit1.Lines.Clear;
  211.   RichEdit1.Font.Name := 'Courier New';
  212.   RichEdit1.Font.Size := 12;
  213.   RichEdit1.Lines.Add('Structure of ' + GetActiveTable.DataBaseName + GetActiveTable.TableName);
  214.   for I:= 0 to GetActiveTable.FieldDefs.Count - 1 do begin
  215.     sFieldName := '  ' + GetActiveTable.FieldDefs.Items[I].Name;
  216.     sFieldType := FieldTypeToString(GetActiveTable.FieldDefs.Items[I].DataType);
  217.     RichEdit1.Lines.Add(sFieldName + '  ' + sFieldType + ' : '+IntToStr(GetActiveTable.FieldDefs.Items[I].Size));
  218.   end;
  219.   RichEdit1.Lines.Add('Total Fields : ' + IntToStr(GetActiveTable.FieldDefs.Count));
  220. //  RichEdit1.Print('Structure of ' + GetActiveTable.DataBaseName +'\'+ GetActiveTable.TableName);
  221.   RichEdit1.Lines.SaveToFile(sTempDrive+ChangeFileExt(GetActiveTable.TableName,'.TXT'));
  222.   CreateNDisplayFile(sTempDrive,ChangeFileExt(GetActiveTable.TableName,'.TXT'));
  223.   RichEdit1.Free;
  224. end;
  225.  
  226. procedure TFrmMenu.Exit1Click(Sender: TObject);
  227. begin
  228.   Close;
  229. end;
  230.  
  231. procedure TFrmMenu.FormClose(Sender: TObject; var Action: TCloseAction);
  232. begin
  233.   if (FindDlg1.Handle <> 0) then
  234.     SendMessage(FindDlg1.Handle,WM_Close,0,0);
  235.   Action := caFree;
  236. end;
  237.  
  238. procedure TFrmMenu.Compare1Click(Sender: TObject);
  239. begin
  240.   Application.CreateForm(TFrmCompare,FrmCompare);
  241.   FrmCompare.Show;
  242. end;
  243.  
  244. procedure TFrmMenu.About1Click(Sender: TObject);
  245. begin
  246.   Application.CreateForm(TAboutBox, AboutBox);
  247.   AboutBox.ShowModal;
  248. end;
  249.  
  250. procedure TFrmMenu.AppendFrom1Click(Sender: TObject);
  251. var
  252.   Memo1 : TMemo;
  253.   sFileName : String;
  254. begin
  255.   OpenDialog1.Title := 'Select file';
  256.   OpenDialog1.Filter := 'Tables (*.db,*.dbf,*.txt)|*.db;*.dbf;*.txt';
  257.   if OpenDialog1.Execute then begin
  258.     sFileName := UpperCase(OpenDialog1.FileName);
  259.     if not IsValidFileForAppend(sFileName) then
  260.       Abort;
  261.     try
  262.       GetActiveTable.DisableControls;
  263.       tblTemp.DisableControls;
  264.       if (ExtractFileExt(sFileName) <> FE_Text) then begin
  265.           tblTemp.Close;
  266.           tblTemp.DataBaseName := ExtractFilePath(sFileName);
  267.           tblTemp.TableName := sFileName;
  268.           tblTemp.Open;
  269.           AppendRecords(tblTemp,Table1);
  270.         end
  271.       else
  272.         AppendTextFile(sFileName,Table1);
  273.     finally
  274.       GetActiveTable.EnableControls;
  275.       tblTemp.EnableControls;
  276.     end;
  277.     if tblTemp.Active then
  278.       tblTemp.Close
  279.   end;
  280. end;
  281.  
  282. procedure TFrmMenu.AppendTextFile(sSourceFileName : String; tblTarget : TTable);
  283. var
  284.   RichEdit : TRichEdit;
  285.   I, J, nTotalFieldSize : Integer;
  286.   sText : String;
  287.   lStringFieldExist : Boolean;
  288. begin
  289.   try
  290.     I := 0;
  291.     J := 0;
  292.     nTotalFieldSize := 0;
  293.     lStringFieldExist := False;
  294.     for J := 0 to tblTarget.FieldDefs.Count - 1 do
  295.       if (tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).DataType = ftString) or
  296.         (tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).DataType = ftMemo) then begin
  297.         lStringFieldExist := True;
  298.         nTotalFieldSize := nTotalFieldSize + tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).Size;
  299.       end;
  300.     if not lStringFieldExist then begin
  301.       MessageBeep(mb_Ok);
  302.       ShowMessage('No String Fields were found in table');
  303.       Abort;
  304.     end;
  305.     RichEdit := TRichEdit.Create(Self);
  306.     RichEdit.Visible := False;
  307.     RichEdit.Parent := Self;
  308.     RichEdit.PlainText := True;
  309.     RichEdit.WordWrap := True;
  310. //  width of one uppercase alphabetical character is approximately 10.5 pixels
  311.     RichEdit.Width := nTotalFieldSize * 10;
  312.     RichEdit.Lines.LoadFromFile(sSourceFileName);
  313.     for I := 0 to RichEdit.Lines.Count - 1 do begin
  314.       sText := Trim(RichEdit.Lines.Strings[I]);
  315.       StatusBar1.SimpleText := 'Copying Line No. : ' + IntToStr(tblTarget.RecNo);
  316.       Application.ProcessMessages;
  317.       if (sText <> '') then begin
  318.         tblTarget.Append;
  319.         if (Length(sText) > 0) then
  320.           for J := 0 to tblTarget.FieldDefs.Count - 1 do
  321.             if (tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).DataType = ftString) or
  322.               (tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).DataType = ftMemo) then begin
  323.               tblTarget.FieldByName(tblTarget.FieldDefs.Items[J].Name).AsString := Copy(sText,0,tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).Size);
  324.               sText := Copy(sText,tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).Size,Length(sText));
  325.               if (Length(sText) = 0) then
  326.                 Break;
  327.             end;
  328.         tblTarget.Post;
  329.       end;
  330.     end
  331.   finally
  332.     RichEdit.Free;
  333.     RichEdit := nil;
  334.   end;
  335. end;
  336.  
  337. procedure TFrmMenu.AppendRecords(tblSource,tblTarget : TTable);
  338. var
  339.   I : Integer;
  340.   sPreviousSimpleText : String;
  341. begin
  342.   tblSource.First;
  343.   try
  344.     tblSource.DisableControls;
  345.     tblTarget.DisableControls;
  346.     sPreviousSimpleText := StatusBar1.SimpleText;
  347.     while not tblSource.EOF do begin
  348.       StatusBar1.SimpleText := 'Copying Record No. : ' + IntToStr(tblSource.RecNo);
  349.       Application.ProcessMessages;
  350.       tblTarget.Append;
  351.       for I := 0 to tblSource.FieldDefs.Count - 1 do begin
  352.         if (tblTarget.FindField(tblSource.FieldDefs.Items[I].Name) <> nil) then begin
  353.           try
  354.             tblTarget.FieldByName(tblSource.FieldDefs.Items[I].Name).AsString := tblSource.FieldByName(tblSource.FieldDefs.Items[I].Name).AsString;
  355.           except
  356.             on E:EDataBaseError do begin
  357.               MessageBeep(mb_Ok);
  358.               ShowMessage('AppendRecords : ' + E.Message);
  359.               if tblTarget.State in [dsInsert,dsEdit] then
  360.                 tblTarget.Cancel;
  361.               Abort;
  362.             end;
  363.           end;
  364.         end;
  365.       end;
  366.       try
  367.         tblTarget.Post;
  368.       except
  369.         on E:EDataBaseError do begin
  370.           MessageBeep(mb_Ok);
  371.           ShowMessage('AppendRecords : ' + E.Message);
  372.           if tblTarget.State in [dsInsert,dsEdit] then
  373.             tblTarget.Cancel;
  374.           Abort;
  375.         end;
  376.       end;
  377.       tblSource.Next;
  378.     end;
  379.   finally
  380.     StatusBar1.SimpleText := sPreviousSimpleText;
  381.     tblSource.EnableControls;
  382.     tblTarget.EnableControls;
  383.   end;  
  384.   tblTarget.Refresh;
  385. end;
  386.  
  387. function TFrmMenu.IsValidFileForAppend(sFileName : String) : Boolean;
  388. begin
  389.   Result := True;
  390.   try
  391.     if not FileExists(sFileName) then begin
  392.       MessageBeep(mb_Ok);
  393.       ShowMessage('File does not exists');
  394.       Result := False;
  395.     end;
  396.     if (ExtractFileExt(sFileName) <> FE_Paradox) and (ExtractFileExt(sFileName) <> FE_FoxPro) and (ExtractFileExt(sFileName) <> FE_Text) then begin
  397.       MessageBeep(mb_Ok);
  398.       ShowMessage('File must be a FoxPro Table (.dbf), Paradox Table (.db) or Text File (.txt)');
  399.       Result := False;
  400.     end;
  401.   except
  402.     Result := False;
  403.   end;
  404. end;
  405.  
  406. procedure TFrmMenu.Find1Click(Sender: TObject);
  407. begin
  408.   FindDlg1.Execute;
  409. end;
  410.  
  411. procedure TFrmMenu.CopyTable1Click(Sender: TObject);
  412. var
  413.   J : Integer;
  414.   sFileName : String;
  415. begin
  416.   sFileName := GetActiveTable.TableName;
  417.   if not InputQuery('Copy File','Enter Table Name',sFileName) then
  418.     Exit;
  419.   if sFileName = '' then begin
  420.     MessageBeep(0);
  421.     ShowMessage('File name cannot be blank');
  422.     Abort;
  423.   end;
  424.   if not GetActiveTable.Active then begin
  425.     MessageBeep(0);
  426.     ShowMessage('Please select a table');
  427.     Exit;
  428.   end;
  429.   StatusBar1.SimpleText := 'Copying table ' + GetActiveTable.TableName;
  430.   tblTemp.Active := False;
  431.   tblTemp.DataBaseName := GetActiveTable.DataBaseName;
  432.   tblTemp.TableName := sFileName;
  433.   tblTemp.FieldDefs := GetActiveTable.FieldDefs;
  434.   tblTemp.CreateTable;
  435.   tblTemp.Open;
  436.   GetActiveTable.DisableControls;
  437.   GetActiveTable.First;
  438.   while not GetActiveTable.EOF do begin
  439.     tblTemp.Append;
  440.     StatusBar1.SimpleText := 'Appending Record ' + IntToStr(GetActiveTable.RecNo);
  441.     StatusBar1.Refresh;
  442.     Application.ProcessMessages;
  443.     for J := 0 to GetActiveTable.FieldDefs.Count - 1 do begin
  444.       sFileName := GetActiveTable.FieldDefs.Items[J].Name;
  445.       if tblTemp.FindField(sFileName) <> nil then begin
  446.         tblTemp.FieldByName(GetActiveTable.FieldDefs.Items[J].Name).AsString := GetActiveTable.FieldByName(GetActiveTable.FieldDefs.Items[J].Name).AsString;
  447.       end;
  448.     end;
  449.     tblTemp.Post;
  450.     GetActiveTable.Next;
  451.   end;
  452.   tblTemp.Close;
  453.   GetActiveTable.EnableControls;
  454. end;
  455.  
  456. procedure TFrmMenu.CopyStructure1Click(Sender: TObject);
  457.   function ValidateFileName(sFileName : String) : String;
  458.   var
  459.     sExtension : String;
  460.   begin
  461.     Result := '';
  462.     sExtension := '';
  463.     sExtension := ExtractFileExt(sFileName);
  464.     if sExtension = '' then
  465.       sExtension := FE_Paradox;
  466.     if (Pos('.',sFileName) > 1) then
  467.       sFileName := Copy(sFileName,1,Pos('.',sFileName)-1);
  468.     if (Length(ExtractFileName(sFileName)) > 8) then
  469.       sFileName := Copy(sFileName,1,8);
  470.     Result := sFileName + sExtension;
  471.   end;
  472. var
  473.   sFileName : String;
  474. begin
  475.   if not GetActiveTable.Active then begin
  476.     MessageBeep(0);
  477.     ShowMessage('Please select a table');
  478.     Exit;
  479.   end;
  480.   sFileName := GetActiveTable.TableName;
  481.   if not InputQuery('Copy File','Enter Table Name',sFileName) then
  482.     Abort;
  483.   if sFileName = '' then begin
  484.     MessageBeep(0);
  485.     ShowMessage('File name cannot be blank');
  486.     Abort;
  487.   end;
  488.   StatusBar1.SimpleText := 'Copying Structure ' + GetActiveTable.TableName;
  489.   sFileName := ValidateFileName(sFileName);
  490.   tblTemp.Close;
  491.   if (ExtractFilePath(sFileName) <> '') then
  492.     tblTemp.DataBaseName := ExtractFilePath(sFileName)
  493.   else
  494.     tblTemp.DataBaseName := GetActiveTable.DataBaseName;
  495.   if FileExists(tblTemp.DataBaseName + '\' + sFileName) then begin
  496.     MessageBeep(mb_Ok);
  497.     if (MessageDlg('File already exists, overwrite',mtWarning,[mbYes,mbNo],0) = mrNo) then
  498.       Exit;
  499.   end;
  500.   tblTemp.TableName := sFileName;
  501.   tblTemp.FieldDefs := GetActiveTable.FieldDefs;
  502.   tblTemp.CreateTable;
  503. end;
  504.  
  505. procedure TFrmMenu.Filter1Click(Sender: TObject);
  506. begin
  507.   if (Screen.ActiveForm is TFrmBrowser) then begin
  508.     Application.CreateForm(TFrmFilter,FrmFilter);
  509.     FrmFilter.ShowFilterForm(GetActiveTable);
  510.   end;
  511.   if (Screen.ActiveForm is TFrmQueryDesigner) then begin
  512.     Application.CreateForm(TFrmFilter,FrmFilter);
  513.     FrmFilter.ShowFilterForm(TTable(TFrmQueryDesigner(Screen.ActiveForm.FindComponent('Query1'))));
  514.   end;
  515. end;
  516.  
  517. procedure TFrmMenu.CreateIndex1Click(Sender: TObject);
  518. var
  519.   sIndexFieldName, sFieldName : String;
  520.   nFieldNo : Integer;
  521. begin
  522.   if not (Screen.ActiveForm is TFrmBrowser) then
  523.     Exit;
  524.   sIndexFieldName := GetSelectedField.FieldName;
  525.   if InputQuery('Create Index','Field Name',sIndexFieldName) then begin
  526.     sFieldName := Copy(sIndexFieldName,0,Pos(';',sIndexFieldName)-1);
  527.     if (GetActiveTable.FindField(sIndexFieldName) <> nil) then
  528.       nFieldNo := GetActiveTable.FindField(sIndexFieldName).FieldNo
  529.     else
  530.       if (GetActiveTable.FindField(sFieldName) <> nil) then
  531.         nFieldNo := GetActiveTable.FindField(sFieldName).FieldNo
  532.       else
  533.         begin
  534.           MessageBeep(mb_Ok);
  535.           ShowMessage('Field not found');
  536.           Abort;
  537.         end;
  538.     GetActiveTable.Close;
  539.     GetActiveTable.FieldDefs.Update;
  540.     GetActiveTable.Exclusive := True;
  541.     try
  542.       if (Pos(';',sIndexFieldName) > 0) or (nFieldNo = 1) then
  543.         GetActiveTable.AddIndex(sIndexFieldName,sIndexFieldName,[ixPrimary,ixUnique])
  544.       else
  545.         GetActiveTable.AddIndex(sIndexFieldName,sIndexFieldName,[]);
  546.     except
  547.       try
  548.         GetActiveTable.AddIndex(sIndexFieldName,sIndexFieldName,[]);
  549.       except
  550.         try
  551.           GetActiveTable.IndexDefs.Update;
  552.         except
  553.           raise;
  554.         end;
  555.       end;
  556.     end;
  557.   end;
  558.   if not GetActiveTable.Active then begin
  559.     GetActiveTable.Exclusive := False;
  560.     GetActiveTable.Open;
  561.   end;
  562. end;
  563.  
  564. procedure TFrmMenu.FindDlg1Show(Sender: TObject);
  565. begin
  566.   if Screen.ActiveForm is TFrmBrowser then
  567.     FindDlg1.TableName := GetActiveTable;
  568. end;
  569.  
  570. procedure TFrmMenu.OpenTable1Click(Sender: TObject);
  571. var
  572.   I : Integer;
  573. //  sDirDelimiter, sFileNames, sFileName : String;
  574.   sDirectory : String;
  575.   aFiles : Array [0..100] of String;
  576. begin
  577.   if (FrmOpenTable.OpenFileDlg(FF_Tables + '|' + FF_Documents + '|' + FF_MediaFiles + '|' + FF_All,sDirectory,aFiles) = mrOk) then begin
  578.     for I := Low(aFiles) to High(aFiles) do begin
  579.       if (aFiles[I] = '') then
  580.         Break;
  581.       CreateNDisplayFile(sDirectory,aFiles[I]);
  582.     end;
  583.   end;
  584. //  FrmOpenTable.Free;
  585. //  FrmOpenTable := nil;
  586. end;
  587.  
  588. procedure TFrmMenu.FormPaint(Sender: TObject);
  589. var
  590.   I : Integer;
  591. begin
  592.   if not lParamReceived and FileExists(ExtractFilePath(Application.ExeName)+'Readme.rtf') then
  593.     CreateNDisplayFile(ExtractFilePath(Application.ExeName),'Readme.rtf');
  594.   if (ParamCount > 0) and (not lParamReceived) then begin
  595.     lParamReceived := True;
  596.     for I := 1 to ParamCount do
  597.       CreateNDisplayFile(ExtractFilePath(ParamStr(I)),ExtractFileName(ParamStr(I)));
  598.   end;
  599.   lParamReceived := True;
  600. end;
  601.  
  602. procedure TFrmMenu.CreateNDisplayFile(sDirectory, sFileName : String);
  603. var
  604.   sFileExt : String;
  605. begin
  606.   sFileExt := UpperCase(ExtractFileExt(sFileName));
  607.   if (sFileExt = FE_FoxPro) or (sFileExt = FE_Paradox) then begin
  608.       Application.CreateForm(TFrmBrowser,FrmBrowser);
  609.       FrmBrowser.OpenBrowser(sDirectory,sFileName);
  610.     end
  611.   else
  612.     if (sFileExt = FE_AVI) or (sFileExt = FE_ICV) or (sFileExt = FE_AUDIO) or
  613.       (sFileExt = FE_VCD) or (sFileExt = FE_MPEG) or (sFileExt = FE_MID) or (sFileExt = FE_RMI) or (sFileExt = FE_WAV) then begin
  614.         Application.CreateForm(TFrmMediaPlayer,FrmMediaPlayer);
  615.         FrmMediaPlayer.OpenPlayer(sDirectory+sFileName);
  616.       end
  617.     else
  618.       if (sFileExt = FE_RTF) then begin
  619.           Application.CreateForm(TFrmTextEdit, FrmTextEdit);
  620.           FrmTextEdit.RichEdit1.PlainText := False;
  621.           FrmTextEdit.OpenTextFile(sDirectory+sFileName);
  622.         end
  623.       else
  624.         if (sFileExt = FE_HTM) or (sFileExt = FE_HTML) then begin
  625. {            Application.CreateForm(TFrmHTMLEdit, FrmHTMLEdit);
  626.             FrmHTMLEdit.OpenHTMLFile(sDirectory+sFileName);}
  627.           end
  628.         else
  629. //          if (sFileExt = FE_Text) then begin
  630.           begin
  631.             Application.CreateForm(TFrmTextEdit, FrmTextEdit);
  632.             FrmTextEdit.OpenTextFile(sDirectory+sFileName);
  633.           end;
  634. end;
  635.  
  636. procedure TFrmMenu.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  637. var
  638.   I : Integer;
  639. begin
  640.   CanClose := True;
  641.   if Screen.ActiveForm <> nil then
  642.     if Screen.ActiveForm.MDIChildCount > 0 then
  643.       for I := 0 to Screen.ActiveForm.MDIChildCount - 1 do
  644.         CanClose := TForm(Screen.ActiveForm.MDIChildren[I]).CloseQuery;
  645. end;
  646.  
  647. procedure TFrmMenu.Close1Click(Sender: TObject);
  648. begin
  649.   if Screen.ActiveForm <> nil then
  650.     Screen.ActiveForm.Close;
  651. end;
  652.  
  653. procedure TFrmMenu.ShowStructure1Click(Sender: TObject);
  654. begin
  655.   if (Screen.ActiveForm is TFrmBrowser) or (Screen.ActiveForm is TFrmQueryDesigner) then begin
  656.     ShowStructure1.Checked := not ShowStructure1.Checked;
  657.     if (Screen.ActiveForm is TFrmBrowser) then
  658.       TFrmBrowser(Screen.ActiveForm).ShowStructure(ShowStructure1.Checked);
  659.     if (Screen.ActiveForm is TFrmQueryDesigner) then
  660.       TFrmQueryDesigner(Screen.ActiveForm).ShowStructure(ShowStructure1.Checked);
  661.   end;
  662. end;
  663.  
  664. procedure TFrmMenu.ShowSelected1Click(Sender: TObject);
  665. begin
  666.   if (Screen.ActiveForm is TFrmBrowser) or (Screen.ActiveForm is TFrmQueryDesigner) then begin
  667.     ShowSelected1.Checked := not ShowSelected1.Checked;
  668.     if (Screen.ActiveForm is TFrmBrowser) then
  669.       AssignGridOptions(TFrmBrowser(Screen.ActiveForm).DBCustGrid1,dgAlwaysShowSelection, ShowSelected1.Checked);
  670.     if (Screen.ActiveForm is TFrmQueryDesigner) then
  671.       AssignGridOptions(TFrmQueryDesigner(Screen.ActiveForm).DBCustGrid1,dgAlwaysShowSelection, ShowSelected1.Checked);
  672.   end;
  673. end;
  674.  
  675. procedure TFrmMenu.ShowEdited1Click(Sender: TObject);
  676. begin
  677.   if (Screen.ActiveForm is TFrmBrowser) or (Screen.ActiveForm is TFrmQueryDesigner) then begin
  678.     ShowEdited1.Checked := not ShowEdited1.Checked;
  679.      if (Screen.ActiveForm is TFrmBrowser) then
  680.       AssignGridOptions(TFrmBrowser(Screen.ActiveForm).DBCustGrid1,dgAlwaysShowEditor, ShowEdited1.Checked);
  681.     if (Screen.ActiveForm is TFrmQueryDesigner) then
  682.       AssignGridOptions(TFrmQueryDesigner(Screen.ActiveForm).DBCustGrid1,dgAlwaysShowEditor, ShowEdited1.Checked);
  683.   end;
  684. end;
  685.  
  686. procedure TFrmMenu.ConfirmDelete1Click(Sender: TObject);
  687. begin
  688.   if (Screen.ActiveForm is TFrmBrowser) then begin
  689.     ConfirmDelete1.Checked := not ConfirmDelete1.Checked;
  690.     AssignGridOptions(TFrmBrowser(Screen.ActiveForm).DBCustGrid1,dgConfirmDelete, ConfirmDelete1.Checked);
  691.   end;  
  692. end;
  693.  
  694. procedure TFrmMenu.ArrangeIcons1Click(Sender: TObject);
  695. begin
  696.   ArrangeIcons;
  697. end;
  698.  
  699. procedure TFrmMenu.Tile1Click(Sender: TObject);
  700. begin
  701.   Tile;
  702. end;
  703.  
  704. procedure TFrmMenu.Cascade1Click(Sender: TObject);
  705. begin
  706.   Cascade
  707. end;
  708.  
  709. procedure TFrmMenu.AddWindowItem(sItemName,sItemCaption : String);
  710. var
  711.   WindowItem : TMenuItem;
  712. begin
  713.   try
  714.     if Window1.Count = 3 then begin
  715.       WindowItem := TMenuItem.Create(Window1);
  716.       WindowItem.Caption := '-';
  717.       WindowItem.Name := SB_Window;
  718.       Window1.Add(WindowItem);
  719.     end;
  720.     WindowItem := TMenuItem.Create(Window1);
  721.     WindowItem.Caption := IntToStr(Window1.Count - 3) + ' : ' + sItemCaption;
  722.     WindowItem.Name := sItemName;
  723.     WindowItem.Checked := True;
  724.     WindowItem.OnClick := ShowMDIChildForm;
  725.     Window1.Add(WindowItem);
  726.   except
  727.     WindowItem.Free;
  728.     WindowItem := nil;
  729.     raise;
  730.   end
  731. end;
  732.  
  733. procedure TFrmMenu.RemoveWindowItem(sItemName : String);
  734. begin
  735.   try
  736.     Window1.FindComponent(sItemName).Free;
  737.     if Window1.Count = 4 then
  738.       Window1.FindComponent(SB_Window).Free;
  739.   except
  740.     raise;
  741.   end;
  742. end;
  743.  
  744. procedure TFrmMenu.ShowMDIChildForm(Sender : TObject);
  745. begin
  746.   TForm(Application.FindComponent((TMenuItem(Sender).Name))).Show;
  747.   ShowMenuWindowItemChecked(TMenuItem(Sender).Name,True)
  748. end;
  749.  
  750. procedure TFrmMenu.ShowMenuWindowItemChecked(sItemName : String; lFlag : Boolean);
  751. begin
  752.   if TMenuItem(Window1.FindComponent(sItemName)) <> nil then
  753.     TMenuItem(Window1.FindComponent(sItemName)).Checked := lFlag;
  754. end;
  755.  
  756. procedure TFrmMenu.Save1Click(Sender: TObject);
  757. begin
  758.   if (Screen.ActiveForm is TFrmTextEdit) then
  759.     TFrmTextEdit(Screen.ActiveForm).SaveToFile(TFrmTextEdit(Screen.ActiveForm).sFileName);
  760. end;
  761.  
  762. procedure TFrmMenu.SumColumn1Click(Sender: TObject);
  763. var
  764.   nSum : Real;
  765.   sFieldName : String;
  766. begin
  767.   if (GetSelectedField.DataType = ftInteger) or
  768.     (GetSelectedField.DataType = ftFloat) or
  769.     (GetSelectedField.DataType = ftAutoInc) or
  770.     (GetSelectedField.DataType = ftSmallint) then begin
  771.       sFieldName := GetSelectedField.FieldName;
  772.       nSum := 0;
  773.       GetActiveTable.DisableControls;
  774.       GetActiveTable.First;
  775.       ResetLoopBreak;
  776.       while not GetActiveTable.EOF do begin
  777.         Application.ProcessMessages;
  778.         if lLoopBreak then begin
  779.           ShowTerminateMsg;
  780.           ResetLoopBreak;
  781.           Break;
  782.         end;
  783.         nSum := nSum + GetActiveTable.FieldByName(sFieldName).AsFloat;
  784.         GetActiveTable.Next;
  785.       end;
  786.       GetActiveTable.First;
  787.       GetActiveTable.EnableControls;
  788.       ShowMessage('Sum of column ' + '''' + sFieldName + '''' + ' : ' + FloatToStr(nSum));
  789.     end
  790.   else
  791.     begin
  792.       ShowMessage('Invalid Data Type');
  793.     end;
  794. end;
  795.  
  796. procedure TFrmMenu.File2Click(Sender: TObject);
  797. begin
  798.   Application.CreateForm(TFrmTextEdit, FrmTextEdit);
  799.   FrmTextEdit.OpenTextFile('');
  800. end;
  801.  
  802. procedure TFrmMenu.Query1Click(Sender: TObject);
  803. begin
  804.   Application.CreateForm(TFrmQueryDesigner, FrmQueryDesigner);
  805.   FrmQueryDesigner.Show;
  806. end;
  807.  
  808. procedure TFrmMenu.Table2Click(Sender: TObject);
  809. begin
  810.   {Interface to create New Table}
  811.   ShowMessage('Option Under Developement')
  812. end;
  813.  
  814. procedure TFrmMenu.SelectIndex1Click(Sender: TObject);
  815. begin
  816.   if (Screen.ActiveForm is TFrmBrowser) then begin
  817.     try
  818.       Application.CreateForm(TFrmSelectIndex, FrmSelectIndex);
  819.       GetActiveTable.IndexFieldNames :=
  820.         FrmSelectIndex.OpenIndex(GetActiveTable.IndexDefs, GetActiveTable.IndexFieldNames);
  821.     except
  822.       on E:EDataBaseError do begin
  823.         MessageBeep(mb_Ok);
  824.         ShowMessage(E.Message);
  825.         Abort;
  826.       end;
  827.     end;
  828.   end;
  829. end;
  830.  
  831. procedure TFrmMenu.MasterLink1Click(Sender: TObject);
  832. begin
  833.   Application.CreateForm(TFrmMasterLink, FrmMasterLink);
  834.   FrmMasterLink.ShowModal;  
  835. end;
  836.  
  837. procedure TFrmMenu.CarryFieldValues1Click(Sender: TObject);
  838. begin
  839.   CarryFieldValues1.Checked := not CarryFieldValues1.Checked;
  840. end;
  841.  
  842. procedure TFrmMenu.MultipleSelect1Click(Sender: TObject);
  843. begin
  844.   if (Screen.ActiveForm is TFrmBrowser) or (Screen.ActiveForm is TFrmQueryDesigner) then begin
  845.     MultipleSelect1.Checked := not MultipleSelect1.Checked;
  846.     if (Screen.ActiveForm is TFrmBrowser) then
  847.       AssignGridOptions(TFrmBrowser(Screen.ActiveForm).DBCustGrid1,dgMultiSelect,MultipleSelect1.Checked);
  848.     if (Screen.ActiveForm is TFrmQueryDesigner) then
  849.       AssignGridOptions(TFrmQueryDesigner(Screen.ActiveForm).DBCustGrid1,dgMultiSelect,MultipleSelect1.Checked);
  850.   end;
  851. end;
  852.  
  853. procedure TFrmMenu.ResetLoopBreak;
  854. begin
  855.   lLoopBreak := False;
  856. end;
  857.  
  858. procedure TFrmMenu.SetLoopBreak;
  859. begin
  860.   lLoopBreak := True;
  861. end;
  862.  
  863. procedure TFrmMenu.ShowTableMenuItem(lShow : Boolean);
  864. begin
  865.   PrintStructure1.Enabled := lShow;
  866.   Find1.Enabled := lShow;
  867.   Filter1.Enabled := lShow;
  868.   SetRange1.Enabled := lShow;
  869.   AppendFrom1.Enabled := lShow;
  870.   CopyTable1.Enabled := lShow;
  871.   CopyStructure1.Enabled := lShow;
  872.   CreateIndex1.Enabled := lShow;
  873.   SumColumn1.Enabled := lShow;
  874.   LocateSearch1.Enabled := lShow;
  875.   SelectIndex1.Enabled := lShow;
  876.   MasterLink1.Enabled := lShow;
  877.   Replace1.Enabled := lShow;
  878.   DeleteRecords1.Enabled := lShow;
  879. end;
  880.  
  881. procedure TFrmMenu.ShowQueryMenuItem(lShow : Boolean);
  882. begin
  883.   PrintStructure1.Enabled := lShow;
  884.   Find1.Enabled := lShow;
  885.   Filter1.Enabled := lShow;
  886.   SetRange1.Enabled := lShow;
  887.   CopyTable1.Enabled := lShow;
  888.   CopyStructure1.Enabled := lShow;
  889.   SumColumn1.Enabled := lShow;
  890.   LocateSearch1.Enabled := lShow;
  891. end;
  892.  
  893. procedure TFrmMenu.ShowTextFileMenuItem(lShow : Boolean);
  894. begin
  895.   Save1.Enabled := lShow;
  896. end;
  897.  
  898. procedure TFrmMenu.ShowClose(lShow : Boolean);
  899. begin
  900.   Close1.Enabled := lShow;
  901. end;
  902.  
  903. procedure TFrmMenu.Export1Click(Sender: TObject);
  904. begin
  905.   {Export Table}
  906.   ShowMessage('Option Under Developement')
  907. end;
  908.  
  909. procedure TFrmMenu.Import1Click(Sender: TObject);
  910. begin
  911.   {Import Table}
  912.   ShowMessage('Option Under Developement')
  913. end;
  914.  
  915. procedure TFrmMenu.All1Click(Sender: TObject);
  916. var
  917.   sFieldName, sString : String;
  918. begin
  919.   sString := '';
  920.   sFieldName := GetSelectedField.FieldName;
  921.   if InputQuery('Replace','Replace Field '+sFieldName+ ' With',sString) then
  922.     ReplaceColumn(sFieldName,sString,RT_All,False,0);
  923. end;
  924.  
  925. procedure TFrmMenu.Rest1Click(Sender: TObject);
  926. var
  927.   sFieldName, sString : String;
  928. begin
  929.   sString := '';
  930.   sFieldName := GetSelectedField.FieldName;
  931.   if InputQuery('Replace','Replace Field '+sFieldName+ ' With',sString) then
  932.     ReplaceColumn(sFieldName,sString,RT_Rest,False,0);
  933. end;
  934.  
  935. procedure TFrmMenu.Next1Click(Sender: TObject);
  936. var
  937.   sFieldName, sString, sRecords : String;
  938. begin
  939.   sString := '';
  940.   sFieldName := GetSelectedField.FieldName;
  941.   if InputQuery('Replace','Replace Field '+sFieldName+ ' With',sString) and InputQuery('','Next Records',sRecords) then
  942.     ReplaceColumn(sFieldName,sString,RT_Next,False,StrToInt(sRecords));
  943. end;
  944.  
  945. function TFrmMenu.GetSelectedField : TField;
  946. begin
  947.   Result := TDBGrid(Screen.ActiveForm.FindComponent('DBCustGrid1')).SelectedField;
  948. end;
  949.  
  950. procedure TFrmMenu.ReplaceColumn(sFieldName, sValue, sReplaceType : String; lField : Boolean; nNextRecords : Integer);
  951. var
  952.   nRecords : Integer;
  953.   bmRecPointer : TBookmark;
  954. begin
  955.   try
  956.     try
  957.       bmRecPointer := GetActiveTable.GetBookmark;
  958.       GetActiveTable.DisableControls;
  959.       ResetLoopBreak;
  960.       if (sReplaceType = RT_Next) then
  961.         nRecords := 1
  962.       else
  963.         nRecords := -99999999;
  964.       if (sReplaceType = RT_All) then
  965.         GetActiveTable.First;
  966.       while (not GetActiveTable.EOF) and (nRecords <= nNextRecords) do begin
  967.         Application.ProcessMessages;
  968.         GetActiveTable.Edit;
  969.         if lField then
  970.           GetActiveTable.FieldByName(sFieldName).AsString := GetActiveTable.FieldByName(sValue).AsString
  971.         else
  972.           GetActiveTable.FieldByName(sFieldName).AsString := sValue;
  973.         GetActiveTable.Post;
  974.         GetActiveTable.Next;
  975.         nRecords := nRecords + 1;
  976.       end;
  977.     except
  978.       on E:EDataBaseError do begin
  979.         MessageBeep(mb_Ok);
  980.         ShowMessage('ReplaceColumn : ' + E.Message);
  981.         Abort;
  982.       end;
  983.     end;
  984.   finally
  985.     try
  986.       GetActiveTable.GotoBookmark(bmRecPointer);
  987.     except
  988.       ;
  989.     end;
  990.     GetActiveTable.FreeBookmark(bmRecPointer);
  991.     GetActiveTable.EnableControls;
  992.   end;
  993. end;
  994.  
  995. procedure TFrmMenu.All2Click(Sender: TObject);
  996. var
  997.   sFieldName1, sFieldName2 : String;
  998. begin
  999.   sFieldName2 := '';
  1000.   sFieldName1 := GetSelectedField.FieldName;
  1001.   if InputQuery('Replace','Replace Field '+ sFieldName1 + ' with Field ', sFieldName2) then begin
  1002.     if (GetActiveTable.FindField(sFieldName2) = nil) then begin
  1003.         MessageBeep(mb_Ok);
  1004.         ShowMessage('Field ' + sFieldName2 + ' not found ');
  1005.       end
  1006.     else
  1007.       ReplaceColumn(sFieldName1,sFieldName2,RT_All,True,0);
  1008.   end;
  1009. end;
  1010.  
  1011. procedure TFrmMenu.Rest2Click(Sender: TObject);
  1012. var
  1013.   sFieldName1, sFieldName2 : String;
  1014. begin
  1015.   sFieldName2 := '';
  1016.   sFieldName1 := GetSelectedField.FieldName;
  1017.   if InputQuery('Replace','Replace Field '+ sFieldName1 + ' with Field ', sFieldName2) then begin
  1018.     if (GetActiveTable.FindField(sFieldName2) = nil) then begin
  1019.         MessageBeep(mb_Ok);
  1020.         ShowMessage('Field ' + sFieldName2 + ' not found ');
  1021.       end
  1022.     else
  1023.       ReplaceColumn(sFieldName1,sFieldName2,RT_Rest,True,0);
  1024.   end;
  1025. end;
  1026.  
  1027. procedure TFrmMenu.Next2Click(Sender: TObject);
  1028. var
  1029.   sFieldName1, sFieldName2, sRecords : String;
  1030. begin
  1031.   sFieldName2 := '';
  1032.   sFieldName1 := GetSelectedField.FieldName;
  1033.   if InputQuery('Replace','Replace Field '+ sFieldName1 + ' with Field ', sFieldName2)  and InputQuery('','Next Records',sRecords) then begin
  1034.     if (GetActiveTable.FindField(sFieldName2) = nil) then begin
  1035.         MessageBeep(mb_Ok);
  1036.         ShowMessage('Field ' + sFieldName2 + ' not found ');
  1037.       end
  1038.     else
  1039.       ReplaceColumn(sFieldName1,sFieldName2,RT_Next,True,StrToInt(sRecords));
  1040.   end;
  1041. end;
  1042.  
  1043. procedure TFrmMenu.MailingLetter1Click(Sender: TObject);
  1044. begin
  1045.   Application.CreateForm(TFrmMailing, FrmMailing);
  1046.   FrmMailing.OpenTextFile('');
  1047. end;
  1048.  
  1049. procedure TFrmMenu.FindFiles1Click(Sender: TObject);
  1050. begin
  1051.   {Find files in selected Directory / Drive}
  1052.   ShowMessage('Option Under Developement')
  1053. end;
  1054.  
  1055. procedure TFrmMenu.NetSessionPath1Click(Sender: TObject);
  1056. var
  1057.   sPath : String;
  1058. begin
  1059.   sPath := Session.NetFileDir;
  1060.   if InputQuery('Enter Path for Session','Path : ', sPath) then
  1061.     Session.NetFileDir := sPath;
  1062. end;
  1063.  
  1064. procedure TFrmMenu.LocateSearch1Click(Sender: TObject);
  1065. var
  1066.   sString : String;
  1067. begin
  1068.   if not (Screen.ActiveForm is TFrmBrowser) then
  1069.     Exit;
  1070.   if InputQuery('Search String','Enter Search String for Field ' + GetSelectedField.FieldName,sString) then begin
  1071.     try
  1072.       if not GetActiveTable.Locate(GetSelectedField.FieldName,sString,[]) then begin
  1073.         MessageBeep(mb_Ok);
  1074.         ShowMessage('String Not Found');
  1075.       end;
  1076.     except
  1077.       raise;
  1078.     end;
  1079.   end;
  1080. end;
  1081.  
  1082. function TFrmMenu.GetActiveTable : TTable;
  1083. begin
  1084.   Result := TTable(TFrmBrowser(Screen.ActiveForm).FindComponent('Table1'));
  1085. end;
  1086.  
  1087. procedure TFrmMenu.ShowPassword1Click(Sender: TObject);
  1088. var
  1089.   sString : String;
  1090. begin
  1091.   if not (Screen.ActiveForm is TFrmBrowser) then
  1092.     Exit;
  1093.   sString := DecryptString(GetActiveTable.FieldByName(GetSelectedField.FieldName).AsString);
  1094.   if InputQuery('Search String','Enter Search String for Field ' + GetSelectedField.FieldName,sString) then begin
  1095.     if not (GetActiveTable.State in [dsInsert,dsEdit]) then
  1096.       GetActiveTable.Edit;
  1097.     GetActiveTable.FieldByName(GetSelectedField.FieldName).AsString := EncryptString(sString); 
  1098.   end;
  1099. end;
  1100.  
  1101. procedure TFrmMenu.Options1Click(Sender: TObject);
  1102. begin
  1103.   {General Options To Save Settings}
  1104.   ShowMessage('Option Under Developement')
  1105. end;
  1106.  
  1107. procedure TFrmMenu.Run1Click(Sender: TObject);
  1108. var
  1109.   sRunApplication, sDirectory, sParameters : String;
  1110.   nResult : Integer;
  1111. begin
  1112.   nResult := 0;
  1113.   if InputQuery('Run Application','Enter File Name',sRunApplication) then begin
  1114.     if (Pos(' ',sRunApplication) > 0) then begin
  1115.       sParameters := Copy(sRunApplication,Pos(' ',sRunApplication)+1,Length(sRunApplication));
  1116.       sRunApplication := Trim(Copy(sRunApplication,0,Pos(' ',sRunApplication)-1));
  1117.     end;
  1118.     sDirectory := ExtractFilePath(sRunApplication);
  1119.     sRunApplication := ExtractFileName(sRunApplication);
  1120.     nResult := ShellExecute(Self.Handle,PChar('Open'),PChar(sRunApplication),PChar(sParameters),PChar(sDirectory),SW_SHOW);
  1121.     if nResult <=32 then
  1122.       ShellError(nResult);
  1123.   end;
  1124. end;
  1125.  
  1126. procedure TFrmMenu.Rest3Click(Sender: TObject);
  1127. var
  1128.   tblSource : TTable;
  1129. begin
  1130.   if (MessageDlg('Delete Rest All Record',mtWarning,[mbYes,mbNo],0) = mrNo) then
  1131.     Abort;
  1132.   tblSource := GetActiveTable;
  1133.   while not tblSource.EOF do
  1134.     tblSource.Delete;
  1135. end;
  1136.  
  1137. procedure TFrmMenu.Next3Click(Sender: TObject);
  1138. var
  1139.   sRecords : String;
  1140.   tblSource : TTable;
  1141.   I : Integer;
  1142. begin
  1143.   I := 0;
  1144.   sRecords := '';
  1145.   tblSource := GetActiveTable;
  1146.   if InputQuery('','Next Records',sRecords) then begin
  1147.     for I := 1 to StrToInt(sRecords) do
  1148.       tblSource.Delete;
  1149.   end;
  1150. end;
  1151.  
  1152. procedure TFrmMenu.ModifyStructure1Click(Sender: TObject);
  1153. var
  1154.   tblSource : TTable;
  1155. begin
  1156.   tblSource := GetActiveTable;
  1157.   if (tblSource <> nil) and (tblSource is TTable) then begin
  1158.     Application.CreateForm(TFrmModifyStructure, FrmModifyStructure);
  1159.     FrmModifyStructure.ShowModal;
  1160.   end;
  1161. end;
  1162.  
  1163. procedure TFrmMenu.CompareFiles1Click(Sender: TObject);
  1164. begin
  1165.   Application.CreateForm(TFrmCompareFile, FrmCompareFile);
  1166.   FrmCompareFile.Show;
  1167. end;
  1168.  
  1169. procedure TFrmMenu.PrivateDirectoryPath1Click(Sender: TObject);
  1170. var
  1171.   sPath : String;
  1172. begin
  1173.   sPath := Session.PrivateDir;
  1174.   if InputQuery('Enter Path for Temp Directory','Path : ', sPath) then
  1175.     Session.PrivateDir := sPath;
  1176. end;
  1177.  
  1178. procedure TFrmMenu.Zap1Click(Sender: TObject);
  1179. var
  1180.   tblSource : TTable;
  1181. begin
  1182.   if (MessageDlg('This will deletes all records in table, Continue ?',mtConfirmation,[mbYes,mbNo],0) = mrYes) then begin
  1183.     tblSource := GetActiveTable;
  1184.     if (tblSource <> nil) then begin
  1185.       tblSource.Close;
  1186.       tblSource.FieldDefs.Update;
  1187.       tblSource.IndexDefs.Update;
  1188.       tblSource.CreateTable;
  1189.       tblSource.Open;
  1190.     end;
  1191.   end;         
  1192. end;
  1193.  
  1194. procedure TFrmMenu.SetRange1Click(Sender: TObject);
  1195. var
  1196.   sString : String;
  1197. begin
  1198.   if not (Screen.ActiveForm is TFrmBrowser) then
  1199.     Exit;
  1200.   if InputQuery('Set Range','Enter String : ',sString) then begin
  1201.     try
  1202.       GetActiveTable.IndexFieldNames := GetSelectedField.FieldName;
  1203.       GetActiveTable.SetRange([sString],[sString]);
  1204.     except
  1205.       raise;
  1206.     end;
  1207.   end;
  1208. end;
  1209.  
  1210. end.
  1211.