#Include "windows.bi"
#Include "win/commctrl.bi"
#Include "list.bi"

Type APPLINFO
	As ZString*40 szAppName
	As ZString*20 szIconName
	As UINT iCost
End Type

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Декларации функций
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Declare Function WndProc(hWnd As HWND ,msg As UINT ,wParam As WPARAM ,lParam As LPARAM ) As Integer
Declare Function LVCompareProc(lParam1 As LPARAM ,lParam2 As LPARAM ,_
lParamSort As LPARAM )As Integer
Declare Sub WndProc_OnCreate(hwnd As  HWND)
Declare Sub WndProc_OnDestroy(Hwnd As HWND)
Declare Sub WndProc_OnCommand(hWnd As HWND ,id As Integer )
Declare Sub WndProc_OnSize(cx As Integer ,cy As  Integer )
Declare Sub WndProc_OnNotify(idFrom As Integer ,pnmhdr As NMHDR Ptr )
Declare Sub WinMain()

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'''''''''''''''''''' Глобальные переменные''''''''''''''''''''''''''
Dim Shared As APPLINFO rgApplInfo(8) = { _
("Generic",           "appicon.ico ",   5), _
("Book",              "book1.ico   ",   2), _
("Driver List",       "drvlist.ico ",  22), _
("MCI CD Player",     "mcicdpl.ico ", 345), _
("MCI String Player", "mcistrvw.ico",  54), _
("MCI Wave Player",   "mciwaver.ico",  32), _
("MCI Window Demo",   "mciwnd.ico  ",   0), _
("Sound Play",        "sndplay.ico ",   0), _
("Wave Play",         "wave.ico    ",   4)}

Dim Shared As HINSTANCE hInst
Dim Shared As ZString*40 szAppName="ListApp",szAppTitle = "List Application"
Dim Shared As HWND hwndList

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''' Вход в программу''''''''''''
WinMain()
''''''''''''''''''''''''''''''''''

' -----------------------------------------------------
' Функция WinMain
' -----------------------------------------------------
Sub WinMain()
	Dim As WNDCLASSEX wc
	Dim As HWND hWnd
	Dim As MSG msg
	Dim As Integer wScreen,hScreen
	hInst = GetModuleHandle(0)

	' Проверяем, не было ли это приложение запущено ранее
	hWnd = FindWindow(szAppName, NULL)
	If hWnd<>0 Then
		If IsIconic(hWnd)<>0 Then ShowWindow(hWnd, SW_RESTORE)
		SetForegroundWindow(hWnd)
		Exit Sub
	EndIf

	' Регистрируем класс окна
	wc.cbSize = SizeOf(WNDCLASSEX)
	wc.hIconSm = LoadImage(hInst, _
	MAKEINTRESOURCE(IDI_APPICONSM), IMAGE_ICON, 16, 16, 0)
	wc.style = 0
	wc.lpfnWndProc = Cast(WndProc,@WndProc)
	wc.cbClsExtra  = 0
	wc.cbWndExtra  = 0
	wc.hInstance = hInst
	wc.hIcon = LoadImage(hInst,_
	MAKEINTRESOURCE(IDI_APPICON), IMAGE_ICON, 32, 32, 0)
	wc.hCursor = LoadCursor(NULL, IDC_ARROW)
	wc.hbrBackground = Cast(HBRUSH,COLOR_WINDOW + 1)
	wc.lpszMenuName = MAKEINTRESOURCE(IDR_APPMENU)
	wc.lpszClassName = StrPtr(szAppName)
	If RegisterClassEx(@wc)=0 Then
		Exit Sub
	EndIf

	' Узнаем размеры экрана
	wScreen = GetSystemMetrics(SM_CXSCREEN)
	hScreen = GetSystemMetrics(SM_CYSCREEN)

	' Создаем главное окно приложения
	hWnd = CreateWindow(szAppName,szAppTitle,WS_OVERLAPPEDWINDOW Or WS_VISIBLE,_
	(wScreen-500)\2,(hScreen-500)\2,500,500, NULL, NULL, hInst, NULL)
	If hWnd=0 Then Exit Sub

	'Запускаем цикл обработки сообщений

	While GetMessage(@msg,0,0,0)
		TranslateMessage(@msg)
		DispatchMessage(@msg)
	Wend
End Sub

' -----------------------------------------------------
' Функция WndProc
' -----------------------------------------------------

Function WndProc(hWnd As HWND ,msg As UINT ,wParam As WPARAM ,lParam As LPARAM ) As Integer
	Select Case msg
		Case WM_CREATE
			WndProc_OnCreate(hwnd)
		Case WM_DESTROY
			WndProc_OnDestroy(hwnd)
		Case WM_COMMAND
			WndProc_OnCommand(hwnd,LoWord(wParam))
		Case WM_NOTIFY
			WndProc_OnNotify(Cast(Integer,wparam) , Cast(NMHDR Ptr,lParam))
		Case WM_SIZE
			WndProc_OnSize(LoWord(lParam),HiWord(lParam))
	End Select
	Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

' -----------------------------------------------------
' Функция WndProc_OnCreate
' -----------------------------------------------------
Sub WndProc_OnCreate(hwnd As  HWND)
	Dim As Integer i
	Dim As RECT rc
	Dim As HIMAGELIST himlSmall,himlLarge
	Dim As HICON hIcon
	Dim As LVCOLUMN lvc
	Dim As LVITEM lvi

	' Определяем размеры внутренней области главного окна
	GetClientRect(hWnd, @rc)

	' Инициализируем библиотеку стандартных органов управления
	InitCommonControls()

	' Создаем орган управления List View
	hwndList = CreateWindowEx(0, WC_LISTVIEW, "", _
	WS_VISIBLE Or WS_CHILD Or WS_BORDER Or LVS_REPORT Or _
	LVS_EDITLABELS,0, 0, rc.right - rc.left, rc.bottom - rc.top, _
	hWnd, Cast(HMENU,IDC_LISTVIEW) , hInst, NULL)

	If hwndList = NULL Then Exit Sub

	' Создаем список изображений
	himlSmall = ImageList_Create( _
	GetSystemMetrics(SM_CXSMICON),GetSystemMetrics(SM_CYSMICON),_
	ILC_COLOR32	, 9, 1)
	himlLarge = ImageList_Create( _
	GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON),_
	ILC_COLOR32	, 9, 1)

	For i = IDI_ICON1 To IDI_ICON9
		hIcon = LoadIcon(hInst, MAKEINTRESOURCE(i))
		ImageList_AddIcon(himlSmall, hIcon)
		ImageList_AddIcon(himlLarge, hIcon)
		DestroyIcon(hicon)
	Next

	' Добавляем списки изображений
	ListView_SetImageList(hwndList, himlSmall, LVSIL_SMALL)
	ListView_SetImageList(hwndList, himlLarge, LVSIL_NORMAL)

	' Вставляем столбцы

	lvc.mask = LVCF_FMT Or LVCF_WIDTH Or LVCF_TEXT Or LVCF_SUBITEM
	lvc.fmt = LVCFMT_LEFT
	lvc.cx = (rc.right - rc.left) / 4

	lvc.iSubItem = 0
	lvc.pszText = StrPtr("Application Name")
	ListView_InsertColumn(hwndList, 0, @lvc)

	lvc.iSubItem = 1
	lvc.pszText = StrPtr("Icon Name")
	ListView_InsertColumn(hwndList, 1, @lvc)

	lvc.iSubItem = 2
	lvc.pszText = StrPtr("Cost, USD")
	ListView_InsertColumn(hwndList, 2, @lvc)
	ListView_SetColumnWidth(hwndList,2,(rc.right-rc.left) / 8)

	' Вставляем строки

	lvi.mask = LVIF_IMAGE Or LVIF_TEXT Or LVIF_PARAM
	lvi.pszText = LPSTR_TEXTCALLBACK

	For i=0 To 8
		lvi.iItem = i
		lvi.cchTextMax = 40
		lvi.lParam = Cast(LPARAM,@rgApplInfo(i))
		For j As Integer = 0 To 2
			lvi.iImage = i
			lvi.iSubItem = j
			SendMessage(hwndList,LVM_INSERTITEM,0,Cast(LPARAM,@lvi))
		Next
	Next
End Sub

' -----------------------------------------------------
' Функция WndProc_OnDestroy
' -----------------------------------------------------

Sub WndProc_OnDestroy(Hwnd As HWND)
	DestroyWindow(hwndList)
	PostQuitMessage(0)
End Sub

' -----------------------------------------------------
' Функция WndProc_OnCommand
' -----------------------------------------------------

Sub WndProc_OnCommand(hWnd As HWND ,id As Integer )
	Dim As DWORD dwStyle
	Select Case id
		Case ID_OPTIONS_ICONVIEW
			dwStyle = GetWindowLong(hwndList, GWL_STYLE)
			If((dwStyle And LVS_TYPEMASK) <> LVS_ICON) Then
				SetWindowLong(hwndList, GWL_STYLE, _
				(dwStyle And Not LVS_TYPEMASK) Or LVS_ICON)
			EndIf
		Case ID_OPTIONS_SMALLICONVIEW
			dwStyle = GetWindowLong(hwndList, GWL_STYLE)
			If((dwStyle And LVS_TYPEMASK) <> LVS_SMALLICON)Then
				SetWindowLong(hwndList, GWL_STYLE,_
				(dwStyle And  Not LVS_TYPEMASK) Or LVS_SMALLICON)
			EndIf

		Case ID_OPTIONS_LISTVIEW
			dwStyle = GetWindowLong(hwndList, GWL_STYLE)
			If((dwStyle And LVS_TYPEMASK) <> LVS_LIST)Then
				SetWindowLong(hwndList, GWL_STYLE,_
				(dwStyle And Not LVS_TYPEMASK) Or LVS_LIST)
			EndIf
		Case ID_OPTIONS_REPORTVIEW
			dwStyle = GetWindowLong(hwndList, GWL_STYLE)
			If((dwStyle And LVS_TYPEMASK) <> LVS_REPORT)Then
				SetWindowLong(hwndList, GWL_STYLE,_
				(dwStyle And  Not LVS_TYPEMASK) Or LVS_REPORT)
			EndIf
		Case ID_FILE_EXIT
			WndProc_OnDestroy(hWnd)
		Case ID_HELP_ABOUT
	End Select
End Sub

'-----------------------------------------------------
' Функция WndProc_OnNotify
'-----------------------------------------------------
Sub WndProc_OnNotify(idFrom As Integer ,pnmhdr As NMHDR Ptr )
	Dim As NMLVDISPINFO Ptr lpLvdi = Cast(NMLVDISPINFO Ptr,pnmhdr)
	Dim As APPLINFO Ptr lpAppinfo = Cast(APPLINFO Ptr,lpLvdi->item.lParam)
	Static As ZString*20 szBuf
	Dim As NMLISTVIEW Ptr lpNm = Cast (NMLISTVIEW Ptr,pnmhdr)

	If (idFrom <> IDC_LISTVIEW) Then Exit Sub

	Select Case pnmhdr->code
		Case LVN_GETDISPINFO
			If lpLvdi->item.mask And LVIF_TEXT Then
				Select Case lpLvdi->item.iSubItem
					Case 0
						lpLvdi->item.pszText = @lpAppinfo->szAppName
					Case 1
						lpLvdi->item.pszText = @lpAppinfo->szIconName
					Case 2
						szBuf=Str(lpAppinfo->iCost)
						lpLvdi->item.pszText = @szBuf
				End Select
			EndIf
		Case LVN_COLUMNCLICK
			ListView_SortItems(lpNm->hdr.hwndFrom,_
			@LVCompareProc, Cast(LPARAM,lpNm->iSubItem))
		Case LVN_BEGINLABELEDIT
		Case LVN_ENDLABELEDIT
			If((lpLvdi->item.iItem <> -1) And _
				(lpLvdi->item.pszText <> NULL)) Then
				lstrcpy(lpAppinfo->szAppName, lpLvdi->item.pszText)
			EndIf
		Case NM_DBLCLK
			Dim As Integer index
			Dim As LVITEM lvi
			Dim As ZString*256 szBuf,szTempbuf

			szTempbuf="Selected item: "

			' Определяем номер выделенного элемента
			index = ListView_GetNextItem(hwndList,_
			-1, LVNI_ALL Or LVNI_SELECTED)

			If (index = -1) Then Exit Sub

			/' Подготавливаем структуру типа LV_ITEM
			 для получения текстовой информации об элементах'/

			lvi.mask = LVIF_TEXT
			lvi.pszText = @szBuf
			lvi.cchTextMax=256
			lvi.iItem = index

			' Получаем название элемента

			lvi.iSubItem = 0
			ListView_GetItem(hwndList, @lvi)
			szTempbuf+=szBuf
			szBuf=""

			/' Получаем текстовую строку, связанную
			 с первым и вторым дополнительным элементом '/
			lvi.iSubItem = 1
			ListView_GetItem(hwndList, @lvi)
			szTempbuf+=" : "
			szTempbuf+=szBuf

			lvi.iSubItem = 2
			ListView_GetItem(hwndList, @lvi)
			szTempbuf+=" : $"
			szTempbuf+=szBuf

			/' Выводим на экран текстовые строки
			 для выбранного элемента '/
			MessageBox(0, szTempbuf, szAppName, MB_OK)
	End Select
End Sub


' -----------------------------------------------------
' Функция WndProc_OnSize
' -----------------------------------------------------
Sub WndProc_OnSize(cx As Integer ,cy As  Integer )
	MoveWindow(hwndList, 0, 0, cx, cy, TRUE)
End Sub

' -----------------------------------------------------
' Функция LVCompareProc
' -----------------------------------------------------

Function LVCompareProc(lParam1 As LPARAM ,lParam2 As LPARAM ,_
	lParamSort As LPARAM )As Integer
	Dim As APPLINFO Ptr pAppInfo1 = Cast(APPLINFO Ptr,lParam1)
	Dim As APPLINFO Ptr pAppInfo2 = Cast(APPLINFO Ptr,lParam2)
	Dim As LPSTR lpStr1, lpStr2
	Dim As Integer iResult

	If pAppInfo1<>0 And pAppInfo2<>0 Then
		Select Case lParamSort
			Case 0
				lpStr1 = @pAppInfo1->szAppName
				lpStr2 = @pAppInfo2->szAppName
				iResult = lstrcmpi(lpStr1, lpStr2)
			Case 1
				lpStr1 = @pAppInfo1->szIconName
				lpStr2 = @pAppInfo2->szIconName
				iResult = lstrcmpi(lpStr1, lpStr2)
			Case 2
				iResult = pAppInfo1->iCost - pAppInfo2->iCost
		End Select
	EndIf
	Return iResult
End Function


