'===========================================================================
' 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