系统内存容量测试 1.frm

Windows API函数,希望大伙有用哦

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H8000000B&
   Caption         =   "Form1"
   ClientHeight    =   2895
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8100
   LinkTopic       =   "Form1"
   ScaleHeight     =   193
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   540
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "内存使用图示"
      Height          =   2685
      Left            =   3300
      TabIndex        =   11
      Top             =   120
      Width           =   4605
      Begin VB.PictureBox Picture1 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000005&
         Height          =   2355
         Left            =   120
         ScaleHeight     =   153
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   289
         TabIndex        =   12
         Top             =   210
         Width           =   4395
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退         出"
      Height          =   315
      Left            =   390
      TabIndex        =   0
      Top             =   2340
      Width           =   2535
   End
   Begin VB.TextBox Text3 
      Alignment       =   1  'Right Justify
      Height          =   285
      Left            =   1620
      TabIndex        =   6
      Text            =   "Text3"
      Top             =   1770
      Width           =   1185
   End
   Begin VB.TextBox Text2 
      Alignment       =   1  'Right Justify
      Height          =   285
      Left            =   1620
      TabIndex        =   5
      Text            =   "Text2"
      Top             =   1380
      Width           =   1185
   End
   Begin VB.TextBox Text1 
      Alignment       =   1  'Right Justify
      Height          =   285
      Left            =   1620
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   900
      Width           =   1185
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   2820
      Top             =   240
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H00008000&
      BorderWidth     =   2
      FillColor       =   &H0080FFFF&
      Height          =   435
      Left            =   360
      Shape           =   4  'Rounded Rectangle
      Top             =   240
      Width           =   2385
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "系统内存测试"
      BeginProperty Font 
         Name            =   "华文新魏"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   540
      TabIndex        =   10
      Top             =   300
      Width           =   1890
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "K"
      Height          =   180
      Left            =   2940
      TabIndex        =   9
      Top             =   1830
      Width           =   90
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "K"
      Height          =   180
      Left            =   2940
      TabIndex        =   8
      Top             =   1395
      Width           =   90
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "K"
      Height          =   180
      Left            =   2940
      TabIndex        =   7
      Top             =   960
      Width           =   90
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "认可内存用量："
      Height          =   180
      Left            =   270
      TabIndex        =   3
      Top             =   1830
      Width           =   1260
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "可用内存："
      Height          =   180
      Left            =   270
      TabIndex        =   2
      Top             =   1395
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "全部物理内存："
      Height          =   180
      Left            =   270
      TabIndex        =   1
      Top             =   960
      Width           =   1260
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Type MEMORYSTATUS
  MemLength As Long
  MemMeoryLoad As Long
  MemTotalPhys As Long
  MemAvailPhys As Long
  MemTotalPageFile As Long
  MemTotalVirtual As Long
  MemAvailVirtual As Long
End Type
  Dim MemInfoBuffer As MEMORYSTATUS
  Dim I As Single, M As Integer
  Dim X(45) As Integer, Y(46) As Single
Private Sub Form_Load()
  For I = 12 To 160 Step 12
    Picture1.Line (0, I)-(290, I), RGB(0, 128, 0)
  Next I
  For I = 12 To 280 Step 12
    Picture1.Line (I, 0)-(I, 170), RGB(0, 128, 0)
  Next I
  GlobalMemoryStatus MemInfoBuffer
  MemInfoBuffer.MemLength = Len(MemInfoBuffer)
    Text1 = MemInfoBuffer.MemTotalPhys / 1024
    Text2 = MemInfoBuffer.MemAvailPhys / 1024
    Text3 = MemInfoBuffer.MemTotalPageFile / 1024
      Timer1.Interval = 100
      Timer1.Enabled = True
    For I = 45 To 0 Step -1
      X(I) = I * 6.5
    Next I
End Sub
Private Sub Command1_Click()
  Timer1.Enabled = False
  Unload Me
  End
End Sub
Private Sub Timer1_Timer()
  GlobalMemoryStatus MemInfoBuffer
  Text2 = MemInfoBuffer.MemAvailPhys / 1024
  M = 158 * (MemInfoBuffer.MemAvailPhys / 1024) / (MemInfoBuffer.MemTotalPhys / 1024)
      Y(0) = M
 Picture1.Cls
    For I = 12 To 160 Step 12
      Picture1.Line (0, I)-(290, I), RGB(0, 128, 0)
    Next I
    For I = 12 To 280 Step 12
      Picture1.Line (I, 0)-(I, 170), RGB(0, 128, 0)
    Next I
For I = 45 To 0 Step -1
    Picture1.Line (X(I) + 6.5, 158 - Y(I + 1))-(X(I), 158 - Y(I)), RGB(255, 0, 0)
    Y(I + 1) = Y(I)
'    Picture1.Line (X(I), 158 - Y(I))-(X(I) + 2.5, 158), RGB(255, 0, 0), BF
'    Y(I + 1) = Y(I)
Next I
End Sub