frmmain.frm

管理器的相关文件合乎饿合乎 饿暖

      Begin VB.Menu sepclear 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPause 
         Caption         =   "暂停"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'==========================================================================================================='
' Author                    : Andreas Laubscher                                                             '
' Contact                   : [e-mail]                                                  '
' Date                      : 17 February 2001                                                              '
' Description               : An NT style Task Manager for Windows 95/98                                    '
'    我为人人,人人为我!
'    枕善居收集汉化整理
'    http://www.mndsoft.com/blog/
'    e-mail:[e-mail]
'==========================================================================================================='
Option Explicit
'==========================================================================================================='
' API Declarations                                                                                          '
'==========================================================================================================='
' Sets window to top.                                                                                       '
'-----------------------------------------------------------------------------------------------------------'
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'==========================================================================================================='
' Variable Declarations                                                                                     '
'==========================================================================================================='
Private fWidth As Integer
Private fHeight As Integer

Private Sub cmdRefresh_Click()

    Call RefreshTasks
    
End Sub

Private Sub Form_Load()

'-----------------------------------------------------------------------------------------------------------'
' Save the form's current size, this is to disable the resize option, while showing the minimize button     '
'-----------------------------------------------------------------------------------------------------------'
    fWidth = Width
    fHeight = Height
'-----------------------------------------------------------------------------------------------------------'
'   Reset our Load graph control variables                                                                  '
'-----------------------------------------------------------------------------------------------------------'
    intStoreY = picBackRight.Height
    intProcY = picBackRight.Height
    
    Timer1.Interval = 500
    strColourMemory = &HC000&
    strColourCPU = &HC0C0&
    
    lblBarCPU.Top = 0
    lblBarCPU.Left = 0
    lblBarCPU.Height = picBackMemory.Height
    lblBarCPU.Width = picBackMemory.Width
    
    lblBarMemory.Top = 0
    lblBarMemory.Left = 0
    lblBarMemory.Height = picBackCPU.Height
    lblBarMemory.Width = picBackCPU.Width
'-----------------------------------------------------------------------------------------------------------'
' Edit the ListView's column widths                                                                         '
'-----------------------------------------------------------------------------------------------------------'
    frmMain.lstTasks.ColumnHeaders(1).Width = frmMain.lstTasks.Width / 4
    frmMain.lstTasks.ColumnHeaders(2).Width = frmMain.lstTasks.Width / 6
    frmMain.lstTasks.ColumnHeaders(3).Width = frmMain.lstTasks.Width / 6
    frmMain.lstTasks.ColumnHeaders(4).Width = frmMain.lstTasks.Width / 6
'-----------------------------------------------------------------------------------------------------------'
' Set the window to permanently display on top (Z-order wise), this is necessary to prevent redraw problems '
' with the load graph. It also makes it easier to monitor the performance of an application                 '
'-----------------------------------------------------------------------------------------------------------'
    Call mnuStayOnTop_Click
'-----------------------------------------------------------------------------------------------------------'
' Trigger a screen update                                                                                   '
'-----------------------------------------------------------------------------------------------------------'
    Call GetSysInfo
    Call RefreshMemory
    Call RefreshTasks
    
End Sub

Private Sub Form_Resize()

    If WindowState <> vbMinimized Then
        Height = fHeight
        Width = fWidth
    End If
    
End Sub

Private Sub lblBarMemory_Click()
    
    Call picBackMemory_Click
    
End Sub

Private Sub lstTasks_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error GoTo exitsub
'==========================================================================================================='
' A right-click triggers the popupmenu                                                                      '
'==========================================================================================================='
    If Button = 2 Then
        lstTasks.HitTest(X, Y).Selected = True
        '---------------------------------------------------------------------------------------------------'
        ' Check the appropriate priority                                                                    '
        '---------------------------------------------------------------------------------------------------'
        frmMain.mnuPriority(1).Checked = False
        frmMain.mnuPriority(2).Checked = False
        frmMain.mnuPriority(3).Checked = False
        frmMain.mnuPriority(4).Checked = False
        
        Select Case lstTasks.SelectedItem.SubItems(1)
        Case "实时"
            frmMain.mnuPriority(1).Checked = True
        Case "高"
            frmMain.mnuPriority(2).Checked = True
        Case "正常"
            frmMain.mnuPriority(3).Checked = True
        Case "空闲"
            frmMain.mnuPriority(4).Checked = True
        End Select
        
        PopupMenu mnuPopupTasks
        
    End If

exitsub:
End Sub

Private Sub mnuClear_Click()
'==========================================================================================================='
' Re-initialize tbe graphing variables                                                                      '
'==========================================================================================================='

    intStoreX = 0
    intProcX = 0
    
    picGraph.Cls
    
    picGraph.Width = picBackRight.Width
    picGraph.Left = 0
    
End Sub

Private Sub mnuEndProcess_Click()
'==========================================================================================================='
' Kill the process                                                                                          '
'==========================================================================================================='
    EndProcess lstTasks.SelectedItem.SubItems(2)
    DoEvents: DoEvents
    Call RefreshTasks
    
End Sub

Private Sub mnuExit_Click()

    Unload Me
    End
    
End Sub

Private Sub mnuPause_Click()
'==========================================================================================================='
' Very simply, we only need to disable the timer that handles the refreshing of the memory data.            '
'==========================================================================================================='
    If Timer1.Enabled Then
        mnuPause.Checked = True
        Timer1.Enabled = False
    Else
        mnuPause.Checked = False
        Timer1.Enabled = True
    End If
    
End Sub

Private Sub mnuPriority_Click(Index As Integer)
'==========================================================================================================='
' Change the priority of the chosen process                                                                 '
'==========================================================================================================='
    SetProcessPriority lstTasks.SelectedItem.SubItems(2), mnuPriority(Index).Caption
    DoEvents: DoEvents
    Call RefreshTasks
    
    For Counter = 1 To 4
        If mnuPriority(Counter).Checked Then
            mnuPriority(Counter).Checked = Not mnuPriority(Counter).Checked
        End If
    Next
    
    mnuPriority(Index).Checked = Not mnuPriority(Index).Checked
    
End Sub

Private Sub mnuStayOnTop_Click()
'==========================================================================================================='
' Sets the Z-Order... um... order of the form.                                                              '
'==========================================================================================================='
    mnuStayOnTop.Checked = Not mnuStayOnTop.Checked
    SetWindowPos Me.hwnd, strNotAlwaysOnTop - 1, 0, 0, 0, 0, 2 Or 1
    strNotAlwaysOnTop = mnuStayOnTop.Checked
    
End Sub

Private Sub picBackCPU_Click()
    On Error GoTo CPUColorExit
    
Dim tmpS As OLE_COLOR

    With cmmDlg
        '---------------------------------------------------------------------------------------------------'
        ' Flags: Sets the initial color value, and sets full colour display on initially                    '
        '---------------------------------------------------------------------------------------------------'
        .DialogTitle = "CPU显示颜色"
        .Flags = cdlCCRGBInit + cdlCCFullOpen
        .Color = strColourCPU
        .CancelError = True
        .ShowColor
    End With
    
    tmpS = cmmDlg.Color
    strColourCPU = CLng(tmpS)
    
    lblLoadCPU.ForeColor = strColourCPU
    lblBarCPU.BackColor = strColourCPU
    
CPUColorExit:
End Sub

Private Sub picBackMemory_Click()
'==========================================================================================================='
' Trigger a colour change                                                                                   '
'==========================================================================================================='
    On Error GoTo MemoryColorExit
    
Dim tmpS As OLE_COLOR

    With cmmDlg
        '---------------------------------------------------------------------------------------------------'
        ' Flags: Sets the initial color value, and sets full colour display on initially                    '
        '---------------------------------------------------------------------------------------------------'
        .DialogTitle = "内存显示颜色"
        .Flags = cdlCCRGBInit + cdlCCFullOpen
        .Color = strColourMemory
        .CancelError = True
        .ShowColor
    End With
    
    tmpS = cmmDlg.Color
    strColourMemory = CLng(tmpS)
    
    lblLoadMemory.ForeColor = strColourMemory
    lblBarMemory.BackColor = strColourMemory
    
MemoryColorExit:
End Sub

Private Sub picGraph_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'==========================================================================================================='
' Triggers the graph's popup menu                                                                           '
'==========================================================================================================='
    If Button = 2 Then
        PopupMenu mnuPopupGraph
    End If
    
End Sub

Private Sub sldUpdate_Change()
'==========================================================================================================='
' Changes the update speed of the ticker                                                                    '
'==========================================================================================================='
    Timer1.Interval = (sldUpdate.Value + 1) * 100
    
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
'==========================================================================================================='
' Refresh the tasks ticker                                                                                  '
'==========================================================================================================='
    If SSTab1.Tab = 1 Then
        Call RefreshTasks
    End If
    
End Sub

Private Sub Timer1_Timer()
'==========================================================================================================='
' Queries the system for ticker information, and edits the results back to the form for display             '
'==========================================================================================================='
    RefreshMemory
    
End Sub

Private Sub Timer2_Timer()
'==========================================================================================================='
' Queries the system for process information, and edits the result back to the form for display             '
'==========================================================================================================='
' We only want to do this if the popumenu is not visible, otherwise me might refresh at the wrong moment    '
'-----------------------------------------------------------------------------------------------------------'
    If Not mnuPopupTasks.Visible Then
        RefreshTasks
    End If
    
End Sub