This one goes down as a collaboration between myself, Sparkie and MrMat
(see thread: viewtopic.php?t=18407)
and shows how to set up a ListIconGadget so that the column headings are drawn vertically (ideal for displaying numerical data ala Excel style!)
One thing to note is that when setting up the ListIcon you must keep the column headings blank and instead place them into an array as shown. This does not mean that you need to reorder the array everytime a column is added, however, as the code is set up to force Windows to take care of that (thanks to MrMat).
Code: Select all
; ************************************************
; Code: Vertical / centred text in ListIconGadget Header
; Author: srod, Sparkie and MrMat.
; Date: December 31, 2005
; OS: Windows only
; ************************************************
; Globals
Global oldListIconCallback, OldHeaderProc, headerheight, font
headerheight=100 ;Change as appropriate.
;The custom draw procedure requires that we store the column headings in an array.
;We do not need to worry about moving the column headings when new columns are added/deleted however.
;Windows will take care of that!
;Also, this requires no extra memory as we do not include column headings when setting up the ListIcon.
#MaxNumberOfColumns=60
Dim heading$(#MaxNumberOfColumns)
;Proc for subclassed headercontrol which is required for resizing header control.
Procedure headerproc(hWnd, uMsg, wParam, lParam)
Protected result, *hdlayout.HD_LAYOUT, *rect.RECT, *windowpos.WINDOWPOS
Select uMsg
Case #HDM_LAYOUT ;Allows the header to be resized.
result = CallWindowProc_(OldHeaderProc, hWnd, uMsg, wParam, lParam)
*hdlayout = lParam
If *hdlayout\prc <> 0
*rect = *hdlayout\prc
*rect\top = headerheight
EndIf
If *hdlayout\pwpos <> 0
*windowpos = *hdlayout\pwpos
*windowpos\cy = headerheight
EndIf
Default
result = CallWindowProc_(OldHeaderProc, hWnd, uMsg, wParam, lParam)
EndSelect
ProcedureReturn result
EndProcedure
; Proc for subclassed ListIconGadget
Procedure SubclassedListIcon(hwnd, msg, wparam, lparam)
result = CallWindowProc_(oldListIconCallback, hwnd, msg, wparam, lparam)
Select msg
Case #WM_NOTIFY
*pnmh.NMHDR = lparam
;--> Get handle to ListIcon header control
If *pnmh\code = #NM_CUSTOMDRAW
*pnmcd.NMCUSTOMDRAW = lparam
;--> Determine drawing stage
Select *pnmcd\dwDrawStage
Case #CDDS_PREPAINT
result = #CDRF_NOTIFYITEMDRAW
Case #CDDS_ITEMPREPAINT
result = #CDRF_DODEFAULT | #CDRF_NOTIFYPOSTPAINT
Case #CDDS_ITEMPOSTPAINT
;Each header item has a user defined 32 bit value which we have already ensured points to the relevant column heading.
;We now need to retrieve the underlying text.
hditem.HD_ITEM
hditem\mask = #HDI_LPARAM
SendMessage_(*pnmh\hwndFrom, #HDM_GETITEM , *pnmcd\dwItemSpec, @hditem)
text$=PeekS(hditem\lparam)
;The following gets the height of the text (will be the width when displayed vertically)
;and is used to centre the text horizontally.
GetTextExtentPoint32_(*pnmcd\hdc, text$, Len(text$), sz.SIZE)
;Set text modes and display text.
SetBkMode_(*pnmcd\hdc,#TRANSPARENT)
SetTextColor_(*pnmcd\hdc, #Black)
TextOut_(*pnmcd\hdc, (*pnmcd\rc\Left+*pnmcd\rc\right)/2+sz\cy/2, 5,text$, Len(text$))
result = #CDRF_SKIPDEFAULT
EndSelect
EndIf
EndSelect
ProcedureReturn result
EndProcedure
; ************************************************
; Main Window
; ************************************************
If OpenWindow(0, 100, 100, 415, 300, "ListIcon Header Text Centered", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
;--> I'll leave the header text Null and draw them in the subclass procedure
ListIconGadget(0, 5, 5, 405, 200, "", 30, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
hHeader = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
;--> Subclass ListIcon and header control so we can customdraw the header text
oldListIconCallback = SetWindowLong_(GadgetID(0), #GWL_WNDPROC, @SubclassedListIcon())
OldHeaderProc = SetWindowLong_(hHeader, #GWL_WNDPROC, @headerproc())
;Create 'vertical' font for header control.
font = CreateFont_(12,6, 2700,0,0,0,0,0,0,0,0,0,0,"ARIAL")
SendMessage_(hHeader, #WM_SETFONT, font, 0)
;Each header item has a user defined 32 bit value which we use to point to the relevant column heading.
;This means that adding/deleting columns will not upset the column headings.
;This is required because of certain quirks with the custom draw techniques ala Windows!
;Thanks to MrMat.
hditem.HD_ITEM
hditem\mask = #HDI_LPARAM
heading$(0)="Col 0"
hditem\lParam = @heading$(0)
SendMessage_(hHeader, #HDM_SETITEM , 0, @hditem)
;Add 50 more columns.
For i = 1 To 50
AddGadgetColumn(0, i, "", 30)
heading$(i)="Col "+Str(i)
hditem\lParam = @heading$(i)
SendMessage_(hHeader, #HDM_SETITEM , i, @hditem)
Next
;Add some data
For b=0 To 99; Add 100 rows.
AddGadgetItem(0,-1,"")
Next
For i = 0 To 99
For j = 0 To 50
SetGadgetItemText(0,i,Str(i+j),j)
Next j
Next i
Repeat
EventID = WaitWindowEvent()
Until EventID = #PB_Event_CloseWindow
DeleteObject_(font)
EndIf
End