PureBoard

Code: Alles auswählen

#CDDS_ITEM = $10000 
#CDDS_SUBITEM = $20000 
#CDDS_PREPAINT = $1 
#CDDS_ITEMPREPAINT = #CDDS_ITEM|#CDDS_PREPAINT 
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
#CDRF_DODEFAULT = $0 
#CDRF_NOTIFYITEMDRAW = $20 
#CDRF_NOTIFYSUBITEMDRAW = $20 
#CDRF_NEWFONT = $2 


;The following callback proc is required to colour ListIcon cells or set individual cellfonts. 
Procedure WinCallbackproc(hWnd, uMsg, wParam, lParam) 
  protected result, row, col 
  Protected *pnmh.NMHDR, *LVCDHeader.NMLVCUSTOMDRAW 
  result = #PB_ProcessPureBasicEvents 

  select uMsg 
    Case #WM_NOTIFY 
      *pnmh.NMHDR = lParam 
      Select *pnmh\code 
        Case #NM_CUSTOMDRAW 
          *LVCDHeader.NMLVCUSTOMDRAW = lParam 
          Select *LVCDHeader\nmcd\dwDrawStage 
            Case #CDDS_PREPAINT 
              result = #CDRF_NOTIFYITEMDRAW 
            Case #CDDS_ITEMPREPAINT 
              result = #CDRF_NOTIFYSUBITEMDRAW 
            Case #CDDS_SUBITEMPREPAINT 
              row = *LVCDHeader\nmcd\dwItemSpec 
              col = *LVCDHeader\iSubItem 
              if col = 0 
                *LVCDHeader\clrTextBk = #green 
                *LVCDHeader\clrText = #blue ;Text colour 
               SelectObject_(*LVCDHeader\nmcd\hDC, usefont(1)) 
              Else 
                *LVCDHeader\clrTextBk = #yellow 
                *LVCDHeader\clrText = #red 
                SelectObject_(*LVCDHeader\nmcd\hDC, usefont(2)) 
              endif 
              result = #CDRF_NEWFONT 
            EndSelect 
      EndSelect 
  endselect 
  procedurereturn result 
EndProcedure 


If OpenWindow(0,0,0,640,300,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_Invisible|#PB_Window_ScreenCentered,"Multiple Fonts") And CreateGadgetList(WindowID(0)) 
  ShowWindow_(WindowID(), #SW_MAXIMIZE) 
  listicongadget(1, 50, 50, 350, 250,"Font 1",120) 

  SetWindowCallback(@WinCallbackproc()) 

;******************************************SET FONTS*************************************** 
loadfont(1,"ARIAL", 18) 
loadfont(2,"TIMES NEW ROMAN", 18,#PB_Font_Bold |#PB_Font_Italic) 
;****************************************************************************************** 

  setgadgetfont(1,usefont(1))  ;To ensure the row height is large enough to accommodate the fonts. 

  AddGadgetColumn(1,1,"Font 2",120) 
  For b=0 To 3; Add 40 rows. 
    AddGadgetItem(1,-1,"Font 1" + chr(10) + "Font 2") 
  Next 

  Repeat 
    EventID = WaitWindowEvent() 
    Select EventID 
    EndSelect 
  Until EventID = #PB_Event_CloseWindow 
EndIf 
end