tshortcut.frm

The code for this article was written for version 1.0 of the Active Template Library (ATL). The cu

VERSION 5.00
Begin VB.Form FTestShortcuts 
   Caption         =   "Test Shortcuts"
   ClientHeight    =   5364
   ClientLeft      =   1848
   ClientTop       =   3048
   ClientWidth     =   5988
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5364
   ScaleWidth      =   5988
   Begin VB.CommandButton cmdNew 
      Caption         =   "Save New"
      Height          =   495
      Left            =   120
      TabIndex        =   20
      Top             =   840
      Width           =   1575
   End
   Begin VB.CommandButton cmdFill 
      Caption         =   "Fill"
      Height          =   375
      Left            =   4920
      TabIndex        =   19
      Top             =   4080
      Width           =   855
   End
   Begin VB.TextBox txtPath 
      Height          =   375
      Left            =   1800
      TabIndex        =   17
      Top             =   2640
      Width           =   3975
   End
   Begin VB.CheckBox chkResolve 
      Caption         =   "Resolve mode"
      Height          =   375
      Left            =   120
      TabIndex        =   16
      Top             =   2040
      Width           =   1455
   End
   Begin VB.TextBox txtArguments 
      Height          =   375
      Left            =   1800
      TabIndex        =   15
      Top             =   4800
      Width           =   3975
   End
   Begin VB.ListBox lstDisplay 
      Height          =   624
      ItemData        =   "TShortcut.frx":0000
      Left            =   120
      List            =   "TShortcut.frx":000D
      TabIndex        =   13
      Top             =   3600
      Width           =   1455
   End
   Begin VB.ListBox lstLocation 
      Height          =   624
      ItemData        =   "TShortcut.frx":0036
      Left            =   120
      List            =   "TShortcut.frx":0043
      TabIndex        =   12
      Top             =   2640
      Width           =   1455
   End
   Begin VB.Frame fmTarget 
      Caption         =   "Target File"
      Height          =   2175
      Left            =   1800
      TabIndex        =   7
      Top             =   120
      Width           =   3975
      Begin VB.DriveListBox drvLink 
         Height          =   288
         Left            =   240
         TabIndex        =   10
         Top             =   348
         Width           =   1575
      End
      Begin VB.DirListBox dirLink 
         Height          =   1155
         Left            =   240
         TabIndex        =   9
         Top             =   840
         Width           =   1575
      End
      Begin VB.FileListBox fileLink 
         Height          =   1608
         Left            =   1920
         TabIndex        =   8
         Top             =   360
         Width           =   1815
      End
   End
   Begin VB.CommandButton cmdRefresh 
      Caption         =   "Refresh"
      Height          =   495
      Left            =   120
      TabIndex        =   5
      Top             =   1440
      Width           =   1575
   End
   Begin VB.TextBox txtDirectory 
      Height          =   375
      Left            =   1800
      TabIndex        =   2
      Top             =   4080
      Width           =   3015
   End
   Begin VB.TextBox txtLink 
      Height          =   375
      Left            =   1800
      TabIndex        =   1
      Top             =   3360
      Width           =   3975
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "Save"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   1575
   End
   Begin VB.Label lbl 
      Caption         =   "Target path:"
      Height          =   255
      Index           =   6
      Left            =   1800
      TabIndex        =   18
      Top             =   2400
      Width           =   1335
   End
   Begin VB.Label lbl 
      Caption         =   "Arguments:"
      Height          =   255
      Index           =   4
      Left            =   1800
      TabIndex        =   14
      Top             =   4560
      Width           =   1335
   End
   Begin VB.Label lbl 
      Caption         =   "Set location:"
      Height          =   255
      Index           =   3
      Left            =   120
      TabIndex        =   11
      Top             =   2400
      Width           =   1215
   End
   Begin VB.Label lbl 
      Caption         =   "Show command:"
      Height          =   255
      Index           =   2
      Left            =   120
      TabIndex        =   6
      Top             =   3360
      Width           =   1335
   End
   Begin VB.Label lbl 
      Caption         =   "Link file: "
      Height          =   255
      Index           =   1
      Left            =   1800
      TabIndex        =   4
      Top             =   3120
      Width           =   1215
   End
   Begin VB.Label lbl 
      Caption         =   "Working Directory:"
      Height          =   255
      Index           =   0
      Left            =   1800
      TabIndex        =   3
      Top             =   3840
      Width           =   1815
   End
End
Attribute VB_Name = "FTestShortcuts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private shortcut As CShortCut
Private sInitDir As String
Private sFilePath As String     ' d:\path\
Private sFileName As String     ' base.ext
Private aDisplay(0 To 2) As Long

Private Sub cmdFill_Click()
    txtDirectory = sFilePath
End Sub

Private Sub cmdNew_Click()
    Set shortcut = Nothing
    Set shortcut = New CShortCut
    cmdSave_Click
End Sub

Private Sub Form_Load()
    Set shortcut = New CShortCut
    ChDir App.Path
    aDisplay(0) = eswNormal
    aDisplay(1) = eswMinimized
    aDisplay(2) = eswMaximized
    dirLink.Path = Environ("windir")
    fileLink_PathChange
    fileLink_Click
    lstLocation.ListIndex = edstDesktop
    lstDisplay.ListIndex = eswNormal - 1
End Sub

Private Sub chkResolve_Click()
    If chkResolve Then
        fileLink.Pattern = "*.LNK"
        cmdSave.Caption = "&Resolve"
    Else
        fileLink.Pattern = "*.*"
        cmdSave.Caption = "&Save"
    End If
End Sub

Private Sub cmdSave_Click()
    If chkResolve Then
        txtPath = shortcut.Resolve(hWnd, txtLink)
        chkResolve = vbUnchecked
    Else
        With shortcut
            .Path = txtPath
            .Location = lstLocation.ListIndex
            '.Location = txtLink
            If txtDirectory <> "" Then .WorkingDirectory = txtDirectory
            If txtArguments <> "" Then .Arguments = txtArguments
            .ShowCommand = aDisplay(lstDisplay.ListIndex)
            .Save True
        End With
    End If
    cmdRefresh_Click
End Sub

Private Sub cmdRefresh_Click()
    With shortcut
        txtPath = .Path
        txtDirectory = .WorkingDirectory
        txtLink = .Location
        txtArguments = .Arguments
        Select Case .ShowCommand
        Case eswNormal
            lstDisplay.ListIndex = 0
        Case eswMinimized
            lstDisplay.ListIndex = 1
        Case eswMaximized
            lstDisplay.ListIndex = 2
        End Select
    End With
End Sub

Private Sub dirLink_Change()
    fileLink.Path = dirLink.Path
    If fileLink.ListCount > 0 Then
        fileLink.ListIndex = 0
    End If
    txtPath = sFilePath & sFileName
End Sub

Private Sub drvLink_Change()
    dirLink.Path = drvLink.Drive
    txtPath = sFilePath & sFileName
End Sub

Private Sub fileLink_PathChange()
    sFilePath = NormalizePath(fileLink.Path)
    If fileLink.ListCount > 0 Then fileLink.ListIndex = 0
    txtPath = sFilePath & sFileName
    shortcut.Path = txtPath
End Sub

Private Sub fileLink_Click()
    sFileName = fileLink.filename
    If chkResolve Then
        txtLink = sFilePath & sFileName
        txtPath = ""
    Else
        txtPath = sFilePath & sFileName
        shortcut.Path = txtPath
        shortcut.Location = lstLocation.ListIndex
        txtLink = shortcut.Location
    End If
End Sub

Private Sub fileLink_PatternChange()
    If fileLink.ListCount > 0 Then
        fileLink.ListIndex = 0
    End If
    txtPath = sFilePath & sFileName
End Sub

Function NormalizePath(sPath As String) As String
    NormalizePath = sPath
    If Right$(sPath, 1) <> "\" Then NormalizePath = sPath & "\"
End Function

Private Sub lstDisplay_Click()
    shortcut.ShowCommand = aDisplay(lstDisplay.ListIndex)
End Sub

Private Sub lstLocation_Click()
    shortcut.Location = lstLocation.ListIndex
    txtLink = shortcut.Location
End Sub

Private Sub txtArguments_Change()
    shortcut.Arguments = txtArguments
End Sub

Private Sub txtDirectory_LostFocus()
    shortcut.WorkingDirectory = txtDirectory
End Sub

Private Sub txtLink_LostFocus()
    shortcut.Location = txtLink
End Sub