PureBoard

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)
End