FreeBasic

Данный пример показывает как можно изменить цвет определенных пунктов ListView. Один пример с использованием библиотеки window9, другой на чистом API

Платформа: Windows
Автор: Станислав Будинов

#INCLUDE "window9.bi" 

 Dim Shared As HWND LWHwnd 

 Function windowproc(hwnd As HWND,msg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer  
    Select Case msg 
   Case WM_NOTIFY 
    Dim nmlcd As LPNMLVCUSTOMDRAW = Cast(LPNMLVCUSTOMDRAW,lParam ) 
    If nmlcd->nmcd.hdr.code = NM_CUSTOMDRAW Then 
     If nmlcd->nmcd.hdr.hWndFrom = LWHwnd Then 
      Select Case nmlcd->nmcd.dwDrawStage 
       Case CDDS_PREPAINT 
        Return CDRF_NOTIFYITEMDRAW 
       Case CDDS_ITEMPREPAINT 
        If nmlcd->nmcd.dwItemSpec = 0 Then 
         nmlcd->clrText = &h00ffff 
         nmlcd->clrTextBk = &h000FF0 
        Elseif nmlcd->nmcd.dwItemSpec = 1 Then 
         nmlcd->clrText = &hFF0000 
         nmlcd->clrTextBk = &hFF00FF 
        Endif 
      End Select 
     Endif 
    Endif 
    End Select 
 End Function 

 Var hwnd=OpenWindow("ColorLW",10,10,190,120) 
 Var Style= LVS_EX_FULLROWSELECT  Or LVS_EX_GRIDLINES 
 LWHwnd=ListViewGadget(1,10,10,150,53,Style,,,0) 
 AddListViewColumn(1, "Столбец",0,1,150) 
 AddListViewItem(1,"1 строка",0,0,0) 
 AddListViewItem(1,"2 строка",0,1,0) 
 SetWindowCallback(@windowproc()) 
 Do 
  Var event=WaitEvent() 
  If Event=EventClose Then End 
 Loop

#INCLUDE "windows.bi"
#INCLUDE Once "win\commctrl.bi"
InitCommonControls()

Dim Shared As HINSTANCE Hinst
Dim Shared As HWND LWHwnd
Dim msg As MSG
Dim As WNDCLASSEX wc
Dim As String NameClass="MyClass"
Hinst=GetModuleHandle(0)
#DEFINE StyleLW LVS_REPORT Or WS_VISIBLE Or WS_CHILD
#DEFINE ExStyle LVS_EX_FULLROWSELECT Or LVS_EX_GRIDLINES

Function wndproc(hwnd As HWND, msg As Uinteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer
    Select Case msg
        Case WM_CREATE
            LWHwnd=CreateWindowEx(0,"SysListView32","",StyleLW,10,10,150,53,hWnd,Cast(HMENU,1),HINST,0)
            Dim As LVCOLUMN LVS9
            LVS9.mask=LVCF_TEXT Or LVCF_WIDTH
            LVS9.fmt=LVCFMT_CENTER
            LVS9.cx=150
            LVS9.pszText =StrPtr("Столбец")
            LVS9.cchTextMax = Len("Столбец")+1
            SendMessage(LWHwnd,LVM_INSERTCOLUMN,0,Cast(LPARAM,@LVS9))
            Dim  lvi As LVITEM
            lvi.mask = LVIF_TEXT
            lvi.pszText = Strptr("2 ячейка")
            SendMessage(LWHwnd,LVM_INSERTITEM,0,Cast(LPARAM,@lvi))
            lvi.pszText = Strptr("1 ячейка")
            SendMessage(LWHwnd,LVM_INSERTITEM,0,Cast(LPARAM,@lvi))
        Case WM_NOTIFY
            Dim nmlcd As LPNMLVCUSTOMDRAW = Cast(LPNMLVCUSTOMDRAW,lParam )
            If nmlcd->nmcd.hdr.code = NM_CUSTOMDRAW Then
                If nmlcd->nmcd.hdr.hWndFrom = LWHwnd Then
                    Select Case nmlcd->nmcd.dwDrawStage
                        Case CDDS_PREPAINT
                            Return CDRF_NOTIFYITEMDRAW
                        Case CDDS_ITEMPREPAINT
                            If nmlcd->nmcd.dwItemSpec = 0 Then
                                nmlcd->clrText = &h00ffff
                                nmlcd->clrTextBk = &h000FF0
                            Elseif nmlcd->nmcd.dwItemSpec = 1 Then
                                nmlcd->clrText = &hFF0000
                                nmlcd->clrTextBk = &hFF00FF
                            Endif
                    End Select
                Endif
            Endif
        Case WM_DESTROY
            PostQuitMessage(0)
    End Select
    Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function

With wc
    .cbSize=SizeOf(WNDCLASSEX)
    .style=CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc=@wndproc
    .hInstance=Hinst
    .hIcon=LoadIcon(0,IDI_QUESTION)
    .hCursor=LoadCursor(0,IDC_ARROW)
    .hbrBackground=Cast(HBRUSH,COLOR_WINDOW)
    .lpszClassName=StrPtr(NameClass)
    .hIconSm=.hIcon
End With

If RegisterClassEx(@wc)=0 Then
    Print "Register error, press any key"
    Sleep
    End
Endif

CreateWindowEx(0,NameClass,"Color ListView",_
WS_VISIBLE Or WS_OVERLAPPEDWINDOW,100,100,190,110,0,0,Hinst,0)

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