📄 dfmain.pas
字号:
unit DfMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, CoolTrayIcon, Menus, StdCtrls, ComCtrls, ImgList;
type
PDriveInfo = PInteger;
TMainForm = class(TForm)
TrayIcon1: TCoolTrayIcon;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
Setup1: TMenuItem;
Exit1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Setup1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure TrayIcon1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
public
Decimals: Byte; // # decimals in drive info
ShowAllDrives: Boolean; // Show all drives in the popup menu?
Qualified: Boolean; // Show type of drives in the popup menu?
Measure: Byte; // Show free space in KB, MB, or GB?
private
Drives: TStringList; // Stores the drive info strings
procedure GetDrivesInfo;
procedure UpdateHint;
procedure UpdateMenu;
procedure DrivesItemClick(Sender: TObject);
end;
var
MainForm: TMainForm;
implementation
uses
DfSetup, IniFiles, ShellApi;
const
IniFileName: String = 'DiskFree.ini';
{$R *.DFM}
{-------------------- TMainForm -----------------------}
procedure TMainForm.FormCreate(Sender: TObject);
var
IniFile: TIniFile;
begin
IniFile := TIniFile.Create(IniFileName);
Decimals := IniFile.ReadInteger('Options', 'Decimals', 0);
ShowAllDrives := IniFile.ReadBool('Options', 'AllDrives', False);
Qualified := IniFile.ReadBool('Options', 'DriveType', False);
Measure := IniFile.ReadInteger('Options', 'Measure', 1);
IniFile.Free;
Drives := TStringList.Create;
// Get initial drives info (for initialization)
// TrayIcon1MouseMove(Self, [], 0, 0);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
var
IniFile: TIniFile;
begin
IniFile := TIniFile.Create(IniFileName);
IniFile.WriteInteger('Options', 'Decimals', Decimals);
IniFile.WriteBool('Options', 'AllDrives', ShowAllDrives);
IniFile.WriteBool('Options', 'DriveType', Qualified);
IniFile.WriteInteger('Options', 'Measure', Measure);
IniFile.Free;
Drives.Free;
end;
procedure TMainForm.TrayIcon1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
// This is where the drive info is displayed
begin
GetDrivesInfo;
UpdateHint;
end;
procedure TMainForm.PopupMenu1Popup(Sender: TObject);
begin
GetDrivesInfo;
UpdateMenu;
end;
procedure TMainForm.Setup1Click(Sender: TObject);
begin
with SetupForm do
if Visible then
BringToFront
else
if SetupForm.ShowModal = mrOk then
begin
// Retrieve info from the various controls
Decimals := TrackBar1.Position;
ShowAllDrives := RadioButton2.Checked;
Qualified := CheckBox1.Checked;
if Radiobutton3.Checked then
Measure := 0
else
if Radiobutton4.Checked then
Measure := 1
else
Measure := 2;
// Update drives info immediately
GetDrivesInfo;
UpdateHint;
end;
end;
procedure TMainForm.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TMainForm.GetDrivesInfo;
// Fill Drives stringlist with info for logical drives
var
I: Integer;
F: Real;
Info: PDriveInfo;
S: String;
begin
// Delete old drives info
for I := 0 to Drives.Count -1 do
Dispose(PDriveInfo(Drives.Objects[I]));
Drives.Clear;
{ It is possible to use GetLogicalDrives and GetLogicalDriveLetters
to get the available drives, but it's far easier to check all
possible drive letters in a loop using the DiskFree method. }
for I := 3 to 26 do // Check all drive letters from C to Z
begin
F := DiskFree(I);
if F >= 0 then // A drive was found, F = free space in bytes
begin
case Measure of
0: begin
F := F/1024; // Convert from bytes to KB
S := ' KB free';
end;
1: begin
F := F/1024/1024; // Convert from bytes to MB
S := ' MB free';
end;
2: begin
F := F/1024/1024/1024; // Convert from bytes to GB
S := ' GB free';
end;
end;
New(Info);
Info^ := GetDriveType(PChar(Chr(I+64)+':\'));
// Store type of drive along with the string
Drives.AddObject(Chr(I+64)+': ' + Format('%.'+IntToStr(Decimals)+'n', [F]) + S, TObject(Info));
end;
end;
end;
procedure TMainForm.UpdateHint;
// Update the hint of the tray icon (for fixed drives only)
var
I: Integer;
NewHint: String;
s: String;
begin
NewHint := '';
for I := 0 to Drives.Count -1 do
if PDriveInfo(Drives.Objects[I])^ = DRIVE_FIXED then
NewHint := NewHint + Drives[I] + '. ';
{ Only assign new hint to the tray icon in case the hint changes.
This avoids unnecessary cursor blinking. }
if TrayIcon1.Hint <> NewHint then
TrayIcon1.Hint := NewHint;
end;
procedure TMainForm.UpdateMenu;
// Update the popup menu according to user-specified options
var
I: Integer;
Item: TMenuItem;
S: String;
ShowDrive: Boolean;
begin
// Remove old drives menu items (they have GroupIndex = 0)
while PopupMenu1.Items[0].GroupIndex = 0 do
PopupMenu1.Items[0].Free;
// Insert new menu items for each drive
for I := Drives.Count-1 downto 0 do
begin
if ShowAllDrives then
ShowDrive := True
else
ShowDrive := (PDriveInfo(Drives.Objects[I])^ = DRIVE_FIXED);
if ShowDrive then
begin
S := Drives[I];
// Insert Chr(8) to right-justify drive space info
S[3] := Chr(8);
// Insert type of drive in drive string (if needed)
if Qualified then
case PDriveInfo(Drives.Objects[I])^ of
DRIVE_FIXED: Insert(' [fixed]', S, 3);
DRIVE_CDROM: Insert(' [cd-rom]', S, 3);
DRIVE_REMOVABLE: Insert(' [removable]', S, 3);
DRIVE_REMOTE: Insert(' [network]', S, 3);
DRIVE_RAMDISK: Insert(' [RAM-disk]', S, 3);
end;
// Now create and insert a menu item for the drive
Item := TMenuItem.Create(PopupMenu1);
Item.Caption := S;
Item.OnClick := DrivesItemClick;
PopupMenu1.Items.Insert(0, Item);
end;
end;
end;
procedure TMainForm.DrivesItemClick(Sender: TObject);
// Start the Explorer with selected drive letter as root directory
var
S: String;
begin
S := TMenuItem(Sender).Caption;
Delete(S, 3, 255);
if GetKeyState(VK_SHIFT) < 0 then // Shift key is held down
begin
if ShellExecute(Application.MainForm.Handle, 'explore', PChar(S),
nil, nil, SW_SHOWNORMAL) <= 32 then
MessageDlg('Error: Could not start Explorer.', mtError, [mbOk], 0);
end
else
if ShellExecute(Application.MainForm.Handle, 'open', PChar(S),
nil, nil, SW_SHOWNORMAL) <= 32 then
MessageDlg('Error: Could not start Explorer.', mtError, [mbOk], 0);
{ You could also use the following:
if ShellExecute(Application.MainForm.Handle, nil, PChar(S),
nil, '.', SW_RESTORE) <= 32 then... }
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -