⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 umfselectfiles.pas

📁 DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen
💻 PAS
字号:
{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2002-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}


unit UMFSelectFiles;

{Contains a page to select the files to be parsed. It is also the base class of
 all the pages to select files. }

interface

uses Windows, Classes, Forms, Controls, StdCtrls, ExtCtrls, CheckLst, Dialogs,
{$IFDEF LINUX}
     Qt,
{$ENDIF}
     UMainFormFrame,
     UJADDState;

type
  {A page to select the files to be parsed. This is also the base class of all
   the pages to select files. }
  TMFSelectFiles = class(TMainFormFrame)
    EditFile: TEdit;
    ButtonBrowse: TButton;
    ButtonBrowseDir: TButton;
    CheckListBox: TCheckListBox;
    ButtonRemove: TButton;
    ButtonAdd: TButton;
    ButtonClear: TButton;
    procedure ButtonBrowseClick(Sender: TObject);
    procedure ButtonBrowseDirClick(Sender: TObject);
    procedure ButtonAddClick(Sender: TObject);
    procedure ButtonRemoveClick(Sender: TObject);
    procedure ButtonClearClick(Sender: TObject);
    procedure CheckListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure CheckListBoxClick(Sender: TObject);
  private
  protected
    //Shows the list of files in the check list box.
    procedure ShowList; virtual;
    //Saves the list of files from the check list box.
    procedure SaveList; virtual;

    //Sets the filter and default file extension for the dialog to select
    //files.
    procedure SetFileDialogFilterAndExtension(Dialog: TOpenDialog); virtual;
  public
    //Creates the components, shows the files and allows dropping of files.
    constructor Create(Parent: TWinControl; State: TJADDState); override;
    //Saves the list and frees the frame.
    destructor Destroy; override;


    //Called when some files are dropped on the form.
    procedure FilesDropped(Files: TStrings); override;

    //Called when the default action of the form should be executed.
    procedure DefaultAction; override;
  end;



implementation

{$R *.dfm}

uses SysUtils, 
{$IFDEF VER120}
     FileCtrl,
{$ENDIF}
     GeneralVCL, UFilePaths,
     UPascalFiles;



{Creates the components, shows the files and allows dropping of files.
~param Parent the component to show the frame in, preferably a TPanel or a
              similar component
~param State  the state of the program }
constructor TMFSelectFiles.Create(Parent: TWinControl; State: TJADDState);
begin
 inherited Create(Parent, State);             //create the page

 Include(FProperties, mffpAcceptsFileDrop);   //accept dropped files

 ShowList;                                    //show the already selected files
end;

{Saves the list and frees the frame. }
destructor TMFSelectFiles.Destroy;
begin
 if Assigned(State) and Assigned(CheckListBox) then
  SaveList;                                   //save the list of selected files

 inherited Destroy;                           //free the page
end;





{Called when some files are dropped on the form.
~param Files the list of the dropped files }
procedure TMFSelectFiles.FilesDropped(Files: TStrings);
var       i             :Integer;                  //counter through files
begin
 for i := 0 to Files.Count - 1 do                  //for each selected file
  if CheckListBox.Items.IndexOf(Files[i]) = -1 then  //if not already in list?
   CheckListBox.Items.Append(Files[i]);                //add the file
end;

{Called when the default action of the form should be executed. }
procedure TMFSelectFiles.DefaultAction;
begin
 ButtonBrowseClick(ButtonBrowse);              //browse for files
end;






{Shows the list of files in the check list box. }
procedure TMFSelectFiles.ShowList;
var       i             :Integer;               //counter through the files
begin
 CheckListBox.Items := State.FilesToParse;      //set all files
 for i := 0 to CheckListBox.Items.Count - 1 do  //also show if they are marked
  CheckListBox.Checked[i] := Assigned(CheckListBox.Items.Objects[i]);
end;

{Saves the list of files from the check list box. }
procedure TMFSelectFiles.SaveList;
var       i             :Integer;               //counter through the files
begin
 for i := 0 to CheckListBox.Items.Count - 1 do  //save whether they are marked
  CheckListBox.Items.Objects[i] := Pointer(Ord(CheckListBox.Checked[i]));
 State.FilesToParse.Assign(CheckListBox.Items); //save all files
end;



{Sets the filter and default file extension for the dialog to select files.
~param Dialog the file dialog to set the filter and extension of }
procedure TMFSelectFiles.SetFileDialogFilterAndExtension(Dialog: TOpenDialog);
begin
 Dialog.Filter := 'Pascal Files (*.pas;*.dpr;*.dpk;*.int)|*.pas;*.dpr;*.dpk;*.int|Units (*.pas)|*.pas|Delphi Projects (*.dpr)|*.dpr|Delphi Packages (*.dpk)|*.dpk|all files (*)|*';
 Dialog.DefaultExt := 'pas';
end;




{Called when the button to browse for files is clicked.
~param Sender the sender of the event, ~[link ButtonBrowse] }
procedure TMFSelectFiles.ButtonBrowseClick(Sender: TObject);
var       S             :String;         //the currently selected path
          IsRelative    :Boolean;        //whether the current path is relative
          Dialog        :TOpenDialog;    //the dialog to select files
          i             :Integer;        //counter through the selected files
begin
 S := EditFile.Text;                     //get the current path and show dialog
 if DirectoryExists(S) then
  S := S + PathDelimiter;
 IsRelative := (FileExists(S) or DirectoryExists(S)) and not IsAbsolutePath(S);
{$IFNDEF LINUX}
 if IsRelative then                      //is a relative path?
  S := ExpandFileName(S);                  //function needs absolute path
{$ENDIF}

 Dialog := TOpenDialog.Create(nil);      //create a file open - dialog
 try
   Dialog.Options := [ofHideReadOnly, ofAllowMultiSelect, ofPathMustExist,
               ofFileMustExist, ofEnableSizing, ofShowHelp];
   if IsRelative then                    //is a relative path?
    Dialog.Options := Dialog.Options + [ofNoChangeDir]; //don't change the path
   Dialog.HelpContext := ButtonBrowse.HelpContext;
   Dialog.Title := 'Choose files to add/file to set';
   Dialog.InitialDir := ExtractFileDir(S);
   SetFileDialogFilterAndExtension(Dialog);

   if Dialog.Execute then                //show the dialog; file(s) chosen?
    begin
     for i := 0 to Dialog.Files.Count - 1 do //for each file
      begin
       S := Dialog.Files[i];                   //get it
       if IsRelative then                      //was a relative path?
        begin                                    //make it also relative
         S := ExtractRelativePath(GetCurrentDir + PathDelimiter, S);
         assert(S <> '');
         if S[1] <> '.' then                     //is a sub-directory?
          S := '.' + PathDelimiter + S;            //prepend '.' and delimiter
        end;

       EditFile.Text := S;                     //use the new file
       ButtonAddClick(nil);                    //and add it to the list
      end;

     S := Dialog.FileName;                   //get selected file
     if IsRelative then                      //was a relative path?
      begin                                    //make it also relative
       S := ExtractRelativePath(GetCurrentDir + PathDelimiter, S);
       assert(S <> '');
       if S[1] <> '.' then                     //is a sub-directory?
        S := '.' + PathDelimiter + S;            //prepend '.' and delimiter
      end;

     EditFile.Text := S;                     //set text field to the file
    end;
 finally
  Dialog.Free;                           //free the dialog
 end;
end;

{Called when the button to browse for a directory is clicked.
~param Sender the sender of the event, ~[link ButtonBrowseDir] }
procedure TMFSelectFiles.ButtonBrowseDirClick(Sender: TObject);
var       S             :String;         //the currently selected path
begin
 S := EditFile.Text;                     //get the current path and show dialog
 if not DirectoryExists(S) then
  S := ExtractFileDir(S);

 //user selects a directory?
 if AskForRelativeDirectory('Select directory to parse:', S) then
  begin
   EditFile.Text := S;                     //use the new path
   ButtonAddClick(nil);                    //and add it to the list
  end;
end;


{Called when the button to add the specified file or directory to the list is
 clicked.
~param Sender the sender of the event, ~[link ButtonAdd] }
procedure TMFSelectFiles.ButtonAddClick(Sender: TObject);
          //the name of the file or directory to add
var       FileName      :String;
          Index         :Integer;          //index of the newly added entry
begin
 FileName := EditFile.Text;                //get the text
 while (FileName <> '') and (FileName[length(FileName)] = PathDelimiter) do
  Delete(FileName, length(FileName), 1);     //remove final path delimiter(s)

 if DirectoryExists(FileName) then         //is a directory?
  begin
   //just add the directory and by default mark it for recursion
   Index := CheckListBox.Items.Add(FileName);
   CheckListBox.Checked[Index] := True;
   CheckListBox.ItemIndex := Index;          //and select it
  end
 else
  if FileExists(FileName) then               //is a valid file?
   begin
    Index := CheckListBox.Items.Add(FileName); //add it to the list
    FileName := ExtractFileExt(FileName);      //get its extension
    //mark it for recursion if it seems to be a project file
    CheckListBox.Checked[Index] := IsPasExt(FileName) and
                                   ((LowerCase(FileName) = '.dpr') or
                                    (LowerCase(FileName) = '.dpk'));
    CheckListBox.ItemIndex := Index;           //and select it
   end;
end;

{Called when the button to remove the selected file from the check list box is
 clicked or when the check list box is double clicked.
~param Sender the sender of the event, ~[link ButtonRemove] or
                                       ~[link CheckListBox] }
procedure TMFSelectFiles.ButtonRemoveClick(Sender: TObject);
begin
 if (CheckListBox.ItemIndex <> -1) and (CheckListBox.Items.Count <> 0) then
  CheckListBox.Items.Delete(CheckListBox.ItemIndex); //remove the selected file
end;

{Called when the button to clear the list of all files is clicked.
~param Sender the sender of the event, ~[link ButtonClear] }
procedure TMFSelectFiles.ButtonClearClick(Sender: TObject);
begin
 CheckListBox.Clear;                               //clear the list
end;


{Called when a key is pressed in the check list box.
~param Sender the sender of the event, ~[link CheckListBox]
~param Key    the pressed key
~param Shift  the state of special modifying keys }
procedure TMFSelectFiles.CheckListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if (Shift = []) and                                 //delete key pressed?
{$IFNDEF LINUX}
                     (Key = VK_DELETE) then
{$ELSE}
                     (Key = Key_Delete) then
{$ENDIF}
  ButtonRemoveClick(Sender);                           //delete the entry
end;

{Called when an entry is selected in the check list box.
~param Sender the sender of the event, ~[link CheckListBox] }
procedure TMFSelectFiles.CheckListBoxClick(Sender: TObject);
begin                                         //show the selected entry
 if (CheckListBox.Items.Count > 0) and (CheckListBox.ItemIndex >= 0) then
  EditFile.Text := CheckListBox.Items[CheckListBox.ItemIndex];
end;

end.
 

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -