开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
FFoldersForm.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：2k
源码类别：

Delphi控件源码

开发平台：

Delphi

FFoldersForm.pas：源码内容
  1. unit FFoldersForm;
  3. interface
  5. {$WARN UNIT_PLATFORM OFF}
  7. uses
  8.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  9.   Forms, Dialogs, StdCtrls, FileCtrl, ShlObj;
  11. type
  12.   TForm1 = class(TForm)
  13.     Edit1: TEdit;
  14.     Label1: TLabel;
  15.     TestButton: TButton;
  16.     CreateButton: TButton;
  17.     SelectButton: TButton;
  18.     btnBrowse: TButton;
  19.     procedure TestButtonClick(Sender: TObject);
  20.     procedure Edit1Change(Sender: TObject);
  21.     procedure CreateButtonClick(Sender: TObject);
  22.     procedure SelectButtonClick(Sender: TObject);
  23.     procedure btnBrowseClick(Sender: TObject);
  24.   private
  25.     { Private declarations }
  26.   public
  27.     { Public declarations }
  28.   end;
  30. var
  31.   Form1: TForm1;
  33. implementation
  35. {$R *.DFM}
  37. procedure TForm1.TestButtonClick(Sender: TObject);
  38. begin
  39.   if DirectoryExists (Edit1.Text) then
  40.     MessageDlg ('OK, the directory ' +
  41.       Edit1.Text + ' exists', mtInformation, [mbOk], 0)
  42.   else
  43.     MessageDlg ('Sorry, the directory ' + Edit1.Text +
  44.       ' doesn''t exist', mtError, [mbOk], 0);
  45. end;
  47. procedure TForm1.Edit1Change(Sender: TObject);
  48. begin
  49.   if Edit1.TExt <> '' then
  50.   begin
  51.     TestButton.Enabled := True;
  52.     CreateButton.Enabled := True;
  53.   end
  54.   else
  55.   begin
  56.     TestButton.Enabled := False;
  57.     CreateButton.Enabled := False;
  58.   end;
  59. end;
  61. procedure TForm1.CreateButtonClick(Sender: TObject);
  62. begin
  63.   if MessageDlg ('Are you sure you want to create the ' +
  64.       Edit1.Text + ' directory', mtConfirmation,
  65.       [mbYes, mbNo], 0) = mrYes then
  66.     ForceDirectories (Edit1.Text);
  67. end;
  69. procedure TForm1.SelectButtonClick(Sender: TObject);
  70. var
  71.   Text: string;
  72. begin
  73.   Text := Edit1.Text;
  74.   if SelectDirectory (Text, [sdAllowCreate,
  75.       sdPerformCreate, sdPrompt], 0) then
  76.     Edit1.Text := Text;
  77. end;
  79. procedure TForm1.btnBrowseClick(Sender: TObject);
  80. var
  81.   bi: TBrowseInfo;
  82.   pidl: pItemIdList;
  83.   strpath, displayname: string;
  84. begin
  85.   SetLength (displayname, 100);
  87.   bi.hwndOwner := Handle;
  88.   bi.pidlRoot := nil;
  89.   bi.pszDisplayName := pChar (displayname);
  90.   bi.lpszTitle := 'Select a folder';
  91.   bi.ulFlags := bif_StatusText;
  92.   bi.lpfn := nil;
  93.   bi.lParam := 0;
  95.   pidl := ShBrowseForFolder (bi);
  97.   SetLength (strPath, 100);
  98.   ShGetPathFromIdList (pidl, PChar(strPath));
  99.   Edit1.Text := strPath;
  100. end;
  102. end.