PureBoard

Code: Alles auswählen

; by HJBremer 09.2022 - Version 1.0

;   basiert auf der XML Demo in der Hilfe von PureBasic - Xml (c) Fantaisie Software

EnableExplicit

#XML = 0
#window = 0
#listecolor = 1

#fontCalibri = 0
#fontConsolas10 = 1
#fontConsolas11 = 2

LoadFont(#fontCalibri, "Calibri", 11)
LoadFont(#fontConsolas10, "Consolas", 10)
LoadFont(#fontConsolas11, "Consolas", 11)

Procedure FillListe(*CurrentNode)   
   
   Static r, g, b, nr
   
   If XMLNodeType(*currentNode) = #PB_XML_Normal
      
      Protected txt$, name$, value$, *childNode
      Protected nodename$ = GetXMLNodeName(*CurrentNode) 
      
      If ExamineXMLAttributes(*currentNode)  ; Add this node . Add name and attributes
         
         While NextXMLAttribute(*currentNode)
            name$ = XMLAttributeName(*currentNode)   : ;Debug "AttributeName: " + name$
            value$ = XMLAttributeValue(*currentNode) : ;Debug "AttributeValue: " + value$            
            Select name$
               Case "r": r = Val(value$): value$ = RSet(Hex(r),2,"0") + " = " + value$
               Case "g": g = Val(value$): value$ = RSet(Hex(g),2,"0") + " = " + value$
               Case "b": b = Val(value$): value$ = RSet(Hex(b),2,"0") + " = " + value$                  
            EndSelect            
            txt$ + #LF$ + value$  
         Wend         
         txt$ + #LF$ + "$"+ RSet(Hex(RGB(r,g,b)),6,"0") + #LF$ + "Mustertext" + #LF$ + Str(nr)
      EndIf
      
      If nodename$ = "palette"
         AddGadgetItem(#listecolor, -1, nodename$ + #LF$ + value$)
      Else
         AddGadgetItem(#listecolor, -1, nodename$ + txt$)
      EndIf
      nr + 1      
      
      *childNode = ChildXMLNode(*currentNode) ; Now get the first child node (if any)
      
      While *childNode <> 0 ; Loop through all available child nodes and call this procedure again      
         FillListe(*childNode)      
         *childNode = NextXMLNode(*childNode)
      Wend        
      
   EndIf
   
EndProcedure 
 
Procedure.i MainCallback(hWnd, msg, wParam, lParam)
   
   ;verschiedene Fonts in der Liste benutzen
   
   Protected result = #PB_ProcessPureBasicEvents 
   
   Protected *nmhdr.NMHDR, *nmlvcustomdraw.NMLVCUSTOMDRAW 
   
   Protected iitem, column, txt$
   
   If msg = #WM_NOTIFY      
      *nmhdr = lParam      
      
      If *nmhdr\code = #NM_CUSTOMDRAW  
         *nmlvcustomdraw = lParam
         
         With *nmlvcustomdraw            
            Select \nmcd\dwDrawStage                  
               Case #CDDS_PREPAINT:     result = #CDRF_NOTIFYITEMDRAW 
               Case #CDDS_ITEMPREPAINT: result = #CDRF_NOTIFYSUBITEMDRAW                   
               Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM
                  
                  iitem = \nmcd\dwItemSpec ;row
                  column = \iSubItem       ;col                  
                  \clrText = #Black                               ;Vorgabe Standard Textcolor 
                  \clrTextBk = $E0FFFF                            ;Vorgabe Standard Backcolor
                  If Mod(iitem,2): \clrTextBk - $090909: EndIf    ;Backcolor jede 2.Zeile anders
                  SelectObject_(\nmcd\hdc, FontID(#fontCalibri))  ;Vorgabe Standard Font            
                  
                  Select column                         
                     Case 3: SelectObject_(\nmcd\hdc, FontID(#fontConsolas10)): \clrText = #Red
                     Case 4: SelectObject_(\nmcd\hdc, FontID(#fontConsolas10)): \clrText = $006600 ;Grün
                     Case 5: SelectObject_(\nmcd\hdc, FontID(#fontConsolas10)): \clrText = $FF0000 ;Blau                        
                     Case 6: SelectObject_(\nmcd\hdc, FontID(#fontConsolas11))                        
                     Case 7: txt$ = GetGadgetItemText(#listecolor, iitem, 6): \clrText = Val(txt$) ;Textfarbe
                     Case 8: txt$ = GetGadgetItemText(#listecolor, iitem, 6): If txt$: \clrTextBk = Val(txt$): EndIf
                  EndSelect
                  
                  ;bei Fontwechsel muß #CDRF_NEWFONT am Ende von #NM_CUSTOMDRAW stehen, auch bei Farbwechsel !!!!!
                  ;wenn Case #CDDS_ITEMPOSTPAINT vorhanden muß #CDRF_NEWFONT bei #CDDS_ITEMPOSTPAINT stehen
                  
                  ProcedureReturn #CDRF_NOTIFYPOSTPAINT                     
                  
               Case #CDDS_ITEMPOSTPAINT|#CDDS_SUBITEM ;Beispiel für POSTPAINT, hier senkrechte Gitterlinien                             
 
                  If \iSubItem   ;column ab 1 
                     Protected gridlinePen = CreatePen_(#PS_SOLID, 2, $DDDDDD) ;Stärke 1 oder 2 
                     SelectObject_(\nmcd\hdc, gridlinePen)                     ;Pen wählen,  
                     MoveToEx_(\nmcd\hdc, \nmcd\rc\left-0, \nmcd\rc\top, 0)    ;Startposi links oben vom SubItem
                     LineTo_(\nmcd\hdc, \nmcd\rc\left-0, \nmcd\rc\bottom)      ;Line links nach unten
                     DeleteObject_(gridlinePen)
                  EndIf
                  
                  ProcedureReturn #CDRF_NEWFONT
                  
            EndSelect           ;von Select dwDrawStage 
         EndWith                ;von *nmlvcustomdraw         
         
      ElseIf *nmhdr\code = #NM_CLICK               ;: Debug " ITEMCLICK"   
         Protected lvhit.LVHITTESTINFO             ;welches Item wurde angeclickt   
         Protected *nmitem.NMITEMACTIVATE = lParam        
         lvhit\pt = *nmitem\ptAction
         SendMessage_(*nmitem\hdr\hwndFrom, #LVM_SUBITEMHITTEST, 0, lvhit) 
         txt$ = GetGadgetItemText(#listecolor, lvhit\iItem, lvhit\iSubItem)
         SetClipboardText(txt$): Debug "to Clipboard: " + txt$ 
         
      EndIf      
   EndIf    ;von Msg 
   
   ProcedureReturn result    
EndProcedure 

Define fileName$ = #PB_Compiler_Home + "Catalogs\ColorTable.xml"

LoadXML(#XML, fileName$)

OpenWindow(#Window, 0, 0, 1000, 500, "Color XML Example", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
SetWindowCallback(@MainCallback())

ListIconGadget(#listecolor, 10, 10, 950, 480, "Node", 0) 
SetGadgetFont(#listecolor, FontID(#fontCalibri))

AddGadgetColumn(#listecolor, 1, "Name 1", 150)
AddGadgetColumn(#listecolor, 2, "Name 2", 155)
AddGadgetColumn(#listecolor, 3, "Rot", 70)
AddGadgetColumn(#listecolor, 4, "Grün", 70)
AddGadgetColumn(#listecolor, 5, "Blau", 70)
AddGadgetColumn(#listecolor, 6, "Hex = BGR", 75)
AddGadgetColumn(#listecolor, 7, "Text", 100)
AddGadgetColumn(#listecolor, 8, "Farbe", 120)

HideGadget(#listecolor, 1)
StickyWindow(#Window, 1) : SetActiveGadget(#listecolor)

Define *node = XMLNodeFromID(#XML, "0")
If *node: FillListe(*node): EndIf

*node = XMLNodeFromID(#XML, "2")
If *node: FillListe(*node): EndIf

*node = XMLNodeFromID(#XML, "1")
If *node: FillListe(*node): EndIf

HideGadget(#listecolor, 0)

Repeat
  Define event = WaitWindowEvent()
Until event = #PB_Event_CloseWindow