home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1999 April / CD_Shareware_Magazine_31.iso / Free / Prg / GetIcon.exe / Form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-07-07  |  11.8 KB  |  373 lines
  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
  4. Begin VB.Form Form1 
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "Extract Icons"
  7.    ClientHeight    =   4230
  8.    ClientLeft      =   5850
  9.    ClientTop       =   2400
  10.    ClientWidth     =   4380
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   4230
  15.    ScaleWidth      =   4380
  16.    Begin ComctlLib.Toolbar tbLarge 
  17.       Align           =   1  'Align Top
  18.       Height          =   420
  19.       Left            =   0
  20.       TabIndex        =   0
  21.       Top             =   0
  22.       Width           =   4380
  23.       _ExtentX        =   7726
  24.       _ExtentY        =   741
  25.       AllowCustomize  =   0   'False
  26.       Wrappable       =   0   'False
  27.       Appearance      =   1
  28.       ImageList       =   "imgLarge"
  29.       _Version        =   327682
  30.    End
  31.    Begin ComctlLib.Toolbar tbSmall 
  32.       Align           =   1  'Align Top
  33.       Height          =   420
  34.       Left            =   0
  35.       TabIndex        =   15
  36.       Top             =   420
  37.       Width           =   4380
  38.       _ExtentX        =   7726
  39.       _ExtentY        =   741
  40.       AllowCustomize  =   0   'False
  41.       Appearance      =   1
  42.       _Version        =   327682
  43.    End
  44.    Begin VB.CommandButton cmdBrowse 
  45.       Caption         =   "&Browse"
  46.       Height          =   375
  47.       Left            =   120
  48.       TabIndex        =   11
  49.       Top             =   3600
  50.       Width           =   735
  51.    End
  52.    Begin VB.Frame Frame2 
  53.       Caption         =   "Icons"
  54.       Height          =   2655
  55.       Left            =   1080
  56.       TabIndex        =   2
  57.       Top             =   1440
  58.       Width           =   2175
  59.       Begin VB.CommandButton cmdBack 
  60.          Caption         =   "Back"
  61.          Height          =   375
  62.          Left            =   240
  63.          TabIndex        =   6
  64.          Top             =   2160
  65.          Width           =   735
  66.       End
  67.       Begin VB.PictureBox picSmall 
  68.          BorderStyle     =   0  'None
  69.          Height          =   240
  70.          Left            =   1320
  71.          ScaleHeight     =   240
  72.          ScaleMode       =   0  'User
  73.          ScaleWidth      =   240
  74.          TabIndex        =   5
  75.          Top             =   1560
  76.          Width           =   240
  77.       End
  78.       Begin VB.PictureBox picLarge 
  79.          BorderStyle     =   0  'None
  80.          Height          =   495
  81.          Left            =   360
  82.          ScaleHeight     =   495
  83.          ScaleMode       =   0  'User
  84.          ScaleWidth      =   495
  85.          TabIndex        =   4
  86.          Top             =   1560
  87.          Width           =   495
  88.       End
  89.       Begin VB.CommandButton cmdNext 
  90.          Caption         =   "Next"
  91.          Height          =   375
  92.          Left            =   1200
  93.          TabIndex        =   3
  94.          Top             =   2160
  95.          Width           =   735
  96.       End
  97.       Begin VB.Label lblIcon 
  98.          BackStyle       =   0  'Transparent
  99.          Height          =   255
  100.          Left            =   1680
  101.          TabIndex        =   14
  102.          Top             =   720
  103.          Width           =   375
  104.       End
  105.       Begin VB.Label Label2 
  106.          Caption         =   "Current Icon Index:"
  107.          Height          =   255
  108.          Left            =   120
  109.          TabIndex        =   13
  110.          Top             =   720
  111.          Width           =   1455
  112.       End
  113.       Begin VB.Label lblIcons 
  114.          BackStyle       =   0  'Transparent
  115.          Height          =   255
  116.          Left            =   1680
  117.          TabIndex        =   10
  118.          Top             =   360
  119.          Width           =   375
  120.       End
  121.       Begin VB.Label Label1 
  122.          Alignment       =   1  'Right Justify
  123.          AutoSize        =   -1  'True
  124.          BackStyle       =   0  'Transparent
  125.          Caption         =   "Number of  Icons:"
  126.          Height          =   195
  127.          Left            =   120
  128.          TabIndex        =   9
  129.          Top             =   360
  130.          Width           =   1260
  131.       End
  132.       Begin VB.Label Label4 
  133.          Alignment       =   2  'Center
  134.          Caption         =   "Small"
  135.          Height          =   255
  136.          Left            =   1200
  137.          TabIndex        =   8
  138.          Top             =   1200
  139.          Width           =   615
  140.       End
  141.       Begin VB.Label Label3 
  142.          Alignment       =   2  'Center
  143.          Caption         =   "Large"
  144.          Height          =   255
  145.          Left            =   240
  146.          TabIndex        =   7
  147.          Top             =   1200
  148.          Width           =   615
  149.       End
  150.    End
  151.    Begin VB.CommandButton cmdQuit 
  152.       Caption         =   "&Quit"
  153.       Height          =   375
  154.       Left            =   3480
  155.       TabIndex        =   1
  156.       Top             =   3600
  157.       Width           =   735
  158.    End
  159.    Begin MSComDlg.CommonDialog cdlOpen 
  160.       Left            =   1440
  161.       Top             =   2520
  162.       _ExtentX        =   847
  163.       _ExtentY        =   847
  164.       _Version        =   327681
  165.       CancelError     =   -1  'True
  166.       FilterIndex     =   1
  167.    End
  168.    Begin ComctlLib.ImageList imgSmall 
  169.       Left            =   1320
  170.       Top             =   3240
  171.       _ExtentX        =   1005
  172.       _ExtentY        =   1005
  173.       BackColor       =   -2147483643
  174.       ImageWidth      =   16
  175.       ImageHeight     =   16
  176.       MaskColor       =   12632256
  177.       UseMaskColor    =   0   'False
  178.       _Version        =   327682
  179.    End
  180.    Begin VB.Label lblFile 
  181.       Alignment       =   2  'Center
  182.       Height          =   255
  183.       Left            =   120
  184.       TabIndex        =   12
  185.       Top             =   1080
  186.       Width           =   4095
  187.       WordWrap        =   -1  'True
  188.    End
  189.    Begin ComctlLib.ImageList imgLarge 
  190.       Left            =   1320
  191.       Top             =   3000
  192.       _ExtentX        =   1005
  193.       _ExtentY        =   1005
  194.       BackColor       =   -2147483643
  195.       ImageWidth      =   32
  196.       ImageHeight     =   32
  197.       MaskColor       =   12632256
  198.       UseMaskColor    =   0   'False
  199.       _Version        =   327682
  200.    End
  201. Attribute VB_Name = "Form1"
  202. Attribute VB_GlobalNameSpace = False
  203. Attribute VB_Creatable = False
  204. Attribute VB_PredeclaredId = True
  205. Attribute VB_Exposed = False
  206. Option Explicit
  207. ' This example demonstrates how to:
  208. '   Extract both large and small icons from executables and dll's.
  209. '   Draw them to a control with a device context handle (.hdc) such as a PictureBox.
  210. '   Draw them to a control without an .hdc property such as an ImageList.
  211. '   Dynamically populate both ImageList and ToolBar controls.
  212. Dim glLargeIcons() As Long
  213. Dim glSmallIcons() As Long
  214. Dim lIndex         As Long
  215. Dim lIcons         As Long
  216. Dim sExeName       As String
  217. Const LARGE_ICON As Integer = 32
  218. Const SMALL_ICON As Integer = 16
  219. Private Sub cmdBack_Click()
  220. ' Get the previous icon.
  221. If lIndex > 0 Then
  222.     lIndex = lIndex - 1
  223.     Call pGetIcon
  224. End If
  225. End Sub
  226. Private Sub cmdBrowse_Click()
  227. Dim btn    As Button
  228. Dim imgObj As ListImage
  229. ' Initialize labels. Clear the picture boxes.
  230. lIcons = 0
  231. lIndex = 0
  232. lblIcons = 0
  233. lblIcon = 0
  234. lblFile = ""
  235. picSmall.Picture = LoadPicture("")
  236. picLarge.Picture = LoadPicture("")
  237. ' Remove all toolbar buttons and the
  238. ' unbind the ImageList controls.
  239. tbLarge.Buttons.Clear
  240. tbLarge.ImageList = Nothing
  241. tbSmall.Buttons.Clear
  242. tbSmall.ImageList = Nothing
  243. ' Remove all images from the ImageList controls
  244. ' and set their size properties.
  245. With imgLarge
  246.     .ListImages.Clear
  247.     .ImageHeight = LARGE_ICON
  248.     .ImageWidth = LARGE_ICON
  249. End With
  250. With imgSmall
  251.     .ListImages.Clear
  252.     .ImageHeight = SMALL_ICON
  253.     .ImageWidth = SMALL_ICON
  254. End With
  255. ' Display the File Open dialog.
  256. ' Filter out all files except exe's and dll's.
  257. cdlOpen.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNHideReadOnly
  258. cdlOpen.filename = ""
  259. cdlOpen.Filter = "Executable Files (*.exe) | *.exe|Application Extension (*.dll) | *.dll"
  260. On Error GoTo CancelButton
  261. cdlOpen.Action = 1
  262. sExeName = cdlOpen.filename
  263. lblFile = sExeName
  264. ' Get the total number of Icons in the file.
  265. lIcons = ExtractIconEx(sExeName, -1, 0, 0, 0)
  266. ' Enable various controls.
  267. lblIcons = lIcons
  268. cmdBack.Enabled = (lIcons > 1)
  269. cmdNext.Enabled = (lIcons > 1)
  270. lblIcons.Enabled = True
  271. lblIcon.Enabled = True
  272. picSmall.Enabled = True
  273. picLarge.Enabled = True
  274. Label1.Enabled = True
  275. Label2.Enabled = True
  276. Label3.Enabled = True
  277. Label4.Enabled = True
  278. Frame2.Enabled = True
  279. ' Dimension the arrays to the number of icons.
  280. ' Get the icons' handles.
  281. ReDim glLargeIcons(lIcons)
  282. ReDim glSmallIcons(lIcons)
  283. Call pGetIcon
  284. ' Add the Large icon to the Large ImageList control.
  285. ' Bind the large ImageList to the large ToolBar.
  286. ' Add a button to the toolbar and populate its ToolTip text.
  287. ' Note: The "Key" fields of both the ImageList and ToolBar
  288. '       control are set to the same value.  This is what
  289. '       binds a particular image in the ImageList to a
  290. '       given button on the ToolBar control.
  291. '           Syntax is:    ...Add(Index, Key, Image)
  292. Set imgObj = imgLarge.ListImages.Add(1, sExeName, picLarge.Image)
  293. With tbLarge
  294.     .ImageList = imgLarge
  295.     ' Syntax is:    ...Add(Index, Key, Caption, Style, Image)
  296.     Set btn = .Buttons.Add(.Buttons.Count + 1, sExeName, , , sExeName)
  297.     .Buttons(1).ToolTipText = sExeName
  298. End With
  299. ' Repeat for the small icon.
  300. Set imgObj = imgSmall.ListImages.Add(1, sExeName, picSmall.Image)
  301. With tbSmall
  302.     .ImageList = imgSmall
  303.     Set btn = .Buttons.Add(.Buttons.Count + 1, sExeName, , , sExeName)
  304.     .Buttons(1).ToolTipText = sExeName
  305. End With
  306. CancelButton:
  307.     'We end up here when hitting Cancel on the Open File dialog.
  308. End Sub
  309. Private Sub cmdNext_Click()
  310. ' Get the next icon.
  311. If lIndex < lIcons - 1 Then
  312.     lIndex = lIndex + 1
  313.     Call pGetIcon
  314. End If
  315. End Sub
  316. Private Sub cmdQuit_Click()
  317. Unload Me
  318. End Sub
  319. Private Sub Form_Load()
  320. ' Disable various controls until a file is selected.
  321. lIndex = 0
  322. cmdBack.Enabled = False
  323. cmdNext.Enabled = False
  324. lblIcons.Enabled = False
  325. lblIcon.Enabled = False
  326. picSmall.Enabled = False
  327. picLarge.Enabled = False
  328. Label1.Enabled = False
  329. Label2.Enabled = False
  330. Label3.Enabled = False
  331. Label4.Enabled = False
  332. Frame2.Enabled = False
  333. ' Align the toolbars to the top of the form.
  334. With tbLarge
  335.     .Align = vbAlignTop
  336.     .AllowCustomize = False
  337.     .Wrappable = False
  338.     .BorderStyle = ccNone
  339. End With
  340. With tbSmall
  341.     .Align = vbAlignTop
  342.     .AllowCustomize = False
  343.     .Wrappable = False
  344.     .BorderStyle = ccNone
  345. End With
  346. ' Set the dimensions of the PictureBox controls where the
  347. ' icons will be drawn.  We will use 32x32 and 16x16 icons.
  348. ' Each size uses its own PictureBox.
  349. picLarge.Height = LARGE_ICON * Screen.TwipsPerPixelY
  350. picLarge.Width = LARGE_ICON * Screen.TwipsPerPixelX
  351. picSmall.Height = SMALL_ICON * Screen.TwipsPerPixelY
  352. picSmall.Width = SMALL_ICON * Screen.TwipsPerPixelX
  353. End Sub
  354. Public Sub pGetIcon()
  355. ' Get the handle of the icon indicated by lIndex.
  356. Call ExtractIconEx(sExeName, lIndex, glLargeIcons(lIndex), glSmallIcons(lIndex), 1)
  357. Dim l As Long
  358. ' Draw the icon to respective picturebox control.
  359. With picLarge
  360.     Set .Picture = LoadPicture("")
  361.     .AutoRedraw = True
  362.     Call DrawIconEx(.hdc, 0, 0, glLargeIcons(lIndex), LARGE_ICON, LARGE_ICON, 0, 0, DI_NORMAL)
  363.     .Refresh
  364. End With
  365. With picSmall
  366.     Set .Picture = LoadPicture("")
  367.     .AutoRedraw = True
  368.     Call DrawIconEx(.hdc, 0, 0, glSmallIcons(lIndex), SMALL_ICON, SMALL_ICON, 0, 0, DI_NORMAL)
  369.     .Refresh
  370. End With
  371. lblIcon = lIndex
  372. End Sub
  373.