'=========================================================================== ' Subject: EXTRACT ICONS FROM DLL/EXE Date: 12-17-98 (17:52) ' Author: David Szafranski Code: LB ' Origin: digital_paris@csi.com Packet: LIBERTY.ABC '=========================================================================== ' IconOBlast 1.1 ' This example shows how to extract icons from .dll and .exe files using the ' ExtractIcon API call. It also builds a menu bar by copying icons to a top ' menu bar and then draws an enhanced recessed or raised 3-D box around each icon. ' The routine also demonstrates how to swap ' icons to achieve a pushbutton effect. It includes a seach routine to find ' all of the *.dll or *.exe files from a selected drive. This example can be used ' to create button bars. Just use a screencapture program to save a bmp of each button. ' Then use loadbmp for all the buttons. Then just swap images using drawbmp to achieve the ' pushbutton effect. Free free to use/modify/improve in any manner! ' Use left mouse click in icon area to select and copy icons to menu bar. ' Use left mouse click on top row of menu icons to get pushbutton effect. ' Use right mouse click on top row of menu icons to erase icon from menu bar. ' Use right mouse click in icon area to replace a previously deleted icon from the menu bar. WindowWidth = 554 WindowHeight = 590 UpperLeftX = int((DisplayWidth - WindowWidth) / 2) UpperLeftY = int((DisplayHeight - WindowHeight) / 2) dim files$(10,10) 'dim for files statement dim list$(2000) 'list of all files fitting search - change value as necessary dim dirs1$(500) 'copy of previous list of subdirectories to be searched dim dirs2$(500) 'list of subdirectories to be searched dim iconsRemoved(14) 'array for storing icons removed, icon number, position removeCount = 0 'counter for storing number of icons removed nomainwin graphicbox #main.bar, 0,0, 546, 80 menu #main, "&File", "&Exit!", [quit] menu #main, "&Select Drive", "&a:\", [drvA], "&c:\", [drvC], "&d:\", [drvD], "&e:\", [drvE] menu #main, "&Choose a File", "&Choose File!", [extract] menu #main, "Find &All Icons", "Search *.&dll's!", [dlls], "Search *.&exe's!", [exes] menu #main, "&Help", "&Help!", [help], "&About", [about] open "Icon-O-Blast!" for graphics_nsb as #main print #main, "trapclose [quit]" open "user.dll" for dll as #user Handle=hwnd(#main) open "shell" for dll as #shell ' set up drive menu checkboxes Menu.graphics = 1 '1 = GRAPHICS window, 0 = Other 'init variables for drive menu check Menu.hWnd = hwnd(#main) Gosub [Menu.Init] Menu.MenuItem = 1 Menu.SubMenuItem = 1 Menu.FirstSubMenuItem = 0 Menu.LastSubMenuItem = 3 gosub [Menu.RadioButton] 'set c:\ as default drive initDrv$ = "c:\" 'starting search path drvs$ = Drives$ 'get list of currently available drives data$ = drvs$ 'create drive array drv$() for checking available drives count = 1 while data$ <> "" length = len(data$) x = instr(data$, " ") if x = 0 then drv$(count) = trim$(data$) : data$ = "" : goto [finish1] drv$(count) = left$(data$, x-1) data$ = right$(data$,length-x) count = count + 1 [finish1] wend adrv=0 : cdrv=0 : ddrv=0 : edrv=0 for i = 1 to count 'compare actual drives available to those listed in menu if drv$(i) = "a:" then adrv=1 if drv$(i) = "c:" then cdrv=1 if drv$(i) = "d:" then ddrv=1 if drv$(i) = "e:" then edrv=1 next i ' if drive is not available, then gray out/disable drive if adrv = 0 then Menu.MenuItem = 1 : Menu.SubMenuItem = 0 : Menu.Enabled = 1 : gosub [Menu.Disable] if cdrv = 0 then Menu.MenuItem = 1 : Menu.SubMenuItem = 1 : Menu.Enabled = 1 : gosub [Menu.Disable] if ddrv = 0 then Menu.MenuItem = 1 : Menu.SubMenuItem = 2 : Menu.Enabled = 1 : gosub [Menu.Disable] if edrv = 0 then Menu.MenuItem = 1 : Menu.SubMenuItem = 3 : Menu.Enabled = 1 : gosub [Menu.Disable] ' functions to control mouse actions print #main, "when leftButtonDown [selectIcon]" 'select icon to place into status bar print #main.bar, "when leftButtonDown [iconButtonDown]" 'swap icon buttons print #main.bar, "when leftButtonUp [iconButtonUp]" 'restore original button icon print #main.bar, "when rightButtonDown [removeIcon]" 'remove icon print #main, "when rightButtonDown [replaceIcon]" 'replace missing/removed icons print #main.bar, "fill lightgray; flush" gosub [initVar] 'initiate all variables leftClickCount=0 [mainLoop] input aVar$ goto [mainLoop] [drvA] Menu.MenuItem = 1 Menu.SubMenuItem = 0 Menu.FirstSubMenuItem = 0 Menu.LastSubMenuItem = 3 gosub [Menu.RadioButton] initDrv$ = "a:\" 'starting search path goto [mainLoop] [drvC] Menu.MenuItem = 1 Menu.SubMenuItem = 1 Menu.FirstSubMenuItem = 0 Menu.LastSubMenuItem = 3 gosub [Menu.RadioButton] initDrv$ = "c:\" 'starting search path goto [mainLoop] [drvD] Menu.MenuItem = 1 Menu.SubMenuItem = 2 Menu.FirstSubMenuItem = 0 Menu.LastSubMenuItem = 3 gosub [Menu.RadioButton] initDrv$ = "d:\" 'starting search path goto [mainLoop] [drvE] Menu.MenuItem = 1 Menu.SubMenuItem = 3 Menu.FirstSubMenuItem = 0 Menu.LastSubMenuItem = 3 gosub [Menu.RadioButton] initDrv$ = "e:\" 'starting search path goto [mainLoop] [selectIcon] 'select an icon and post to top status bar if leftClickCount = 14 then [mainLoop] 'max no of icons in bar is 14 xM = MouseX yM = MouseY+16 iconx = int(xM/iconSize) 'each icon is 32 wide icony = int(yM/iconSize) xstart = iconx*iconSize 'copy icon to status bar print #main, "getbmp Icon "; xstart; " "; (icony*iconSize)-16; " "; iconSize; " "; iconSize print #main.bar, "drawbmp Icon "; leftClickCount*36+10; " "; 4 print #main.bar, "drawbmp Icon "; leftClickCount*36+10; " "; 42 print #main.bar, "flush" x= leftClickCount*36+9 'draw raised3D status box for top row of icons y = 3 boxWidth = iconSize+2 boxHeight = iconSize+2 gosub [raised3DBox] x= leftClickCount*36+9 'draw recessed3D status box for bottom row of icons y = 41 boxWidth = iconSize+2 boxHeight = iconSize+2 gosub [recessed3DBox] leftClickCount = leftClickCount+1 goto [mainLoop] [iconButtonDown] 'swap bottom button with top button if leftClickCount = 0 then goto [mainLoop] xMBar = MouseX 'find out where mouse is yMBar = MouseY if yMBar < 2 or yMBar > 38 then goto [mainLoop] 'if mouseclick out of first row of icons then exit if xMBar < 8 or xMBar > 512 then goto [mainLoop] iconNum = int((xMBar-8) / 36) 'determine icon number xbutton = iconNum*36 + 8 'starting position of selected button print #main.bar, "getbmp topIcon "; xbutton; " "; 2; " "; 36; " "; 36 'get top icon print #main.bar, "getbmp bottomIcon "; xbutton; " "; 40; " "; 36; " "; 36 'get bottom icon print #main.bar, "drawbmp bottomIcon "; xbutton; " "; 2; " "; 36; " "; 36 'copy bottom icon to top goto [mainLoop] [iconButtonUp] if leftClickCount = 0 then goto [mainLoop] if yMBar < 2 or yMBar > 38 then goto [mainLoop] 'if mouseclick out of range then exit if xMBar < 8 or xMBar > 512 then goto [mainLoop] print #main.bar, "drawbmp topIcon "; xbutton; " "; 2; " "; 36; " "; 36 'redraw original top icon goto [mainLoop] [removeIcon] xMBar = MouseX 'find out where mouse is yMBar = MouseY if leftClickCount = 0 then goto [mainLoop] removeCount = removeCount + 1 'count number of icons removed if yMBar < 2 or yMBar > 38 then goto [mainLoop] 'if mouseclick out of range then exit if xMBar < 8 or xMBar > 512 then goto [mainLoop] iconRem = int((xMBar-8) / 36) 'determine icon number to be removed remButton = iconRem*36 + 8 'x starting position of selected button iconsRemoved(removeCount-1) = iconRem 'store icon number removed print #main.bar, "backcolor lightgray; color lightgray" 'draw a box to cover selected icons print #main.bar, "place "; remButton; " "; 2 print #main.bar, "boxfilled "; remButton+36; " "; 38 print #main.bar, "place "; remButton; " "; 40 print #main.bar, "boxfilled "; remButton+36; " "; 76 print #main.bar, "flush" goto [mainLoop] [replaceIcon] if removeCount = 0 then goto [mainLoop] xM = MouseX yM = MouseY+16 iconx = int(xM/iconSize) 'each icon is 32 wide icony = int(yM/iconSize) xstart = iconx*iconSize 'copy icon to status bar print #main, "getbmp Icon "; xstart; " "; (icony*iconSize)-16; " "; iconSize; " "; iconSize print #main.bar, "drawbmp Icon "; iconsRemoved(removeCount-1)*36+10; " "; 4 print #main.bar, "drawbmp Icon "; iconsRemoved(removeCount-1)*36+10; " "; 42 print #main.bar, "flush" x= iconsRemoved(removeCount-1)*36+9 'draw raised3D status box for top row of icons y = 3 boxWidth = iconSize+2 boxHeight = iconSize+2 gosub [raised3DBox] x= iconsRemoved(removeCount-1)*36+9 'draw recessed3D status box for bottom row of icons y = 41 boxWidth = iconSize+2 boxHeight = iconSize+2 gosub [recessed3DBox] removeCount = removeCount -1 goto [mainLoop] [extract] if iconNo > 238 then confirm "Window is Full! Begin Another?"; answer$ : _ if answer$ = "no" then [mainLoop] : gosub [initVar] Filedialog "Please select an exe\ico\dll file", "*.*", szFile$ test$ = lower$(right$(szFile$,4)) if test$ <> ".exe" and test$ <> ".dll" and test$ <> ".ico" _ then notice "Choose another file!" : goto [mainLoop] if szFile$ = "" then goto[mainLoop] szFile$=szFile$+chr$(0) gosub [extractIcons] goto [mainLoop] [dlls] 'search for all *.dlls on selected drive and then search each file for icons searchExt$ = "*.dll" 'type of file to search for gosub [search] 'get list of *.dll files in list$() exit = 0 'flag to get out of extraction loop - see sub [full] for i = 1 to totalFound szFile$ = list$(i) + chr$(0) gosub [extractIcons] if exit = 1 then i = totalFound next i goto [mainLoop] [exes] 'search for all *.dlls on selected drive and then search each file for icons searchExt$ = "*.exe" 'type of file to search for gosub [search] 'get list of *.exe files in list$() exit = 0 'flag to get out of extraction loop - see sub [full] for i = 1 to totalFound szFile$ = list$(i) + chr$(0) gosub [extractIcons] if exit = 1 then i = totalFound next i goto [mainLoop] [help] message$ = "1. Use left mouse click in icon area to select and copy icons to menu bar." + chr$(13)+ _ "2. Use left mouse click on top row of menu icons to get pushbutton effect." + chr$(13)+ _ "3. Use right mouse click on top row of menu icons to erase icon from menu bar." + chr$(13)+ _ "4. Use right mouse click in icon area to replace a previously deleted menu bar icon." title$ = "Icon-O-Blast 1.0" h=hwnd(#main) wtype = 4160 calldll #user, "Messagebox", _ h as word, _ message$ as ptr, _ title$ as ptr, _ wtype as word, _ RESULT as short input r$ goto [mainLoop] [about] message$ = "Icon-O-Blast 1.0" + chr$(13)+ _ "David Szafranski" + chr$(13)+ _ "73642.3326@compuserve.com" title$ = "Icon-O-Blast 1.0" h=hwnd(#main) wtype = 4160 calldll #user, "Messagebox", _ h as word, _ message$ as ptr, _ title$ as ptr, _ wtype as word, _ RESULT as short input r$ goto [mainLoop] [quit] calldll #user, "ReleaseDC", Handle as word, hdc as word, Ret as ushort close #shell close #user close #main end '=====START OF SUBROUTINES======================= [extractIcons] Calldll #user, "GetDC", Handle as word, hdc as word calldll #user, "GetWindowWord", Handle as word, _GWL_HINSTANCE as word, hCurrentInst as word hicon = 2 IndexNo = 1 iconsPerFile = 0 while hicon > 1 if iconNo > row*iconsPerRow and iconNo < row*iconsPerRow+iconsPerRow+1 then _ x=iconSize * (iconNo -1 - row*iconsPerRow) : y= (row * iconSize) + drop calldll #shell, "ExtractIcon", hCurrentInst as word, szFile$ as ptr, IndexNo as ushort, hicon as word calldll #user, "DrawIcon", hdc as short, x as short, y as short, hicon as word, Ret as short if hicon > 1 then gosub [flushIcon] if hicon > 1 then IndexNo = IndexNo +1 if hicon > 1 then iconNo = iconNo + 1 if hicon > 1 then count = count + 1 if hicon > 1 and count > iconsPerRow then count = 1 : row = row + 1 if iconNo > 238 then gosub [full] if hicon > 1 then iconsPerFile = iconsPerFile + 1 ' if hicon = 0 and iconsPerFile = 0 then notice "No Icons in this file!" wend return [flushIcon] print #main, "getbmp Icon "; x; " "; y; " "; iconSize; " "; iconSize print #main, "drawbmp Icon "; x; " "; y print #main, "flush" return [initVar] 'initiate variables print #main, "fill white; flush" count = 1 'count icons in each row gbox = 544 'width of area to print icons iconNo = 1 'count of total no of icons row = 0 'row count iconSize = 32 'size of icons iconsPerRow = gbox/iconSize 'no of icons per row drop = 80 'y value of place to start printing icons return [full] confirm "Window is Full! Begin Another?"; answer$ if answer$ = "yes" then gosub [initVar] else hicon = 0 : exit = 1 return [raised3DBox] ' x is the x position to start drawing box ' y is the y position to start drawing box ' boxWidth is the desired box width ' boxHeight is the desired box height ' x is the x position to start drawing box ' y is the y position to start drawing box ' boxWidth is the desired box width ' boxHeight is the desired box height print #main.bar, "color white ; down" print #main.bar, "place "; x; " "; y print #main.bar, "line "; x; " "; y; " "; x; " "; y+boxHeight-1 print #main.bar, "place "; x; " "; y print #main.bar, "line "; x; " "; y; " "; x + boxWidth-1; " "; y print #main.bar, "color white ; down" print #main.bar, "place "; x-1; " "; y-1 print #main.bar, "line "; x-1; " "; y-1; " "; x-1; " "; y+boxHeight print #main.bar, "place "; x-1; " "; y-1 print #main.bar, "line "; x-1; " "; y-1; " "; x + boxWidth; " "; y-1 print #main.bar, "color darkgray" print #main.bar, "place "; x; " "; y+boxHeight-1 print #main.bar, "line "; x; " "; y+boxHeight-1; " "; x+boxWidth-1; " "; y+boxHeight-1 print #main.bar, "place "; x+boxWidth-1; " "; y print #main.bar, "line "; x+boxWidth-1; " "; y; " "; x+boxWidth-1; " "; y+boxHeight print #main.bar, "color black" print #main.bar, "place "; x-1; " "; y+boxHeight print #main.bar, "line "; x-1; " "; y+boxHeight; " "; x+boxWidth; " "; y+boxHeight print #main.bar, "place "; x+boxWidth; " "; y-1 print #main.bar, "line "; x+boxWidth; " "; y-1; " "; x+boxWidth; " "; y+boxHeight+1 print #main.bar, "flush" return [recessed3DBox] ' x is the x position to start drawing box ' y is the y position to start drawing box ' boxWidth is the desired box width ' boxHeight is the desired box height print #main.bar, "color darkgray ; down" print #main.bar, "place "; x; " "; y print #main.bar, "line "; x; " "; y; " "; x; " "; y+boxHeight-1 print #main.bar, "place "; x; " "; y print #main.bar, "line "; x; " "; y; " "; x + boxWidth-1; " "; y print #main.bar, "color black ; down" print #main.bar, "place "; x-1; " "; y-1 print #main.bar, "line "; x-1; " "; y-1; " "; x-1; " "; y+boxHeight print #main.bar, "place "; x-1; " "; y-1 print #main.bar, "line "; x-1; " "; y-1; " "; x + boxWidth; " "; y-1 print #main.bar, "color white" print #main.bar, "place "; x; " "; y+boxHeight-1 print #main.bar, "line "; x; " "; y+boxHeight-1; " "; x+boxWidth-1; " "; y+boxHeight-1 print #main.bar, "place "; x+boxWidth-1; " "; y print #main.bar, "line "; x+boxWidth-1; " "; y; " "; x+boxWidth-1; " "; y+boxHeight-1 print #main.bar, "color white" print #main.bar, "place "; x-1; " "; y+boxHeight print #main.bar, "line "; x-1; " "; y+boxHeight; " "; x+boxWidth; " "; y+boxHeight print #main.bar, "place "; x+boxWidth; " "; y-1 print #main.bar, "line "; x+boxWidth; " "; y-1; " "; x+boxWidth; " "; y+boxHeight+1 print #main.bar, "flush" return [Menu.Init] ' Gets handle of menu bar note: Menu radiobutton code courtesy Alyce Watson & Brosco if Menu.graphics = 1 then CallDLL #user, "GetParent", _ Menu.hWnd AS word, _ Menu.hParent AS word Menu.hWnd = Menu.hParent end if calldll #user, "GetMenu", _ Menu.hWnd as word, Menu.hMenu as word Menu.Checked = 8 return [Menu.RadioButton] calldll #user, "GetSubMenu", _ Menu.hMenu as word, _ Menu.MenuItem as short, _ menu.hSubMenu as word calldll #user, "GetMenuItemID", _ menu.hSubMenu as word, _ Menu.SubMenuItem as short, _ menu.id as word calldll #user, "GetMenuItemID", _ menu.hSubMenu as word, _ Menu.FirstSubMenuItem as short, _ menu.id0 as word calldll #user, "GetMenuItemID", _ menu.hSubMenu as word, _ Menu.LastSubMenuItem as short, _ menu.idx as word calldll #user,"CheckMenuRadioItem", _ Menu.hMenu as word, _ menu.id0 as word, _ menu.idx as word, _ menu.id as word, _ Menu.Checked as short, _ menu.result as short return [Menu.Disable] calldll #user, "GetSubMenu", _ Menu.hMenu as word, _ Menu.MenuItem as short, _ menu.hSubMenu as word calldll #user, "GetMenuItemID", _ menu.hSubMenu as word, _ Menu.SubMenuItem as short, _ menu.id as word calldll #user, "EnableMenuItem", _ menu.hSubMenu as word,_ menu.id as word,_ Menu.Enabled as word,_ 'enabled=0,grayed=1 Menu.enabled.return as word 'returns previous state of menu item return '==================Start of Search Routine===================== [search] cursor hourglass ' searchExt$ = "*.dll" 'type of file to search for ' initDrv$ = "c:\" 'starting search path totalFound = 0 'total no of files found countDir1 = 1 'directory counter countDir2 = 0 'directory counter redim files$(10,10) 'dim for files statement redim list$(2000) 'list of all files fitting search - change value as necessary redim dirs1$(500) 'copy of previous list of subdirectories to be searched redim dirs2$(500) 'list of subdirectories to be searched dirs$(1) = "" while countDir1 >0 'quit loop when no more subdirs are found that have subdirs totalSubs = 0 'reset total number of subdirs countDir2 = 0 'reset count of subdirs for j = 1 to countDir1 startDir$ = initDrv$ + right$(dirs1$(j),len(dirs1$(j))-1) 'remove \ from directory string gosub [getDir] 'call the "files" command if quantityFiles = 0 then goto [subDirs] num = 1 for i = totalFound-quantityFiles to totalFound-1 list$(i) = left$(initDrv$,len(initDrv$)-1) + dirs1$(j) + "\" + files$(num,0) 'keep track of files found and put in list$() num = num + 1 next i [subDirs] if quantitySubs = 0 then goto [nextJ] for i = quantityFiles+1 to quantityFiles+quantitySubs 'keep track of names of subdir found with more subdirs dirs2$(i - quantityFiles + totalSubs) = files$(i,0) next i totalSubs = totalSubs + quantitySubs [nextJ] next j for i = 1 to countDir2 'replace list of old subdirs with new list dirs1$(i) = dirs2$(i) next i countDir1 = countDir2 'replace last count of subdirs with new count wend 'end of search routine cursor normal return [getDir] files startDir$, searchExt$, files$( 'call files function quantityFiles = val(files$(0,0)) 'no of files found quantitySubs = val(files$(0,1)) 'no of subdirs found totalFound = totalFound + quantityFiles 'total no of files found countDir2 = countDir2 + quantitySubs 'total no of subdirs found this go around return