FreeBasic

Бывает , что необходим табличный вывод информации. Пример ниже как показывает как это несложно сделать. Дополнительно для исходного кода нужна библиотека window9

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

'; English forum: http://www.purebasic.fr/english/viewtopic.php?t=15714&highlight=
'; Author: localmotion34 (updated for PB 4.00 by Andre)
'; Adapted on FreeBasic: Станислав Будинов
'; Date: 26. June 2005
'; OS: Windows
'; Demo: No
'
'
'; Here is a little piece of code that could be the beginning of a simple grid
'; or whatever else someone had in mind for a lisbox. It's based on an ownerdrawn
'; listbox as previously i have posted before. This just takes advantage of the
'; #wm_drawitem message and the #wm_notify message. Take it for what it is worth,
'; and use it as you need.

#INCLUDE "window9.bi"

Dim Shared OriginProc As Long ,editcontrol As HWND ,crtitem As Long
Dim Shared As ZString*32 sArray_Item(35)

Function ListboxProc(hwnd As HWND, msg As UINT, wParam As WPARAM,lParam As LPARAM) As Integer
    Select Case msg
        Case WM_DRAWITEM            
            Static As HBRUSH currentBrush,hbrushSelectedFocus           
            If currentBrush<>0 Then DeleteObject(currentBrush)
            If hbrushSelectedFocus<>0 Then DeleteObject(hbrushSelectedFocus)            
            hbrushSelectedFocus = CreateSolidBrush(BGR(0, 0, 80))
            Dim As Integer dtFlags,currentTextColor,drawfoc,drawbox
            Dim As HWND listb = GetWindow(hwnd,GW_CHILD)
            Dim As DRAWITEMSTRUCT Ptr  lpdis = Cast(DRAWITEMSTRUCT Ptr,lParam),lptris
            lptris  = lpdis
            Select Case lpdis->CtlType
                Case ODT_LISTBOX
                    Dim As Integer itemHeight = SendMessage(lpdis->hwndItem,LB_GETITEMHEIGHT,0,0)
                    Select Case lpdis->itemState
                        Case ODS_SELECTED
                            dtFlags = DT_CENTER Or DT_VCENTER
                            currentBrush = CreateSolidBrush(BGR(0, 0, 80))
                            currentTextColor = &HFFFFFF
                            drawfoc=FALSE
                            drawbox=FALSE
                        Case ODS_SELECTED Or ODS_FOCUS
                            dtFlags = DT_CENTER Or DT_VCENTER
                            currentBrush = hbrushSelectedFocus
                            currentTextColor = &HFFFFFF
                            drawfoc = TRUE
                            drawbox = FALSE
                        Case 0
                            dtFlags = DT_CENTER Or DT_VCENTER
                            currentTextColor = BGR(0, 0, 0)
                            drawfoc = FALSE
                            drawbox = TRUE
                    End Select
                    FillRect(lpdis->hdc, @lpdis->rcItem, currentBrush)
                    If drawfoc = True Then
                        DrawFocusRect(lpdis->hdc, @lpdis->rcItem)
                    Endif
                    If drawbox = True Then
                        Rectangle(lpdis->hdc,lpdis->rcItem.left,lpdis->rcItem.top,lpdis->rcItem.right,lpdis->rcItem.bottom)
                    Endif
                    SetBkMode(lpdis->hdc, TRANSPARENT)
                    SetTextColor(lpdis->hdc, currentTextColor)
                    DrawText(lpdis->hdc, Strptr(sArray_Item(lpdis->ItemID)), Len(sArray_Item(lpdis->ItemID)), @lpdis->rcItem, dtFlags)
                    Return 0
            End Select
        Case WM_COMMAND
            Select Case Hiword(wParam)
                Case LBN_DBLCLK
                    Dim As RECT itmrect
                    Dim As Integer itmhght
                    crtitem = SendMessage(Cast(HWND,lParam),LB_GETCURSEL,0,0)
                    SendMessage(Cast(HWND,lParam),LB_GETITEMRECT,crtitem,Cast(LPARAM,@itmrect))
                    itmhght = SendMessage(Cast(HWND,lParam),LB_GETITEMHEIGHT,0,0)
                    UseGadgetList(Cast(HWND,lParam))
                    editcontrol = StringGadget(Cint(GetProp(Cast(HWND,lParam),"EDITMATRIX")),itmrect.left+1,itmrect.top,itmrect.right-itmrect.left-2,itmhght,sArray_Item(crtitem),ES_AUTOHSCROLL Or WS_BORDER)
                    SetFocus(editcontrol)
                    Return 0
                Case LBN_SELCHANGE
                    If editcontrol Then
                        SendMessage(Cast(HWND,lParam),LB_DELETESTRING,crtitem,0)
                        sArray_Item(crtitem) = GetGadgetText(Cint(GetProp(Cast(HWND,lParam),"EDITMATRIX")))
                        SendMessage(Cast(HWND,lParam),LB_INSERTSTRING,crtitem,Cast(LPARAM,@sArray_Item(crtitem)))
                        FreeGadget(Cint(GetProp(Cast(HWND,lParam),"EDITMATRIX")))
                        editcontrol = 0
                    Endif
                    Return 0
            End Select
    End Select
    Return CallWindowProc(Cast(WNDPROC,OriginProc),hwnd,msg,wParam,lParam)
End Function

Function LBGrid(iGadgetConteiner As Integer,iGadgetMatrix As Integer,iGadgetEdit As Integer, x As Integer,y As Integer,width_ As Integer,height As Integer,itemHeight As Integer) As HWND
    Dim As HWND Window_, lb
    Window_ = ContainerGadget(iGadgetConteiner,x,y,width_-3,height-1,WS_EX_DLGMODALFRAME)
    lb=ListBoxGadget(iGadgetMatrix,0,0,width_,height,LBS_OWNERDRAWFIXED+LBS_HASSTRINGS+LBS_MULTICOLUMN+LBS_NOTIFY)
    OriginProc = SetWindowLong(window_, GWL_WNDPROC, Cast(Long,@ListboxProc))
    SetProp(lb,"EDITMATRIX",Cast(handle,iGadgetEdit))
    SendMessage(lb, LB_SETITEMHEIGHT, 0, itemHeight)
    SendMessage(lb, LB_SETCOLUMNWIDTH, 80,0)
    UseGadgetList(GetParent(Window_))
    Return lb
End Function

Enum MatrixENUM
    CONTEINER = 1
    MATRIX
    MATRIXEDIT
End Enum

Dim As HWND hwnd = OpenWindow( "",  100, 200, 320, 280)
CenterWindow(hwnd)
Dim As HWND grid = LBGrid(CONTEINER,MATRIX,MATRIXEDIT,30,20,250,200,0)

For i As Integer =0 To 35
    sArray_Item(i) = Str(i)
    AddListBoxItem(2,sArray_Item(i))
Next

Do :Loop Until WaitEvent = eventclose