vbAccelerator - Contents of code file: frmShortCut.frm

VERSION 5.00
Begin VB.Form frmShortCutTest 
   Caption         =   "Shortcut Class Test Application"
   ClientHeight    =   4965
   ClientLeft      =   3255
   ClientTop       =   3135
   ClientWidth     =   6465
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmShortCut.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4965
   ScaleWidth      =   6465
   Begin VB.CommandButton cmdPickTarget 
      Caption         =   "..."
      Height          =   375
      Left            =   5940
      TabIndex        =   13
      ToolTipText     =   "Choose Target"
      Top             =   480
      Width           =   435
   End
   Begin VB.Frame fraIcon 
      Caption         =   "&Icon:"
      Height          =   2055
      Left            =   120
      TabIndex        =   7
      Top             =   2700
      Width           =   5775
      Begin VB.CommandButton cmdPickIcon 
         Caption         =   "&Pick..."
         Height          =   375
         Left            =   1200
         TabIndex        =   12
         ToolTipText     =   "Choose Icon"
         Top             =   1560
         Width           =   1155
      End
      Begin VB.TextBox txtIconIndex 
         Height          =   375
         Left            =   1200
         TabIndex        =   11
         Top             =   660
         Width           =   4395
      End
      Begin VB.TextBox txtIconFile 
         Height          =   375
         Left            =   1200
         TabIndex        =   9
         Top             =   240
         Width           =   4395
      End
      Begin VB.Label lblIconIndex 
         Caption         =   "Icon I&ndex"
         Height          =   315
         Left            =   60
         TabIndex        =   10
         Top             =   720
         Width           =   1095
      End
      Begin VB.Label lblIconFile 
         Caption         =   "Icon &File"
         Height          =   315
         Left            =   60
         TabIndex        =   8
         Top             =   300
         Width           =   1095
      End
   End
   Begin VB.TextBox txtDescription 
      Height          =   1215
      Left            =   1200
      MultiLine       =   -1  'True
      TabIndex        =   6
      Top             =   1320
      Width           =   4635
   End
   Begin VB.TextBox txtArguments 
      Height          =   375
      Left            =   1200
      TabIndex        =   4
      Top             =   900
      Width           =   4635
   End
   Begin VB.TextBox txtTarget 
      Height          =   375
      Left            =   1200
      TabIndex        =   2
      Top             =   480
      Width           =   4635
   End
   Begin VB.Label lblDescription 
      Caption         =   "&Description:"
      Height          =   315
      Left            =   60
      TabIndex        =   5
      Top             =   1380
      Width           =   1095
   End
   Begin VB.Label lblArguments 
      Caption         =   "&Arguments:"
      Height          =   315
      Left            =   60
      TabIndex        =   3
      Top             =   960
      Width           =   1095
   End
   Begin VB.Label lblTarget 
      Caption         =   "&Target:"
      Height          =   315
      Left            =   60
      TabIndex        =   1
      Top             =   540
      Width           =   1095
   End
   Begin VB.Label lblShortCut 
      BackColor       =   &H80000000&
      Caption         =   " "
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000014&
      Height          =   315
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   6315
   End
   Begin VB.Menu mnuFileTOP 
      Caption         =   "&File"
      Begin VB.Menu mnuFile 
         Caption         =   "&New..."
         Index           =   0
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuFile 
         Caption         =   "&Open..."
         Index           =   1
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuFile 
         Caption         =   "-"
         Index           =   2
      End
      Begin VB.Menu mnuFile 
         Caption         =   "&Save..."
         Index           =   3
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuFile 
         Caption         =   "-"
         Index           =   4
      End
      Begin VB.Menu mnuFile 
         Caption         =   "E&xit"
         Index           =   5
      End
   End
End
Attribute VB_Name = "frmShortCutTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_cShortcut As cShellLink

Private Sub newShortcut()
   Set m_cShortcut = New cShellLink
   txtTarget.Text = ""
   txtArguments.Text = ""
   txtDescription.Text = ""
   txtIconFile.Text = ""
   txtIconIndex.Text = ""
End Sub

Private Sub openShortcut()
   Dim c As New cCommonDialog
   Dim sFile As String
   
   If (c.VBGetOpenFileName( _
      sFile, _
      Filter:="Shortcuts (*.LNK)|*.LNK|All Files (*.*)|*.*", _
      FilterIndex:=1, _
      DefaultExt:="LNK", _
      Owner:=Me.hwnd)) Then
      
      Set m_cShortcut = New cShellLink
      m_cShortcut.Resolve sFile, , Me.hwnd
      
      txtTarget.Text = m_cShortcut.TargetFile
      txtArguments.Text = m_cShortcut.Arguments
      txtDescription.Text = m_cShortcut.Description
      
      txtIconFile.Text = m_cShortcut.IconFile
      txtIconIndex.Text = m_cShortcut.IconIndex
      
      lblShortCut.Caption = " " & sFile
      
   End If
End Sub

Private Sub saveShortcut()
   
   Dim c As New cCommonDialog
   Dim sFile As String
   
   If (c.VBGetSaveFileName( _
      sFile, _
      Filter:="Shortcuts (*.LNK)|*.LNK|All Files (*.*)|*.*", _
      FilterIndex:=1, _
      DefaultExt:="LNK", _
      Owner:=Me.hwnd)) Then
      
      m_cShortcut.TargetFile = txtTarget.Text
      m_cShortcut.Arguments = txtArguments.Text
      m_cShortcut.Description = txtDescription.Text
      m_cShortcut.IconFile = txtIconFile.Text
      On Error Resume Next
      m_cShortcut.IconIndex = txtIconIndex.Text
      
      On Error GoTo 0
      m_cShortcut.Save sFile
      
      lblShortCut.Caption = " " & sFile
      
   End If
   
End Sub

Private Sub cmdPickIcon_Click()
   Dim f As New frmPickIcon
   f.IconFile = txtIconFile.Text
   On Error Resume Next
   f.IconIndex = txtIconIndex.Text
   On Error GoTo 0
   f.Show vbModal, Me
   If Not (f.Cancelled) Then
      txtIconFile.Text = f.IconFile
      txtIconIndex.Text = f.IconIndex
   End If
End Sub

Private Sub cmdPickTarget_Click()
   Dim cBF As New cBrowseForFolder
   Dim sFile As String
   cBF.hWndOwner = Me.hwnd
   cBF.UseNewUI = True
   cBF.FileSystemOnly = True
   cBF.IncludeFiles = True
   sFile = cBF.BrowseForFolder
   If Len(sFile) > 0 Then
      txtTarget.Text = sFile
   End If
   
End Sub

Private Sub Form_Load()
   lblShortCut.Caption = " New Shortcut"
End Sub

Private Sub mnuFile_Click(Index As Integer)
   Select Case Index
   Case 0
      newShortcut
   Case 1
      openShortcut
   Case 3
      saveShortcut
   Case 5
      Unload Me
   End Select
End Sub