FBSL - Icon viewer

[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

Code

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

Code

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

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