1. You can associate the program with dll files.
2. DragDrop is supported
Download
Code: Select all
;- TOP
EnableExplicit
Define UserIntLang, *Lang
If OpenLibrary(0, "kernel32.dll")
*Lang = GetFunction(0, "GetUserDefaultUILanguage")
If *Lang
UserIntLang = CallFunctionFast(*Lang)
EndIf
CloseLibrary(0)
EndIf
#CountStrLang = 9
Global Dim Lng.s(#CountStrLang)
Lng(1) = "No icons in the file"
Lng(2) = "Small icons"
Lng(3) = "Large icons"
Lng(4) = "List"
Lng(5) = "Table"
Lng(6) = "Change background color"
Lng(7) = "Save selected icon to ico file"
Lng(8) = "Open file"
Lng(9) = "Select file to save"
If UserIntLang = 10491 ; ru
Lng(1) = "Нет иконок в файле"
Lng(2) = "Маленькие иконки"
Lng(3) = "Большие иконки"
Lng(4) = "Список"
Lng(5) = "Таблица"
Lng(6) = "Изменить цвет фона"
Lng(7) = "Сохранить выбранный значок в ico-файл"
Lng(8) = "Открыть файл"
Lng(9) = "Выберите файл для сохранения"
EndIf
#Window = 0
#Menu = 0
;- ● Enumeration
Enumeration Gadget
#btnOpen
#btnSizeicon
#LIG
EndEnumeration
Enumeration Menu
#mLarge
#mSmall
#mList
#mReport
#mBackground
#mSaveIcon
EndEnumeration
Structure icons
; List *iconsLarge()
List iconsLarge.i()
List iconsSmall.i()
flgLarge.i
flgSmall.i
EndStructure
; XIncludeFile "SaveIcon.pb"
; XIncludeFile "ForDLL_Icon_Viewer.pb"
Procedure IsHex(*text)
Protected flag = 1, *c.Character = *text
If *c\c = 0
ProcedureReturn 0
EndIf
Repeat
If Not ((*c\c >= '0' And *c\c <= '9') Or (*c\c >= 'a' And *c\c <= 'f') Or (*c\c >= 'A' And *c\c <= 'F'))
flag = 0
Break
EndIf
*c + SizeOf(Character)
Until Not *c\c
; Debug flag
ProcedureReturn flag
EndProcedure
Procedure RGBtoBGR(c)
; ProcedureReturn RGB(Blue(c), Green(c), Red(c))
ProcedureReturn ((c & $00FF00) | ((c & $0000FF) << 16) | ((c & $FF0000) >> 16))
EndProcedure
; def если пустая строка или больше 6 или 5 или 4
; def в BGR, не RGB, то есть готовое для применения
; Color$ это RGB прочитанный из ini с последующим преобразованием в BGR
Procedure ColorValidate(Color$, def = 0)
Protected tmp$, tmp2$, i
; Debug Color$
i = Len(Color$)
If i <= 6 And IsHex(@Color$)
Select i
Case 6
; def = Val("$" + Color$)
; RGBtoBGR2(@def)
def = RGBtoBGR(Val("$" + Color$))
Case 1
def = Val("$" + LSet(Color$, 6, Color$))
Case 2
def = Val("$" + Color$ + Color$ + Color$)
Case 3
; сразу переворачиваем в BGR
For i = 3 To 1 Step -1
tmp$ = Mid(Color$, i, 1)
tmp2$ + tmp$ + tmp$
Next
def = Val("$" + tmp2$)
EndSelect
EndIf
; Debug Hex(def)
ProcedureReturn def
EndProcedure
;- ● Define
Define hIcon, hiconFolder, hiconSizeicon, i, m_event, tmp, tmp$, path$, ini$
Define iconsData.icons
Define flgiconSize = 1
Define background = $222222
Define foreground = $aaaaaa
Define width = 800
Define height = 600
CompilerIf #PB_Compiler_OS >= #PB_OS_Windows_10
Define nicon = 319
CompilerElse
Define nicon = 12
CompilerEndIf
Define height = 600
SetCurrentDirectory("C:\Windows\System32\")
If ExtractIconEx_("Shell32.dll", 3, @hIcon, 0, 1)
If hIcon
hiconFolder = hIcon
EndIf
EndIf
If ExtractIconEx_("Shell32.dll", 319, @hIcon, 0, 1)
If hIcon
hiconSizeicon = hIcon
EndIf
EndIf
Procedure SizeWindowHandler()
Protected w, h
w = WindowWidth(#Window)
h = WindowHeight(#Window)
ResizeGadget(#LIG, #PB_Ignore, #PB_Ignore, w - 10, h - 55)
EndProcedure
Procedure Clearing(*iconsData.icons) ; очистка при смене файла
ClearGadgetItems(#LIG)
ForEach *iconsData\iconsLarge()
DestroyIcon_(*iconsData\iconsLarge())
Next
ForEach *iconsData\iconsSmall()
DestroyIcon_(*iconsData\iconsSmall())
Next
ClearList(*iconsData\iconsLarge())
ClearList(*iconsData\iconsSmall())
*iconsData\flgLarge = 0
*iconsData\flgSmall = 0
EndProcedure
Procedure Fill_LIG_Small(*iconsData.icons, path$)
Protected i, hIcon, success
If Not Asc(path$)
ProcedureReturn
EndIf
ClearGadgetItems(#LIG)
i = 0
Repeat
hIcon = 0
success = ExtractIconEx_(path$, i, 0, @hIcon, 1)
If success
If hIcon And AddElement(*iconsData\iconsSmall())
*iconsData\iconsSmall() = hIcon
AddGadgetItem(#LIG, i, Str(i), hIcon)
EndIf
Else
Break
EndIf
i + 1
ForEver
*iconsData\flgSmall = 1
EndProcedure
Procedure Fill_LIG_Large(*iconsData.icons, path$)
Protected i, hIcon, success
If Not Asc(path$)
ProcedureReturn
EndIf
ClearGadgetItems(#LIG)
i = 0
Repeat
hIcon = 0
success = ExtractIconEx_(path$, i, @hIcon, 0, 1)
If success
If hIcon And AddElement(*iconsData\iconsLarge())
*iconsData\iconsLarge() = hIcon
AddGadgetItem(#LIG, i, Str(i), hIcon)
EndIf
Else
Break
EndIf
i + 1
ForEver
*iconsData\flgLarge = 1
EndProcedure
Procedure OpenPath(*iconsData.icons, path$, flgiconSize)
Protected count_icons
If Asc(path$) And FileSize(path$) > 100
Clearing(*iconsData)
count_icons = ExtractIconEx_(path$, -1, 0, 0, 1)
If count_icons
If flgiconSize
Fill_LIG_Large(*iconsData, path$)
Else
Fill_LIG_Small(*iconsData, path$)
EndIf
SetWindowTitle(#Window, "DLL Icon Viewer" + " : " + GetFilePart(path$) + " (" + Str(count_icons) + ")")
Else
path$ = "" ; сброс пути если файл пуст
SetWindowTitle(#Window, "DLL Icon Viewer")
MessageRequester("", Lng(1))
EndIf
EndIf
EndProcedure
Procedure SetView(*iconsData.icons, path$, flgiconSize, View)
Protected i
SendMessage_(GadgetID(#LIG), #WM_SETREDRAW, 0, 0)
SetGadgetAttribute(#LIG, #PB_ListIcon_DisplayMode, View)
If *iconsData\flgSmall = 0
Fill_LIG_Small(*iconsData, path$) ; если нет маленьких иконок то запрашиваем их
Else
ClearGadgetItems(#LIG)
i = 0
ForEach *iconsData\iconsSmall()
AddGadgetItem(#LIG, i, Str(i), *iconsData\iconsSmall())
i + 1
Next
EndIf
SendMessage_(GadgetID(#LIG), #WM_SETREDRAW, 1, 0)
flgiconSize = 0
EndProcedure
;- ● ini
ini$ = GetPathPart(ProgramFilename()) + "DLL_Icon_Viewer.ini"
If OpenPreferences(ini$) ; открываем ini
path$ = ReadPreferenceString("path", "")
background = ColorValidate(ReadPreferenceString("background", ""), background)
foreground = ColorValidate(ReadPreferenceString("foreground", ""), foreground)
flgiconSize = ReadPreferenceInteger("view", flgiconSize)
width = ReadPreferenceInteger("width", width)
height = ReadPreferenceInteger("height", height)
ClosePreferences()
EndIf
tmp = CountProgramParameters()
If tmp
path$ = ProgramParameter(0)
EndIf
;-┌──GUI──┐
If OpenWindow(#Window, 0, 0, width, height, "DLL Icon Viewer",
#PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget)
ButtonImageGadget(#btnOpen, 5, 5, 40, 40, hiconFolder)
ButtonImageGadget(#btnSizeicon, 50, 5, 40, 40, hiconSizeicon)
ListIconGadget(#LIG, 5, 50, width - 10, height - 55, "", 100, #PB_ListIcon_FullRowSelect | #LVS_NOCOLUMNHEADER)
SetGadgetColor(#LIG, #PB_Gadget_BackColor, background)
SetGadgetColor(#LIG, #PB_Gadget_FrontColor, foreground)
If flgiconSize
SetGadgetAttribute(#LIG, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
Else
SetGadgetAttribute(#LIG, #PB_ListIcon_DisplayMode, #PB_ListIcon_SmallIcon)
EndIf
EnableGadgetDrop(#LIG, #PB_Drop_Files, #PB_Drag_Copy)
If CreatePopupMenu(#Menu)
MenuItem(#mSmall, Lng(2))
MenuItem(#mLarge, Lng(3))
MenuItem(#mList, Lng(4))
MenuItem(#mReport, Lng(5))
MenuBar()
MenuItem(#mBackground, Lng(6))
MenuItem(#mSaveIcon, Lng(7))
EndIf
OpenPath(iconsData, path$, flgiconSize)
BindEvent(#PB_Event_SizeWindow, @SizeWindowHandler())
;-┌──Loop──┐
Repeat
Select WaitWindowEvent()
;- ├ DragDrop
Case #PB_Event_GadgetDrop ; событие перетаскивания
Select EventGadget()
Case #LIG
path$ = EventDropFiles()
tmp = FindString(path$, Chr(10)) ; если несколько файлов то отрезать первый
If tmp
path$ = Left(path$, tmp - 1)
EndIf
OpenPath(iconsData, path$, flgiconSize)
EndSelect
;- ├ Gadget
Case #PB_Event_Gadget
Select EventGadget()
Case #btnSizeicon
DisplayPopupMenu(#Menu, WindowID(#Window)) ; покажем всплывающее Меню
Case #btnOpen
path$ = OpenFileRequester(Lng(8), GetCurrentDirectory(), "*.dll|*.dll|*.exe|*.exe|*.ocx|*.ocx|*.cpl|*.cpl|*.res|*.res|*.scr|*.scr|*.ico|*.ico", 0)
OpenPath(iconsData, path$, flgiconSize)
EndSelect
;- ├ Menu
Case #PB_Event_Menu
m_event = EventMenu()
Select m_event
Case #mReport
SetView(iconsData.icons, path$, flgiconSize, #PB_ListIcon_Report)
Case #mList
SetView(iconsData.icons, path$, flgiconSize, #PB_ListIcon_List)
Case #mSmall
SetView(iconsData.icons, path$, flgiconSize, #PB_ListIcon_SmallIcon)
Case #mLarge
SendMessage_(GadgetID(#LIG), #WM_SETREDRAW, 0, 0)
SetGadgetAttribute(#LIG, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
If iconsData\flgLarge = 0
Fill_LIG_Large(iconsData, path$) ; если нет больших иконок то запрашиваем их
Else
ClearGadgetItems(#LIG)
i = 0
ForEach iconsData\iconsLarge()
AddGadgetItem(#LIG, i, Str(i), iconsData\iconsLarge())
i + 1
Next
EndIf
SendMessage_(GadgetID(#LIG), #WM_SETREDRAW, 1, 0)
flgiconSize = 1
Case #mBackground
tmp = ColorRequester()
If tmp > -1
SetGadgetColor(#LIG, #PB_Gadget_BackColor, tmp)
EndIf
Case #mSaveIcon
tmp = GetGadgetState(#LIG)
If tmp <> -1
tmp$ = GetCurrentDirectory()
If GetCurrentDirectory() = "C:\Windows\System32\"
tmp$ = GetPathPart(ProgramFilename())
EndIf
tmp$ = SaveFileRequester(Lng(9), tmp$ + "file.ico", "*.ico|*.ico|", 0)
If Asc(tmp$)
If Right(tmp$, 4) <> ".ico"
tmp$ + ".ico"
EndIf
EndIf
If flgiconSize
If SelectElement(iconsData\iconsLarge(), tmp)
; SaveIcon(iconsData\iconsLarge(), tmp$)
MessageRequester("", "SaveIcon.pb is required")
EndIf
Else
If SelectElement(iconsData\iconsSmall(), tmp)
; SaveIcon(iconsData\iconsSmall(), tmp$)
MessageRequester("", "SaveIcon.pb is required")
EndIf
EndIf
; tmp$ = GetGadgetItemText(#LIG, tmp)
EndIf
EndSelect
;- ├ Close
Case #PB_Event_CloseWindow
Clearing(iconsData.icons)
CloseWindow(#Window)
DestroyIcon_(hiconFolder)
DestroyIcon_(hiconSizeicon)
End
EndSelect
ForEver
;-└──Loop──┘
EndIfCode: Select all
path = C:\Windows\System32\Shell32.dll
view = 1
background = 2
foreground = a
width = 800
height = 600
