home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Delphi.5 / Samples / sourceD5 / browutil.exe / BROWSER / OPENFILE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-03-27  |  7.8 KB  |  287 lines
  1. unit OpenFile;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls, FileCtrl, ShellAPI, Literals;
  8.  
  9. type
  10.   TFrmOpenTable = class(TForm)
  11.     Panel1: TPanel;
  12.     Panel2: TPanel;
  13.     BtnOpen: TButton;
  14.     FileListBox1: TFileListBox;
  15.     ListBox1: TListBox;
  16.     BtnCancel: TButton;
  17.     DriveComboBox1: TDriveComboBox;
  18.     DirectoryListBox1: TDirectoryListBox;
  19.     Splitter1: TSplitter;
  20.     FilterComboBox1: TFilterComboBox;
  21.     Label1: TLabel;
  22.     EdtFileName: TEdit;
  23.     Label2: TLabel;
  24.     Label3: TLabel;
  25.     BtnRun: TButton;
  26.     procedure DirectoryListBox1Change(Sender: TObject);
  27.     procedure BtnOpenClick(Sender: TObject);
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure ListBox1DblClick(Sender: TObject);
  30.     procedure DirectoryListBox1Enter(Sender: TObject);
  31.     procedure DirectoryListBox1Exit(Sender: TObject);
  32.     procedure FilterComboBox1Change(Sender: TObject);
  33.     procedure ListBox1KeyUp(Sender: TObject; var Key: Word;
  34.       Shift: TShiftState);
  35.     procedure ListBox1Click(Sender: TObject);
  36.     procedure DirectoryListBox1KeyDown(Sender: TObject; var Key: Word;
  37.       Shift: TShiftState);
  38.     procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
  39.       Shift: TShiftState);
  40.     procedure BtnCancelClick(Sender: TObject);
  41.     procedure BtnRunClick(Sender: TObject);
  42.     procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  43.       Shift: TShiftState; X, Y: Integer);
  44.     procedure FormActivate(Sender: TObject);
  45.   private
  46.     { Private declarations }
  47.     wModalResult : TModalResult;
  48.     procedure AssignFileName(sFileName : String);
  49.     procedure GatherFileNames(ListBox : TListBox);
  50.     function ValidateFileNames : Boolean;
  51.     procedure EnableRunButton;
  52.   public
  53.     { Public declarations }
  54.     function OpenFileDlg(sFileFilter : String; var sDirName : String; var aFiles : Array of String) : TModalResult;
  55.   end;
  56.  
  57. var
  58.   FrmOpenTable: TFrmOpenTable;
  59.  
  60. implementation
  61.  
  62. uses GenFunc;
  63.  
  64. {$R *.DFM}
  65.  
  66. procedure TFrmOpenTable.DirectoryListBox1Change(Sender: TObject);
  67. begin
  68.   ListBox1.Items.Assign(FileListBox1.Items);
  69. end;
  70.  
  71. procedure TFrmOpenTable.BtnOpenClick(Sender: TObject);
  72. begin
  73.   try
  74. //    if (ListBox1.SelCount <= 0) then
  75.     if not ValidateFileNames then
  76.       Exit;
  77.     if (EdtFileName.Text <> '') then begin
  78. //      Self.ModalResult := mrOk
  79.         wModalResult := mrOk;
  80.         Close;
  81.       end
  82.     else
  83. //      Self.ModalResult := mrNone;
  84.       wModalResult := mrNone;
  85.   except
  86. //    Self.ModalResult := mrNone;
  87.     wModalResult := mrNone;
  88.     Abort;
  89.   end;
  90. end;
  91.  
  92. procedure TFrmOpenTable.FormCreate(Sender: TObject);
  93. begin
  94.   DirectoryListBox1Change(FileListBox1);
  95. end;
  96.  
  97. procedure TFrmOpenTable.ListBox1DblClick(Sender: TObject);
  98. begin
  99.   BtnOpen.Click;
  100. end;
  101.  
  102. procedure TFrmOpenTable.DirectoryListBox1Enter(Sender: TObject);
  103. begin
  104.   BtnOpen.Default := False;
  105. end;
  106.  
  107. procedure TFrmOpenTable.DirectoryListBox1Exit(Sender: TObject);
  108. begin
  109.   BtnOpen.Default := True;
  110. end;
  111.  
  112. procedure TFrmOpenTable.FilterComboBox1Change(Sender: TObject);
  113. begin
  114.   DirectoryListBox1Change(FileListBox1);
  115. end;
  116.  
  117. procedure TFrmOpenTable.ListBox1KeyUp(Sender: TObject; var Key: Word;
  118.   Shift: TShiftState);
  119. begin
  120.   GatherFileNames(ListBox1);
  121.   EnableRunButton;
  122. end;
  123.  
  124. procedure TFrmOpenTable.ListBox1Click(Sender: TObject);
  125. begin
  126.   GatherFileNames(ListBox1);
  127. end;
  128.  
  129. procedure TFrmOpenTable.GatherFileNames(ListBox : TListBox);
  130. var
  131.   I : Integer;
  132.   sFileNames : String;
  133. begin
  134.   sFileNames := '';
  135.   for I := 0 to ListBox.Items.Count - 1 do
  136.     if ListBox.Selected[I] then
  137.       sFileNames := sFileNames + ListBox.Items.Strings[I] + ',';
  138.   AssignFileName(Copy(sFileNames,0,Length(sFileNames)-1));
  139. end;
  140.  
  141. procedure TFrmOpenTable.AssignFileName(sFileName : String);
  142. begin
  143.   EdtFileName.Text := sFileName;
  144. end;
  145.  
  146. function TFrmOpenTable.ValidateFileNames : Boolean;
  147. var
  148.   sFileName, sDirDelimiter : String;
  149. begin
  150.   Result := True;
  151.   sFileName := EdtFileName.Text;
  152.   if DirectoryExists(ExtractFileDir(sFileName)) then begin
  153.     if not FileExists(sFileName) then
  154.       sDirDelimiter := '\';
  155.     try
  156.       FileListBox1.Directory := ExtractFileDir(sFileName+sDirDelimiter);
  157.     except
  158.       FileListBox1.Directory := ExtractFileDir(sFileName);
  159.     end;
  160.     if (ExtractFileName(sFileName) = '') then begin
  161.       Result := False;
  162.       Exit;
  163.     end;
  164.     EdtFileName.Text := ExtractFileName(sFileName);
  165.     sFileName := ExtractFileName(sFileName);
  166.   end;
  167.   if (Copy(FrmOpenTable.FileListBox1.Directory,Length(FrmOpenTable.FileListBox1.Directory),1) <> '\') then
  168.     sDirDelimiter := '\'
  169.   else
  170.     sDirDelimiter := '';
  171.   if (ExtractFileName(sFileName) <> '') then
  172.     if not FileExists(FileListBox1.Directory + sDirDelimiter + ExtractFileName(sFileName)) then begin
  173.       Result := (Pos(',',sFileName) > 0);
  174.       try
  175.         FileListBox1.Directory := sFileName;
  176.         EdtFileName.Text := '';
  177.         sFileName := '';
  178.       except
  179.         ;
  180.       end;
  181.     end
  182.   else
  183. //    Result := True;
  184. end;
  185.  
  186. procedure TFrmOpenTable.DirectoryListBox1KeyDown(Sender: TObject;
  187.   var Key: Word; Shift: TShiftState);
  188. begin
  189.   if (Key = 8) then
  190.     FileListBox1.Directory := '..';
  191. end;
  192.  
  193. procedure TFrmOpenTable.ListBox1KeyDown(Sender: TObject; var Key: Word;
  194.   Shift: TShiftState);
  195. var
  196.   sDir : String;
  197. begin
  198.   if Key = 46 then begin
  199.     sDir := FrmOpenTable.FileListBox1.Directory;
  200.     if (Copy(FrmOpenTable.FileListBox1.Directory,Length(FrmOpenTable.FileListBox1.Directory),1) <> '\') then
  201.       sDir := sDir + '\';
  202.     DeleteFiles(ListBox1,True,sDir);
  203.     FileListBox1.Update;
  204.     DirectoryListBox1.OnChange(nil);
  205.   end;
  206. end;
  207.  
  208. function TFrmOpenTable.OpenFileDlg(sFileFilter : String; var sDirName : String; var aFiles : Array of String) : TModalResult;
  209. var
  210.   I : Integer;
  211.   sDir, sFileNames, sFileName : String;
  212. begin
  213.   FilterComboBox1.Filter := sFileFilter;
  214.   Self.ShowModal;
  215.   Result := wModalResult;
  216.   if (Result = mrOk) then begin
  217.     if (Copy(FileListBox1.Directory,Length(FileListBox1.Directory),1) <> '\') then
  218.       sDir := FileListBox1.Directory+'\'
  219.     else
  220.       sDir := FileListBox1.Directory;
  221.     sDirName := sDir;
  222.     sFileNames := UpperCase(EdtFileName.Text);
  223.     I := 0;
  224.     while Length(sFileNames) > 0 do begin
  225.       if Pos(',',sFileNames) > 0 then begin
  226.           sFileName := Copy(sFileNames,0,Pos(',',sFileNames)-1);
  227.           sFileNames := Copy(sFileNames,Pos(',',sFileNames)+1,Length(sFileNames));
  228.         end
  229.       else
  230.         begin
  231.           sFileName := sFileNames;
  232.           sFileNames := '';
  233.         end;
  234.       if FileExists(sDir + sFileName) then begin
  235.         aFiles[I] := sFileName;
  236.         I := I + 1;
  237.       end;
  238.     end;
  239.   end;
  240. end;
  241.  
  242. procedure TFrmOpenTable.BtnCancelClick(Sender: TObject);
  243. begin
  244.   wModalResult := mrNone;
  245.   Close;
  246. end;
  247.  
  248. procedure TFrmOpenTable.BtnRunClick(Sender: TObject);
  249. var
  250.   nResult : Integer;
  251. begin
  252.   if (ListBox1.SelCount <= 0) then
  253.     Exit;
  254.   nResult := ShellExecute(Self.Handle,PChar('Open'),PChar(ListBox1.Items.Strings[ListBox1.ItemIndex]),nil,nil,SW_SHOW);
  255.   if nResult <=32 then
  256.     ShellError(nResult);
  257. end;
  258.  
  259. procedure TFrmOpenTable.EnableRunButton;
  260. var
  261.   sFileExt : String;
  262. begin
  263.   sFileExt := UpperCase(ExtractFileExt(ListBox1.Items.Strings[ListBox1.ItemIndex]));
  264.   if (sFileExt = FE_COM) or (sFileExt = FE_EXE) or (sFileExt = FE_BAT) then
  265.     BtnRun.Enabled := True
  266.   else
  267.     BtnRun.Enabled := False;
  268. end;
  269.  
  270. procedure TFrmOpenTable.ListBox1MouseDown(Sender: TObject;
  271.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  272. begin
  273.   EnableRunButton;
  274. end;
  275.  
  276. procedure TFrmOpenTable.FormActivate(Sender: TObject);
  277. var
  278.   sDirectory : String;
  279. begin
  280.   DirectoryListBox1.Refresh;
  281.   sDirectory := DirectoryListBox1.Directory;
  282.   DirectoryListBox1.Directory := 'c:\';
  283.   DirectoryListBox1.Directory := sDirectory;
  284. end;
  285.  
  286. end.
  287.