📄 umfselectfiles.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 + -