Frage zu WindowCallbackProc & eigenem Gadget mittels Canvas

[Josh]

Das Gadget soll nach dem Anklicken eines Zahlenfeldes dieses farblich hervorheben und die Farbe dann innerhalb von 1-2 Sekunden langsam wieder "wegdimmen".

Vielleicht kannst du ein andersfarbiges Fenster über diesen Zahlenfeld legen und dieses dann mit AnimateWindow_ ausblenden.

[Kurzer]

Danke Josh, aber das wäre IMHO etwas sehr durch die Brust ins Auge, wenn ein Gadget extra ein Fenster öffnet, um einen Teil seiner Grafik zu verdecken bzw. zu dimmen.

Bin schon fündig geworden: SetTimer_() API ist mein Freund
SetTimer_(\iGadgetID, 1, 500, #Null)

Der API-Timer funktioniert auch an Gadgets. In Windows scheint ja alles ein "Window" zu sein, was ein hWnd haben kann.

[edel]

Danke ts-soft, die Strukturen habe ich gefunden. Soweit lichtet sich der Schleier.

Aber was bedeutet folgender Hinweis in der Event.h (am Ende der Datei)?

Code: Alles auswählen

// When using PB_Event_AddWithData, the caller of PB_Event_Get must ensure that
// the FreeData function is called when it received a non-zero free function pointer

void PB_Event_Add(int ID, integer ObjectID, integer WindowID, integer Type);
void PB_Event_AddWithData(int ID, integer ObjectID, integer WindowID, integer Type, void *Data, EventDataFreeFunction FreeData);

Müsste in Edels code noch ein Freedata vorkommen?

Auch die ID von $332C in Edels code erschliesst sich mir nicht. Ist es egal welche ID man einsetzt? WindowID = 0 ist auch unklar. Vermutung: Der Teil muss nur gefüllt sein, wenn den Event ein Fenster sendet und kein Gadget.

$332C ist #PB_Event_Gadget (id). ObjectID ist die GadgetNr, WindowID ist die WindowNr (Kein Handle) an welches das Event geschickt wird (wichtig fuer EventWindow). Als Type kannst du z.B. #PB_EventType_Change benutzen. Mit*Data kann man noch Speicher mitgeben, der dann wieder ueber die Funktion FreeData freigegeben werden kann. Mit den letzten beiden Parameter hab ich aber noch nicht herumgespielt, kann dir dazu nicht mehr sagen.
Ohne die beiden letzten Parameter, kann man aber auch PB_Event_Add benuten.


Du kannst die Timer Funktion von Windows direkt nutzen :

Code: Alles auswählen

#Color = $FFFFFF

Global OldProc

Procedure CanvasProc(hWnd, Msg, wParam, lParam)
	Static count = -1	
	Static color = $FF80FF
	
	Protected gadgetid
	
	gadgetid = GetProp_(hWnd, "PB_ID")
	
	If msg = #WM_PAINT
		
		StartDrawing(CanvasOutput(gadgetid))
			Box(0, 0, 20, 20, RGB(Red(color), count, Blue(color)))
		StopDrawing()
		
	EndIf
	
	If msg = #WM_TIMER
		
		count + 1		
		
		If count = 255
			KillTimer_(hWnd,0)
			;							  ^- timer_id		
			color = #Color
		EndIf	  				 
		
		InvalidateRect_(hwnd, 0, 0); neuzeichnen erzwingen
		
	EndIf
	
	If msg = #WM_LBUTTONDBLCLK
		count = 0
		color = #Color
		SetTimer_(hwnd, 0, 10, 0)
	EndIf						 ;^- timer_id
	
	
	ProcedureReturn CallWindowProc_(OldProc, hWnd, Msg, wParam, lParam)
EndProcedure

Procedure start()
	
	Protected window
	Protected event	
	Protected canvas
	
	window = OpenWindow(#PB_Any, 0, 0, 360, 200, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)	
	canvas = CanvasGadget(#PB_Any, 10, 10, 50, 50)
	
	
	OldProc = SetWindowLongPtr_(GadgetID(canvas), #GWLP_WNDPROC, @CanvasProc())
	
	Repeat
		event = WaitWindowEvent()
		
		If EventWindow() = window
			
			If event = #PB_Event_CloseWindow
				Break
			EndIf		
			
			
		EndIf
		
	ForEver
	
	
	
EndProcedure:start()

[Kurzer]

Besten Dank für die Infos, Edel.

Okay, hat nun zwar elend lange gedauert, aber Zeit ist in letzer.. äh Zeit... bei mir leider Mangelware.

Ich hatte den fertigen Code des templates versprochen. Hier ist er. Ist ein Codeschloss-Gadget geworden.

Vermutlich werde ich an anderer Stelle noch einen reinen "Customgadget-Thread" eröffnen, wo an diesem template herumgebastelt werden kann und Codes für neue Customgadgets eingestellt werden können.

Code: Alles auswählen

;*************************************************************************
;*
;* Template für ein Customgadget das auf dem PureBasic Canvasgadget aufbaut
;*
;*************************************************************************
;*
;* Programname       : Customgadget-Template
;* Filename          : Customgadget-Template.pbi
;* Filetype          : Includefile [Main, Includefile, Datafile]
;* Programming lang. : Purebasic 4.61+
;* Compile as        : Windows Exe
;* Version           : 1.00
;* Date              : 08.01.2013
;* Autor             : Kurzer
;* -----------------------------------------------------------------------
;* VORWORT:
;*
;* Dieser Code ist entstanden, weil ich mir die Realisierung von eigenen Gadgets in PureBasic mit Hilfe des neuen 
;* Canvasgadgets genauer ansehen wollte. Mein Dank geht an die hilfreichen Unterstützer: HJBremer, Edel & ts-soft
;* Der Code ist ausschließlich unter Windows lauffähig (wegen Verwendung von WinAPI) und ab der PB Version 4.61 kompilierbar
;* 
;* Ich würde mich freuen, wenn dieses Gerüst von euch aufgegriffen werden würde. Solltet ihr vorhandene Funktionen optimieren,
;* dann wäre es super, wenn ihr euren Code hier wieder einstellen würdet (dies betrifft die eigentlichen Kernfunktionen,
;* die zur Erstellung des Customgadgets nötig sind. Der grafische Schnickschnack drum herum ist nicht gemeint ;-))
;* 
;* BESCHREIBUNG:
;* 
;* Das Gedget stellt ein Eingabezahlenfeld dar, welches zur Eingabe von numerischen Codes gedacht ist (Codeschloß).
;* Es besitzt die Ziffern 0 - 9 sowie die Tasten "C" zum Löschen der Eingabe (Clear) und "E" zum Übernehmen der Ziffern (Enter)
;* 
;* Besitzt das Gadget den Fokus, dann können die entsprechenden Ziffern und Buchstaben über die Tastatur eingeben werden,
;* eine Eingabe mittels Mausklick ist ebenso möglich. Bei jedem Tastendruck leuchtet die gedrückte Taste im Gadget kurz auf.
;* 
;* Das Gadget wird wie die normalen PB-Gadgets auch durch den PB-Eventloop abgefragt.
;* Um zwei Möglichkeiten der Eventerzeugung zu demonstrieren, behandelt das Gadget die Ziffern anders als die Tasten C und E.
;*
;* Werden die Ziffern gedrückt, dann sendet das Gadget wie jedes normale PB Gadget einen #PB_Event_Gadget Event, welcher mit
;* WaitWindowEvent() empfangen wird. EventGadget() enthält dabei die Nummer des Gadgets, so wie auch bei nativen PB-Gadgets.
;* EventType() liefert bei gedrückten Ziffern den Eventtypen #MG_KEYPRESSED
;* Um zu ermitteln welche Ziffer gedrückt wurde, muss man bei Auftreten des o.g. Events die Gadgetprozedur
;* MeinGadget_GetCurrentChar(iGadgetNr) aufrufen. Die Prozedur gibt die zuletzt gedrückte Taste zurück.
;*
;* Anders verhält es sich bei den Tasten C und E.
;* Hier liefert WaitWindowEvent() nicht den Event #PB_Event_Gadget, sondern einen durch das Gadget definiertes Event.
;*
;* Wird C gedrückt, dann wird der Event #MG_CLEAR gesendet, bei Taste E wird #MG_ENTER gesendet.
;* Entsprechender Demo-/Testcode befindet sich am Ende des Quellcodes.
;*
;* Insgesamt gehören zu diesem Gadget zwei Prozeduren, die für den PureBasic-Nutzer relevant sind.
;*
;* MeinGadget(iGadgetNr, x.i, y.i, iWidth.i, iHeight.i, [iBackgroundColor], [iTextColor], [iFokusColor])
;* MeinGadget_GetCurrentChar(iGadgetNr)
;*
;* Der Präfix "MeinGadget_" wurde genau so genannt (und nicht etwa "Zahlencode_"), weil der Code ein template darstellt und kein
;* wirklich fertiges CustomGadget sein soll.
;*
;* Ich habe versucht den Code so weit wie möglich zu kommentieren. Solltet ihr Fehler oder Falschaussagen in den Beschreibungen
;* finden, dann scheut Euch nicht diese zu korrigieren und den korrigierten Code im Forum zu posten.
;*
;* Besten Dank und viel Spaß!
;* Kurzer
;*
;* -----------------------------------------------------------------------
;* Historie:
;* Version 1.00 vom 08.01.2013, erstellt durch: Kurzer
;* Release: Erstellung der erste Version
;*
;* Version 1.01 vom xx.xx.xxxx, erstellt durch: xxx
;* New feature / Bugfix: xxx
;* ... usw ...
;*************************************************************************

EnableExplicit

; Importieren einer internen PB-Funktion zum Senden eines GadgetEvents
ImportC ""
   PB_Event_Add(ID, ObjectID, WindowID, Type)
EndImport

;*************************************************************************
;* Strukturen & Konstanten
;*************************************************************************
Structure MeinGadget_Point
	x.w
	y.w
EndStructure

; Hier werden die geometrischen Daten eines jeden Tastenfelds verwaltet
Structure MeinGadget_Fields
	sFieldChar.s{2}
	iFieldX.i
	iFieldY.i
	iFieldWidth.i
	iFieldHeigth.i
EndStructure

; Hier werden die internen Daten des Gadgets verwaltet
Structure MeinGadget_Attributes
	iGadgetNr.i
	iGadgetID.i
	iOldWindowProc.i
	iGadgetInitalized.i
	
	iLastChar.i											; ASCII Code der zuletzt gedrückten Taste
	iCurrentField.i									; Nummer des zuletzt gedrückten Felds
	iPosX.i													; Position und Ausmaße des Gadgets
	iPosY.i
	iWidth.i
	iHeight.i
	
	iFrontColor.i										; Farben des Gadgets
	iBackColor.i
	iNormalBackColor.i
	iFocusBackColor.i
	iActiveFieldBackColor.i
	iActiveFieldBackColorDimm.i
	
	iFieldWidth.i										; Temporäre Variablen für die Berechnung der geometrischen Daten der Tastenfelder
	iFieldHeight.i
	iFields.MeinGadget_Fields[12]
EndStructure

; Konstanten für die Events des Gadgets
#MG_ENTER = #WM_USER + 1
#MG_CLEAR = #WM_USER + 2

; Konstanten für die Eventtypes des Gadgets
#MG_KEYPRESSED = #WM_USER + 1

;*************************************************************************
;* Interne Prozeduren die nur das Gadget selbst aufruft
;*************************************************************************

Procedure   _MeinGadget_CalculateSize(*stMeinGadget.MeinGadget_Attributes)
	; +-----------------------------------------------------------------
	; |Description  : Berechnet die Größe der Tastenfelder, damit diese homogen 
	; |							:	auf die Gesamtbreite und Höhe des Gadgets verteilt sind
	; |Arguments    : *stMeinGadget: Pointer auf die Gadget-Attributstruktur
	; |Results      : -
	; |Remarks      : -
	; +-----------------------------------------------------------------
	
	; Da unser Gadget auch während der Laufzeit in der Größe veränderbar sein soll (PB-Befehl ResizeGadget()),
	; muss die gesamte grafische Ausgabe skalierbar sein. Die Skalierung übernimmt diese Prozedur.
	; Sie wird aus der Callbackprozedur des Gadgets heraus aufgerufen und zwar beim Auftreten des Events #WM_SIZE
	
	With *stMeinGadget
		\iPosX = GadgetX(*stMeinGadget\iGadgetNr)
		\iPosY = GadgetY(*stMeinGadget\iGadgetNr)
		\iWidth = GadgetWidth(*stMeinGadget\iGadgetNr)
		\iHeight = GadgetHeight(*stMeinGadget\iGadgetNr)
		
		\iFieldWidth = \iWidth / 3
		\iFieldHeight = \iHeight / 4
		
		\iFields[0]\sFieldChar = "7" : \iFields[0]\iFieldX = 0 : \iFields[0]\iFieldY = 0 : \iFields[0]\iFieldWidth = \iFieldWidth : \iFields[0]\iFieldHeigth = \iFieldHeight
		\iFields[1]\sFieldChar = "8" : \iFields[1]\iFieldX = \iFieldWidth : \iFields[1]\iFieldY = 0 : \iFields[1]\iFieldWidth = \iFieldWidth : \iFields[1]\iFieldHeigth = \iFieldHeight
		\iFields[2]\sFieldChar = "9" : \iFields[2]\iFieldX = \iFieldWidth * 2 : \iFields[2]\iFieldY = 0 : \iFields[2]\iFieldWidth = \iWidth - (\iFieldWidth * 2) : \iFields[2]\iFieldHeigth = \iFieldHeight
		
		\iFields[3]\sFieldChar = "4" : \iFields[3]\iFieldX = 0 : \iFields[3]\iFieldY = \iFieldHeight : \iFields[3]\iFieldWidth = \iFieldWidth : \iFields[3]\iFieldHeigth = \iFieldHeight
		\iFields[4]\sFieldChar = "5" : \iFields[4]\iFieldX = \iFieldWidth : \iFields[4]\iFieldY = \iFieldHeight : \iFields[4]\iFieldWidth = \iFieldWidth : \iFields[4]\iFieldHeigth = \iFieldHeight
		\iFields[5]\sFieldChar = "6" : \iFields[5]\iFieldX = \iFieldWidth * 2 : \iFields[5]\iFieldY = \iFieldHeight : \iFields[5]\iFieldWidth = \iWidth - (\iFieldWidth * 2) : \iFields[5]\iFieldHeigth = \iFieldHeight
		
		\iFields[6]\sFieldChar = "1" : \iFields[6]\iFieldX = 0 : \iFields[6]\iFieldY = \iFieldHeight * 2 : \iFields[6]\iFieldWidth = \iFieldWidth : \iFields[6]\iFieldHeigth = \iFieldHeight
		\iFields[7]\sFieldChar = "2" : \iFields[7]\iFieldX = \iFieldWidth : \iFields[7]\iFieldY = \iFieldHeight * 2 : \iFields[7]\iFieldWidth = \iFieldWidth : \iFields[7]\iFieldHeigth = \iFieldHeight
		\iFields[8]\sFieldChar = "3" : \iFields[8]\iFieldX = \iFieldWidth * 2 : \iFields[8]\iFieldY = \iFieldHeight * 2 : \iFields[8]\iFieldWidth = \iWidth - (\iFieldWidth * 2) : \iFields[8]\iFieldHeigth = \iFieldHeight
		
		\iFields[9]\sFieldChar = "0" : \iFields[9]\iFieldX = 0 : \iFields[9]\iFieldY = \iFieldHeight * 3 : \iFields[9]\iFieldWidth = \iFieldWidth : \iFields[9]\iFieldHeigth = \iHeight - (\iFieldHeight * 3)
		\iFields[10]\sFieldChar = "E" : \iFields[10]\iFieldX = \iFieldWidth : \iFields[10]\iFieldY = \iFieldHeight * 3 : \iFields[10]\iFieldWidth = \iFieldWidth : \iFields[10]\iFieldHeigth = \iHeight - (\iFieldHeight * 3)
		\iFields[11]\sFieldChar = "C" : \iFields[11]\iFieldX = \iFieldWidth * 2 : \iFields[11]\iFieldY = \iFieldHeight * 3 : \iFields[11]\iFieldWidth = \iWidth - (\iFieldWidth * 2) : \iFields[11]\iFieldHeigth = \iHeight - (\iFieldHeight * 3)
	EndWith
EndProcedure
Procedure.s _MeinGadget_FindCharUnderMouse(*stMeinGadget.MeinGadget_Attributes, *lPoint.MeinGadget_Point)
	; +-----------------------------------------------------------------
	; |Description  : Ermittelt das Zahlenfeld unter der Mausposition und
	; |							:	gibt das dem Feld zugeordnete Zeichen zurück
	; |Arguments    : *stMeinGadget: Pointer auf die Gadget-Attributstruktur
	; |							:	*lPoint      : POINT Struktur mit den Koordinaten der Mausposition
	; |Results      : Das Zeichen, welches dem Feld unter der Mausposition zugeordnet ist
	; |             : bzw. "", wenn kein Feld ermittelt werden kann.
	; |Remarks      : -
	; +-----------------------------------------------------------------
  Protected.i x, y, j
  
  ; Jedem der 12 Tastenfelder ist ein Zeichen zugeordnet (0-9 und C und E)
  ; Diese Prozedur ermittelt, welches Feld sich unter Mauspointer befindet und gibt das
  ; Zeichen zurück, welches dem Feld zugeordnet ist.
  ; Hintergrund des Ganzen ist, dass die Auswertung der Gadget-Tastenfelder nur auf Basis eines auf der 
  ; (echten Computer-)Tatstatur gedrückten Zeichens erfolt. Ich wollte keine zwei Auswertungsprozeduren schreiben
  ; (eine für gedrückte Taste und eine für den Mausklick), da diese den Eventloop in der Callbackprozedur aufgebläht hätte.
  ; Somit gibt es für die Mausabfrage diese Prozedur, die quasi einen Mausklick in eine gedrückte Taste umwandelt.
  
	x = *lPoint\x  
	y = *lPoint\y
	
	With *stMeinGadget
		For j = 0 To 11
			If x >= \iFields[j]\iFieldX And x <= \iFields[j]\iFieldX + \iFields[j]\iFieldWidth - 1 And y >= \iFields[j]\iFieldY And y <= \iFields[j]\iFieldY + \iFields[j]\iFieldHeigth - 1
				ProcedureReturn \iFields[j]\sFieldChar
			EndIf
		Next j
	EndWith
	
	ProcedureReturn ""
EndProcedure
Procedure.i _MeinGadget_FindFieldFromChar(*stMeinGadget.MeinGadget_Attributes, iChar.i)
	; +-----------------------------------------------------------------
	; |Description  : Ermittelt das Zahlenfeld, welches dem Zeichen iChar zugeordnet ist.
	; |Arguments    : *stMeinGadget: Pointer auf die Gadget-Attributstruktur
	; |							:	iChar        : ASCII Code des Zeichens, zu dem das zugehörige Feld gesucht wird
	; |Results      : Die Nummer des entsprechenden Felds
	; |Remarks      : -
	; +-----------------------------------------------------------------
  Protected.i j
  
  ; Wie oben schon beschreiben, ist jedem der 12 Tastenfelder ein Zeichen zugeordnet (0-9 und C und E)
  ; Diese Prozedur ermittelt auf Basis eines gegeben Zeichend das zugehörige Feld bzw. dessen Nummer
  ; und gibt diese zurück.
  ; Die Prozedur ist nötig, um nach einem Tastendruck innnerhalb des Gadgets das zugehörige Tastenfeld
  ; und daraus ableitend das Rechteck zu ermitteln, welches aufblitzen soll.
  
  With *stMeinGadget
		For j = 0 To 11
			If UCase(Chr(iChar)) = UCase(\iFields[j]\sFieldChar)
				ProcedureReturn j
			EndIf
		Next j
	EndWith
	
	ProcedureReturn -1
EndProcedure
Procedure   _MeinGadget_ProcessChar(*stMeinGadget.MeinGadget_Attributes, iChar.i)
	; +-----------------------------------------------------------------
	; |Description  : Setzt die Variable für das zuletzt gedrücktes Zeichen und die Farben
	; |             : für die Hervorhebung des aktuelle gedrückten Felds.
	; |             : Die Prozedur startet außerdem einen Timer, der für das zurückdimmen
	; |             : der Hervorhebungsfarbe zuständig ist
	; |Arguments    : *stMeinGadget: Pointer auf die Gadget-Attributstruktur
	; |							:	iChar        : ASCII Code des Zeichens, das gedrückt wurde
	; |Results      : -
	; |Remarks      : -
	; +-----------------------------------------------------------------
	
	; Die Prozedur setzt zwei interne Variabeln und startet den Timer, der für das dimmen der Farbe
	; der aktuelle gedrückten Taste zuständig ist.
	; Die Prozedur ist lediglich dazu da, um redundanten Code aus dem Callback Eventloop herauszunehmen,
	; der sonst dreifach dort stünde.
	
	With *stMeinGadget
		\iCurrentField = _MeinGadget_FindFieldFromChar(*stMeinGadget, iChar)
		\iLastChar = iChar
		\iActiveFieldBackColorDimm = \iActiveFieldBackColor
		
		; Hier setzen wir einen Windowtimer, der das Farbdimmen der aktuelle gedrückten Taste realisiert
		SetTimer_(\iGadgetID, 1, 60, #Null)
	EndWith
EndProcedure
Procedure.i _MeinGadget_DimmActiveField(*stMeinGadget.MeinGadget_Attributes)
	; +-----------------------------------------------------------------
	; |Description  : Dimmt die Hervorhebungsfarbe der aktuell gedrückten Taste 
	; |Arguments    : *stMeinGadget: Pointer auf die Gadget-Attributstruktur
	; |Results      : 1/0, 1 wenn vollständig gedimmt wurde, 0 wenn die Ursprungsfarbe noch nicht erreicht wurde
	; |Remarks      : Die Prozedur wird vom Timer angesprungen
	; +-----------------------------------------------------------------
  Protected.i j, r, g, b, r2, g2, b2
  
  ; Diese Prozedur wird ca. 60 mal pro Sekunde vom Timer angesprungen.
  ; Sie zählt die Hintergrundfarbe des aktuell gedrückten Ziffernfeldes rauf
  ; Ist die Farbe soweit gedimmt (hmm, eigentlich aufgeblendet), dass sie mit der normelen Hintergrundfarbe
  ; übereinstimmt, dann gibt die Prozedur eine 1 zurück, welches dazu führt, dass der Timer entfernt wird
  ; (außerhalb dieser Prozedur). Der Timer zum dimmen existiert also nur so lange, wie es etwas zu dimmen gibt.
  
  With *stMeinGadget
  	r = Red(\iBackColor)
  	g = Green(\iBackColor)
  	b = Blue(\iBackColor)
  	
  	r2 = Red(\iActiveFieldBackColorDimm)
  	g2 = Green(\iActiveFieldBackColorDimm)
  	b2 = Blue(\iActiveFieldBackColorDimm)
  	
  	If r2 < r : r2 + $11 : ElseIf r2 > r : r2 = r : EndIf
  	If g2 < g : g2 + $11 : ElseIf g2 > g : g2 = g : EndIf
  	If b2 < b : b2 + $11 : ElseIf b2 > b : b2 = b : EndIf
  	
  	\iActiveFieldBackColorDimm = RGB(r2, g2, b2)
  EndWith
  
  If r2 = r And g2 = g And b2 = b
	  ; Wenn die Farbe vollständig heruntergedimmt wurde, dann gibt die Prozedur 1 (#True) zurück
  	ProcedureReturn 1
  Else
  	; Ansonsten 0
  	ProcedureReturn 0
  EndIf
EndProcedure
Procedure   _MeinGadget_Repaint(*stMeinGadget.MeinGadget_Attributes)
	; +-----------------------------------------------------------------
	; |Description  : Zeichnet die Testen in das Canvasgadget
	; |Arguments    : *stMeinGadget: Pointer auf die Gadget-Attributstruktur
	; |Results      : -
	; |Remarks      : Die Prozedur wird bei jedem #WM_PAINT-Event aufgerufen.
	; +-----------------------------------------------------------------
  Protected.i j
  
  ; Diese Prozedur zeichnet das Gadget in das PB-CanvasGadget.
  ; Hier werden die Tastenfelder (Rechtecke) und die Ziffern gezeichnet.
  ; die Prozedur wird bei jedem Auftreten eines #WM_PAINT Events vom Gadget Callback aus aufgerufen
  
  With *stMeinGadget
		If \iGadgetInitalized = 1
			If StartDrawing(CanvasOutput(\iGadgetNr))
				
				; Hintergrundfarbe zeichnen
				DrawingMode(#PB_2DDrawing_Default)
				Box(0, 0, \iWidth, \iHeight, \iBackColor)
				
				; Felder und Ziffern in den feldern zeichnen
				DrawingMode(#PB_2DDrawing_Outlined)
				For j = 0 To 11
					If j = \iCurrentField
						; Hier wird das zu dimmende Feld gezeichnet...
						DrawingMode(#PB_2DDrawing_Default)
						Box(\iFields[j]\iFieldX+1, \iFields[j]\iFieldY+1, \iFields[j]\iFieldWidth-2, \iFields[j]\iFieldHeigth-2, \iActiveFieldBackColorDimm)
						DrawingMode(#PB_2DDrawing_Outlined)
						Box(\iFields[j]\iFieldX, \iFields[j]\iFieldY, \iFields[j]\iFieldWidth, \iFields[j]\iFieldHeigth, \iFrontColor)
						DrawText(\iFields[j]\iFieldX + ((\iFields[j]\iFieldWidth - TextWidth(\iFields[j]\sFieldChar)) / 2), \iFields[j]\iFieldY + ((\iFields[j]\iFieldHeigth - TextHeight(\iFields[j]\sFieldChar)) / 2), \iFields[j]\sFieldChar, \iFrontColor, \iActiveFieldBackColorDimm)
					Else
						; und hier alle anderen
						Box(\iFields[j]\iFieldX, \iFields[j]\iFieldY, \iFields[j]\iFieldWidth, \iFields[j]\iFieldHeigth, \iFrontColor)
						DrawText(\iFields[j]\iFieldX + ((\iFields[j]\iFieldWidth - TextWidth(\iFields[j]\sFieldChar)) / 2), \iFields[j]\iFieldY + ((\iFields[j]\iFieldHeigth - TextHeight(\iFields[j]\sFieldChar)) / 2), \iFields[j]\sFieldChar, \iFrontColor, \iBackColor)
					EndIf
				Next j
			
				DrawingMode(#PB_2DDrawing_Default)
				StopDrawing()
			EndIf
		EndIf
	EndWith
EndProcedure
Procedure   _MeinGadget_WindowProcCallback(iWindow.i, iMessage.i, wParam.i, lParam.i) 
	; +-----------------------------------------------------------------
	; |Description  : Callback-Prozedur des CanvasGadgets, welches als Grundlage dient
	; |Arguments    : iWindow : Fensterhandle
	; |             : iMessage: Gadgetevent
	; |             : wParam  : wParameter des Events
	; |             : lParam  : lParameter des Events
	; |Results      : -
	; |Remarks      : -
	; +-----------------------------------------------------------------
	Protected *stMeinGadget.MeinGadget_Attributes
	Protected.s sFieldchar
	
	; Die Adresse des allokierten Gadgetspeichers aus den Userdaten des Gadgets auslesen
	*stMeinGadget = GetWindowLongPtr_(iWindow, #GWLP_USERDATA)
	
	; Nachfolgend werden die Events bearbeitet, die für unser Customgeadget wichtig sind.
	; Wird ein Case-Zweig mit "ProcedureReturn 0" verlassen, dann wird der entsprechende Event NICHT mehr an PureBasic
	; weitergegeben. Demzufolge löst der Event nur die Aktionen aus, die wir hier im Callback aufrufen.
	With *stMeinGadget
		Select iMessage
			Case #WM_TIMER
				If _MeinGadget_DimmActiveField(*stMeinGadget)
					; Ist die Farbe komplett heruntergedimmt, dann kann der Timer wieder entfernt werden, Rückgabewert = 0
					KillTimer_(\iGadgetID, 1)
				EndIf
				PostMessage_(iWindow, #WM_PAINT, 0, 0)
				ProcedureReturn 0
			Case #WM_CHAR
				If wParam	> 47 And wParam < 58 ; Ziffern 0 - 9
					_MeinGadget_ProcessChar(*stMeinGadget, wParam)
					PB_Event_Add(#PB_Event_Gadget, \iGadgetNr, 0, #MG_KEYPRESSED)     
					ProcedureReturn 0
				ElseIf wParam = 67 Or wParam = 99 ; Zeichen C oder c
					_MeinGadget_ProcessChar(*stMeinGadget, wParam)
					PostMessage_(iWindow, #MG_CLEAR, wParam, lParam)
					ProcedureReturn 0
				ElseIf wParam = 69 Or wParam = 101 Or wParam = 13; Zeichen E oder e oder RETURN
					If wParam = 13 : wParam = 69 : EndIf
				  _MeinGadget_ProcessChar(*stMeinGadget, wParam)
					PostMessage_(iWindow, #MG_ENTER, wParam, lParam)
					ProcedureReturn 0
				Else
					; Bei allen anderen CHARs passiert nichts, sie werden an PB durchgereicht.
				EndIf
			Case #WM_PAINT
				_MeinGadget_Repaint(*stMeinGadget)
			Case #WM_SIZE
				; Wird die Gadgetgröße verändert (z.B. mit ResizeGadget()), dann müssen unsere Strukturfelder neu berechnet und das Gadget neu gezeichnet werden.
				; das Neuzeichnen wird durch das Auslösen der Message #WM_PAINT realisiert, damit hier kein redundanter Aufruf der Zeichenprozedur entsteht.
				_MeinGadget_CalculateSize(*stMeinGadget)
				PostMessage_(iWindow, #WM_PAINT, 0, 0)
			Case #WM_SETFOCUS
				; Da unser Gadget kein eigenes Fokusrechteck hat (weil wir kein #PB_Canvas_DrawFocus angegeben haben), sorgen wir mit einer speziellen
				; Hintergrundfarbe dafür, dass man das Gadget erkennt, welches momentan den Tastaturfokus besitzt. Bei #WM_KILLFOCUS wird die Hintergrundfarbe
				; dann wieder zurückgesetzt (siehe unten).
				\iBackColor = \iFocusBackColor
				\iActiveFieldBackColorDimm = \iBackColor
			Case #WM_KILLFOCUS
				\iBackColor = \iNormalBackColor
				\iActiveFieldBackColorDimm = \iBackColor
			Case #WM_LBUTTONDOWN, #WM_LBUTTONDBLCLK
				; Bei einem Mausklick ermitteln wir das Feld unter dem Cursor uns senden eine #WM_CHAR Message mit dem entsprechenden Zeichen
				; Alle weiteren aktionen werden zentral im Zweig WM_CHAR bearbeitet.
				sFieldchar = _MeinGadget_FindCharUnderMouse(*stMeinGadget, @lParam)
				If sFieldchar <> ""
					PostMessage_(iWindow, #WM_CHAR, Asc(sFieldchar), 0)
				EndIf
				ProcedureReturn 0
			Case #WM_NCDESTROY
				; #WM_NCDESTROY wird gesendet, wenn unser Gadget freigegeben wird. Hier sollten wir also unsere eigenen Ressourcen ebenfalls freigeben.
				; Die alte WindowCallback-Prozedur des Gadgets wieder restaurieren (nur der Form halber, denn das Gadget wird eh gleich entfernt)
				SetWindowLongPtr_(iWindow, #GWLP_WNDPROC, \iOldWindowProc)
				; Den Speicher für die Gadgetstrukrur wieder freigeben
				FreeMemory(*stMeinGadget)
				; Und die Eventbearbeitung direkt verlassen ohne die alte WindowCallback-Prozedur aufzurufen
				ProcedureReturn 0
		EndSelect 
		; Danach wird die alte WindowCallback-Prozedur aufgerufen, damit restlichen Events bearbeitet werden
		ProcedureReturn CallWindowProc_(\iOldWindowProc, iWindow, iMessage, wParam, lParam)
	EndWith

EndProcedure 

;*************************************************************************
;* Externe Prozeduren (Befehlssatz des Gadgets)
;*************************************************************************

Procedure.i MeinGadget(iGadgetNr, x.i, y.i, iWidth.i, iHeight.i, iBackgroundColor = $EAE9CF, iTextColor = $000000, iFokusColor = $FAFAF4)
	; +-----------------------------------------------------------------
	; |Description  : Prozedur zur Definition des Gadgets
	; |Arguments    : iGadgetNr				: Gadgetnummer oder #PB_Any
	; |             : x        				: X-Position des Gadgets
	; |             : y        				: Y-Position des Gadgets
	; |             : iWidth  			  : Breite des Gadgets
	; |             : iHeight  				: Höhe des Gadgets
	; |             : iBackgroundColor: Hintergrundfarbe des Gadgets, wenn es nicht den Fokus hat
	; |             : iTextColor			: Vordergrundfarbe des Gadgets
	; |             : iBackgroundColor: iFokusColor des Gadgets, wenn es den Fokus hat
	; |Results      : 0, wenn das Gadget nicht erzeugt werden konnte, sonst die GadgetNr
	; |Remarks      : -
	; +-----------------------------------------------------------------
	Protected *stMeinGadget.MeinGadget_Attributes

	; Speicher für die Gadgetstrukrur allokieren
	*stMeinGadget = AllocateMemory(SizeOf(MeinGadget_Attributes))
	
	If *stMeinGadget > 0
		With *stMeinGadget
			
			; Das Gadget erzeugen und Nummer und ID in der Gadgetstrukrur speichern
			\iGadgetNr = CanvasGadget(iGadgetNr, x, y, iWidth, iHeight, #PB_Canvas_Keyboard|#PB_Canvas_Border) ; #PB_Canvas_Border|#PB_Canvas_Keyboard
			If iGadgetNr = #PB_Any
				\iGadgetID = GadgetID(\iGadgetNr)
			Else	
				\iGadgetID = \iGadgetNr
				\iGadgetNr = iGadgetNr
			EndIf
			
			If \iGadgetNr <> 0 And \iGadgetInitalized = 0
				\iFrontColor =iTextColor
				\iBackColor = iBackgroundColor
				\iNormalBackColor = iBackgroundColor
				\iFocusBackColor  = iFokusColor
				\iActiveFieldBackColor = iBackgroundColor / 2
				\iCurrentField = -1
				
				; Hier werden die Größen der einzelnen Felder berechnet
				_MeinGadget_CalculateSize(*stMeinGadget)
				
				; Die Adresse des allokierten Gadgetspeichers in den Userdaten des Gadgets merken
				SetWindowLongPtr_(\iGadgetID, #GWLP_USERDATA, *stMeinGadget)
				
				; Die Adresse der ursprünglichen WindowCallback-Prozedur holen, da diese von unserer neuen WindowCallback-Prozedur angesprungen werden muss.
				\iOldWindowProc = GetWindowLongPtr_(\iGadgetID, #GWL_WNDPROC)
				
				; Die neue WindowCallback-Prozedur für das Gadget setzen
				SetWindowLongPtr_(\iGadgetID, #GWLP_WNDPROC, @_MeinGadget_WindowProcCallback())

				\iGadgetInitalized = 1
			EndIf
			ProcedureReturn \iGadgetNr
		Else
			; Strukturspeicher allokieren ist fehlgeschlagen, das Gadget wurde nicht erzeugt
			ProcedureReturn 0
		EndIf
		
	EndWith
	
EndProcedure
Procedure.s MeinGadget_GetCurrentChar(iGadgetNr)
	; +-----------------------------------------------------------------
	; |Description  : Gibt die zuletzt gedrückte Taste des Gadgets zurück
	; |Arguments    : iGadgetNr				: Gadgetnummer
	; |Results      : ASCII Code der zuletzt gedrückten Taste oder -1, wenn es keine gibt.
	; |Remarks      : -
	; +-----------------------------------------------------------------
	Protected *stMeinGadget.MeinGadget_Attributes
	
	; Die Adresse des allokierten Gadgetspeichers aus den Userdaten des Gadgets auslesen...
	*stMeinGadget = GetWindowLongPtr_(GadgetID(iGadgetNr), #GWLP_USERDATA)
	
	; und die zuletzt gedrückte Taste zurückgeben
	ProcedureReturn Chr(*stMeinGadget\iLastChar)
EndProcedure

;*************************************************************************
;* Democode, der die Anwendung des Gadgets demonstriert
;*************************************************************************

If OpenWindow(0, 0, 0, 500, 290, "Test", #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window3D_SizeGadget) 
	Define.i iEvent, iEventtype, iEventType, iEventGadget
	Define.i iTrackbar
	Dim Gadget.i(2)
	Dim iStringGadget.i(2)
	
	iTrackbar = TrackBarGadget(#PB_Any, 10, 10, 180, 20, 90, 180)
	iStringGadget(0) = StringGadget(#PB_Any, 10, 35, 180, 20, "")
	iStringGadget(1) = StringGadget(#PB_Any, 200, 35, 120, 20, "")
	iStringGadget(2) = StringGadget(#PB_Any, 330, 35, 160, 20, "")
	
	DisableGadget(iStringGadget(0), 1)
	DisableGadget(iStringGadget(1), 1)
	DisableGadget(iStringGadget(2), 1)
	
	Gadget(0) = MeinGadget(#PB_Any, 10, 60, 90, 90 * 1.2)
	Gadget(1) = MeinGadget(#PB_Any, 200, 60, 120, 120)
	Gadget(2) = MeinGadget(#PB_Any, 330, 60, 160, 160, $008000, $FFFFFF, $32CD9A)
	SetActiveGadget(Gadget(0))
	
	Repeat 
		iEvent = WaitWindowEvent()      
		iEventGadget = EventGadget() 
		iEventType = EventType() 
		
		Select iEvent
			Case #PB_Event_Gadget
				Select iEventGadget
					Case 	iTrackbar
						ResizeGadget(Gadget(0), GadgetX(Gadget(0)), GadgetY(Gadget(0)), GetGadgetState(iTrackbar), GetGadgetState(iTrackbar) * 1.2)
					Case Gadget(0)
						Select iEventType
							Case #MG_KEYPRESSED
								Debug "Gadget 0: #MG_KEYPRESSED, Key: " + MeinGadget_GetCurrentChar(Gadget(0))
								SetGadgetText(iStringGadget(0), GetGadgetText(iStringGadget(0)) + MeinGadget_GetCurrentChar(Gadget(0)))
						EndSelect
					Case Gadget(1)
						Select iEventType
							Case #MG_KEYPRESSED
								Debug "Gadget 1: #MG_KEYPRESSED, Key: " + MeinGadget_GetCurrentChar(Gadget(1))
								SetGadgetText(iStringGadget(1), GetGadgetText(iStringGadget(1)) + MeinGadget_GetCurrentChar(Gadget(1)))
						EndSelect
					Case Gadget(2)
						Select iEventType
							Case #MG_KEYPRESSED
								Debug "Gadget 2: #MG_KEYPRESSED, Key: " + MeinGadget_GetCurrentChar(Gadget(2))
								SetGadgetText(iStringGadget(2), GetGadgetText(iStringGadget(2)) + MeinGadget_GetCurrentChar(Gadget(2)))
						EndSelect
				EndSelect
				
			Case #MG_CLEAR
				Select iEventGadget
					Case Gadget(0)
						Debug "Gadget 0: #MG_CLEAR"
						SetGadgetText(iStringGadget(0), "")
					Case Gadget(1)
						Debug "Gadget 1: #MG_CLEAR"
						SetGadgetText(iStringGadget(1), "")
					Case Gadget(2)
						Debug "Gadget 2: #MG_CLEAR"
						SetGadgetText(iStringGadget(2), "")
				EndSelect
				
			Case #MG_ENTER
				Select iEventGadget
					Case Gadget(0)
						Debug "Gadget 0: #MG_ENTER"
						SetGadgetText(iStringGadget(0), "")
					Case Gadget(1)
						Debug "Gadget 1: #MG_ENTER"
						SetGadgetText(iStringGadget(1), "")
					Case Gadget(2)
						Debug "Gadget 2: #MG_ENTER"
						SetGadgetText(iStringGadget(2), "")
				EndSelect
				
			Case #PB_Event_CloseWindow 
				End 
		EndSelect 
		
	ForEver 
EndIf 

[ts-soft]

Haste Dir ja richtig Mühe mit den Kommentaren gemacht

Gruß
Thomas