home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.Form frmExtractIcon
- Caption = "Extracting a File's Associated Icons"
- ClientHeight = 2550
- ClientLeft = 60
- ClientTop = 345
- ClientWidth = 4785
- Icon = "frmExtractIcon.frx":0000
- LinkTopic = "Form1"
- ScaleHeight = 2550
- ScaleWidth = 4785
- StartUpPosition = 3 'Windows Default
- Begin VB.PictureBox picSmall
- Appearance = 0 'Flat
- AutoRedraw = -1 'True
- BorderStyle = 0 'None
- ForeColor = &H80000008&
- Height = 240
- Left = 4200
- ScaleHeight = 240
- ScaleWidth = 240
- TabIndex = 8
- Top = 120
- Width = 240
- End
- Begin VB.CommandButton cmdLoad
- Caption = "&Load Icons"
- Default = -1 'True
- Height = 375
- Left = 3480
- TabIndex = 1
- Top = 1440
- Width = 1215
- End
- Begin VB.TextBox txtFileName
- Height = 285
- Left = 480
- TabIndex = 0
- Text = "C:\Autoexec.bat"
- Top = 1080
- Width = 4215
- End
- Begin VB.PictureBox picLarge
- Appearance = 0 'Flat
- AutoRedraw = -1 'True
- BorderStyle = 0 'None
- ForeColor = &H80000008&
- Height = 480
- Left = 4200
- ScaleHeight = 480
- ScaleWidth = 480
- TabIndex = 6
- Top = 480
- Width = 480
- End
- Begin VB.Label Label5
- AutoSize = -1 'True
- Caption = "File:"
- Height = 195
- Left = 120
- TabIndex = 12
- Top = 1110
- Width = 285
- End
- Begin VB.Label Label6
- Alignment = 1 'Right Justify
- AutoSize = -1 'True
- Caption = "Written for the VB Center Code Library"
- BeginProperty Font
- Name = "Small Fonts"
- Size = 6.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 165
- Left = 2340
- TabIndex = 11
- Top = 2040
- Width = 2355
- End
- Begin VB.Label Label7
- Alignment = 1 'Right Justify
- AutoSize = -1 'True
- Caption = "http://www.geocities.com/SiliconValley/Way/6445"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H00800000&
- Height = 195
- Left = 360
- TabIndex = 10
- Top = 2280
- Width = 4365
- End
- Begin VB.Label Label4
- AutoSize = -1 'True
- Caption = "32x32:"
- Height = 195
- Left = 3600
- TabIndex = 9
- Top = 480
- Width = 480
- End
- Begin VB.Label Label3
- AutoSize = -1 'True
- Caption = "16x16:"
- Height = 195
- Left = 3600
- TabIndex = 7
- Top = 120
- Width = 480
- End
- Begin VB.Label Label2
- AutoSize = -1 'True
- Caption = "Type:"
- Height = 195
- Left = 120
- TabIndex = 5
- Top = 480
- Width = 405
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "Name:"
- Height = 195
- Left = 120
- TabIndex = 4
- Top = 120
- Width = 465
- End
- Begin VB.Label lblFileType
- AutoSize = -1 'True
- Caption = "MS-DOS Batch File"
- Height = 195
- Left = 720
- TabIndex = 3
- Top = 480
- Width = 1380
- End
- Begin VB.Label lblFileName
- AutoSize = -1 'True
- Caption = "Autoexec"
- Height = 195
- Left = 720
- TabIndex = 2
- Top = 120
- Width = 675
- End
- Attribute VB_Name = "frmExtractIcon"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Private Sub cmdLoad_Click()
- Dim hImgSmall As Long ' The handle to the system image list
- Dim FileName As String ' The file name to get icon from
- Dim r As Long
- FileName$ = txtFileName.Text
- ' Get the system icons associated with the file
- hImgSmall& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), _
- BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
- hImgLarge& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), _
- BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
- ' Fill in the labels with the image's file data
- lblFileName.Caption = Left$(shinfo.szDisplayName, _
- InStr(shinfo.szDisplayName, Chr$(0)) - 1)
- lblFileType.Caption = Left$(shinfo.szTypeName, _
- InStr(shinfo.szTypeName, Chr$(0)) - 1)
- ' Set the pictureboxes to receive the icons.
- picSmall.Picture = LoadPicture()
- picLarge.Picture = LoadPicture()
- ' Draw the associated icons into the picture boxes
- r& = ImageList_Draw(hImgSmall&, shinfo.iIcon, picSmall.hDC, 0, 0, ILD_TRANSPARENT)
- r& = ImageList_Draw(hImgLarge&, shinfo.iIcon, picLarge.hDC, 0, 0, ILD_TRANSPARENT)
- End Sub
- Private Sub Form_Load()
- cmdLoad_Click
- End Sub
-