Da hab ich doch mal mit dem Canvaszeug rumgespielt... und siehe da :
Code: Alles auswählen
;#####
;##### Matrix Gadget
;#####
;##### Matrix Routine von : AndyX (http://purebasic.fr/german/viewtopic.php?p=76436#p76436)
;#####
EnableExplicit
Macro Center(Value, Max)
(((Max) - (Value)) / 2)
EndMacro
Structure MatrixGadget_Structure
text.s
refresh.i
thread.i
halt.i
font.i
fontcolor.i
EndStructure
Procedure UpdateMatrixGadgetThread(Gadget)
Protected i, j, xx, yy, scrollletter.c, Green.c, Letter, FontFarbe
Protected StartTime = ElapsedMilliseconds()
Protected *p.MatrixGadget_Structure
If IsGadget(Gadget)
If GadgetType(Gadget) = #PB_GadgetType_Canvas
Dim Array_Screen_Letters.Point(GetSystemMetrics_(#SM_CXSCREEN)/10, GetSystemMetrics_(#SM_CYSCREEN)/10)
For i = 0 To GadgetHeight(Gadget) /10
For j = 0 To GadgetWidth(Gadget) /10
With Array_Screen_Letters(j,i)
\x = Random(250)
\y = Random(222)+33
EndWith
Next j
Next i
Else
ProcedureReturn #False
EndIf
Else
ProcedureReturn #False
EndIf
Repeat
If IsGadget(Gadget)
If GadgetType(Gadget) = #PB_GadgetType_Canvas
*p = GetWindowLong_(GadgetID(Gadget),#GWL_USERDATA)
If *p\halt = 1
Break
EndIf
StartDrawing(CanvasOutput(Gadget))
Box(0,0,GadgetWidth(Gadget),GadgetHeight(Gadget),0)
For i = 0 To GadgetHeight(Gadget) /10
For j = 0 To GadgetWidth(Gadget) /10
With Array_Screen_Letters(j,i)
DrawText(j*10,i*10,Chr(\y),RGB(0,\x,0),0)
EndWith
Next j
Next i
If Len(*p\text)>0
DrawingMode(#PB_2DDrawing_Default|#PB_2DDrawing_Transparent)
If IsFont(*p\font)
DrawingFont(FontID(*p\font))
EndIf
If *p\fontcolor = -1
FontFarbe = #White
EndIf
DrawText(Center(TextWidth(*p\Text), GadgetWidth(Gadget)),Center(TextHeight(*p\Text), GadgetHeight(Gadget)),*p\Text,FontFarbe)
EndIf
For i = GadgetHeight(Gadget)/10 To 0 Step -1
For j = GadgetWidth(Gadget)/10 To 0 Step -1
If i And Random(1)=0
scrollletter.c = Array_Screen_Letters(j,i-1)\y
Green.c = Array_Screen_Letters(j,i-1)\x
With Array_Screen_Letters(j,i)
If Random(3)<>1
Letter = scrollletter
Else
Letter = Random(222)+33
EndIf
\x = Green - Random(1)
If \x <= 0
\x = Random(250)
\y = Random(222)+33
EndIf
EndWith
ElseIf (Not i) And Random(1)=0
With Array_Screen_Letters(j,i)
\y = Random(222)+33
\x = Random(250)
EndWith
EndIf
Next j
Next i
StopDrawing()
Else
Break
EndIf
Else
Break
EndIf
Repeat
If ElapsedMilliseconds() - StartTime >= *p\refresh
StartTime = ElapsedMilliseconds()
Break
EndIf
Delay(1)
ForEver
ForEver
FreeMemory(*p)
FreeArray(Array_Screen_Letters())
EndProcedure
Procedure MatrixGadget(Gadget, x, y, w, h, Refresh = 60, Text.s = "", Font = 0, FontColor = -1)
Protected Result, GadNr, Thread
Protected *p.MatrixGadget_Structure
If #PB_Compiler_Version<460
MessageRequester("","Es wird PB 4.6 benötigt")
End
EndIf
If Gadget = #PB_Any
Result = CanvasGadget(#PB_Any, x, y, w, h)
GadNr = Result
Else
Result = CanvasGadget(Gadget, x, y, w, h)
GadNr = Gadget
EndIf
*p = AllocateMemory(SizeOf(MatrixGadget_Structure))
;InitializeStructure(*p, MatrixGadget_Structure)
*p\text = Text
*p\refresh = refresh
Thread = CreateThread(@UpdateMatrixGadgetThread(),GadNr)
*p\thread = Thread
*p\font = Font
*p\fontcolor = FontColor
SetWindowLong_(GadgetID(GadNr),#GWL_USERDATA,*p)
ProcedureReturn Result
EndProcedure
Procedure SetMatrixGadgetRefresh(Gadget, Refresh)
Protected *p.MatrixGadget_Structure
If IsGadget(Gadget)
*p.MatrixGadget_Structure = GetWindowLong_(GadgetID(Gadget),#GWL_USERDATA)
If *p
If IsThread(*p\thread)
*p\refresh = Refresh
SetWindowLong_(GadgetID(Gadget),#GWL_USERDATA,*p)
EndIf
EndIf
EndIf
EndProcedure
Procedure SetMatrixGadgetText(Gadget, Text.s = "", Font = 0, FontColor = -1)
Protected *p.MatrixGadget_Structure
If IsGadget(Gadget)
*p.MatrixGadget_Structure = GetWindowLong_(GadgetID(Gadget),#GWL_USERDATA)
If *p
If IsThread(*p\thread)
*p\text = text
If IsFont(Font)
*p\font = Font
EndIf
If FontColor>-1
*p\fontcolor = FontColor
EndIf
SetWindowLong_(GadgetID(Gadget),#GWL_USERDATA,*p)
EndIf
EndIf
EndIf
EndProcedure
Procedure FreeMatrixGadget(Gadget)
Protected *p.MatrixGadget_Structure
If IsGadget(Gadget)
*p.MatrixGadget_Structure = GetWindowLong_(GadgetID(Gadget),#GWL_USERDATA)
If *p
If IsThread(*p\thread)
*p\halt = 1
WaitThread(*p\thread)
FreeGadget(Gadget)
EndIf
EndIf
EndIf
EndProcedure
DisableExplicit
;##### Testlauf
FontNummer = LoadFont(#PB_Any, "Comic Sans MS",18)
Window = OpenWindow(#PB_Any, 0, 0, 640, 260, "MatrixGadget Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
mGadget = MatrixGadget(#PB_Any, 0, 0, 640, 200, 60, "Das MatrixGadget", FontNummer)
tracker = TrackBarGadget(#PB_Any, 10, 220, 300, 30, 10, 200, #PB_TrackBar_Ticks)
text = TextGadget(#PB_Any, 320, 225, 50, 20, "60 ms")
button = ButtonGadget(#PB_Any, 380, 225, 100, 20, "RandomSize")
GadgetToolTip(tracker, "Refreshrate einstellen")
SetGadgetState(tracker, 60)
Repeat :
Event=WaitWindowEvent(25)
If Event =#PB_Event_Gadget
Select EventGadget()
Case button
w = Random(640) : h = Random(200)
x = Center(w, 640) : y = Center(h, 200)
ResizeGadget(mGadget, x, y, w, h)
Case tracker
SetMatrixGadgetRefresh(mGadget, GetGadgetState(tracker))
SetGadgetText(text, Str(GetGadgetState(tracker))+" ms")
Case mGadget
Select EventType()
Case #PB_EventType_MouseEnter
SetMatrixGadgetText(mGadget, "nich klicken... nein nicht")
Case #PB_EventType_MouseLeave
SetMatrixGadgetText(mGadget, "Das MatrixGadget")
Case #PB_EventType_LeftButtonDown
SetMatrixGadgetText(mGadget, "AUA !!")
EndSelect
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
FreeMatrixGadget(mGadget)
EndWenn man SetGadgetData() nicht braucht, kann das ganze auch auf anderen Systemen laufen.
(da ist ein Stück WindowAPI drin)
Einzige Haken, wenn man das Programm beenden will muss man das Gadget explizit freigeben,
damit es nicht zu einer Fehlermeldung ala Gadget ist nicht initialisert kommt, wobei ich doch Abfrage
ob das Gadget da ist oder nicht... wenn jemand da nen Tipp hat...
Irgendwie hatte ich gerade an eine andere Matrix gedacht.
ick och, "MatrixGadget" hat sich so seriös angehört.