FreeBasic

Два примера виртуального списка. Один с использованием библиотеки Window9 (а значит проще), второй на чистом API. В примерах идет заполнение списка в четыре колонки по 50000 строковых значений. При выделении какого нибудь пункта и последующего нажатия правой кнопки мыши, отображается значение из этого пункта.

Автор: Станислав Будинов.

C использованием Библиотеки Window9

#INCLUDE "window9.bi"

Dim Shared As Integer Count=50000
Dim Shared As String array(Count ,3)
#DEFINE Style LVS_OWNERDATA Or LVS_REPORT
#DEFINE ExStyle LVS_EX_FULLROWSELECT Or LVS_EX_GRIDLINES Or LVS_EX_SUBITEMIMAGES

Function WinProc(hwnd As hwnd, msg As UINT, wParam As WPARAM, lParam As lparam) As Integer
    Select Case  msg
        Case WM_NOTIFY
            Dim Nmhdr As NMHDR Ptr=Cast(NMHDR Ptr,lParam)
            Select Case  Nmhdr->code
                Case LVN_GETDISPINFO
                    Dim Ndisp As NMLVDISPINFO Ptr = Cast(NMLVDISPINFO Ptr,lParam)
                    If Ndisp->item.mask And LVIF_TEXT Then
                        Ndisp->item.pszText = Strptr(array(Ndisp->item.iItem,Ndisp->item.iSubItem))
                    Endif
                Case NM_RCLICK
                    SetGadgetText(2,GetTextItemListView(1,GetItemListView(),GetSubItemListView()))
            End Select
    End Select
    Return 0
End Function

OpenWindow("Виртуальный список", 0, 0, 490, 350)
ListViewGadget(1,10,10,440,250,ExStyle,Style)
AddListViewColumn(1,"Column1",0,1,110)
AddListViewColumn(1,"Column2",1,2,110)
AddListViewColumn(1,"Column3",2,3,110)
AddListViewColumn(1,"Column4",3,4,110)
TextGadget(2,100,280,140,20,"номер")
ButtonGadget(3,300,280,140,20,"Заполнить список")
SetWindowCallback(Cast(Integer,@WinProc()))

Do
    Select Case WaitEvent()
        Case EventGadget
            Select Case EventNumber
                Case 3
                    DeleteListViewItemsAll(1)
                    SendMessage(GadgetID(1), LVM_SETITEMCOUNT, Count,1 )
                    For a As Integer = 0 To Count
                        array(a,0) = "1_" & a
                        array(a,1) = "2_" & a
                        array(a,2) = "3_" & a
                        array(a,3) = "4_" & a
                    Next
            End Select
        Case EventClose
            Exit Do
    End Select
Loop

На чистом API

#INCLUDE "windows.bi"
#INCLUDE Once "win\commctrl.bi"
InitCommonControls()
Type LV_ITEM
    As UINT         mask
    As Integer      iItem
    As Integer      iSubItem
    As UINT         state
    As UINT         stateMask
    As LPTSTR       pszText
    As Integer      cchTextMax
    As Integer      iImage
    As LPARAM       lParam
End Type
Dim Shared As Integer Count=50000
Dim Shared As String array(Count ,3)
Dim Shared As HINSTANCE Hinst
Dim Shared As HWND LWHwnd,BnHwnd,StHwnd
Dim msg As MSG
Dim As WNDCLASSEX wc
Dim As String NameClass="MyClass"
Hinst=GetModuleHandle(0)
#DEFINE StyleLW LVS_OWNERDATA Or 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,440,250,hWnd,Cast(HMENU,1),HINST,0)
            StHwnd=CreateWindowEx(0,"Static","Number",WS_VISIBLE Or WS_CHILD,100,280,140,20,hWnd,Cast(HMENU,2),HINST,0)
            BnHwnd=CreateWindowEx(0,"button","Go",WS_VISIBLE Or WS_CHILD,300,280,140,20,hWnd,Cast(HMENU,3),HINST,0)
            Dim As LVCOLUMN LVS9
            Dim As String column="Column_",TCol
            For i As Integer=1 To 4
                TCol=column & i
                LVS9.mask=LVCF_FMT Or LVCF_SUBITEM Or LVCF_TEXT Or LVCF_WIDTH
                LVS9.fmt=LVCFMT_CENTER
                LVS9.cx=110
                LVS9.pszText =StrPtr(Tcol)
                LVS9.cchTextMax = Len(column)+1
                LVS9.iSubItem = i
                SendMessage(LWHwnd,LVM_INSERTCOLUMN,i-1,Cast(LPARAM,@LVS9))
            Next
            SendMessage(LWHwnd,LVM_SETEXTENDEDLISTVIEWSTYLE,0 ,Cast(LPARAM,ExStyle))
        Case WM_COMMAND
            Select Case Loword(wparam)
                Case 3
                    SendMessage(LWHwnd,LVM_DELETEALLITEMS,0,0)
                    SendMessage(LWHwnd, LVM_SETITEMCOUNT, Count,1 )
                    For a As Integer = 0 To Count
                        array(a,0) = "1_" & a
                        array(a,1) = "2_" & a
                        array(a,2) = "3_" & a
                        array(a,3) = "4_" & a
                    Next
            End Select
        Case WM_NOTIFY
            Dim Nmhdr As NMHDR Ptr=Cast(NMHDR Ptr,lParam)
            Select Case  Nmhdr->code
                Case LVN_GETDISPINFO
                    Dim Ndisp As NMLVDISPINFO Ptr = Cast(NMLVDISPINFO Ptr,lParam)
                    If Ndisp->item.mask And LVIF_TEXT Then
                        Ndisp->item.pszText = Strptr(array(Ndisp->item.iItem,Ndisp->item.iSubItem))
                    Endif
                Case NM_RCLICK
                    Dim buf As String*256
                    Dim act_ As LPNMITEMACTIVATE=Cast(LPNMITEMACTIVATE,Nmhdr)
                    Dim LV_ITEM As LV_ITEM
                    LV_ITEM.iSubItem=act_->iSubItem
                    LV_ITEM.pszText= Cast(LPSTR,@buf)
                    LV_ITEM.cchTextMax=256
                    SendMessage(LWHwnd,LVM_GETITEMTEXT,act_->iItem,Cast(lparam,@LV_ITEM))
                    SetWindowText(StHwnd,buf)
            End Select
        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,"Virtual ListView",_
WS_VISIBLE Or WS_OVERLAPPEDWINDOW,100,100,480,350,0,0,Hinst,0)

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