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

📄 dfmain.pas

📁 diskfree is tools for calculate free size of disks
💻 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 + -