Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/
Vielleicht kannst du ein andersfarbiges Fenster über diesen Zahlenfeld legen und dieses dann mit AnimateWindow_ ausblenden.Kurzer hat geschrieben:Das Gadget soll nach dem Anklicken eines Zahlenfeldes dieses farblich hervorheben und die Farbe dann innerhalb von 1-2 Sekunden langsam wieder "wegdimmen".
$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.Kurzer hat geschrieben: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)?Müsste in Edels code noch ein Freedata vorkommen?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);
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.
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()
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
