Tweet
Since there haven't been many class/object demos, I thought I would submit one that might be useful. It is simply a listbox with some headers at the top which can be clicked for sorting, similar to listview controls. The only reason to create it in a class is to keep the data encapsulated. Everything above FUNCTION PBMAIN() could be kept in an include file if desired.
Code:
#DIM ALL
#INCLUDE "win32api.inc"
'#INCLUDE "debug.inc"
%ID_List = 100 'headers use 101, 102, ...
%ID_Status = 201
GLOBAL colList AS IColumnList
CLASS CColumnList
INSTANCE hDlg, listID AS LONG 'handle of listbox parent, ID of listbox
INSTANCE x, y, xx, yy AS LONG 'location & size of listbox
INSTANCE numColumns AS LONG 'number of columns in listbox
INSTANCE numItems AS LONG 'number of items in listbox
INSTANCE hiLite AS LONG 'high lighted item in listbox
INSTANCE ti() AS STRING 'column header titles
INSTANCE wi() AS LONG 'column header widths (neg for right alligned)
INSTANCE colType() AS LONG '1,2,3 for str, val, date column type (neg for right-adjust)
INSTANCE items() AS STRING 'row strings with TAB separated columns
INSTANCE recNo() AS LONG 'record number as originally added
CLASS METHOD showList
LOCAL i, k AS LONG, s AS STRING
LISTBOX RESET hDlg, listID
FOR i = 1 TO numItems
s = items(recNo(i))
IF recNo(i) = hiLite THEN hiLite = i
REPLACE "," WITH $TAB IN s
LISTBOX ADD hDlg, listID, s
NEXT i
IF hiLite = 0 THEN hiLite = 1
CONTROL SEND hDlg, %ID_LIST, %LB_SETCURSEL, hiLite - 1, 0
showStatus 1: showStatus 2
CONTROL SET FOCUS hDlg, %ID_LIST
END METHOD
INTERFACE IColumnList
INHERIT IUNKNOWN
PROPERTY GET getHandle() AS LONG
PROPERTY = hDlg
END PROPERTY
PROPERTY GET getNumShown() AS LONG
PROPERTY = numItems
END PROPERTY
PROPERTY GET getHiLite() AS LONG
PROPERTY = hiLite
END PROPERTY
PROPERTY SET setHiLite(BYVAL n AS LONG)
hiLite = n
END PROPERTY
METHOD getRecordNo(BYVAL i AS LONG) AS LONG
IF UBOUND(recNo()) >= i THEN
METHOD = recNo(i)
END IF
END METHOD
METHOD createList(hParent AS LONG, ID_List AS LONG, _
a AS LONG, b AS LONG, w AS LONG, h AS LONG, _
pwi AS DWORD, pti AS DWORD, numCols AS LONG)
'hParent, ID_List = handle of containing dialog, control id
'a, b, w, h = location and size of control including listbox headers (pixels/units from parent)
'pwi = pointer to wi(), width of columns (neg value for right adjusted)
'pti = pointer to ti(), title of columns (leading chr$(1) for value, chr$(2) for date)
'numCols = number of columns
'-----------------------------------------------------------------------------------------------------
LOCAL nStyle, i, j, k, n, hdc, ws, ht, rx, ry, u, nPixels AS LONG
LOCAL cSize AS SIZEL, r AS RECT, txt AS ASCIIZ*16, s AS STRING
DIM wi(1 TO numCols) AT pwi
DIM ti(1 TO numCols) AT pti
DIM tabstops(numCols - 1) AS LONG
DIM colType(1 TO numCols) AS INSTANCE LONG
'determine pixels or dialog units-------------------------
hDlg = hParent: listID = ID_list
DIALOG GET SIZE hDlg TO rx, ry
GetWindowRect hDlg, r
IF rx = (r.nRight - r.nLeft) THEN nPixels = 1
'determine header height and scroll width ----------------
txt = "0": hdc = GetDC(hDlg)
GetTextExtentPoint32 hdc, BYVAL VARPTR(txt), LEN(txt), cSize
ht = 1.2 * cSize.cy: u = cSize.cx
ws = GetSystemMetrics(%SM_CXVSCROLL)
IF nPixels = 0 THEN DIALOG PIXELS hDlg, ws, ht TO UNITS ws, ht
ReleaseDC hDlg, hdc
'define column types -------------------------------------
FOR i = 1 TO numCols
colType(i) = ASC(LEFT$(ti(i), 1)) + 1
IF colType(i) <= 3 THEN ti(i) = MID$(ti(i), 2) ELSE colType(i) = 1
colType(i) = SGN(wi(i)) * coltype(i): wi(i) = ABS(wi(i))
NEXT i
'fit last column width -----------------------------------
j = 0: FOR i = 1 TO numCols - 1: j = j + wi(i): NEXT i
wi(numCols) = w - j - ws
'create the listbox --------------------------------------
x = a: y = b: xx = w: yy = h: numColumns = numCols
nStyle = %WS_VSCROLL OR %LBS_DISABLENOSCROLL OR %LBS_USETABSTOPS OR %WS_TABSTOP
CONTROL ADD LISTBOX, hDlg, listID, , x, y+ht, xx, yy-ht, nStyle, %WS_EX_CLIENTEDGE, CALL ListCB
'define tabstops for listbox -----------------------------
tabstops(0) = 2
FOR i = 1 TO numColumns - 1: tabstops(i) = tabstops(i - 1) + wi(i): NEXT i
tabstops(numColumns - 1) = tabstops(numColumns - 1) - 2
FOR i = 0 TO numColumns - 1
IF colType(i + 1) < 0 THEN 'right alligned tabstop
tabstops(i) = SGN(colType(i + 1)) * (tabstops(i) + wi(i + 1) - 6)
END IF
NEXT i
IF nPixels THEN 'convert pixels to dialog units for tabstops
DIALOG PIXELS hDlg, 1000, 0 TO UNITS rx, ry
FOR i = 0 TO numColumns - 1: tabstops(i) = rx/1000 * tabstops(i): NEXT i
END IF
CONTROL SEND hDlg, listID, %LB_SETTABSTOPS, numColumns, VARPTR(tabstops(0))
'create listbox headers ----------------------------------
n = %SS_NOTIFY
j = x
FOR i = 1 TO numColumns
IF i > 1 THEN j = j + wi(i - 1)
IF colType(i) < 0 THEN
s = ti(i) + " ": nStyle = %SS_RIGHT + n
ELSE
s = " " + ti(i): nStyle = %SS_LEFT + n
END IF
CONTROL ADD LABEL, hDlg, listID+i, s, j, y, wi(i), ht, nStyle, %WS_EX_STATICEDGE, CALL ListCB
NEXT i
END METHOD
METHOD addItem(itemStr AS STRING, nShow AS LONG)
'add itemStr to items() and list if nShow > 0
INCR numItems
REDIM PRESERVE items(1 TO numItems)
REDIM PRESERVE recNo(1 TO numItems)
items(numItems) = itemStr
recNo(numItems) = numItems
IF nShow THEN colList.showList
END METHOD
METHOD convertDate(s AS STRING) AS LONG
'convert "10/13/1934" to 19341013
LOCAL mo AS WORD, day AS WORD, yr AS WORD
mo = VAL(LEFT$(s, 2))
day = VAL(MID$(s, 4, 2))
yr = VAL(RIGHT$(s, 4)) - 1980
ROTATE RIGHT yr, 7
ROTATE LEFT mo, 5
METHOD = yr + mo + day
END METHOD
METHOD columnSort(nCol AS LONG)
'this routine toggles the column sort when the column header is clicked.
'colType() holds the type of column: string=1, value=2, or date=3
'the key to this routine is simply to determine the tagged recNo()
'------------------------------------------------------------------------
LOCAL i, n, nSort AS LONG, s AS STRING
DIM sArray(1 TO numItems) AS STRING
DIM nArray(1 TO numItems) AS LONG
hiLite = recNo(hiLite)
n = ABS(colType(nCol)) 'neg colType signals right adjusted
FOR i = 1 TO numItems 'fill the appropriate array with the specified column
s = PARSE$(items(recNo(i)), nCol)
IF n = 2 THEN 'value, use numeric array
nArray(i) = VAL(s)
ELSEIF n = 3 THEN 'date, use numeric array
nArray(i) = colList.convertDate(s)
ELSE 'use string array
sArray(i) = s
END IF
NEXT i
nSort = -1
IF sArray(numItems) > sArray(1) OR nArray(numItems) > nArray(1) THEN nSort = 1
IF nSort < 0 THEN 'sort as ascending
IF n = 1 THEN 'use string array
ARRAY SORT sArray(), COLLATE UCASE, TAGARRAY recNo(), ASCEND
ELSE 'use numeric array
ARRAY SORT nArray(), TAGARRAY recNo(), ASCEND
END IF
ELSE 'sort as descending
IF n = 1 THEN 'use string array
ARRAY SORT sArray(), COLLATE UCASE, TAGARRAY recNo(), DESCEND
ELSE 'use numeric array
ARRAY SORT nArray(), TAGARRAY recNo(), DESCEND
END IF
END IF
ME.showList
END METHOD
END INTERFACE
END CLASS
CALLBACK FUNCTION listCB()
LOCAL top, k, n AS LONG
SELECT CASE CB.MSG
CASE %WM_COMMAND
IF CB.CTL = %ID_List AND CB.CTLMSG = %LBN_SELCHANGE THEN
CONTROL SEND CB.HNDL, %ID_List, %LB_GETTOPINDEX, 0, 0 TO k
CONTROL SEND CB.HNDL, %ID_LIST, %LB_GETCURSEL, 0, 0 TO n
top = k + 1: colList.setHiLite() = n + 1
ELSEIF CB.CTL > %ID_List AND CB.CTLMSG = %STN_CLICKED THEN
colList.columnSort(CB.CTL - %ID_List)
END IF
END SELECT
END FUNCTION
FUNCTION PBMAIN()
LOCAL hMain, nStyle, n, x, y AS LONG
LOCAL title AS STRING
LOCAL wi() AS LONG, ti() AS STRING
LET colList = CLASS "CColumnList"
n = 5
DIM wi(1 TO n), ti(1 TO n)
wi(1) = 50: wi(2) = 50: wi(3) = 70: wi(4) = 70: wi(5) = -60 'units
' wi(1) = 70: wi(2) = 70: wi(3) = 100: wi(4) = 100: wi(5) = -90 'pixels
ti(1) = CHR$(2) + "Date": ti(2) = "Type": ti(3) = "Descr": ti(4) = "Name": ti(5) = CHR$(1) + "Amount"
title = "Column List Demo"
nStyle = %WS_SYSMENU OR %WS_MINIMIZEBOX
DIALOG NEW 0, title$,,, 320, 350, nStyle TO hMain
' DIALOG NEW PIXELS, 0, title$,,, 450, 350, nStyle TO hMain
colList.createList(hMain, %ID_List, 10, 20, 300, 300, VARPTR(wi(1)), VARPTR(ti(1)), 5)
' colList.createList(hMain, %ID_List, 10, 20, 430, 300, VARPTR(wi(1)), VARPTR(ti(1)), 5)
DIALOG GET SIZE hMain TO x, y
CONTROL ADD STATUSBAR, hMain, %ID_Status, "", 0, 0, 0, 0
STATUSBAR SET PARTS hMain, %ID_Status, x - 90, 999
DIALOG SHOW MODAL hMain CALL mainProc
END FUNCTION
CALLBACK FUNCTION mainProc()
LOCAL i, numShown, yr, mo, day, amt AS LONG
LOCAL sDate, sType, sDescr, sName, sAmt, sItem AS STRING
SELECT CASE CBMSG
CASE %WM_INITDIALOG
numShown = 24: yr = 2000: mo = 6: day = 0: amt = 200
FOR i = 1 TO numShown
day = day + 5: IF day > 30 THEN INCR mo: day = 5
IF mo > 12 THEN INCR yr: mo = 1: day = 5
sDate = FORMAT$(mo, "00") + "/" + FORMAT$(day, "00") + "/" + FORMAT$(yr, "0000")
sType = "type" + STR$(i MOD 6)
sDescr = "description " + FORMAT$(i, "00")
sName = "name " + FORMAT$(i MOD 16, "00")
sAmt = TRIM$(STR$(amt + i)) + ".00"
sItem = sDate + "," + sType + "," + sDescr + "," + sName + "," + sAmt
colList.addItem(sItem, (i = numShown))
NEXT i
CASE %WM_COMMAND
IF CB.CTL = %ID_List AND CB.CTLMSG = %LBN_SELCHANGE THEN
showStatus 1: showStatus 2
ELSEIF CB.CTL > %ID_List AND CB.CTL <= %ID_List + numShown THEN
IF CB.CTLMSG = %STN_CLICKED THEN showStatus 1
END IF
END SELECT
END FUNCTION
SUB showStatus(panelNo AS LONG)
LOCAL n, k, hDlg AS LONG, s AS STRING
k = colList.getHiLite
IF panelNo = 1 THEN
n = colList.getRecordNo(k)
s = "Record number: " + STR$(n)
ELSEIF panelNo = 2 THEN
n = colList.getNumShown
s = STR$(k)+" :"+STR$(n)
END IF
hDlg = colList.getHandle
STATUSBAR SET TEXT hDlg, %ID_Status, panelNo, 0, s
END SUB