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