home *** CD-ROM | disk | FTP | other *** search
- {***********Browser Utility 3.0***********
- _________________________________________
-
- Author : Veeranna Ronad
- (Consultant)
- E-Mail : vyronad@hotmail.com, vyronad2@bol.net.in
-
- This is a Freeware utility.
- Developed in Delphi 5, utility to open all registered applications and
- various operations on table.
-
- Components used :
-
- 1) MSDBMemo.pas : Component to edit memo content with Zoomed window by double click on it.
- 2) MSRichEd.pas : Component to edit memo content with Zoomed window by double click on it.
- 3) FindDlg.pas : Component search through out all columns in a table.
- }
-
- unit Menu;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
- ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables, StdCtrls, FileCtrl,
- ComCtrls, Menus, msDBMemo, FindDlg, GenFunc, ShellAPI;
-
- type
- TFrmMenu = class(TForm)
- tblTemp: TTable;
- StatusBar1: TStatusBar;
- FindDlg1: TFindDlg;
- MainMenu1: TMainMenu;
- File1: TMenuItem;
- PrintStructure1: TMenuItem;
- Close1: TMenuItem;
- N1: TMenuItem;
- Exit1: TMenuItem;
- Edit1: TMenuItem;
- Find1: TMenuItem;
- Utility1: TMenuItem;
- Filter1: TMenuItem;
- Compare1: TMenuItem;
- N3: TMenuItem;
- AppendFrom1: TMenuItem;
- CopyTable1: TMenuItem;
- CopyStructure1: TMenuItem;
- N4: TMenuItem;
- CreateIndex1: TMenuItem;
- ShowStructure1: TMenuItem;
- ConfirmDelete1: TMenuItem;
- Help1: TMenuItem;
- About1: TMenuItem;
- OpenTable1: TMenuItem;
- Window1: TMenuItem;
- Table1: TTable;
- View1: TMenuItem;
- ShowSelected1: TMenuItem;
- ShowEdited1: TMenuItem;
- Tile1: TMenuItem;
- Cascade1: TMenuItem;
- ArrangeIcons1: TMenuItem;
- Save1: TMenuItem;
- N2: TMenuItem;
- SumColumn1: TMenuItem;
- New1: TMenuItem;
- File2: TMenuItem;
- Query1: TMenuItem;
- Table2: TMenuItem;
- SelectIndex1: TMenuItem;
- N5: TMenuItem;
- MasterLink1: TMenuItem;
- CarryFieldValues1: TMenuItem;
- MultipleSelect1: TMenuItem;
- OpenDialog1: TOpenDialog;
- N6: TMenuItem;
- Export1: TMenuItem;
- Import1: TMenuItem;
- N7: TMenuItem;
- Replace1: TMenuItem;
- All1: TMenuItem;
- Rest1: TMenuItem;
- Next1: TMenuItem;
- MailingLetter1: TMenuItem;
- MailingLabel1: TMenuItem;
- Text1: TMenuItem;
- Field1: TMenuItem;
- All2: TMenuItem;
- Rest2: TMenuItem;
- Next2: TMenuItem;
- FindFiles1: TMenuItem;
- NetSessionPath1: TMenuItem;
- LocateSearch1: TMenuItem;
- ShowPassword1: TMenuItem;
- N8: TMenuItem;
- Run1: TMenuItem;
- Tools1: TMenuItem;
- Options1: TMenuItem;
- DeleteRecords1: TMenuItem;
- Rest3: TMenuItem;
- Next3: TMenuItem;
- ModifyStructure1: TMenuItem;
- CompareFiles1: TMenuItem;
- SaveDialog1: TSaveDialog;
- PrivateDirectoryPath1: TMenuItem;
- Zap1: TMenuItem;
- SetRange1: TMenuItem;
- procedure PrintStructure1Click(Sender: TObject);
- procedure Exit1Click(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure Compare1Click(Sender: TObject);
- procedure About1Click(Sender: TObject);
- procedure AppendFrom1Click(Sender: TObject);
- procedure Find1Click(Sender: TObject);
- procedure CopyTable1Click(Sender: TObject);
- procedure CopyStructure1Click(Sender: TObject);
- procedure Filter1Click(Sender: TObject);
- procedure CreateIndex1Click(Sender: TObject);
- procedure FindDlg1Show(Sender: TObject);
- procedure OpenTable1Click(Sender: TObject);
- procedure FormPaint(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure Close1Click(Sender: TObject);
- procedure ShowStructure1Click(Sender: TObject);
- procedure ShowSelected1Click(Sender: TObject);
- procedure ShowEdited1Click(Sender: TObject);
- procedure ConfirmDelete1Click(Sender: TObject);
- procedure ArrangeIcons1Click(Sender: TObject);
- procedure Tile1Click(Sender: TObject);
- procedure Cascade1Click(Sender: TObject);
- procedure Save1Click(Sender: TObject);
- procedure SumColumn1Click(Sender: TObject);
- procedure File2Click(Sender: TObject);
- procedure Query1Click(Sender: TObject);
- procedure Table2Click(Sender: TObject);
- procedure SelectIndex1Click(Sender: TObject);
- procedure MasterLink1Click(Sender: TObject);
- procedure CarryFieldValues1Click(Sender: TObject);
- procedure MultipleSelect1Click(Sender: TObject);
- procedure Export1Click(Sender: TObject);
- procedure Import1Click(Sender: TObject);
- procedure All1Click(Sender: TObject);
- procedure Rest1Click(Sender: TObject);
- procedure Next1Click(Sender: TObject);
- procedure MailingLetter1Click(Sender: TObject);
- procedure All2Click(Sender: TObject);
- procedure Rest2Click(Sender: TObject);
- procedure Next2Click(Sender: TObject);
- procedure FindFiles1Click(Sender: TObject);
- procedure NetSessionPath1Click(Sender: TObject);
- procedure LocateSearch1Click(Sender: TObject);
- procedure ShowPassword1Click(Sender: TObject);
- procedure Options1Click(Sender: TObject);
- procedure Run1Click(Sender: TObject);
- procedure Rest3Click(Sender: TObject);
- procedure Next3Click(Sender: TObject);
- procedure ModifyStructure1Click(Sender: TObject);
- procedure CompareFiles1Click(Sender: TObject);
- procedure PrivateDirectoryPath1Click(Sender: TObject);
- procedure Zap1Click(Sender: TObject);
- procedure SetRange1Click(Sender: TObject);
- private
- { Private declarations }
- lParamReceived : Boolean;
- procedure CreateNDisplayFile(sDirectory, sFileName : String);
- procedure ShowMDIChildForm(Sender : TObject);
- function IsValidFileForAppend(sFileName : String) : Boolean;
- procedure AppendRecords(tblSource,tblTarget : TTable);
- procedure AppendTextFile(sSourceFileName : String; tblTarget : TTable);
- function GetSelectedField : TField;
- procedure ReplaceColumn(sFieldName, sValue, sReplaceType : String; lField : Boolean; nNextRecords : Integer);
- function GetActiveTable : TTable;
- public
- { Public declarations }
- aTableStructure, aFieldContent : array [0..500] of string;
- TableRecords : TTableRecords;
- lLoopBreak : Boolean;
- procedure ShowTableMenuItem(lShow : Boolean);
- procedure AddWindowItem(sItemName,sItemCaption : String);
- procedure RemoveWindowItem(sItemName : String);
- procedure ShowMenuWindowItemChecked(sItemName : String; lFlag : Boolean);
- procedure ShowTextFileMenuItem(lShow : Boolean);
- procedure ShowQueryMenuItem(lShow : Boolean);
- procedure ResetLoopBreak;
- procedure SetLoopBreak;
- procedure ShowClose(lShow : Boolean);
- end;
-
- var
- FrmMenu: TFrmMenu;
-
- implementation
-
- uses Compare, About, Filter, OpenFile, Browse, TextEdit, QryDsgn,
- SelIndex, MastLink, Player, MedPlay, Literals, Mailing, {HtmlEdit,}
- ModiStru, CompFile;
-
- {$R *.DFM}
-
- procedure TFrmMenu.PrintStructure1Click(Sender: TObject);
- var
- I : Integer;
- sFieldName, sFieldType : String;
- RichEdit1 : TRichEdit;
- begin
- RichEdit1 := TRichEdit.Create(Self);
- RichEdit1.Parent := Self;
- RichEdit1.PlainText := True;
- RichEdit1.Visible := False;
- RichEdit1.Lines.Clear;
- RichEdit1.Font.Name := 'Courier New';
- RichEdit1.Font.Size := 12;
- RichEdit1.Lines.Add('Structure of ' + GetActiveTable.DataBaseName + GetActiveTable.TableName);
- for I:= 0 to GetActiveTable.FieldDefs.Count - 1 do begin
- sFieldName := ' ' + GetActiveTable.FieldDefs.Items[I].Name;
- sFieldType := FieldTypeToString(GetActiveTable.FieldDefs.Items[I].DataType);
- RichEdit1.Lines.Add(sFieldName + ' ' + sFieldType + ' : '+IntToStr(GetActiveTable.FieldDefs.Items[I].Size));
- end;
- RichEdit1.Lines.Add('Total Fields : ' + IntToStr(GetActiveTable.FieldDefs.Count));
- // RichEdit1.Print('Structure of ' + GetActiveTable.DataBaseName +'\'+ GetActiveTable.TableName);
- RichEdit1.Lines.SaveToFile(sTempDrive+ChangeFileExt(GetActiveTable.TableName,'.TXT'));
- CreateNDisplayFile(sTempDrive,ChangeFileExt(GetActiveTable.TableName,'.TXT'));
- RichEdit1.Free;
- end;
-
- procedure TFrmMenu.Exit1Click(Sender: TObject);
- begin
- Close;
- end;
-
- procedure TFrmMenu.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- if (FindDlg1.Handle <> 0) then
- SendMessage(FindDlg1.Handle,WM_Close,0,0);
- Action := caFree;
- end;
-
- procedure TFrmMenu.Compare1Click(Sender: TObject);
- begin
- Application.CreateForm(TFrmCompare,FrmCompare);
- FrmCompare.Show;
- end;
-
- procedure TFrmMenu.About1Click(Sender: TObject);
- begin
- Application.CreateForm(TAboutBox, AboutBox);
- AboutBox.ShowModal;
- end;
-
- procedure TFrmMenu.AppendFrom1Click(Sender: TObject);
- var
- Memo1 : TMemo;
- sFileName : String;
- begin
- OpenDialog1.Title := 'Select file';
- OpenDialog1.Filter := 'Tables (*.db,*.dbf,*.txt)|*.db;*.dbf;*.txt';
- if OpenDialog1.Execute then begin
- sFileName := UpperCase(OpenDialog1.FileName);
- if not IsValidFileForAppend(sFileName) then
- Abort;
- try
- GetActiveTable.DisableControls;
- tblTemp.DisableControls;
- if (ExtractFileExt(sFileName) <> FE_Text) then begin
- tblTemp.Close;
- tblTemp.DataBaseName := ExtractFilePath(sFileName);
- tblTemp.TableName := sFileName;
- tblTemp.Open;
- AppendRecords(tblTemp,Table1);
- end
- else
- AppendTextFile(sFileName,Table1);
- finally
- GetActiveTable.EnableControls;
- tblTemp.EnableControls;
- end;
- if tblTemp.Active then
- tblTemp.Close
- end;
- end;
-
- procedure TFrmMenu.AppendTextFile(sSourceFileName : String; tblTarget : TTable);
- var
- RichEdit : TRichEdit;
- I, J, nTotalFieldSize : Integer;
- sText : String;
- lStringFieldExist : Boolean;
- begin
- try
- I := 0;
- J := 0;
- nTotalFieldSize := 0;
- lStringFieldExist := False;
- for J := 0 to tblTarget.FieldDefs.Count - 1 do
- if (tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).DataType = ftString) or
- (tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).DataType = ftMemo) then begin
- lStringFieldExist := True;
- nTotalFieldSize := nTotalFieldSize + tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).Size;
- end;
- if not lStringFieldExist then begin
- MessageBeep(mb_Ok);
- ShowMessage('No String Fields were found in table');
- Abort;
- end;
- RichEdit := TRichEdit.Create(Self);
- RichEdit.Visible := False;
- RichEdit.Parent := Self;
- RichEdit.PlainText := True;
- RichEdit.WordWrap := True;
- // width of one uppercase alphabetical character is approximately 10.5 pixels
- RichEdit.Width := nTotalFieldSize * 10;
- RichEdit.Lines.LoadFromFile(sSourceFileName);
- for I := 0 to RichEdit.Lines.Count - 1 do begin
- sText := Trim(RichEdit.Lines.Strings[I]);
- StatusBar1.SimpleText := 'Copying Line No. : ' + IntToStr(tblTarget.RecNo);
- Application.ProcessMessages;
- if (sText <> '') then begin
- tblTarget.Append;
- if (Length(sText) > 0) then
- for J := 0 to tblTarget.FieldDefs.Count - 1 do
- if (tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).DataType = ftString) or
- (tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).DataType = ftMemo) then begin
- tblTarget.FieldByName(tblTarget.FieldDefs.Items[J].Name).AsString := Copy(sText,0,tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).Size);
- sText := Copy(sText,tblTarget.FindField(tblTarget.FieldDefs.Items[J].Name).Size,Length(sText));
- if (Length(sText) = 0) then
- Break;
- end;
- tblTarget.Post;
- end;
- end
- finally
- RichEdit.Free;
- RichEdit := nil;
- end;
- end;
-
- procedure TFrmMenu.AppendRecords(tblSource,tblTarget : TTable);
- var
- I : Integer;
- sPreviousSimpleText : String;
- begin
- tblSource.First;
- try
- tblSource.DisableControls;
- tblTarget.DisableControls;
- sPreviousSimpleText := StatusBar1.SimpleText;
- while not tblSource.EOF do begin
- StatusBar1.SimpleText := 'Copying Record No. : ' + IntToStr(tblSource.RecNo);
- Application.ProcessMessages;
- tblTarget.Append;
- for I := 0 to tblSource.FieldDefs.Count - 1 do begin
- if (tblTarget.FindField(tblSource.FieldDefs.Items[I].Name) <> nil) then begin
- try
- tblTarget.FieldByName(tblSource.FieldDefs.Items[I].Name).AsString := tblSource.FieldByName(tblSource.FieldDefs.Items[I].Name).AsString;
- except
- on E:EDataBaseError do begin
- MessageBeep(mb_Ok);
- ShowMessage('AppendRecords : ' + E.Message);
- if tblTarget.State in [dsInsert,dsEdit] then
- tblTarget.Cancel;
- Abort;
- end;
- end;
- end;
- end;
- try
- tblTarget.Post;
- except
- on E:EDataBaseError do begin
- MessageBeep(mb_Ok);
- ShowMessage('AppendRecords : ' + E.Message);
- if tblTarget.State in [dsInsert,dsEdit] then
- tblTarget.Cancel;
- Abort;
- end;
- end;
- tblSource.Next;
- end;
- finally
- StatusBar1.SimpleText := sPreviousSimpleText;
- tblSource.EnableControls;
- tblTarget.EnableControls;
- end;
- tblTarget.Refresh;
- end;
-
- function TFrmMenu.IsValidFileForAppend(sFileName : String) : Boolean;
- begin
- Result := True;
- try
- if not FileExists(sFileName) then begin
- MessageBeep(mb_Ok);
- ShowMessage('File does not exists');
- Result := False;
- end;
- if (ExtractFileExt(sFileName) <> FE_Paradox) and (ExtractFileExt(sFileName) <> FE_FoxPro) and (ExtractFileExt(sFileName) <> FE_Text) then begin
- MessageBeep(mb_Ok);
- ShowMessage('File must be a FoxPro Table (.dbf), Paradox Table (.db) or Text File (.txt)');
- Result := False;
- end;
- except
- Result := False;
- end;
- end;
-
- procedure TFrmMenu.Find1Click(Sender: TObject);
- begin
- FindDlg1.Execute;
- end;
-
- procedure TFrmMenu.CopyTable1Click(Sender: TObject);
- var
- J : Integer;
- sFileName : String;
- begin
- sFileName := GetActiveTable.TableName;
- if not InputQuery('Copy File','Enter Table Name',sFileName) then
- Exit;
- if sFileName = '' then begin
- MessageBeep(0);
- ShowMessage('File name cannot be blank');
- Abort;
- end;
- if not GetActiveTable.Active then begin
- MessageBeep(0);
- ShowMessage('Please select a table');
- Exit;
- end;
- StatusBar1.SimpleText := 'Copying table ' + GetActiveTable.TableName;
- tblTemp.Active := False;
- tblTemp.DataBaseName := GetActiveTable.DataBaseName;
- tblTemp.TableName := sFileName;
- tblTemp.FieldDefs := GetActiveTable.FieldDefs;
- tblTemp.CreateTable;
- tblTemp.Open;
- GetActiveTable.DisableControls;
- GetActiveTable.First;
- while not GetActiveTable.EOF do begin
- tblTemp.Append;
- StatusBar1.SimpleText := 'Appending Record ' + IntToStr(GetActiveTable.RecNo);
- StatusBar1.Refresh;
- Application.ProcessMessages;
- for J := 0 to GetActiveTable.FieldDefs.Count - 1 do begin
- sFileName := GetActiveTable.FieldDefs.Items[J].Name;
- if tblTemp.FindField(sFileName) <> nil then begin
- tblTemp.FieldByName(GetActiveTable.FieldDefs.Items[J].Name).AsString := GetActiveTable.FieldByName(GetActiveTable.FieldDefs.Items[J].Name).AsString;
- end;
- end;
- tblTemp.Post;
- GetActiveTable.Next;
- end;
- tblTemp.Close;
- GetActiveTable.EnableControls;
- end;
-
- procedure TFrmMenu.CopyStructure1Click(Sender: TObject);
- function ValidateFileName(sFileName : String) : String;
- var
- sExtension : String;
- begin
- Result := '';
- sExtension := '';
- sExtension := ExtractFileExt(sFileName);
- if sExtension = '' then
- sExtension := FE_Paradox;
- if (Pos('.',sFileName) > 1) then
- sFileName := Copy(sFileName,1,Pos('.',sFileName)-1);
- if (Length(ExtractFileName(sFileName)) > 8) then
- sFileName := Copy(sFileName,1,8);
- Result := sFileName + sExtension;
- end;
- var
- sFileName : String;
- begin
- if not GetActiveTable.Active then begin
- MessageBeep(0);
- ShowMessage('Please select a table');
- Exit;
- end;
- sFileName := GetActiveTable.TableName;
- if not InputQuery('Copy File','Enter Table Name',sFileName) then
- Abort;
- if sFileName = '' then begin
- MessageBeep(0);
- ShowMessage('File name cannot be blank');
- Abort;
- end;
- StatusBar1.SimpleText := 'Copying Structure ' + GetActiveTable.TableName;
- sFileName := ValidateFileName(sFileName);
- tblTemp.Close;
- if (ExtractFilePath(sFileName) <> '') then
- tblTemp.DataBaseName := ExtractFilePath(sFileName)
- else
- tblTemp.DataBaseName := GetActiveTable.DataBaseName;
- if FileExists(tblTemp.DataBaseName + '\' + sFileName) then begin
- MessageBeep(mb_Ok);
- if (MessageDlg('File already exists, overwrite',mtWarning,[mbYes,mbNo],0) = mrNo) then
- Exit;
- end;
- tblTemp.TableName := sFileName;
- tblTemp.FieldDefs := GetActiveTable.FieldDefs;
- tblTemp.CreateTable;
- end;
-
- procedure TFrmMenu.Filter1Click(Sender: TObject);
- begin
- if (Screen.ActiveForm is TFrmBrowser) then begin
- Application.CreateForm(TFrmFilter,FrmFilter);
- FrmFilter.ShowFilterForm(GetActiveTable);
- end;
- if (Screen.ActiveForm is TFrmQueryDesigner) then begin
- Application.CreateForm(TFrmFilter,FrmFilter);
- FrmFilter.ShowFilterForm(TTable(TFrmQueryDesigner(Screen.ActiveForm.FindComponent('Query1'))));
- end;
- end;
-
- procedure TFrmMenu.CreateIndex1Click(Sender: TObject);
- var
- sIndexFieldName, sFieldName : String;
- nFieldNo : Integer;
- begin
- if not (Screen.ActiveForm is TFrmBrowser) then
- Exit;
- sIndexFieldName := GetSelectedField.FieldName;
- if InputQuery('Create Index','Field Name',sIndexFieldName) then begin
- sFieldName := Copy(sIndexFieldName,0,Pos(';',sIndexFieldName)-1);
- if (GetActiveTable.FindField(sIndexFieldName) <> nil) then
- nFieldNo := GetActiveTable.FindField(sIndexFieldName).FieldNo
- else
- if (GetActiveTable.FindField(sFieldName) <> nil) then
- nFieldNo := GetActiveTable.FindField(sFieldName).FieldNo
- else
- begin
- MessageBeep(mb_Ok);
- ShowMessage('Field not found');
- Abort;
- end;
- GetActiveTable.Close;
- GetActiveTable.FieldDefs.Update;
- GetActiveTable.Exclusive := True;
- try
- if (Pos(';',sIndexFieldName) > 0) or (nFieldNo = 1) then
- GetActiveTable.AddIndex(sIndexFieldName,sIndexFieldName,[ixPrimary,ixUnique])
- else
- GetActiveTable.AddIndex(sIndexFieldName,sIndexFieldName,[]);
- except
- try
- GetActiveTable.AddIndex(sIndexFieldName,sIndexFieldName,[]);
- except
- try
- GetActiveTable.IndexDefs.Update;
- except
- raise;
- end;
- end;
- end;
- end;
- if not GetActiveTable.Active then begin
- GetActiveTable.Exclusive := False;
- GetActiveTable.Open;
- end;
- end;
-
- procedure TFrmMenu.FindDlg1Show(Sender: TObject);
- begin
- if Screen.ActiveForm is TFrmBrowser then
- FindDlg1.TableName := GetActiveTable;
- end;
-
- procedure TFrmMenu.OpenTable1Click(Sender: TObject);
- var
- I : Integer;
- // sDirDelimiter, sFileNames, sFileName : String;
- sDirectory : String;
- aFiles : Array [0..100] of String;
- begin
- if (FrmOpenTable.OpenFileDlg(FF_Tables + '|' + FF_Documents + '|' + FF_MediaFiles + '|' + FF_All,sDirectory,aFiles) = mrOk) then begin
- for I := Low(aFiles) to High(aFiles) do begin
- if (aFiles[I] = '') then
- Break;
- CreateNDisplayFile(sDirectory,aFiles[I]);
- end;
- end;
- // FrmOpenTable.Free;
- // FrmOpenTable := nil;
- end;
-
- procedure TFrmMenu.FormPaint(Sender: TObject);
- var
- I : Integer;
- begin
- if not lParamReceived and FileExists(ExtractFilePath(Application.ExeName)+'Readme.rtf') then
- CreateNDisplayFile(ExtractFilePath(Application.ExeName),'Readme.rtf');
- if (ParamCount > 0) and (not lParamReceived) then begin
- lParamReceived := True;
- for I := 1 to ParamCount do
- CreateNDisplayFile(ExtractFilePath(ParamStr(I)),ExtractFileName(ParamStr(I)));
- end;
- lParamReceived := True;
- end;
-
- procedure TFrmMenu.CreateNDisplayFile(sDirectory, sFileName : String);
- var
- sFileExt : String;
- begin
- sFileExt := UpperCase(ExtractFileExt(sFileName));
- if (sFileExt = FE_FoxPro) or (sFileExt = FE_Paradox) then begin
- Application.CreateForm(TFrmBrowser,FrmBrowser);
- FrmBrowser.OpenBrowser(sDirectory,sFileName);
- end
- else
- if (sFileExt = FE_AVI) or (sFileExt = FE_ICV) or (sFileExt = FE_AUDIO) or
- (sFileExt = FE_VCD) or (sFileExt = FE_MPEG) or (sFileExt = FE_MID) or (sFileExt = FE_RMI) or (sFileExt = FE_WAV) then begin
- Application.CreateForm(TFrmMediaPlayer,FrmMediaPlayer);
- FrmMediaPlayer.OpenPlayer(sDirectory+sFileName);
- end
- else
- if (sFileExt = FE_RTF) then begin
- Application.CreateForm(TFrmTextEdit, FrmTextEdit);
- FrmTextEdit.RichEdit1.PlainText := False;
- FrmTextEdit.OpenTextFile(sDirectory+sFileName);
- end
- else
- if (sFileExt = FE_HTM) or (sFileExt = FE_HTML) then begin
- { Application.CreateForm(TFrmHTMLEdit, FrmHTMLEdit);
- FrmHTMLEdit.OpenHTMLFile(sDirectory+sFileName);}
- end
- else
- // if (sFileExt = FE_Text) then begin
- begin
- Application.CreateForm(TFrmTextEdit, FrmTextEdit);
- FrmTextEdit.OpenTextFile(sDirectory+sFileName);
- end;
- end;
-
- procedure TFrmMenu.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- var
- I : Integer;
- begin
- CanClose := True;
- if Screen.ActiveForm <> nil then
- if Screen.ActiveForm.MDIChildCount > 0 then
- for I := 0 to Screen.ActiveForm.MDIChildCount - 1 do
- CanClose := TForm(Screen.ActiveForm.MDIChildren[I]).CloseQuery;
- end;
-
- procedure TFrmMenu.Close1Click(Sender: TObject);
- begin
- if Screen.ActiveForm <> nil then
- Screen.ActiveForm.Close;
- end;
-
- procedure TFrmMenu.ShowStructure1Click(Sender: TObject);
- begin
- if (Screen.ActiveForm is TFrmBrowser) or (Screen.ActiveForm is TFrmQueryDesigner) then begin
- ShowStructure1.Checked := not ShowStructure1.Checked;
- if (Screen.ActiveForm is TFrmBrowser) then
- TFrmBrowser(Screen.ActiveForm).ShowStructure(ShowStructure1.Checked);
- if (Screen.ActiveForm is TFrmQueryDesigner) then
- TFrmQueryDesigner(Screen.ActiveForm).ShowStructure(ShowStructure1.Checked);
- end;
- end;
-
- procedure TFrmMenu.ShowSelected1Click(Sender: TObject);
- begin
- if (Screen.ActiveForm is TFrmBrowser) or (Screen.ActiveForm is TFrmQueryDesigner) then begin
- ShowSelected1.Checked := not ShowSelected1.Checked;
- if (Screen.ActiveForm is TFrmBrowser) then
- AssignGridOptions(TFrmBrowser(Screen.ActiveForm).DBCustGrid1,dgAlwaysShowSelection, ShowSelected1.Checked);
- if (Screen.ActiveForm is TFrmQueryDesigner) then
- AssignGridOptions(TFrmQueryDesigner(Screen.ActiveForm).DBCustGrid1,dgAlwaysShowSelection, ShowSelected1.Checked);
- end;
- end;
-
- procedure TFrmMenu.ShowEdited1Click(Sender: TObject);
- begin
- if (Screen.ActiveForm is TFrmBrowser) or (Screen.ActiveForm is TFrmQueryDesigner) then begin
- ShowEdited1.Checked := not ShowEdited1.Checked;
- if (Screen.ActiveForm is TFrmBrowser) then
- AssignGridOptions(TFrmBrowser(Screen.ActiveForm).DBCustGrid1,dgAlwaysShowEditor, ShowEdited1.Checked);
- if (Screen.ActiveForm is TFrmQueryDesigner) then
- AssignGridOptions(TFrmQueryDesigner(Screen.ActiveForm).DBCustGrid1,dgAlwaysShowEditor, ShowEdited1.Checked);
- end;
- end;
-
- procedure TFrmMenu.ConfirmDelete1Click(Sender: TObject);
- begin
- if (Screen.ActiveForm is TFrmBrowser) then begin
- ConfirmDelete1.Checked := not ConfirmDelete1.Checked;
- AssignGridOptions(TFrmBrowser(Screen.ActiveForm).DBCustGrid1,dgConfirmDelete, ConfirmDelete1.Checked);
- end;
- end;
-
- procedure TFrmMenu.ArrangeIcons1Click(Sender: TObject);
- begin
- ArrangeIcons;
- end;
-
- procedure TFrmMenu.Tile1Click(Sender: TObject);
- begin
- Tile;
- end;
-
- procedure TFrmMenu.Cascade1Click(Sender: TObject);
- begin
- Cascade
- end;
-
- procedure TFrmMenu.AddWindowItem(sItemName,sItemCaption : String);
- var
- WindowItem : TMenuItem;
- begin
- try
- if Window1.Count = 3 then begin
- WindowItem := TMenuItem.Create(Window1);
- WindowItem.Caption := '-';
- WindowItem.Name := SB_Window;
- Window1.Add(WindowItem);
- end;
- WindowItem := TMenuItem.Create(Window1);
- WindowItem.Caption := IntToStr(Window1.Count - 3) + ' : ' + sItemCaption;
- WindowItem.Name := sItemName;
- WindowItem.Checked := True;
- WindowItem.OnClick := ShowMDIChildForm;
- Window1.Add(WindowItem);
- except
- WindowItem.Free;
- WindowItem := nil;
- raise;
- end
- end;
-
- procedure TFrmMenu.RemoveWindowItem(sItemName : String);
- begin
- try
- Window1.FindComponent(sItemName).Free;
- if Window1.Count = 4 then
- Window1.FindComponent(SB_Window).Free;
- except
- raise;
- end;
- end;
-
- procedure TFrmMenu.ShowMDIChildForm(Sender : TObject);
- begin
- TForm(Application.FindComponent((TMenuItem(Sender).Name))).Show;
- ShowMenuWindowItemChecked(TMenuItem(Sender).Name,True)
- end;
-
- procedure TFrmMenu.ShowMenuWindowItemChecked(sItemName : String; lFlag : Boolean);
- begin
- if TMenuItem(Window1.FindComponent(sItemName)) <> nil then
- TMenuItem(Window1.FindComponent(sItemName)).Checked := lFlag;
- end;
-
- procedure TFrmMenu.Save1Click(Sender: TObject);
- begin
- if (Screen.ActiveForm is TFrmTextEdit) then
- TFrmTextEdit(Screen.ActiveForm).SaveToFile(TFrmTextEdit(Screen.ActiveForm).sFileName);
- end;
-
- procedure TFrmMenu.SumColumn1Click(Sender: TObject);
- var
- nSum : Real;
- sFieldName : String;
- begin
- if (GetSelectedField.DataType = ftInteger) or
- (GetSelectedField.DataType = ftFloat) or
- (GetSelectedField.DataType = ftAutoInc) or
- (GetSelectedField.DataType = ftSmallint) then begin
- sFieldName := GetSelectedField.FieldName;
- nSum := 0;
- GetActiveTable.DisableControls;
- GetActiveTable.First;
- ResetLoopBreak;
- while not GetActiveTable.EOF do begin
- Application.ProcessMessages;
- if lLoopBreak then begin
- ShowTerminateMsg;
- ResetLoopBreak;
- Break;
- end;
- nSum := nSum + GetActiveTable.FieldByName(sFieldName).AsFloat;
- GetActiveTable.Next;
- end;
- GetActiveTable.First;
- GetActiveTable.EnableControls;
- ShowMessage('Sum of column ' + '''' + sFieldName + '''' + ' : ' + FloatToStr(nSum));
- end
- else
- begin
- ShowMessage('Invalid Data Type');
- end;
- end;
-
- procedure TFrmMenu.File2Click(Sender: TObject);
- begin
- Application.CreateForm(TFrmTextEdit, FrmTextEdit);
- FrmTextEdit.OpenTextFile('');
- end;
-
- procedure TFrmMenu.Query1Click(Sender: TObject);
- begin
- Application.CreateForm(TFrmQueryDesigner, FrmQueryDesigner);
- FrmQueryDesigner.Show;
- end;
-
- procedure TFrmMenu.Table2Click(Sender: TObject);
- begin
- {Interface to create New Table}
- ShowMessage('Option Under Developement')
- end;
-
- procedure TFrmMenu.SelectIndex1Click(Sender: TObject);
- begin
- if (Screen.ActiveForm is TFrmBrowser) then begin
- try
- Application.CreateForm(TFrmSelectIndex, FrmSelectIndex);
- GetActiveTable.IndexFieldNames :=
- FrmSelectIndex.OpenIndex(GetActiveTable.IndexDefs, GetActiveTable.IndexFieldNames);
- except
- on E:EDataBaseError do begin
- MessageBeep(mb_Ok);
- ShowMessage(E.Message);
- Abort;
- end;
- end;
- end;
- end;
-
- procedure TFrmMenu.MasterLink1Click(Sender: TObject);
- begin
- Application.CreateForm(TFrmMasterLink, FrmMasterLink);
- FrmMasterLink.ShowModal;
- end;
-
- procedure TFrmMenu.CarryFieldValues1Click(Sender: TObject);
- begin
- CarryFieldValues1.Checked := not CarryFieldValues1.Checked;
- end;
-
- procedure TFrmMenu.MultipleSelect1Click(Sender: TObject);
- begin
- if (Screen.ActiveForm is TFrmBrowser) or (Screen.ActiveForm is TFrmQueryDesigner) then begin
- MultipleSelect1.Checked := not MultipleSelect1.Checked;
- if (Screen.ActiveForm is TFrmBrowser) then
- AssignGridOptions(TFrmBrowser(Screen.ActiveForm).DBCustGrid1,dgMultiSelect,MultipleSelect1.Checked);
- if (Screen.ActiveForm is TFrmQueryDesigner) then
- AssignGridOptions(TFrmQueryDesigner(Screen.ActiveForm).DBCustGrid1,dgMultiSelect,MultipleSelect1.Checked);
- end;
- end;
-
- procedure TFrmMenu.ResetLoopBreak;
- begin
- lLoopBreak := False;
- end;
-
- procedure TFrmMenu.SetLoopBreak;
- begin
- lLoopBreak := True;
- end;
-
- procedure TFrmMenu.ShowTableMenuItem(lShow : Boolean);
- begin
- PrintStructure1.Enabled := lShow;
- Find1.Enabled := lShow;
- Filter1.Enabled := lShow;
- SetRange1.Enabled := lShow;
- AppendFrom1.Enabled := lShow;
- CopyTable1.Enabled := lShow;
- CopyStructure1.Enabled := lShow;
- CreateIndex1.Enabled := lShow;
- SumColumn1.Enabled := lShow;
- LocateSearch1.Enabled := lShow;
- SelectIndex1.Enabled := lShow;
- MasterLink1.Enabled := lShow;
- Replace1.Enabled := lShow;
- DeleteRecords1.Enabled := lShow;
- end;
-
- procedure TFrmMenu.ShowQueryMenuItem(lShow : Boolean);
- begin
- PrintStructure1.Enabled := lShow;
- Find1.Enabled := lShow;
- Filter1.Enabled := lShow;
- SetRange1.Enabled := lShow;
- CopyTable1.Enabled := lShow;
- CopyStructure1.Enabled := lShow;
- SumColumn1.Enabled := lShow;
- LocateSearch1.Enabled := lShow;
- end;
-
- procedure TFrmMenu.ShowTextFileMenuItem(lShow : Boolean);
- begin
- Save1.Enabled := lShow;
- end;
-
- procedure TFrmMenu.ShowClose(lShow : Boolean);
- begin
- Close1.Enabled := lShow;
- end;
-
- procedure TFrmMenu.Export1Click(Sender: TObject);
- begin
- {Export Table}
- ShowMessage('Option Under Developement')
- end;
-
- procedure TFrmMenu.Import1Click(Sender: TObject);
- begin
- {Import Table}
- ShowMessage('Option Under Developement')
- end;
-
- procedure TFrmMenu.All1Click(Sender: TObject);
- var
- sFieldName, sString : String;
- begin
- sString := '';
- sFieldName := GetSelectedField.FieldName;
- if InputQuery('Replace','Replace Field '+sFieldName+ ' With',sString) then
- ReplaceColumn(sFieldName,sString,RT_All,False,0);
- end;
-
- procedure TFrmMenu.Rest1Click(Sender: TObject);
- var
- sFieldName, sString : String;
- begin
- sString := '';
- sFieldName := GetSelectedField.FieldName;
- if InputQuery('Replace','Replace Field '+sFieldName+ ' With',sString) then
- ReplaceColumn(sFieldName,sString,RT_Rest,False,0);
- end;
-
- procedure TFrmMenu.Next1Click(Sender: TObject);
- var
- sFieldName, sString, sRecords : String;
- begin
- sString := '';
- sFieldName := GetSelectedField.FieldName;
- if InputQuery('Replace','Replace Field '+sFieldName+ ' With',sString) and InputQuery('','Next Records',sRecords) then
- ReplaceColumn(sFieldName,sString,RT_Next,False,StrToInt(sRecords));
- end;
-
- function TFrmMenu.GetSelectedField : TField;
- begin
- Result := TDBGrid(Screen.ActiveForm.FindComponent('DBCustGrid1')).SelectedField;
- end;
-
- procedure TFrmMenu.ReplaceColumn(sFieldName, sValue, sReplaceType : String; lField : Boolean; nNextRecords : Integer);
- var
- nRecords : Integer;
- bmRecPointer : TBookmark;
- begin
- try
- try
- bmRecPointer := GetActiveTable.GetBookmark;
- GetActiveTable.DisableControls;
- ResetLoopBreak;
- if (sReplaceType = RT_Next) then
- nRecords := 1
- else
- nRecords := -99999999;
- if (sReplaceType = RT_All) then
- GetActiveTable.First;
- while (not GetActiveTable.EOF) and (nRecords <= nNextRecords) do begin
- Application.ProcessMessages;
- GetActiveTable.Edit;
- if lField then
- GetActiveTable.FieldByName(sFieldName).AsString := GetActiveTable.FieldByName(sValue).AsString
- else
- GetActiveTable.FieldByName(sFieldName).AsString := sValue;
- GetActiveTable.Post;
- GetActiveTable.Next;
- nRecords := nRecords + 1;
- end;
- except
- on E:EDataBaseError do begin
- MessageBeep(mb_Ok);
- ShowMessage('ReplaceColumn : ' + E.Message);
- Abort;
- end;
- end;
- finally
- try
- GetActiveTable.GotoBookmark(bmRecPointer);
- except
- ;
- end;
- GetActiveTable.FreeBookmark(bmRecPointer);
- GetActiveTable.EnableControls;
- end;
- end;
-
- procedure TFrmMenu.All2Click(Sender: TObject);
- var
- sFieldName1, sFieldName2 : String;
- begin
- sFieldName2 := '';
- sFieldName1 := GetSelectedField.FieldName;
- if InputQuery('Replace','Replace Field '+ sFieldName1 + ' with Field ', sFieldName2) then begin
- if (GetActiveTable.FindField(sFieldName2) = nil) then begin
- MessageBeep(mb_Ok);
- ShowMessage('Field ' + sFieldName2 + ' not found ');
- end
- else
- ReplaceColumn(sFieldName1,sFieldName2,RT_All,True,0);
- end;
- end;
-
- procedure TFrmMenu.Rest2Click(Sender: TObject);
- var
- sFieldName1, sFieldName2 : String;
- begin
- sFieldName2 := '';
- sFieldName1 := GetSelectedField.FieldName;
- if InputQuery('Replace','Replace Field '+ sFieldName1 + ' with Field ', sFieldName2) then begin
- if (GetActiveTable.FindField(sFieldName2) = nil) then begin
- MessageBeep(mb_Ok);
- ShowMessage('Field ' + sFieldName2 + ' not found ');
- end
- else
- ReplaceColumn(sFieldName1,sFieldName2,RT_Rest,True,0);
- end;
- end;
-
- procedure TFrmMenu.Next2Click(Sender: TObject);
- var
- sFieldName1, sFieldName2, sRecords : String;
- begin
- sFieldName2 := '';
- sFieldName1 := GetSelectedField.FieldName;
- if InputQuery('Replace','Replace Field '+ sFieldName1 + ' with Field ', sFieldName2) and InputQuery('','Next Records',sRecords) then begin
- if (GetActiveTable.FindField(sFieldName2) = nil) then begin
- MessageBeep(mb_Ok);
- ShowMessage('Field ' + sFieldName2 + ' not found ');
- end
- else
- ReplaceColumn(sFieldName1,sFieldName2,RT_Next,True,StrToInt(sRecords));
- end;
- end;
-
- procedure TFrmMenu.MailingLetter1Click(Sender: TObject);
- begin
- Application.CreateForm(TFrmMailing, FrmMailing);
- FrmMailing.OpenTextFile('');
- end;
-
- procedure TFrmMenu.FindFiles1Click(Sender: TObject);
- begin
- {Find files in selected Directory / Drive}
- ShowMessage('Option Under Developement')
- end;
-
- procedure TFrmMenu.NetSessionPath1Click(Sender: TObject);
- var
- sPath : String;
- begin
- sPath := Session.NetFileDir;
- if InputQuery('Enter Path for Session','Path : ', sPath) then
- Session.NetFileDir := sPath;
- end;
-
- procedure TFrmMenu.LocateSearch1Click(Sender: TObject);
- var
- sString : String;
- begin
- if not (Screen.ActiveForm is TFrmBrowser) then
- Exit;
- if InputQuery('Search String','Enter Search String for Field ' + GetSelectedField.FieldName,sString) then begin
- try
- if not GetActiveTable.Locate(GetSelectedField.FieldName,sString,[]) then begin
- MessageBeep(mb_Ok);
- ShowMessage('String Not Found');
- end;
- except
- raise;
- end;
- end;
- end;
-
- function TFrmMenu.GetActiveTable : TTable;
- begin
- Result := TTable(TFrmBrowser(Screen.ActiveForm).FindComponent('Table1'));
- end;
-
- procedure TFrmMenu.ShowPassword1Click(Sender: TObject);
- var
- sString : String;
- begin
- if not (Screen.ActiveForm is TFrmBrowser) then
- Exit;
- sString := DecryptString(GetActiveTable.FieldByName(GetSelectedField.FieldName).AsString);
- if InputQuery('Search String','Enter Search String for Field ' + GetSelectedField.FieldName,sString) then begin
- if not (GetActiveTable.State in [dsInsert,dsEdit]) then
- GetActiveTable.Edit;
- GetActiveTable.FieldByName(GetSelectedField.FieldName).AsString := EncryptString(sString);
- end;
- end;
-
- procedure TFrmMenu.Options1Click(Sender: TObject);
- begin
- {General Options To Save Settings}
- ShowMessage('Option Under Developement')
- end;
-
- procedure TFrmMenu.Run1Click(Sender: TObject);
- var
- sRunApplication, sDirectory, sParameters : String;
- nResult : Integer;
- begin
- nResult := 0;
- if InputQuery('Run Application','Enter File Name',sRunApplication) then begin
- if (Pos(' ',sRunApplication) > 0) then begin
- sParameters := Copy(sRunApplication,Pos(' ',sRunApplication)+1,Length(sRunApplication));
- sRunApplication := Trim(Copy(sRunApplication,0,Pos(' ',sRunApplication)-1));
- end;
- sDirectory := ExtractFilePath(sRunApplication);
- sRunApplication := ExtractFileName(sRunApplication);
- nResult := ShellExecute(Self.Handle,PChar('Open'),PChar(sRunApplication),PChar(sParameters),PChar(sDirectory),SW_SHOW);
- if nResult <=32 then
- ShellError(nResult);
- end;
- end;
-
- procedure TFrmMenu.Rest3Click(Sender: TObject);
- var
- tblSource : TTable;
- begin
- if (MessageDlg('Delete Rest All Record',mtWarning,[mbYes,mbNo],0) = mrNo) then
- Abort;
- tblSource := GetActiveTable;
- while not tblSource.EOF do
- tblSource.Delete;
- end;
-
- procedure TFrmMenu.Next3Click(Sender: TObject);
- var
- sRecords : String;
- tblSource : TTable;
- I : Integer;
- begin
- I := 0;
- sRecords := '';
- tblSource := GetActiveTable;
- if InputQuery('','Next Records',sRecords) then begin
- for I := 1 to StrToInt(sRecords) do
- tblSource.Delete;
- end;
- end;
-
- procedure TFrmMenu.ModifyStructure1Click(Sender: TObject);
- var
- tblSource : TTable;
- begin
- tblSource := GetActiveTable;
- if (tblSource <> nil) and (tblSource is TTable) then begin
- Application.CreateForm(TFrmModifyStructure, FrmModifyStructure);
- FrmModifyStructure.ShowModal;
- end;
- end;
-
- procedure TFrmMenu.CompareFiles1Click(Sender: TObject);
- begin
- Application.CreateForm(TFrmCompareFile, FrmCompareFile);
- FrmCompareFile.Show;
- end;
-
- procedure TFrmMenu.PrivateDirectoryPath1Click(Sender: TObject);
- var
- sPath : String;
- begin
- sPath := Session.PrivateDir;
- if InputQuery('Enter Path for Temp Directory','Path : ', sPath) then
- Session.PrivateDir := sPath;
- end;
-
- procedure TFrmMenu.Zap1Click(Sender: TObject);
- var
- tblSource : TTable;
- begin
- if (MessageDlg('This will deletes all records in table, Continue ?',mtConfirmation,[mbYes,mbNo],0) = mrYes) then begin
- tblSource := GetActiveTable;
- if (tblSource <> nil) then begin
- tblSource.Close;
- tblSource.FieldDefs.Update;
- tblSource.IndexDefs.Update;
- tblSource.CreateTable;
- tblSource.Open;
- end;
- end;
- end;
-
- procedure TFrmMenu.SetRange1Click(Sender: TObject);
- var
- sString : String;
- begin
- if not (Screen.ActiveForm is TFrmBrowser) then
- Exit;
- if InputQuery('Set Range','Enter String : ',sString) then begin
- try
- GetActiveTable.IndexFieldNames := GetSelectedField.FieldName;
- GetActiveTable.SetRange([sString],[sString]);
- except
- raise;
- end;
- end;
- end;
-
- end.
-