I am modifying Ziltches code (which is the only multi column list code I could find) to make it more OO and I'm also planning to add a sort facility to it. Most of it works ok, but I'm having problems getting the clicks from the column headings.
This code gives the following errror:
Compile Error: Unable to convert from 'Int(Int,Int,Int,Int)' to 'Byte Ptr'
(line 31)
However, if I make oldListProc a global (line 19) and NewListProc a function (line 194) then it runs, but obviously that will not work for each object created. So it's obviously something to do with it being a method in the type, but I have no idea why. Any ideas?
Strict Extern "win32" Function CallWindowProc:Int(lpPrevWndFunc,hWnd,uMsg,wParam,lParam) = "CallWindowProcA@20" End Extern '============================================================================== Type TMultiColumnListBox 'Original code: Ziltch 29 August 2006. 'Modified by Ghost Dancer July 2008 'You can use this code if you credit Ziltch & Ghost Dancer '============================================================================== Const LBS_MULTICOLUMN = 512 Field listBoxGadg:TGadget Field colWidth 'needed to reset width of first column when gadget created Field curRow 'used for adding new rows Field oldListProc 'used for column heading selections '------------------------------------------------------------------------------ Function Create:TMultiColumnListBox(x, y, w, h, parent:TGadget, firstColTxt$ = "", firstColWidth = 100) '------------------------------------------------------------------------------ Local newListBox:TMultiColumnListBox = New TMultiColumnListBox newListBox.listBoxGadg = CreateListBox(x, y, w, h, parent) newListBox.ListBoxHeading(0, firstColTxt$, firstColWidth) newListBox.colWidth = firstColWidth newListBox.oldListProc = SetWindowLongA(QueryGadget(newListBox.listBoxGadg,QUERY_HWND), GWL_WNDPROC,Int(Byte Ptr(newListBox.NewListProc))) Return newListBox End Function '------------------------------------------------------------------------------ Method ListBoxHeading(Column,Text$,width=0) '------------------------------------------------------------------------------ Local ListboxHwnd=QueryGadget(listBoxGadg,QUERY_HWND) Local col:LVCOLUMN = New LVCOLUMN If width = 0 Then Col.mask = LVCF_TEXT| LVCF_FMT Else Col.mask = LVCF_TEXT| LVCF_FMT | LVCF_WIDTH col.cx = width End If col.pszText = Text$.ToCString() Local ListBoxstyle = GetWindowLongA(ListboxHwnd , GWL_STYLE) If (ListBoxstyle & LVS_NOCOLUMNHEADER ) Then ListBoxstyle = ListBoxstyle ~LVS_NOCOLUMNHEADER If ListBoxstyle & LVS_EDITLABELS=0 Then ListBoxstyle = ListBoxstyle | LVS_EDITLABELS SetWindowLongA(ListboxHwnd , GWL_STYLE, ListBoxstyle ) 'change the style so that we have headings End If SendMessageA(ListboxHwnd,LVM_SETCOLUMNA,Column,Int(Byte Ptr Col)) End Method '------------------------------------------------------------------------------ Method AddListBoxColumn(Column,HeadingText$,width,Style=0) '------------------------------------------------------------------------------ Local ListboxHwnd=QueryGadget(listBoxGadg,QUERY_HWND) Local col:LVCOLUMN = New LVCOLUMN Col.mask = LVCF_WIDTH | LVCF_TEXT | LVCF_FMT Col.fmt = Style Col.cx = width col.pszText = HeadingText$.ToCString() Local ListBoxstyle = GetWindowLongA(ListboxHwnd , GWL_STYLE) If (ListBoxstyle & LBS_MULTICOLUMN ) <> ( LBS_MULTICOLUMN ) Then ListBoxstyle = ListBoxstyle | LBS_MULTICOLUMN SetWindowLongA(ListboxHwnd , GWL_STYLE, ListBoxstyle ) 'change the style so that we have headings End If SendMessageA(ListboxHwnd,LVM_INSERTCOLUMNA,Column,Int(Byte Ptr Col)) End Method '------------------------------------------------------------------------------ Method AddListBoxItem(text$[]) '------------------------------------------------------------------------------ 'add first column & reset width AddGadgetItem(listBoxGadg, text$[0]) ListBoxColumnWidth(0, colWidth) For Local column = 1 To text$.Length - 1 Local ListboxHwnd=QueryGadget(listBoxGadg,QUERY_HWND) Local ColItem:LVITEM = New LVITEM ColItem.mask = LVIF_TEXT ColItem.iSubItem = column ColItem.iItem = curRow ColItem.pszText = Text$[column].ToCString() ColItem.cchTextMax = Text$[column].Length + 1 SendMessageA( ListboxHwnd,LVM_SETITEMA,0,Int(Byte Ptr ColItem)) ColItem=Null Next 'increment row count curRow:+ 1 End Method '------------------------------------------------------------------------------ Method GetListBoxItem:String(Row,Column) '------------------------------------------------------------------------------ Local ListboxHwnd=QueryGadget(listBoxGadg,QUERY_HWND) If ListboxHwnd Then Local Ans$ Local TextBank:TBank=CreateBank(1024) 'Local Text:Byte[256] Local ColItem:LVITEM = New LVITEM ColItem.mask = LVIF_TEXT ColItem.iSubItem = Column ColItem.iItem = Row ColItem.pszText = BankBuf(TextBank) ColItem.cchTextMax = 255 SendMessageA( ListboxHwnd,LVM_GETITEMA,0,Int(Byte Ptr ColItem)) If ColItem.pszText <> Null Ans$=Ans$.fromcstring(ColItem.pszText) ColItem=Null End If Return Trim(Ans$) End If End Method '------------------------------------------------------------------------------ Method SetListBoxItem(Text:String,Row,Column=0) '------------------------------------------------------------------------------ Local ListboxHwnd=QueryGadget(listBoxGadg,QUERY_HWND) If Column=0 Then listBoxGadg.items[Row].Text = text If ListboxHwnd Then Local ColItem:LVITEM = New LVITEM ColItem.mask = LVIF_TEXT ColItem.iSubItem = Column ColItem.iItem = Row ColItem.pszText = Text.Tocstring() ColItem.cchTextMax = Len(Text) Return SendMessageA( ListboxHwnd,LVM_SETITEMA,0,Int(Byte Ptr ColItem)) End If End Method '------------------------------------------------------------------------------ Method ListBoxColumnWidth(Column,width) '------------------------------------------------------------------------------ Local ListboxHwnd=QueryGadget(listBoxGadg,QUERY_HWND) Local col:LVCOLUMN = New LVCOLUMN Col.mask = LVCF_WIDTH col.cx = width SendMessageA(ListboxHwnd,LVM_SETCOLUMNA,Column,Int(Byte Ptr Col)) End Method '------------------------------------------------------------------------------ Method ListBoxGadgetMultiSelect() '------------------------------------------------------------------------------ Local ListboxHwnd = QueryGadget(listBoxGadg,QUERY_HWND) Local ListBoxstyle = GetWindowLongA(ListboxHwnd , GWL_STYLE) If (ListBoxstyle & LVS_SINGLESEL) = LVS_SINGLESEL Then Return SetWindowLongA(ListboxHwnd , GWL_STYLE, ListBoxstyle ~ LVS_SINGLESEL ) 'change the style End If End Method '------------------------------------------------------------------------------ Method getSelectedItem$(col = 0) '------------------------------------------------------------------------------ If SelectedGadgetItem(listBoxGadg) >= 0 Then Return GetListBoxItem(SelectedGadgetItem(listBoxGadg), col) End If End Method '------------------------------------------------------------------------------ Method NewListProc:Int(hWnd:Int,Msg:Int,wParam:Int,lParam) "win32" '------------------------------------------------------------------------------ Const HDN_ITEMCLICKW = -322 If Msg = WM_NOTIFY Then Local NotifyMess:HD_NOTIFY = New HD_NOTIFY Local Tstr$ MemCopy( Byte Ptr(NotifyMess),Byte Ptr( lParam), SizeOf(HD_NOTIFY) ) If NotifyMess.code = HDN_ITEMCLICKW Then Print NotifyMess.iitem End If EndIf If oldListProc <>0 Then Return CallWindowProc(oldListProc, hWnd, Msg, wParam,Int(Byte Ptr( lParam))) End Method End Type '============================================================================== Type HD_NOTIFY '============================================================================== Field hwndFrom Field idFrom Field code Field iItem Field iButton Field pitem EndType '============================================================================== Type LVCOLUMN '============================================================================== Field mask Field fmt Field cx Field pszText:Byte Ptr Field cchTextMax Field iSubItem End Type '============================================================================== Type LVITEM '============================================================================== Field mask Field iItem Field iSubItem Field iState Field stateMask Field pszText:Byte Ptr Field cchTextMax Field iImage Field lParam Field iIndent Field iGroupId Field cColumns Field puColumns End Type '****************************************************************************** 'example code '****************************************************************************** 'set up Local window:TGadget =CreateWindow("Multi-Column List Example",100,100,320,180,Null,WINDOW_TITLEBAR|WINDOW_CLIENTCOORDS) Local listBox:TMultiColumnListBox = TMultiColumnListBox.Create(2, 2, 300, 150, window, "Name") listBox.AddListBoxColumn(1, "Sex", 80) listBox.AddListBoxColumn(2, "Age", 80) 'add some data listBox.AddListBoxItem(["Simon", "Male", "34"]) listBox.AddListBoxItem(["Jane", "Female", "29"]) listBox.AddListBoxItem(["Peter", "Male", "38"]) listBox.AddListBoxItem(["Sally", "Female", "44"]) Local Gadget:TGadget 'Main Loop Repeat WaitEvent() Gadget = TGadget(EventSource()) Select EventID() Case EVENT_WINDOWCLOSE Select gadget Case window Exit End Select End Select Forever Print "Selected Item: " + listBox.getSelectedItem() + ", aged " + listBox.getSelectedItem(2) End
This code gives the following errror:
Compile Error: Unable to convert from 'Int(Int,Int,Int,Int)' to 'Byte Ptr'
(line 31)
However, if I make oldListProc a global (line 19) and NewListProc a function (line 194) then it runs, but obviously that will not work for each object created. So it's obviously something to do with it being a method in the type, but I have no idea why. Any ideas?