home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Delphi.5 / Samples / sourceD5 / browutil.exe / BROWSER / BROWSE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-02  |  14.4 KB  |  465 lines
  1. unit Browse;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, DBCtrls, DB, DBTables, StdCtrls, FileCtrl,
  8.   ComCtrls, Menus, FindDlg, Grids, DBGrids, CustGrid;
  9.  
  10. type
  11.   TFrmBrowser = class(TForm)
  12.     DataSource1: TDataSource;
  13.     Table1: TTable;
  14.     PopupMenu1: TPopupMenu;
  15.     Scatter1: TMenuItem;
  16.     Gather1: TMenuItem;
  17.     StatusBar1: TStatusBar;
  18.     DBCustGrid1: TDBCustGrid;
  19.     N1: TMenuItem;
  20.     New1: TMenuItem;
  21.     Edit1: TMenuItem;
  22.     Insert1: TMenuItem;
  23.     Delete1: TMenuItem;
  24.     N2: TMenuItem;
  25.     Save1: TMenuItem;
  26.     Revert1: TMenuItem;
  27.     N3: TMenuItem;
  28.     MultipleScatter1: TMenuItem;
  29.     MultipleGather1: TMenuItem;
  30.     View1: TMenuItem;
  31.     HideColumn1: TMenuItem;
  32.     ShowAllColumns1: TMenuItem;
  33.     DeleteViewProperties1: TMenuItem;
  34.     N4: TMenuItem;
  35.     Loadafile1: TMenuItem;
  36.     Savetofile1: TMenuItem;
  37.     procedure FileListBox1Click(Sender: TObject);
  38.     procedure Table1AfterPost(DataSet: TDataSet);
  39.     procedure Exit1Click(Sender: TObject);
  40.     procedure About1Click(Sender: TObject);
  41.     procedure Table1AfterScroll(DataSet: TDataSet);
  42.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  43.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  44.     procedure FormActivate(Sender: TObject);
  45.     procedure Table1AfterOpen(DataSet: TDataSet);
  46.     procedure Table1AfterClose(DataSet: TDataSet);
  47.     procedure DataSource1StateChange(Sender: TObject);
  48.     procedure Scatter1Click(Sender: TObject);
  49.     procedure Gather1Click(Sender: TObject);
  50.     procedure New1Click(Sender: TObject);
  51.     procedure Insert1Click(Sender: TObject);
  52.     procedure Edit1Click(Sender: TObject);
  53.     procedure Delete1Click(Sender: TObject);
  54.     procedure Save1Click(Sender: TObject);
  55.     procedure Revert1Click(Sender: TObject);
  56.     procedure FormDestroy(Sender: TObject);
  57.     procedure FormDeactivate(Sender: TObject);
  58.     procedure PopupMenu1Popup(Sender: TObject);
  59.     procedure Table1BeforeInsert(DataSet: TDataSet);
  60.     procedure Table1AfterInsert(DataSet: TDataSet);
  61.     procedure MultipleScatter1Click(Sender: TObject);
  62.     procedure MultipleGather1Click(Sender: TObject);
  63.     procedure FormKeyUp(Sender: TObject; var Key: Word;
  64.       Shift: TShiftState);
  65.     procedure HideColumn1Click(Sender: TObject);
  66.     procedure ShowAllColumns1Click(Sender: TObject);
  67.     procedure DeleteViewProperties1Click(Sender: TObject);
  68.     procedure FormCreate(Sender: TObject);
  69.     procedure DBCustGrid1TitleClick(Column: TColumn);
  70.     procedure Loadafile1Click(Sender: TObject);
  71.     procedure Savetofile1Click(Sender: TObject);
  72.   private
  73.     { Private declarations }
  74.     lFieldModified, lShowStructure  : Boolean;
  75.     procedure SaveBrowserSettings;
  76.     procedure ReadBrowserSettings;
  77.   public
  78.     { Public declarations }
  79.     procedure OpenBrowser(sDirectory, sFileName : String);
  80.     function AskSaveChanges : Boolean;
  81.     procedure ShowStructure(lStructure : Boolean);
  82.   end;
  83.  
  84. var
  85.   FrmBrowser: TFrmBrowser;
  86.  
  87. implementation
  88.  
  89. uses Compare, About, Filter, GenFunc, Menu, Literals;
  90.  
  91. {$R *.DFM}
  92.  
  93. procedure TFrmBrowser.FileListBox1Click(Sender: TObject);
  94. begin
  95.   Table1.Active := False;
  96.   Table1.IndexFieldNames := '';
  97.   Table1.Filter := '';
  98.   Table1.Filtered := False;
  99. //  Table1.DataBaseName := FileListBox1.Directory;
  100. //  Table1.TableName := FileListBox1.Items[FileListBox1.ItemIndex];
  101.   Table1.Active := True;
  102.   ShowStructure(FrmMenu.ShowStructure1.Checked);
  103. end;
  104.  
  105. procedure TFrmBrowser.Table1AfterPost(DataSet: TDataSet);
  106. begin
  107.   Table1.Refresh;
  108. end;
  109.  
  110. procedure TFrmBrowser.Exit1Click(Sender: TObject);
  111. begin
  112.   Close;
  113. end;
  114.  
  115. procedure TFrmBrowser.About1Click(Sender: TObject);
  116. begin
  117.   Application.CreateForm(TAboutBox, AboutBox);
  118.   AboutBox.ShowModal;
  119. end;
  120.  
  121. procedure TFrmBrowser.Table1AfterScroll(DataSet: TDataSet);
  122. begin
  123.   StatusBar1.SimpleText := 'Table : '+ Table1.TableName +'  '+
  124.                            'Records : ' + IntToStr(Table1.RecordCount) + '  ' +
  125.                            'Record No : ' + IntToStr(Table1.RecNo) + '  ' +
  126.                            'Filter : ' + Table1.Filter;
  127. end;
  128.  
  129. procedure TFrmBrowser.OpenBrowser(sDirectory, sFileName : String);
  130.   function ExtractPath(sString : String) : String;
  131.   var
  132.     sTmpString : String;
  133.   begin
  134.     sTmpString := Copy(sString,Pos('\',sString),Length(sString));
  135.     sTmpString := Copy(sTmpString,0,Pos('File:',sTmpString)-3);
  136.     Result := sTmpString;
  137.   end;
  138. begin
  139.   try
  140.     Self.Caption := sDirectory + sFileName;
  141.     Table1.DatabaseName := sDirectory;
  142.     Table1.TableName := sFileName;
  143.     Table1.Open;
  144.   except
  145.     on E:EDataBaseError do begin
  146.       try
  147.         if (Pos(EM_DirControlledby,UpperCase(E.Message)) > 0) then begin
  148.             AssignNetFileDir(ExtractPath(E.Message));
  149.             Table1.Open;
  150.           end
  151.         else
  152.           if (Pos(EM_IndexOutofDate,UpperCase(E.Message)) > 0) then begin
  153.               DeleteFile(sDirectory+ChangeFileExt(sFileName,'.Px'));
  154.               Table1.Open;
  155.             end
  156.           else
  157.             begin
  158.               Table1.Open;
  159.             end;
  160.       except
  161.         on E:EDataBaseError do begin
  162.           if (Pos('Insufficient table',E.Message) > 0) then
  163.             E.Message := 'Invalid Password';
  164.           ShowMessage(E.Message);
  165.           Self.Close;
  166.           Exit;
  167.         end;
  168.       end;
  169.     end;
  170.   end;
  171.   Self.FormStyle := fsMDIChild;
  172.   ReadBrowserSettings;
  173.   Self.Visible := True;
  174.   Self.Show;
  175. end;
  176.  
  177. procedure TFrmBrowser.FormClose(Sender: TObject; var Action: TCloseAction);
  178. begin
  179.   if Table1.Active then
  180.     Table1.Refresh;
  181.   Table1.Close;  
  182.   Action := caFree;
  183. end;
  184.  
  185. procedure TFrmBrowser.FormCloseQuery(Sender: TObject;
  186.   var CanClose: Boolean);
  187. begin
  188.   CanClose := AskSaveChanges;
  189.   if CanClose then
  190.     Self.SaveBrowserSettings;
  191. end;
  192.  
  193. function TFrmBrowser.AskSaveChanges : Boolean;
  194. var
  195.   wWord : Word;
  196. begin
  197.   wWord := mrNo;
  198.   if lFieldModified then begin
  199.     wWord := MessageDlg('Changes have been made save',mtWarning,[mbYes,mbNo,mbCancel],0);
  200.     if (wWord = mrYes) then
  201.       Table1.Post
  202.     else
  203.       if (wWord = mrNo) then
  204.         Table1.Cancel;
  205.   end;
  206.   Result := (wWord <> mrCancel);
  207. end;
  208.  
  209. procedure TFrmBrowser.FormActivate(Sender: TObject);
  210. var
  211.   I : Integer;
  212. begin
  213.   FrmMenu.Table1 := Table1;
  214.   FrmMenu.ShowClose(True);
  215.   FrmMenu.ShowStructure1.Checked := lShowStructure;
  216.   FrmMenu.ShowQueryMenuItem(False);
  217.   FrmMenu.ShowTextFileMenuItem(False);
  218.   FrmMenu.ShowTableMenuItem(Table1.Active);
  219.   AssignGridOptions(DBCustGrid1,dgAlwaysShowSelection,FrmMenu.ShowSelected1.Checked);
  220.   AssignGridOptions(DBCustGrid1,dgAlwaysShowEditor,FrmMenu.ShowEdited1.Checked);
  221.   AssignGridOptions(DBCustGrid1,dgConfirmDelete,FrmMenu.ConfirmDelete1.Checked);
  222.   AssignGridOptions(DBCustGrid1,dgMultiSelect,FrmMenu.MultipleSelect1.Checked);
  223. end;
  224.  
  225. procedure TFrmBrowser.Table1AfterOpen(DataSet: TDataSet);
  226. begin
  227. //  SetDateFormatForFields(TTable(DataSet));
  228.   FormActivate(Self);
  229. end;
  230.  
  231. procedure TFrmBrowser.Table1AfterClose(DataSet: TDataSet);
  232. begin
  233.   FormActivate(Self);
  234. end;
  235.  
  236. procedure TFrmBrowser.ShowStructure(lStructure : Boolean);
  237. var
  238.   I : Integer;
  239. begin
  240.   lShowStructure := lStructure;
  241.   for I := 0 to Table1.FieldCount - 1 do begin
  242.     if lStructure then
  243.       DBCustGrid1.Columns.Items[I].Title.Caption := DBCustGrid1.Fields[I].FieldName + ' : ' +
  244.                                                 FindFieldType(DBCustGrid1.Fields[I].DataType) + ' : ' +
  245.                                                 IntToStr(DBCustGrid1.Fields[I].DataSize)
  246.     else
  247.       DBCustGrid1.Columns.Items[I].Title.Caption := DBCustGrid1.Fields[I].FieldName;
  248.   end;
  249. end;
  250.  
  251. procedure TFrmBrowser.DataSource1StateChange(Sender: TObject);
  252. begin
  253.   lFieldModified := (Table1.State in [dsInsert,dsEdit]);
  254. end;
  255.  
  256. procedure TFrmBrowser.Scatter1Click(Sender: TObject);
  257. begin
  258.   Scatter(Table1,FrmMenu.aTableStructure,FrmMenu.aFieldContent);
  259. end;
  260.  
  261. procedure TFrmBrowser.Gather1Click(Sender: TObject);
  262. begin
  263.   Gather(Table1,FrmMenu.aTableStructure,FrmMenu.aFieldContent);
  264. end;
  265.  
  266. procedure TFrmBrowser.New1Click(Sender: TObject);
  267. begin
  268.   Table1.Append;
  269. end;
  270.  
  271. procedure TFrmBrowser.Insert1Click(Sender: TObject);
  272. begin
  273.   Table1.Insert;
  274. end;
  275.  
  276. procedure TFrmBrowser.Edit1Click(Sender: TObject);
  277. begin
  278.   Table1.Edit;
  279. end;
  280.  
  281. procedure TFrmBrowser.Delete1Click(Sender: TObject);
  282. begin
  283.   if (MessageDlg('Delete Record',mtConfirmation,[mbYes,mbNo],0) = mrYes) then
  284.     Table1.Delete;
  285. end;
  286.  
  287. procedure TFrmBrowser.Save1Click(Sender: TObject);
  288. begin
  289.   Table1.Post;
  290. end;
  291.  
  292. procedure TFrmBrowser.Revert1Click(Sender: TObject);
  293. begin
  294.   Table1.Cancel;
  295. end;
  296.  
  297. procedure TFrmBrowser.FormDestroy(Sender: TObject);
  298. begin
  299.   FrmMenu.ShowClose(False);
  300. //  FrmMenu.RemoveWindowItem(Self.Name)
  301. end;
  302.  
  303. procedure TFrmBrowser.FormDeactivate(Sender: TObject);
  304. begin
  305.   if Sender <> nil then
  306.     FrmMenu.ShowMenuWindowItemChecked(Self.Name,False);
  307. end;
  308.  
  309. procedure TFrmBrowser.PopupMenu1Popup(Sender: TObject);
  310. begin
  311.   Scatter1.Enabled := Table1.Active;
  312.   Gather1.Enabled := Table1.Active;
  313.   New1.Enabled := Table1.Active;
  314.   Insert1.Enabled := Table1.Active;
  315.   Edit1.Enabled := Table1.Active;
  316.   Delete1.Enabled := Table1.Active;
  317.   if Table1.Active then begin
  318.     Save1.Enabled := (Table1.State in [dsInsert,dsEdit]);
  319.     Revert1.Enabled := (Table1.State in [dsInsert,dsEdit]);
  320.   end;
  321.   if (DBCustGrid1.SelectedField.DataType in [ftMemo,ftFmtMemo,ftGraphic,ftParadoxOle,ftDBaseOle,ftTypedBinary,ftBlob]) then begin
  322.       Loadafile1.Enabled := True;
  323.       Savetofile1.Enabled := True;
  324.     end
  325.   else
  326.     begin
  327.       Loadafile1.Enabled := False;
  328.       Savetofile1.Enabled := False;
  329.     end;
  330. end;
  331.  
  332. procedure TFrmBrowser.Table1BeforeInsert(DataSet: TDataSet);
  333. begin
  334.   If FrmMenu.CarryFieldValues1.Checked then
  335.     Scatter(Table1,FrmMenu.aTableStructure,FrmMenu.aFieldContent);
  336. end;
  337.  
  338. procedure TFrmBrowser.Table1AfterInsert(DataSet: TDataSet);
  339. begin
  340.   If FrmMenu.CarryFieldValues1.Checked then
  341.     Gather(Table1,FrmMenu.aTableStructure,FrmMenu.aFieldContent);
  342. end;
  343.  
  344. procedure TFrmBrowser.MultipleScatter1Click(Sender: TObject);
  345. begin
  346.   MultiScatter(Table1,DBCustGrid1,FrmMenu.TableRecords);
  347. end;
  348.  
  349. procedure TFrmBrowser.MultipleGather1Click(Sender: TObject);
  350. begin
  351.   MultiGather(Table1,FrmMenu.TableRecords);
  352. end;
  353.  
  354. procedure TFrmBrowser.FormKeyUp(Sender: TObject; var Key: Word;
  355.   Shift: TShiftState);
  356. begin
  357.   if Key = VK_ESCAPE then
  358.     FrmMenu.SetLoopBreak;
  359. end;
  360.  
  361. procedure TFrmBrowser.SaveBrowserSettings;
  362. var
  363.   sSection : String;
  364.   I : Integer;
  365. begin
  366.   I := 0;
  367.   sSection := UpperCase(Table1.DatabaseName + Table1.TableName);
  368.   SaveToIni(sIF_Browser,sSection,SI_FormLeft,IntToStr(Self.Left));
  369.   SaveToIni(sIF_Browser,sSection,SI_FormTop,IntToStr(Self.Top));
  370.   SaveToIni(sIF_Browser,sSection,SI_FormWidth,IntToStr(Self.Width));
  371.   SaveToIni(sIF_Browser,sSection,SI_FormHeight,IntToStr(Self.Height));
  372.   for I := 0 to Table1.FieldDefs.Count - 1 do begin
  373.     if DBCustGrid1.Columns.Count >= Table1.FieldDefs.Count then begin
  374.       SaveToIni(sIF_Browser,sSection,SI_GridColWidth+IntToStr(I),IntToStr(DBCustGrid1.Columns.Items[I].Width));
  375.       SaveToIni(sIF_Browser,sSection,SI_GridColCaption+IntToStr(I),DBCustGrid1.Columns.Items[I].Title.Caption);
  376.     end;
  377. //    SaveToIni(sIF_Browser,sSection,SI_TableFieldName+IntToStr(I),Table1.FieldDefs.Items[I].Name);
  378.     if Table1.FieldByName(Table1.FieldDefs.Items[I].Name).Visible then
  379.       SaveToIni(sIF_Browser,sSection,SI_GridColVisible+IntToStr(I),SV_True)
  380.     else
  381.       SaveToIni(sIF_Browser,sSection,SI_GridColVisible+IntToStr(I),SV_False);
  382.   end;
  383. end;
  384.  
  385. procedure TFrmBrowser.ReadBrowserSettings;
  386. var
  387.   sSection : String;
  388.   I : Integer;
  389. begin
  390.   I := 0;
  391.   sSection := UpperCase(Table1.DatabaseName + Table1.TableName);
  392.   Self.Left := StrToInt(ReadFromIni(sIF_Browser,sSection,SI_FormLeft,IntToStr(Self.Left)));
  393.   Self.Top := StrToInt(ReadFromIni(sIF_Browser,sSection,SI_FormTop,IntToStr(Self.Top)));
  394.   Self.Width := 300;
  395.   Self.Height := 300;
  396.   Self.Width := StrToInt(ReadFromIni(sIF_Browser,sSection,SI_FormWidth,IntToStr(Self.Width)));
  397.   Self.Height := StrToInt(ReadFromIni(sIF_Browser,sSection,SI_FormHeight,IntToStr(Self.Height)));
  398.   for I := 0 to Table1.FieldDefs.Count - 1 do begin
  399.     if (ReadFromIni(sIF_Browser,sSection,SI_GridColCaption+IntToStr(I),'') <> '') then begin
  400.       DBCustGrid1.Columns.Items[I].Width := StrToInt(ReadFromIni(sIF_Browser,sSection,SI_GridColWidth+IntToStr(I),IntToStr(DBCustGrid1.Columns.Items[I].Width)));
  401. //      DBCustGrid1.Columns.items[I].Title.Caption := ReadFromIni(sIF_Browser,sSection,SI_GridColCaption+IntToStr(I),DBCustGrid1.Columns.items[I].Title.Caption);
  402.     end;
  403.     if (ReadFromIni(sIF_Browser,sSection,SI_GridColVisible+IntToStr(I),'TRUE') = SV_False) then
  404.       Table1.FieldByName(Table1.FieldDefs.Items[I].Name).Visible := False
  405.     else
  406.       Table1.FieldByName(Table1.FieldDefs.Items[I].Name).Visible := True;
  407.   end;
  408. end;
  409.  
  410. procedure TFrmBrowser.HideColumn1Click(Sender: TObject);
  411. begin
  412.   DBCustGrid1.SelectedField.Visible := False;
  413. end;
  414.  
  415. procedure TFrmBrowser.ShowAllColumns1Click(Sender: TObject);
  416. var
  417.   I : Integer;
  418. begin
  419.   for I := 0 to Table1.FieldDefs.Count - 1 do
  420.     Table1.FieldByName(Table1.FieldDefs.Items[I].Name).Visible := True;
  421.   DBCustGrid1.DataSource := nil;
  422.   DBCustGrid1.DataSource := DataSource1;
  423. end;
  424.  
  425. procedure TFrmBrowser.DeleteViewProperties1Click(Sender: TObject);
  426. var
  427.   sSection : String;
  428. begin
  429.   sSection := UpperCase(Table1.DatabaseName + Table1.TableName);
  430.   DeleteFromIni(sIF_Browser,sSection);
  431. end;
  432.  
  433. procedure TFrmBrowser.FormCreate(Sender: TObject);
  434. begin
  435.   Self.Width := 0;
  436.   Self.Height := 0;
  437. end;
  438.  
  439. procedure TFrmBrowser.DBCustGrid1TitleClick(Column: TColumn);
  440. begin
  441.   Table1.Filtered := False;
  442. end;
  443.  
  444. procedure TFrmBrowser.Loadafile1Click(Sender: TObject);
  445. begin
  446.   FrmMenu.OpenDialog1.Title := 'Select file';
  447.   FrmMenu.OpenDialog1.Filter := 'Any file (*.*)|*.*';
  448.   if FrmMenu.OpenDialog1.Execute then begin
  449.     if not (Table1.State in [dsInsert,dsEdit]) then
  450.       Table1.Edit;
  451.     TBlobField(Table1.FieldByName(DBCustGrid1.SelectedField.FieldName)).LoadFromFile(FrmMenu.OpenDialog1.FileName);
  452.   end;
  453. end;
  454.  
  455. procedure TFrmBrowser.Savetofile1Click(Sender: TObject);
  456. begin
  457.   FrmMenu.SaveDialog1.Title := 'Select file';
  458.   FrmMenu.SaveDialog1.Filter := 'Any file (*.*)|*.*';
  459.   if FrmMenu.SaveDialog1.Execute then begin
  460.     TBlobField(Table1.FieldByName(DBCustGrid1.SelectedField.FieldName)).SaveToFile(FrmMenu.SaveDialog1.FileName);
  461.   end;
  462. end;
  463.  
  464. end.
  465.