Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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
http://www.garybeene.com/sw/gbsnippets.htm