Other Software > Developer's Corner
FBSL - Icon viewer
(1/1)
Gerome:
[modified source to avoid crash]
Hello,
Here's a icon viewer developped in Fbsl.
The source code will show you how to :
-use volatile CLASS
-use API calls
-use API structure manipulation
--- ---'======================================================
' Shell32 Icon Index FBSL
'======================================================
#Option Explicit
#DLLDECLARE user32("GetSystemMetrics","DestroyIcon")
#DLLDECLARE comctl32("ImageList_Create","ImageList_ReplaceIcon")
#DLLDECLARE shell32("ExtractIcon")
DIM $LV_ITEM, %hList, %t, %hIcon, %hImage, $index, %j
' ------------------------------------------------------
'// SysListView Class :: TYPE + MACRO
' ------------------------------------------------------
Class SLV '// volatile class (== without parens() )
Macro SetValue(param1, param2) = SetMem( LV_ITEM, param1, param2 )
Static mask = 0, iItem = 4, iSubItem = 8, state = 12
Static stateMask = 16, pszText = 20, cchTextMax = 24, iImage = 28
Static ILC_COLOR32 = 32, ILC_MASK = 1, LVSIL_SMALL = 1, LVSIL_STATE = 2
Static LVS_LIST = 0x0003, LVIF_TEXT = 1, LVIF_IMAGE = 2, LVS_REPORT = 0x0001
Static LVS_TYPEMASK = 3, LVS_EX_GRIDLINES = 1, LVS_EX_LABELTIP = 0x00004000
Static LVIS_STATEIMAGEMASK = 0xF000, SM_CXICON = 11, SM_CYICON = 12
End Class
' ------------------------------------------------------
' // Main Entry point
' ------------------------------------------------------
Sub Main()
MYCreateSysListView()
Begin Events
End Events
End Sub
' ------------------------------------------------------
'// ListView Creation
' ------------------------------------------------------
Sub MYCreateSysListView()
Fbsl_settext(me,"Shell32 Icon Index")
Alloc(LV_ITEM,36)
SLV->SetValue( SLV->LVIF_TEXT + SLV->LVIS_STATEIMAGEMASK + SLV->LVIF_IMAGE, SLV->mask )' set state masks
SLV->SetValue( 256, SLV->cchTextMax)
hList = Fbsl_control("SysListView32",me,"",0,0,0,500,294,_
WS_VISIBLE + WS_CHILD + SLV->LVS_LIST + SLV->LVS_TYPEMASK + SLV->LVS_REPORT, WS_EX_STATICEDGE)
SendMessage(hList, SLV->LVM_SETBKCOLOR, 0, rgb(255,255,192))
SendMessage(hList, SLV->LVM_SETTEXTBKCOLOR, 0, rgb(255,255,192))
SendMessage(hList, SLV->LVM_SETEXTENDEDLISTVIEWSTYLE,0, SLV->LVS_EX_LABELTIP)
'==========create an image list======================
hImage = ImageList_Create(GetSystemMetrics(SLV->SM_CXICON),_
GetSystemMetrics(SLV->SM_CYICON), SLV->ILC_COLOR32 + SLV->ILC_MASK, 1, 1)
'====Extract the icon then destroy the handle to replace with next icon
For t = 0 To 237
hIcon = ExtractIcon(0,"shell32.dll",t)
ImageList_ReplaceIcon(hImage,-1,hIcon)
DestroyIcon(hIcon)
If hIcon <> 0 Then j = t
Next
'=====set the image list to the listview=========
SendMessage(hList,SLV->LVM_SETIMAGELIST,SLV->LVSIL_SMALL,hImage)
'=====populate the listview======================
For t = 0 To j
index = "Icon # : " & t
SLV->SetValue( t, SLV->iItem) ' item index
SLV->SetValue( @index, SLV->pszText) ' pointer to text string
SLV->SetValue( t, SLV->iImage) ' image index
SendMessage(hList,SLV->LVM_INSERTITEM,0,LV_ITEM)
Next
Resize(me, 0, 0, 520, 324)
Center(me)
Show(me)
End Sub
Enjoy ;)
jgpaiva:
I'm disapointed... This was just now going to be very usefull, but it doesn't work.. :(
Cpilot:
Yeah that crashes on my machine too.
Here, try the original script with out all the class and volatile geegaw type stuff.
--- ---'======================================================
' Shell32 Icon Index FBSL
' Cpilot 11/04/05
' http://outcastprogramming.com/
'======================================================
'$apptype console
#dlldeclare user32("GetSystemMetrics","DestroyIcon")
#dlldeclare comctl32("ImageList_Create","ImageList_ReplaceIcon")
#dlldeclare shell32("ExtractIcon")
dim $LV_ITEM,%hList,%t,%hIcon,%hImage,$index,%j
begin const
ILC_COLOR32 = 32
ILC_MASK = &H1
LVSIL_SMALL = 1
LVSIL_STATE = 2
LVS_LIST = 0x0003
LVIF_TEXT = 0x1
LVIF_IMAGE = &H2
LVS_REPORT = 0x0001
LVS_TYPEMASK = 0x3
LVS_EX_GRIDLINES = &H1
LVS_EX_LABELTIP = 0x00004000
LVIS_STATEIMAGEMASK = &HF000
SM_CXICON = 11
SM_CYICON = 12
'=======VB struct ================
'Public Type LV_ITEM
mask = 0
iItem = 4
iSubItem = 8
state = 12
stateMask = 16
pszText = 20
cchTextMax = 24
iImage = 28
' lParam 32
' iIndent 36
'End Type
end const
fbsl_settext(me,"Shell32 Icon Index")
alloc(LV_ITEM,36)
SetMem(LV_ITEM,LVIF_TEXT + LVIS_STATEIMAGEMASK + LVIF_IMAGE,mask) ' set state masks
SetMem(LV_ITEM,256,cchTextMax)
Resize(me,0,0,510,330)
center(me)
show( me )
hList = fbsl_control("SysListView32",me,"",0,0,0,500,294,_
WS_VISIBLE + WS_CHILD + LVS_LIST + LVS_TYPEMASK + LVS_REPORT,WS_EX_STATICEDGE)
SendMessage(hList,LVM_SETBKCOLOR,0,rgb(255,255,192))
SendMessage(hList,LVM_SETTEXTBKCOLOR,0,rgb(255,255,192))
SendMessage(hList,LVM_SETEXTENDEDLISTVIEWSTYLE,0,LVS_EX_LABELTIP)
'==========create an image list======================
hImage = ImageList_Create(GetSystemMetrics(SM_CXICON),_
GetSystemMetrics(SM_CYICON),ILC_COLOR32 + ILC_MASK,1,1)
'====================================================
'====Extract the icon then destroy the handle to
' replace with next icon========================
for t = 0 to 237
'shell32.dll
'c:\program files\outlook express\msimn.exe
'c:\program files\outlook express\msoeres.dll
hIcon = ExtractIcon(0,"shell32.dll",t)
ImageList_ReplaceIcon(hImage,-1,hIcon)
DestroyIcon(hIcon)
if hIcon <> 0 then
j = t
end if
next
'=====set the image list to the listview=========
SendMessage(hList,LVM_SETIMAGELIST,LVSIL_SMALL,hImage)
'================================================
'=====populate the listview======================
for t = 0 to j
index = "Icon # : " & t
SetMem(LV_ITEM,t,iItem) ' item index
SetMem(LV_ITEM,@index,pszText) ' pointer to text string
SetMem(LV_ITEM,t,iImage) ' image index
SendMessage(hList,LVM_INSERTITEM,0,LV_ITEM)
next
begin events
select case cbmsg
case wm_close
exitprogram(0)
end select
end events
Works fine on my WinXP Sp2.
Gerome:
Hello,
I'm disapointed... This was just now going to be very usefull, but it doesn't work.. :(
-jgpaiva (April 26, 2006, 04:30 AM)
--- End quote ---
Sorry, but it works... into the CLASS, you just have to replace all DIM with STATIC keyword and all will work nicely :)
Sorry for the inconvenient...
The newest CLASS layer will be flexible and inherits will also work ;)
jgpaiva:
Yes, it works now!
Thanks :Thmbsup:
Navigation
[0] Message Index
Go to full version