Catalogs\ColorTable.xml anzeigen

Windowsspezifisches Forum , API ,..
Beiträge, die plattformübergreifend sind, gehören ins 'Allgemein'-Forum.
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Catalogs\ColorTable.xml anzeigen

Beitrag von hjbremer »

die Auswahl und Nutzung der Colortable mit dem PB Werkzeug Farbauswahl ist mäßig, finde ich.

Hier mal der Versuch diese Colortable via XML Befehle (von denen ich keine Ahnung habe) anzuzeigen

und via Mausclick den Hexwert ins Clipboard zu kopieren

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

Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer