Demo: TreeView + ImageList

[zydon]

Here again as I'm progressing as a newbie, I made a simple Win32 GUI Treeview with ImageList using internal/hook icons resources. I'm using Win95-OSR2, so if this demo can run on WinXP, could you post a screenshot of it. I just want to know how it's look on XP.

Compile it using -s gui options.


Screenshot:




Code:
[syntax="QBasic"]
'Filename: \FreeBasic\Examples\Gui\TreeView.bas
'--------------------------------------------------------------
' TreeViewEx and ImageList Demo for FreeBasic.
' compiled using FreeBasic v0.11b
' by zydon@mesra.net
'--------------------------------------------------------------

option explicit
option private

'--------------------------------------------------------------
'$include once:'win\kernel32.bi'
'$include once:'win\user32.bi'
'$include once:'win\commctrl32.bi'
'--------------------------------------------------------------

'-- user.structure.treeview
type TVITEM
Mask as integer
Handle as integer
STATE as integer
StateMask as integer
Text as long
Lenght as long
Image as long
SelectedImage as long
Children as long
lParam as long
end type

type TVINSERTSTRUCT
Parent as long
InsertAfter as long
Item as TVITEM
end type

'-- addition.static.commctrl32.bi -------
#define ILC_MASK 1
#define ILC_COLOR8 8
#define ILC_COLOR16 16
#define ILC_COLOR24 24
#define ILC_COLOR32 32
'----------------------------------------
#define TVI_ROOT &HFFFF0000
'----------------------------------------
#define TVIF_TEXT 1
#define TVIF_IMAGE 2
#define TVIF_SELECTEDIMAGE &H20
'----------------------------------------
#define TVM_INSERTITEM &H1100
#define TVM_SETIMAGELIST ( &H1100 + 9 )
#define TVM_SETBKCOLOR ( &H1100 + 29 )
'----------------------------------------
#define TVSIL_NORMAL 0
'----------------------------------------
#define TVS_HASBUTTONS 1
#define TVS_HASLINES 2
#define TVS_LINESATROOT 4
'----------------------------------------
Const WC_TREEVIEW = "SysTreeView32"
'----------------------------------------

'-- addition+fix.api.library
#define AddChild SendMessage
#define BV byval
#define Arg1 (BV p1 as long, BV s2 as string, BV p3 as long)
#define Arg2 (BV hwnd As Long, BV uMsg As Long, BV wParam As Long, BV lParam As Long)
'Undocumented API feature
declare function ExtractIcon lib "shell32" Alias "ExtractIconA" Arg1 As Integer
#undef BV

'-- program.code.begin

dim shared hInstance as long
dim shared rc as RECT
dim shared htv as long
dim shared si1 as integer

dim shared six as integer
dim shared siy as integer
dim shared iclr as integer
dim shared iccx as INITCOMMONCONTROLSEX

hInstance = GetModuleHandle( null )
six = GetSystemMetrics(SM_CXSMICON)
siy = GetSystemMetrics(SM_CYSMICON)
iclr = ILC_COLOR8 or ILC_MASK
si1 = ImageList_Create(six,siy,iclr,1,1)

iccx.dwSize = len(INITCOMMONCONTROLSEX)
iccx.dwICC = ICC_TREEVIEW_CLASSES or ICC_WIN95_CLASSES

InitCommonControlsEx(iccx)


'-- user.owner.procedures

''
'' Window Procedure Handler
''
function WndProc Arg2 as integer


WndProc = 0

select case ( uMsg )
case WM_CREATE

dim tvis as TVINSERTSTRUCT

dim i as long,_
hico as long,_
hPrev as long,_
tlib as long

dim ico$, text$


GetClientRect hWnd, rc

htv = CreateWindowEx( _
WS_EX_CLIENTEDGE,WC_TREEVIEW, "",_
WS_CHILD or WS_VISIBLE or TVS_HASLINES _
or TVS_LINESATROOT or TVS_HASBUTTONS,_
0,18,160,rc.nbottom-20,_
hWnd,0,hInstance,0)

SendMessage(htv,TVM_SETBKCOLOR,0,&hfff0e1)

for i=3 to 5
ico$ = str$(i)
hico = ExtractIcon(0,"Shell32.DLL",i)
ImageList_ReplaceIcon(si1,-1,hico)
DestroyIcon(hico)
next i

SendMessage(htv,TVM_SETIMAGELIST,TVSIL_NORMAL,byval si1)

CLEAR tvis,0,len(tvis)

tvis.Item.Mask = TVIF_TEXT or TVIF_IMAGE or TVIF_SELECTEDIMAGE

'-- Root: tv.additem -> tv.item(0)
text$ = "FreeBasic"
tvis.Item.Text = SADD(text$)
tvis.Item.Lenght = len(text$)
tvis.Item.Image = 0
tvis.Item.SelectedImage = 1
tvis.InsertAfter = 0
tvis.Parent = TVI_ROOT
hPrev = AddChild(htv,TVM_INSERTITEM,0,tvis)

'-- tv.additem -> tv.item(1) | tv.parent=0
text$ = "Inc"
tvis.Item.Text = SADD(text$)
tvis.Item.Lenght = len(text$)
tvis.Parent = hPrev
hPrev = AddChild(htv,TVM_INSERTITEM,0,tvis)

'-- tv.additem -> tv.item(2) | tv.parent=1
text$ = "Win"
tvis.Item.Text = SADD(text$)
tvis.Item.Lenght = len(text$)
tvis.Parent = hPrev
hPrev = AddChild(htv,TVM_INSERTITEM,0,tvis)

'-- tv.additem -> tv.item(3) | tv.parent=2
text$ = "Gui"
tvis.Item.Text = SADD(text$)
tvis.Item.Lenght = len(text$)
tvis.Parent = hPrev
hPrev = AddChild(htv,TVM_INSERTITEM,0,tvis)

'-- tv.additem -> tv.item(4) | tv.parent=0
text$ = "Assembler"
tvis.Item.Text = SADD(text$)
tvis.Item.Lenght = len(text$)
tvis.Parent = TVI_ROOT
hPrev = AddChild(htv,TVM_INSERTITEM,0,tvis)

'-- tv.additem -> tv.item(5) | tv.parent=0
text$ = "Tutorials"
tvis.Item.Text = SADD(text$)
tvis.Item.Lenght = len(text$)
hPrev = AddChild(htv,TVM_INSERTITEM,0,tvis)

'-- tv.additem -> tv.item(6) | tv.parent=0
text$ = "Object Oriented"
tvis.Item.Text = SADD(text$)
tvis.Item.Lenght = len(text$)
hPrev = AddChild(htv,TVM_INSERTITEM,0,tvis)
case WM_SIZE
GetClientRect hWnd, rc
IF ( htv <> 0 ) THEN _
MoveWindow(htv,0,18,160,rc.nBottom-rc.nTop-20,1)
case WM_KEYDOWN
if( (wParam and &hff) = 27 ) then
PostMessage hWnd, WM_CLOSE, 0, 0
end if
case WM_DESTROY
ImageList_Destroy(si1)
PostQuitMessage 0
exit function
end select

WndProc = DefWindowProc( hWnd, uMsg, wParam, lParam )

end function


''
'' Main Program Exclusive Entry
''
dim wMsg as MSG
dim wcls as WNDCLASS
dim hWnd as unsigned long

dim szAppName as string
szAppName = "WinTreeView"

with wcls
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = hInstance
.hIcon = LoadIcon( null, IDI_APPLICATION )
.hCursor = LoadCursor( null, IDC_ARROW )
.hbrBackground = 16 ' btnface color
.lpszMenuName = null
.lpszClassName = strptr( szAppName )
end with

if ( RegisterClass( wcls ) = false ) then
MessageBox null, "Failed to register wcls!", szAppName, MB_ICONERROR
end 1
end if

hWnd = CreateWindowEx( 0, _
szAppName, "Treeview Demo", _
WS_OVERLAPPEDWINDOW or WS_VISIBLE, _
100, 100, 420, 240, _
null, null, hInstance, null )

''
'' messages loop
''
do until( GetMessage( wMsg, null, 0, 0 ) = FALSE )
TranslateMessage wMsg
DispatchMessage wMsg
loop

ExitProcess 0
[/syntax]

EDIT: [1] FreeMemory has been replaced with FB CLEAR keyword. [2] SendMessage uses updated. Thanks v1ctor.


For WinXP users, save this code as TreeView.EXE.Manifest at the same directory as the compiled program:

[syntax="XML"]
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urnchemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="1.0.0.0"
processorArchitecture="X86"
name="FreeBasic.GUI.App"
type="win32"
/>
<description>Treeview Demo.</description>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="X86"
publicKeyToken="6595b64144ccf1df"
language="*"
/>
</dependentAssembly>
</dependency>
</assembly>
[/syntax]

EDIT: Updated Manifest content

Have fun...