frmeditentry.frm

高级卸载工具

'E-Mail  ：[e-mail]
'QQ      ：158676144
'源码作者：如果您有VB商业源码需要获得收益，本站将有VIP收费下载频道可供你发布!
'         您有权定价;改价;删除;及即时查看下载量(即收益)，所有收益全部归您！
'         本站将在双方协商的一个金额周期内打款到作者帐户中，您只需负责打款费用！
'         本站只作为一个平台提供最新VB源码咨讯和源码下载！
'本注释由<站长工具之智能注释>软件自动添加！金诺VB园有此软件下载！
'★★★★★****************************★★★★★**********************★★★★★


Option Explicit

Dim mlngColWidth As Long

'=========================================================================
' Add a new row into the Grid by simply incrementing the row counter
'=========================================================================
Private Sub cmdAdd_Click()
    MSFEntries.Rows = MSFEntries.Rows + 1
    MSFEntries.SetFocus
End Sub

'=========================================================================
' Unload the form
'=========================================================================
Private Sub cmdCancel_Click()
    Unload Me
End Sub

'=========================================================================
' Delete the selected row.
'=========================================================================
Private Sub cmdDelete_Click()
On Error Resume Next
    Dim intMsg As Integer
    
    intMsg = MsgBox("Are you sure you want to delete the value?", vbQuestion + vbYesNo, App.Title)
    If intMsg = vbNo Then
        Exit Sub
    End If
    MSFEntries.RemoveItem MSFEntries.RowSel
    MSFEntries.SetFocus
End Sub

Private Sub cmdOk_Click()
On Error GoTo errHandle:
    
    Dim i As Integer
    
    ' Delete the uinstall key
    DeleteKey HKEY_LOCAL_MACHINE, UnInstallPath & FrmMain.lstview.SelectedItem.Key
    
    ' Simply recreate all the entries again
    With MSFEntries
        For i = 1 To .Rows - 1
            If Len(Trim$(.TextMatrix(i, 0))) > 0 Then
                SaveString HKEY_LOCAL_MACHINE, UnInstallPath & FrmMain.lstview.SelectedItem.Key, Trim$(.TextMatrix(i, 0)), Trim$(.TextMatrix(i, 1) & vbNullChar)
            End If
        Next
    End With
    
    Unload Me
    FrmMain.mnu_refresh_Click
    Exit Sub
errHandle:
    MsgBox "Error occurred Edit Entry Ok: " & vbCrLf & Err.Description, vbCritical, App.Title
End Sub

'=========================================================================
' Form Load Event
'=========================================================================
Private Sub Form_Load()
On Error Resume Next
    Dim i As Integer                                    ' Loop Counter
    Dim strTemp As String, coltemp As Collection, varArr As Variant
    Me.Icon = FrmMain.Icon                              ' Set the icon to application's default
    
    MSFEntries.TextMatrix(0, 0) = "Registry Key"        ' Set the captions for the MsFlexGrid
    MSFEntries.TextMatrix(0, 1) = "Registry Value"
    
    ' MSFEntries.ColWidth(1) = 3900
    ' Registry Path for the selected program. The selected program can be found under the selected item
    ' from the Main form's List View
    TxtDName.Text = FrmMain.lstview.SelectedItem.Text
    
    MSFEntries.Row = 1
    MSFEntries.Col = 0
    picSoftLarge.Picture = FrmMain.ImgLarge.ListImages(FrmMain.lstview.SelectedItem.Icon).Picture
    
    ' EnumRegistryValuesEx will Enumerate the values of a registry key
    ' added as a array of matrix 3
    ' The items returned are delimeted by chr(1) and chr(0)
    Set coltemp = EnumRegistryValuesEx(HKEY_LOCAL_MACHINE, UnInstallPath & FrmMain.lstview.SelectedItem.Key)
    
    If coltemp.Count > 0 Then
        For i = 1 To coltemp.Count
            ' Retrieve the stored valu and data in array
            varArr = coltemp.Item(i)
            ' Add the item and description into the Grid
            AddItem Trim$(varArr(0)), Trim$(varArr(1))
        Next
    End If
    
    ' Since we have to keep the fixed rows > total no. of rows.
    ' So a blank line is introduced in the start. This should be removed.
    MSFEntries.RemoveItem 1
    If MSFEntries.ColWidth(1) < mlngColWidth Then
        MSFEntries.ColWidth(1) = mlngColWidth
    End If
End Sub

'=========================================================================
' AddItem:- Add a new entry into the MsFlexGrid
' Paramaters:-
' Heading: This is the first entry or column e.g UninstallString
' Description: This actually contains the acutal value
'=========================================================================
Private Sub AddItem(Heading As String, ByVal Desc As String)
On Error GoTo errHandle:
    
    ' Only icrement the row count if there is a new entry
    If MSFEntries.Rows >= 2 Then
        MSFEntries.Rows = MSFEntries.Rows + 1
    End If

    ' Put the Head part and Description into first and second column into
    ' the grid  respectively
    MSFEntries.Row = MSFEntries.Rows - 1
    MSFEntries.Col = 0
    MSFEntries.CellAlignment = 1
    MSFEntries.TextMatrix(MSFEntries.Rows - 1, 0) = Trim$(Heading)
    MSFEntries.Col = 1
    MSFEntries.CellAlignment = 1
    MSFEntries.TextMatrix(MSFEntries.Rows - 1, 1) = Trim$(Desc)
    If Me.TextWidth(Trim$(Desc)) > mlngColWidth Then
        mlngColWidth = Me.TextWidth(Trim$(Desc))
    End If
    Exit Sub
errHandle:
    MsgBox "Error occurred Edit Entry AddItem: " & vbCrLf & Err.Description, vbCritical, App.Title
End Sub

'=========================================================================
'To make the Grid Editable!
'=========================================================================
Private Sub MSFEntries_GotFocus()
    If txtEdit.Visible = False Then Exit Sub
    MSFEntries = txtEdit
    txtEdit.Visible = False
End Sub

Private Sub MSFEntries_LeaveCell()
    If txtEdit.Visible = False Then Exit Sub
    MSFEntries = txtEdit
    txtEdit.Visible = False
End Sub

Private Sub EditKeyCode(MSHFlexGrid As Control, Edt As Control, KeyCode As Integer, Shift As Integer)
   
    ' Standard edit control processing.
    Select Case KeyCode
        Case 27   ' ESC: hide, return focus to MSHFlexGrid.
            Edt.Visible = False
            MSHFlexGrid.SetFocus
        Case 13   ' ENTER return focus to MSHFlexGrid.
            MSHFlexGrid.SetFocus
        Case 38      ' Up.
            MSHFlexGrid.SetFocus
            DoEvents
            If MSHFlexGrid.Row > MSHFlexGrid.FixedRows Then
                MSHFlexGrid.Row = MSHFlexGrid.Row - 1
            End If
        Case 40      ' Down.
            MSHFlexGrid.SetFocus
            DoEvents
            If MSHFlexGrid.Row < MSHFlexGrid.Rows - 1 Then
                MSHFlexGrid.Row = MSHFlexGrid.Row + 1
            End If
    End Select
End Sub

Private Sub MSFEntries_KeyPress(KeyAscii As Integer)
    MSHFlexGridEdit MSFEntries, txtEdit, KeyAscii
End Sub

Private Sub MSFEntries_Click()
    MSHFlexGridEdit MSFEntries, txtEdit, 32 ' Simulate a space.
End Sub

Private Sub MSHFlexGridEdit(MSHFlexGrid As MSFlexGrid, Edt As TextBox, KeyAscii As Integer)
    Dim lngWidth As Long
   
    ' Use the character that was typed.
    Select Case KeyAscii
        ' A space means edit the current text.
        Case 0 To 32
            Edt = MSHFlexGrid
            Edt.SelStart = 0
        ' Anything else means replace the current text.
        Case Else
            Edt = Chr$(KeyAscii)
            Edt.SelStart = 1
    End Select
    
    If MSHFlexGrid.CellWidth > MSHFlexGrid.Width Then
        If MSFEntries.Rows > 5 Then
            lngWidth = MSHFlexGrid.Width - 275
        Else
            lngWidth = MSHFlexGrid.Width - 50
        End If
    Else
        lngWidth = MSHFlexGrid.CellWidth
    End If
    
    ' Show Edt at the right place.
    Edt.Move MSHFlexGrid.Left + MSHFlexGrid.CellLeft + 50, MSHFlexGrid.Top + MSHFlexGrid.CellTop + 10, lngWidth - 42, MSHFlexGrid.CellHeight - 8
    Edt.Visible = True
    
    ' And make it work.
    Edt.SetFocus
End Sub

Private Sub MSFEntries_Scroll()
    If txtEdit.Visible = True Then
        txtEdit.Text = ""
        txtEdit.Visible = False
    End If
End Sub

Private Sub txtEdit_KeyPress(KeyAscii As Integer)
    ' Delete returns to get rid of beep.
    If KeyAscii = Asc(vbCr) Then
        KeyAscii = 0
    End If
End Sub

Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
    EditKeyCode MSFEntries, txtEdit, KeyCode, Shift
End Sub

Private Sub txtEdit_LostFocus()
    MSFEntries_LeaveCell
End Sub