Extract Icon

Category: Icons

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
 
Global hDlg,hIcon,hLst As Dword
Global ResourceName, ExeName As String, imgW,imgH As Long
%IDC_GraphicL = 300
%IDC_GraphicS = 301
%IDC_ExtractLarge = 302
%IDC_Select = 303
%IDC_TextBox = 304
%IDC_Label = 305
%IDC_ExtractBoth = 306
%IDC_ExtractSmall = 307
 
Function PBMain() As Long
   ExeName = EXE.Path$ + "gblaunch.exe"
   Dialog New Pixels, 0, "Icon Extractor",300,300,510,220, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %IDC_Select, "Select File", 10,10,80,25
   Control Add Button, hDlg, %IDC_ExtractLarge, "Extract Large Icon", 100,10,120,25
   Control Add Button, hDlg, %IDC_ExtractSmall, "Extract Small Icon", 240,10,120,25
   Control Add Button, hDlg, %IDC_ExtractBoth, "Extract Both Icons", 380,10,120,25
   Control Add TextBox, hDlg, %IDC_TextBox, "gblaunch.exe",10,45,480,20
   Control Add Label, hDlg, %IDC_Label, "<icon info>",150,75,340,20,%SS_Left,%WS_Ex_ClientEdge
   Control Add Graphic, hDlg, %IDC_GraphicL,"", 10,75,128,128, %WS_Visible Or %WS_Border    'w,h will change once resources are read
   Control Add Graphic, hDlg, %IDC_GraphicS,"", 150,110,64,64, %WS_Visible Or %WS_Border    'w,h will change once resources are read
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_Select
               ExeName = SelectFile
               Control Set Text hDlg, %IDC_TextBox, ExeName
            Case %IDC_ExtractLarge
               DisplaySystemLargeIcon
            Case %IDC_ExtractSmall
               DisplaySystemSmallIcon
            Case %IDC_ExtractBoth
               DisplaySystemBothIcons
         End Select
   End Select
End Function
 
Function SelectFile() As String
   Local title$, startfolder$, filter$, startfile$, defaultext$, flags&, filevar$, countvar&
   title$ = "Select Applicaton" : filter$ = "EXE" + $Nul + "*.exe" + $Nul
   startfolder$ = ExeName : startfile$ = ExeName : defaultext$ = ""
   flags& = %OFN_Explorer Or %OFN_FileMustExist Or %OFN_HideReadOnly
   Display Openfile hDlg, 100, 100, title$, startfolder$, filter$, startfile$, defaultext$, flags& To filevar$, countvar&
   If Len(filevar$) Then Function = filevar$ Else Function = ExeName
End Function
 
Sub DisplaySystemLargeIcon
   'get icon handle
   Control Get Text hDlg, %IDC_TextBox To ExeName
   If InStr(ExeName,"\") = 0 Then ExeName = EXE.Path$ + ExeName
   hIcon = ExtractIcon(GetModuleHandle(""),(ExeName),0)
   '0     - first icon in specified file
   '-1    - for EXE/DLL, is # of RT_GROUP_ICON resources
   '      - for ICO, is 1
   '-300  - icon whose index is absolute value of the negative number (execpt for -1)
   'get icon size
   Local P As IconInfo
   GetIconInfo hIcon,P
   imgW = P.xHotSpot*2
   imgH = P.yHotSpot*2
   'create imagelist
   ImageList New Icon imgW,imgH,24,1 To hLst
   ImageList Add Icon hLst, hIcon
   'display image in graphic control
   Graphic Attach hDlg, %IDC_GraphicS : Graphic Clear
   Graphic Attach hDlg, %IDC_GraphicL : Graphic Clear
   Graphic ImageList (0,0),hLst,1,0,%ILD_Normal
   'clean up
   Control Set Text hDlg, %IDC_Label, Str$(imgW) +" x "+ Str$(imgH)
   ImageList Kill hLst : DestroyIcon hIcon
End Sub
 
Sub DisplaySystemBothIcons
   Dim L(0) As Dword,S(0) As Dword
   Local imgWL,imgHL,imgWS,imgHS As Long, hLstL,hLstS As Dword
 
   'icon dimensions
   imgWL = GetSystemMetrics(%SM_cxIcon)   'system large
   imgHL = GetSystemMetrics(%SM_cyIcon)   'system large
   imgWS = GetSystemMetrics(%SM_cxsmIcon) 'system small
   imgHS = GetSystemMetrics(%SM_cysmIcon) 'system small
 
   'get icon handles in array L(), S()
   Control Get Text hDlg, %IDC_TextBox To ExeName
   If InStr(ExeName,"\") = 0 Then ExeName = EXE.Path$ + ExeName
   hIcon = ExtractIconEx((ExeName),0,L(0),S(0),1)
   'create Large/Small imagelist with one icon in each
   ImageList New Icon imgWL,imgHL,24,1 To hLstL
   ImageList Add Icon hLstL, L(0)
   ImageList New Icon imgWS,imgHS,24,1 To hLstS
   ImageList Add Icon hLstS, S(0)
 
   'display image in graphic control
   Graphic Attach hDlg, %IDC_GraphicL : Graphic Clear
   Graphic ImageList (0,0),hLstL,1,0,%ILD_Normal
   Graphic Attach hDlg, %IDC_GraphicS : Graphic Clear
   Graphic ImageList (0,0),hLstS,1,0,%ILD_Normal
 
   'clean up
   Control Set Text hDlg, %IDC_Label, Str$(imgWL) +" x "+ Str$(imgHL) + "        " + Str$(imgWS) +" x "+ Str$(imgHS)
End Sub
 
Sub DisplaySystemSmallIcon
   Dim L(0) As Dword,S(0) As Dword
   Local imgWS,imgHS As Long, hLstS As Dword
 
   'icon dimensions
   imgWS = GetSystemMetrics(%SM_cxsmIcon) 'system small
   imgHS = GetSystemMetrics(%SM_cysmIcon) 'system small
 
   'get icon handles in array L(), S()
   Control Get Text hDlg, %IDC_TextBox To ExeName
   If InStr(ExeName,"\") = 0 Then ExeName = EXE.Path$ + ExeName
   hIcon = ExtractIconEx((ExeName),0,L(0),S(0),1)
 
   'create Large/Small imagelist with one icon in each
   ImageList New Icon imgWS,imgHS,24,1 To hLstS
   ImageList Add Icon hLstS, S(0)
 
   'display image in graphic control
   Graphic Attach hDlg, %IDC_GraphicL : Graphic Clear
   Graphic Attach hDlg, %IDC_GraphicS : Graphic Clear
   Graphic ImageList (0,0),hLstS,1,0,%ILD_Normal
 
   'clean up
   Control Set Text hDlg, %IDC_Label, Str$(imgWS) +" x "+ Str$(imgHS)
End Sub
 
'gbs_00884
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm