home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / SRC / DISKPROP.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  4KB  |  139 lines
  1. {**************************************************************************}
  2. {                                                                          }
  3. {    Calmira shell for Microsoft« Windows(TM) 3.1                          }
  4. {    Source Release 1.0                                                    }
  5. {    Copyright (C) 1997  Li-Hsin Huang                                     }
  6. {                                                                          }
  7. {    This program is free software; you can redistribute it and/or modify  }
  8. {    it under the terms of the GNU General Public License as published by  }
  9. {    the Free Software Foundation; either version 2 of the License, or     }
  10. {    (at your option) any later version.                                   }
  11. {                                                                          }
  12. {    This program is distributed in the hope that it will be useful,       }
  13. {    but WITHOUT ANY WARRANTY; without even the implied warranty of        }
  14. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         }
  15. {    GNU General Public License for more details.                          }
  16. {                                                                          }
  17. {    You should have received a copy of the GNU General Public License     }
  18. {    along with this program; if not, write to the Free Software           }
  19. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.             }
  20. {                                                                          }
  21. {**************************************************************************}
  22.  
  23. unit Diskprop;
  24.  
  25. interface
  26.  
  27. uses
  28.   Classes, SysUtils, Graphics, Controls, Forms, StdCtrls, Buttons, ExtCtrls, 
  29.   TabNotBk, BarGauge;
  30.  
  31. type
  32.   TDiskDialog = class(TForm)
  33.     OKBtn: TBitBtn;
  34.     Notebook: TTabbedNotebook;
  35.     Label10: TLabel;
  36.     DriveLetter: TLabel;
  37.     Label11: TLabel;
  38.     DriveType: TLabel;
  39.     Label12: TLabel;
  40.     DriveSize: TLabel;
  41.     Label13: TLabel;
  42.     DriveFree: TLabel;
  43.     Label14: TLabel;
  44.     DriveImage: TImage;
  45.     Label1: TLabel;
  46.     VolLabel: TLabel;
  47.     Bevel1: TBevel;
  48.     Gauge: TBarGauge;
  49.     procedure FormShow(Sender: TObject);
  50.     procedure DriveImageClick(Sender: TObject);
  51.     procedure FormCreate(Sender: TObject);
  52.   private
  53.     { Private declarations }
  54.   public
  55.     { Public declarations }
  56.   end;
  57.  
  58.  
  59. procedure DiskPropExecute(drive : Char);
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64.  
  65. uses Strings, Drives, Resource, FileCtrl, Settings,
  66.   Files, Environs, WinTypes;
  67.  
  68. {
  69. var
  70.   DiskDialog: TDiskDialog;
  71. }
  72.  
  73. procedure TDiskDialog.FormShow(Sender: TObject);
  74. var
  75.   dnum : Integer;
  76.   drive : Char;
  77.   dtype : TDriveType;
  78.   size, free : Longint;
  79.   vol : string;
  80. begin
  81.   drive := DriveLetter.Caption[1];
  82.   dnum := DriveNumber(drive);
  83.   dtype := GuessDriveType(drive);
  84.   DriveType.Caption := DriveDesc[dtype];
  85.   DriveImage.Picture.Icon := icons.Drive[dtype];
  86.  
  87.   Screen.Cursor := crHourGlass;
  88.   try
  89.     size := DiskSize(dnum);
  90.     if size <> -1 then free := DiskFree(dnum);
  91.   finally
  92.     Screen.Cursor := crDefault;
  93.   end;
  94.  
  95.   if size <> -1 then begin
  96.     DriveSize.Caption := FormatByte(size);
  97.     DriveFree.Caption := FormatByte(free);
  98.  
  99.     if dtype = dtNetwork then vol := GetNetworkVolume(drive)
  100.     else vol := GetVolumeID(drive);
  101.     if vol > '' then VolLabel.Caption := vol;
  102.  
  103.     if size > 1024 then begin
  104.       size := size div 1024;
  105.       free := free div 1024;
  106.     end;
  107.  
  108.     Gauge.MaxValue := size;
  109.     Gauge.Progress := size - free;
  110.   end;
  111.  
  112.   Gauge.ForeColor := Colors[ccPercent];
  113.   Gauge.Font.Color := Colors[ccPercentText];
  114. end;
  115.  
  116. procedure TDiskDialog.DriveImageClick(Sender: TObject);
  117. begin
  118.   ExecuteFile(EnvironSubst(DiskProg), '', '', 'Open', SW_SHOWNORMAL);
  119. end;
  120.  
  121. procedure DiskPropExecute(drive : Char);
  122. begin
  123.   with TDiskDialog.Create(Application) do
  124.   try
  125.     DriveLetter.Caption := Upcase(drive);
  126.     ShowModal;
  127.   finally
  128.     Free;
  129.   end;
  130. end;
  131.  
  132. procedure TDiskDialog.FormCreate(Sender: TObject);
  133. begin
  134.   OKBtn.Cancel := True;
  135.   Notebook.PageIndex := 0;
  136. end;
  137.  
  138. end.
  139.