FreeBasic

Пример, показывающий ручную отрисовку ListBox с помощью стиля LBS_OWNERDRAWFIXED. Пример адаптирован с PureBasic

Платформа: Windows
Автор: Fluid Byte
Адаптация исходника под Freebasic: Станислав Будинов

'Autor: Fluid Byte

#INCLUDE "window9.bi"

Type ST
    sMain As ZString*64
    sSub As ZString*64
End Type

Type LBITEMEX
    Icon As HICON
    Title As ZString*64
    Text As ZString*64
End Type

Const As Integer LST_Ownerdraw = 101
Dim As ST sArray(1 To 5)

Function WindowCallback(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM)As Integer
    Select Case uMsg
        Case WM_DRAWITEM
            Dim lpdis As DRAWITEMSTRUCT Ptr = Cast(DRAWITEMSTRUCT Ptr ,lParam)
            Dim lbex As LBITEMEX Ptr = GetProp(GadgetID(LST_Ownerdraw),Cast(Any Ptr ,lpdis->itemID+1))
            Dim As HDC  hdcMem
            Dim As HGDIOBJ hfntPrevious
            Dim As HBRUSH hbrFace
            Dim As HFONT hfntTitle
            Dim As LOGFONT lplf

            If lpdis->itemState And ODS_SELECTED Then
                hbrFace = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
                FillRect(lpdis->hdc,@lpdis->rcItem,hbrFace)
                DrawFocusRect(lpdis->hdc,@lpdis->rcItem)
                SetTextColor(lpdis->hdc,GetSysColor(COLOR_HIGHLIGHTTEXT))
            Else
                hbrFace = CreateSolidBrush(GetSysColor(COLOR_WINDOW))
                FillRect(lpdis->hdc,@lpdis->rcItem,hbrFace)
                SetTextColor(lpdis->hdc,GetSysColor(COLOR_WINDOWTEXT))
            Endif
            DeleteObject(hbrFace)   
            DrawIcon(lpdis->hdc,2,lpdis->rcItem.top + 2,lbex->Icon)
            GetObject(Cast(HGDIOBJ,SendMessage(lpdis->hWndItem,WM_GETFONT,0,0)),Sizeof(LOGFONT),@lplf)
            lplf.lfHeight = -MulDiv(12,GetDeviceCaps(lpdis->hdc,LOGPIXELSY),72)
            
            hfntTitle = CreateFontIndirect(@lplf)
            SetBkMode(lpdis->hdc,TRANSPARENT)
            hfntPrevious = SelectObject(lpdis->hdc,hfntTitle)
            TextOut(lpdis->hdc,40,lpdis->rcItem.top + 2,lbex->title,lstrlen(lbex->title))
            SelectObject(lpdis->hdc,hfntPrevious)
            TextOut(lpdis->hdc,40,lpdis->rcItem.top + 20,lbex->text,lstrlen(lbex->text))
            DeleteObject(hfntTitle)
         
            Return True
    End Select

End Function

Sub AddLBItemEx(Gadget As Integer,Position As Integer,Icon As HICON, Title As String,Text  As String)
    Dim lbex  As LBITEMEX Ptr = New LBITEMEX
    Dim As Integer Index
    lbex->Icon = Icon
    lbex->Title = Title
    lbex->Text = Text
    Index = SendMessage(GadgetID(Gadget),LB_ADDSTRING,0,0)
    SetProp(GadgetID(LST_Ownerdraw),Cast(LPSTR,Index+1),lbex)
End Sub

OpenWindow("Window",0,0,500,250)
ListBOxGadget(LST_Ownerdraw,10,10,480,230,LBS_OWNERDRAWFIXED)
SendMessage(GadgetID(LST_Ownerdraw),LB_SETITEMHEIGHT,0,Cast(LParam,36))
SetWindowCallback(Cast(Integer,@WindowCallback()))
Dim As HICON icon = loadIcon(0,IDI_QUESTION)
Dim As HICON icon2 = loadIcon(0,IDI_EXCLAMATION)

For i As Integer=1 To 5
    sArray(i).sMain = "Maintext " & i
    sArray(i).sSub = "Subtext " & i
    If i Mod 2 Then
        AddLBItemEx(LST_Ownerdraw,-1,icon,sArray(i).sMain,sArray(i).sSub)
    Else
        AddLBItemEx(LST_Ownerdraw,-1,icon2,sArray(i).sMain,sArray(i).sSub)
    Endif   
Next

Do : Loop Until WaitEvent() = EventClose


Sub ENDED Destructor
    For i As Integer = 1 To 5
        Dim lbex As LBITEMEX Ptr = GetProp(GadgetID(LST_Ownerdraw),Cast(Any Ptr ,i))
        Delete lbex
    Next    
End Sub