home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / w3_disk / meter.arj / METERFRM.TXT < prev    next >
Encoding:
Text File  |  1991-12-12  |  2.6 KB  |  121 lines
  1. Dim Pi As Double
  2. Dim Regs As Registers
  3. Dim DriveNum As Integer
  4.  
  5. Sub TheDrive_Change ()
  6. Update_Caption
  7. End Sub
  8.  
  9. Sub Update_Caption ()
  10. D$ = TheDrive.Drive
  11. Caption = UpCase(D$) + ":"
  12. DriveNum = Asc(Caption) - 64
  13. End Sub
  14.  
  15. Function UpCase (ByVal A$) As String
  16. S% = Asc(A$)
  17. If S% >= 97 And S% <= 122 Then S% = S% - 32
  18. UpCase = Chr$(S%)
  19. End Function
  20.  
  21. Sub Form_Load ()
  22. FillStyle = Solid
  23. Pi = 4 * Atn(1)
  24. Update_Caption
  25. End Sub
  26.  
  27. Sub TheTimer_Timer ()
  28. Update_Display
  29. End Sub
  30.  
  31. Sub Update_Display ()
  32. If WindowState = 1 Then
  33.   Scale (-16, 7)-(16, -1)
  34. Else
  35.   Scale (-20, 8)-(20, -4)
  36. End If
  37. Regs.AX = &H3600
  38. Regs.DX = DriveNum
  39. Regs.DS = 0 ' Insurance against GP faults
  40. Regs.ES = 0
  41. MsDos Regs
  42. If Regs.AX = -1 Then Regs.DX = 0 'Use Regs.DX=0 to flag error
  43. If Regs.DX = 0 Then 'Avoid division by zero
  44.  Fraction = 0
  45. Else
  46.  Clusters& = Regs.DX
  47.  FreeClusters& = Regs.BX
  48.  If Clusters& < 0 Then Clusters& = Clusters& + 65536
  49.  If FreeClusters& < 0 Then FreeClusters& = FreeClusters& + 65536
  50.  Fraction = FreeClusters& / Clusters&
  51. End If
  52. Angle = Pi * Fraction 'The more free space, the larger Angle gets
  53. If Angle = 0 Then Angle = .01!
  54. If Angle < Pi Then
  55.  FillColor = RED
  56.  Circle (0, 0), 12, Black, -Angle, -Pi 'Draw from Angle to Pi
  57. End If
  58. If Angle > .1! Then
  59.  FillColor = WHITE
  60.  Circle (0, 0), 12, Black, -1E-32, -Angle
  61. End If
  62. If WindowState = 0 Then
  63.  CurrentY = 3
  64. Else
  65.  CurrentY = 6
  66. End If
  67.  
  68. If Regs.DX <> 0 Then
  69.  Legend$ = Format$(Fraction, "##0%")
  70.  If WindowState = 0 Then Legend$ = Legend$ + " Free"
  71. Else
  72.  Legend$ = "Error"
  73. End If
  74. CurrentX = -TextWidth(Legend$) / 2
  75. Print Legend$;
  76. If WindowState = 0 Then
  77.   Legend$ = Format$((CDbl(FreeClusters&) * Regs.AX) * Regs.CX, "#,###,###,###,###") + " Bytes"
  78.   Print
  79.   CurrentX = -TextWidth(Legend$) / 2
  80.   Print Legend$;
  81. End If
  82. End Sub
  83.  
  84. Sub Form_Paint ()
  85. Update_Display
  86. End Sub
  87.  
  88. Sub Interval_KeyPress (KeyAscii As Integer)
  89.   Select Case KeyAscii
  90.     Case 13
  91.       KeyAscii = 0
  92.       Reset_Timer
  93.       TheDrive.SetFocus
  94.       Exit Sub
  95.     Case 8
  96.       Exit Sub
  97.     Case Asc("0") To Asc("9")
  98.       If Len(Interval.Text) < 2 Then Exit Sub
  99.     End Select
  100.   KeyAscii = 0
  101.   Beep
  102. End Sub
  103.  
  104. Sub Interval_LostFocus ()
  105. Reset_Timer
  106. End Sub
  107.  
  108. Sub Reset_Timer ()
  109.   Interval.Text = LTrim$(RTrim$(Interval.Text))
  110.   If Len(Interval.Text) <> 0 Then
  111.     NewInterval = Val(Interval.Text) * 1000
  112.     If NewInterval <> 0 Then
  113.       If NewInterval <> TheTimer.Interval Then
  114.         TheTimer.Interval = Val(Interval.Text) * 1000
  115.       End If
  116.     End If
  117.   End If
  118. Interval.Text = LTrim$(Str$(TheTimer.Interval / 1000))
  119. End Sub
  120.  
  121.