Delphi has a calendar that is string based called Tstring calendar. while ive been fooling around with ownerdrawn listboxes, i whipped up a beginning to a string calendar that anyone can feel free to use.
NOTE: when dealing with a listbox, item order goes from TOP TO BOTTOM, not left to right like a normal calendar does.
Does anyone know how to get the item order of a listbox left to right by the way?
Code: Select all
Global OriginProc,editcontrol.l ,editprocedure.l ,crtitem.l
Global Dim itemrect.RECT(50)
Procedure GetPanelDisplayWindowID(hwnd,item)
tc_item.TC_ITEM
tc_item\Mask=#TCIF_PARAM
SendMessage_(hwnd,#TCM_GETITEM,item,tc_item)
ProcedureReturn tc_item\lParam
EndProcedure
Procedure EditProc(hwnd,msg,wParam,lParam)
Select msg
Case #WM_RBUTTONDOWN
ProcedureReturn 0
EndSelect
ProcedureReturn CallWindowProc_(editprocedure,hwnd,msg,wParam,lParam)
EndProcedure
Procedure ListboxProc( hwnd, msg,wParam,lParam)
Select msg
Case #WM_DRAWITEM
hbrushSelectedFocus.l = CreateSolidBrush_(RGB(0, 0, 80))
textbuffer$ = Space(255)
listb=GetWindow_(hwnd,#GW_CHILD)
*lpdis.DRAWITEMSTRUCT=lParam
*lptris.DRAWITEMSTRUCT=*lpdis.DRAWITEMSTRUCT
Select *lpdis\CtlType
Case #ODT_LISTBOX
If *lpdis\itemID= 0 Or *lpdis\itemID= 6 Or *lpdis\itemID= 12 Or *lpdis\itemID=18 Or *lpdis\itemID=24 Or *lpdis\itemID=30 Or *lpdis\itemID=36
Else
itemHeight=SendMessage_(*lpdis\hwndItem,#LB_GETITEMHEIGHT,0,0)
Select *lpdis\itemState
Case #ODS_SELECTED
dtFlags = #DT_LEFT | #DT_VCENTER
currentBrush = CreateSolidBrush_(RGB(0, 0, 80))
currentTextColor = #White
drawfoc=#False
drawbox=#False
Case #ODS_SELECTED | #ODS_FOCUS
dtFlags = #DT_LEFT | #DT_VCENTER
currentBrush = hbrushSelectedFocus
currentTextColor = #White
drawfoc=#True
Case 0
dtFlags = #DT_LEFT | #DT_VCENTER
currentBrush = #White
currentTextColor = RGB(0, 0, 0)
drawfoc=#False
drawbox=#True
EndSelect
SendMessage_(*lpdis\hwndItem,#LB_GETTEXT,*lpdis\itemID,textbuffer$)
lbText$=textbuffer$
FillRect_(*lpdis\hdc, *lpdis\rcItem, currentBrush)
If drawfoc=#True
DrawFocusRect_(*lpdis\hdc, *lpdis\rcItem)
EndIf
If drawbox=#True
hpen=CreatePen_(#PS_INSIDEFRAME ,0,#Black)
Rectangle_(*lpdis\hdc,*lpdis\rcItem\left,*lpdis\rcItem\top,*lpdis\rcItem\right,*lpdis\rcItem\bottom)
EndIf
SetBkMode_(*lpdis\hdc, #TRANSPARENT)
SetTextColor_(*lpdis\hdc, currentTextColor)
*lpdis\rcItem\left+5
DrawText_(*lpdis\hdc, lbText$, Len(lbText$), *lpdis\rcItem, dtFlags)
ProcedureReturn 0
EndIf
EndSelect
EndSelect
ProcedureReturn CallWindowProc_(OriginProc,hwnd,msg,wParam,lParam)
EndProcedure
ProcedureDLL LBGrid(x,y,width,height,itemHeight,type,parent,tabitem)
class.s=Space(255)
cs=GetClassName_(parent,@class, Len(class))
If class = "SysTabControl32"
finalparent=GetPanelDisplayWindowID(parent,tabitem)
Else
finalparent=parent
EndIf
window=OpenWindow(#PB_Any,x,y,width,height,"", #PB_Window_BorderLess|#PB_Window_Invisible)
SetWindowLong_(WindowID(window),#GWL_STYLE, #WS_CHILD|#WS_DLGFRAME|#WS_EX_CLIENTEDGE|#WS_CLIPCHILDREN|#WS_CLIPSIBLINGS )
SetParent_(WindowID(window),finalparent)
ShowWindow_(WindowID(window),#SW_SHOW)
lb=ListViewGadget(#PB_Any,0,0,width,height,#LBS_OWNERDRAWFIXED|#LBS_HASSTRINGS|#LBS_MULTICOLUMN|#LBS_NOTIFY)
OriginProc= SetWindowLong_(WindowID(window), #GWL_WNDPROC, @ListboxProc())
SendMessage_(GadgetID(lb), #LB_SETITEMHEIGHT, 0, itemHeight)
SendMessage_(GadgetID(lb), #LB_SETCOLUMNWIDTH, 30,0)
SetWindowLong_(GadgetID(lb),#GWL_STYLE,GetWindowLong_(GadgetID(lb),#GWL_STYLE)|#WS_BORDER )
ShowWindow_(GadgetID(lb),#SW_SHOW)
For a=0 To 41
AddGadgetItem(lb,-1,"")
Next
UseGadgetList(GadgetID(lb))
For a=0 To 41 Step 6
day$="Sun"
If a=6 :day$="Mon": ElseIf a=12: day$="Tue":ElseIf a=18:day$="Wed":ElseIf a=24:day$="Thu":ElseIf a=30
day$="Fri": ElseIf a=36: day$="Sat":EndIf
SendMessage_(GadgetID(lb),#LB_GETITEMRECT,a,itemrect(a))
ButtonGadget(#PB_Any,itemrect(a)\left,itemrect(a)\top,itemrect(a)\right-itemrect(a)\left,20,day$,#BS_FLAT)
Next
UseGadgetList(finalparent)
ProcedureReturn lb
EndProcedure
#WindowWidth = 390
#WindowHeight = 350
If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight, "", #PB_Window_MinimizeGadget)
grid=LBGrid(30,20,215,125,20,0,WindowID(0),0)
;- create some images
;- add some items
;- event loop
Repeat
EventID = WaitWindowEvent()
If EventID = #PB_Event_Gadget
Select EventGadget()
EndSelect
EndIf
Until EventID = #PB_Event_CloseWindow
EndIf
End
