Windows Screensaver mit Sprite3D-Lib-Funktionen

Anwendungen, Tools, Userlibs und anderes nützliches.
Antworten
Benutzeravatar
Makke
Beiträge: 156
Registriert: 24.08.2011 18:00
Computerausstattung: AMD Ryzen 7 5700X - AMD Radeon RX 6800 XT - 32 GB DDR4 SDRAM
Wohnort: Ruhrpott
Kontaktdaten:
Kontaktdaten von Makke

Windows Screensaver mit Sprite3D-Lib-Funktionen

Beitrag von Makke »

Hallo zusammen,

ich habe mal mit der Sprite 3D Lib rumprobiert und herausgekommen ist da ein kleiner Bildschirmschoner.

Hier der Link: http://rllp.kilu.de/files/ssloupbubbles.zip und hier der Source-Code:

Code: Alles auswählen

; loup bubbles demo by Makke
; 2011-11-10

EnableExplicit

; constants
#APPNAME      = "Loup-Bubbles"
#DESKTOP_MAIN = 0
#DESKTOP_REFR = 10000
#DESKTOP_SYNC = #PB_Screen_SmartSynchronization;#PB_Screen_NoSynchronization
Enumeration
  #TEXTFONT
  #DESKTOP_IMAGE
  #DESKTOP_SPRITE
  #GRAB_IMAGE
  #SCREENSHOT
EndEnumeration
#SPRITE2D_TRANSCOL = $FF00FF  
#ZOOMINPX          = 35
#MORPHINPX         = 15

; structures
Structure BubbleInfo
  coords.RECT
  hNorm2D.i
  hNorm3D.i
  hGrabImg.i
  hGrab2D.i
  hGrab3D.i
  ilength.i
  iradius.i
  ispeedh.i
  ispeedv.i
  collide.i
EndStructure

; dynamic lists
NewList Bubbles.BubbleInfo()

; variables
ExamineDesktops()
Define Desk_Width.i     = DesktopWidth(#DESKTOP_MAIN)
Define Desk_Height.i    = DesktopHeight(#DESKTOP_MAIN)
Define Desk_Depth.i     = DesktopDepth(#DESKTOP_MAIN)
Define Desk_Freq.i      = DesktopFrequency(#DESKTOP_MAIN)

Define DoLoop.i
Define ShowFPS.i        = #False
Define RefreshCounter.i = ElapsedMilliseconds()

Define MorphDir.i
Define MorphCounter.f

; declarations
Declare.i InitScreen()
Declare.i InitBubbles()
Declare.i GetDesktopBackgroundAsSprite()
Declare.i GetCollisionBorderSide()
Declare.i CheckBubbleCollision()
Declare.i CreateBubbleBackground()
Declare.s GetFPS()
Declare ConfigScreenSaver()
Declare ShowScreensaverPreview(ParentWIndow.l)
Declare ScreensaverPasswordCheck()
Declare CheckProgramParameters()

; hardware initialization
If Not InitSprite() Or Not InitSprite3D() Or Not InitKeyboard() Or Not InitMouse()
  MessageRequester("ERROR", "You need DirectX 9 or higher!", #MB_OK|#MB_ICONERROR)
  End
EndIf
; check program parameters
CheckProgramParameters()
If Not InitScreen()
  MessageRequester("ERROR", "Can't open DirectX window!", #MB_OK|#MB_ICONERROR)
  End
EndIf
If Not InitBubbles()
  CloseScreen()
  MessageRequester("ERROR", "Can't create DirectX surfaces!", #MB_OK|#MB_ICONERROR)
  End
EndIf
If Not GetDesktopBackgroundAsSprite()
  CloseScreen()
  MessageRequester("ERROR", "Can't capture desktop image!", #MB_OK|#MB_ICONERROR)
  End
EndIf

; main loop
DoLoop = #True
Repeat
  ; refresh desktop
  If (ElapsedMilliseconds() - RefreshCounter) >= #DESKTOP_REFR
    If GetDesktopBackgroundAsSprite()
      RefreshCounter = ElapsedMilliseconds()
    Else
      CloseScreen()
      MessageRequester("ERROR", "Can't capture desktop picture!", #MB_OK|#MB_ICONERROR)
      End
    EndIf
  EndIf
  ; draw desktop image as background
  DisplaySprite(#DESKTOP_SPRITE, 0, 0)
  ; check if bubbles collide with screen
  GetCollisionBorderSide()
  ; check if bubbles collide with each other
  CheckBubbleCollision()
  ; move the bubbles
  With Bubbles()
    ForEach Bubbles()
      \coords\top    = \coords\top  + \ispeedv
      \coords\left   = \coords\left + \ispeedh
      \coords\right  = \coords\left + \ilength
      \coords\bottom = \coords\top  + \ilength
    Next
  EndWith
  ; morph the bubbles 
  If MorphDir = -1
    MorphCounter - 0.5
    If MorphCounter <= -#MORPHINPX
      MorphDir = 1
    EndIf
  ElseIf MorphDir = 1
    MorphCounter + 0.5
    If MorphCounter >= #MORPHINPX
      MorphDir = -1
    EndIf
  Else
    MorphDir = 1
    MorphCounter + 1
  EndIf
  ; after movement create the loup background
  CreateBubbleBackground()
  ; paint 'em
  Start3D()
  With Bubbles()
    ForEach Bubbles()
      If IsSprite3D(\hGrab3D)
        ZoomSprite3D(\hGrab3D, \ilength, \ilength)
        TransformSprite3D(\hGrab3D, 0+MorphCounter, 0-MorphCounter, \ilength-MorphCounter, 0-MorphCounter, \ilength-MorphCounter, \ilength+MorphCounter, 0+MorphCounter, \ilength+MorphCounter)
        DisplaySprite3D(\hGrab3D, \coords\left, \coords\top, 128)
      EndIf
      TransformSprite3D(\hNorm3D, 0+MorphCounter, 0-MorphCounter, \ilength-MorphCounter, 0-MorphCounter, \ilength-MorphCounter, \ilength+MorphCounter, 0+MorphCounter, \ilength+MorphCounter)
      DisplaySprite3D(\hNorm3D, \coords\left, \coords\top, 128)
    Next
  EndWith
  Stop3D()
  ; test
;   StartDrawing(ScreenOutput())
;   ForEach Bubbles()
;     DrawText(Bubbles()\coords\left, Bubbles()\coords\top, Str(ListIndex(Bubbles())))
;   Next
;   StopDrawing()
  ; show fps
  If ShowFPS = #True
    StartDrawing(ScreenOutput())
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(#TEXTFONT))
    DrawText(Desk_Width - 100, 5, "fps: " + GetFPS(), $000000)
    StopDrawing()
  Else
    GetFPS()
  EndIf
  ; input
  ExamineMouse()
  If MouseDeltaX() > 10 Or MouseDeltaY() > 10
    DoLoop = #False
  EndIf
  If MouseButton(#PB_MouseButton_Left) Or MouseButton(#PB_MouseButton_Right) Or MouseButton(#PB_MouseButton_Middle)
    DoLoop = #False
  EndIf
  ExamineKeyboard()
  If KeyboardReleased(#PB_Key_F11)
    If ShowFPS = #True
      ShowFPS = #False
    Else
      ShowFPS = #True
    EndIf
  ElseIf KeyboardReleased(#PB_Key_F12)
    GrabSprite(#SCREENSHOT, 0, 0, Desk_Width, Desk_Height)
    SaveSprite(#SCREENSHOT, "loup-bubble-screenshot.bmp")
    FreeSprite(#SCREENSHOT)
  ElseIf KeyboardReleased(#PB_Key_All)
    DoLoop = #False
  EndIf
  ; buffer management
  FlipBuffers()
  Delay(1)
Until DoLoop = #False

End

; procedures

Procedure CheckProgramParameters()
  Define param1.s = UCase(ProgramParameter(0))
  Define param2.s = ProgramParameter(1)
  If Len(param1) > 2
    param2 = Mid(param1, 4, Len(param1)-3)
  EndIf
  param1 = Mid(param1, 2, 1)
  Select param1
    Case "" 
      ; configure saver
      ConfigScreenSaver()
    Case "C" 
      ; configure saver
      ConfigScreenSaver()
    Case "P" 
      ; preview
      ShowScreensaverPreview(Val(param2))
    Case "A" 
      ; password
      ScreensaverPasswordCheck()
    Case "S" 
      ; main
      ProcedureReturn 
  EndSelect
EndProcedure

Procedure ConfigScreenSaver()
  Define txt.s = Chr(169) + " 2011 by Markus Müller"+Chr(13)+Chr(10)+"Nothing to configure at the moment!"+Chr(13)+Chr(10)+Chr(13)+Chr(10)+"F11 - Show FPS"+Chr(13)+Chr(10)+"F12 - Screenshot"
  MessageRequester(#APPNAME, txt, #MB_OK|#MB_ICONINFORMATION)
  End
EndProcedure

Procedure ShowScreensaverPreview(ParentWindow.l)
  Define Message.MSG
  Define ClientDC.i
  Define ClientRect.RECT
  Define ClientWidth.i
  Define ClientHeight.i
  Define ClientBrush.i
  ; is parent window valid
  If ParentWindow < 0
    MessageRequester("ERROR", "Can not create screensaver preview, no parent window!", #MB_OK|#MB_ICONERROR)
    End
  EndIf
  ClientDC = GetDC_(ParentWindow)
  GetClientRect_(ParentWindow, ClientRect)
  With ClientRect
    ClientWidth  = \right  - \left
    ClientHeight = \bottom - \top
  EndWith
  ClientBrush = CreateSolidBrush_(RGB(0, 0, 0))
  FillRect_(ClientDC, ClientRect, ClientBrush) 
  SetBkColor_(ClientDC, RGB(0, 0, 0))
  SetTextColor_(ClientDC, RGB(255, 255, 0))
  TextOut_(CLientDC, 0, 45, #APPNAME, Len(#APPNAME))
  ReleaseDC_(ParentWindow, ClientDC)
  End
EndProcedure

Procedure ScreensaverPasswordCheck()
  ; windows does it itself
  End
EndProcedure

Procedure.i InitScreen()
  Shared Desk_Depth
  Shared Desk_Freq
  Shared Desk_Height
  Shared Desk_Width
  If OpenScreen(Desk_Width, Desk_Height, Desk_Depth, #APPNAME, #DESKTOP_SYNC, Desk_Freq)
    LoadFont(#TEXTFONT, "Verdana", 14, #PB_Font_HighQuality|#PB_Font_Bold)
    StartDrawing(ScreenOutput())
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(#TEXTFONT))
    DrawText((Desk_Width - 60) / 2, (Desk_Height - 8) / 2, "LOADING ...", $FFFFFF)
    StopDrawing()
    FlipBuffers()
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.i InitBubbles()
  Shared Bubbles()
  Shared Desk_Width
  Shared Desk_Height
  Define tempsprite.i = CatchSprite(#PB_Any, ?BUBBLE, #PB_Sprite_Texture)
  If Not IsSprite(tempsprite)
    ProcedureReturn #False
  EndIf
  With Bubbles()
    ; Bubble 1
    AddElement(Bubbles())
    \hNorm2D = tempsprite ;CopySprite(tempsprite, #PB_Any, #PB_Sprite_Texture)
    \hNorm3D = CreateSprite3D(#PB_Any, \hNorm2D)
    \ilength = SpriteWidth(\hNorm2D)
    \iradius = (\ilength / 2) - 20
    \ispeedh = 2 + Random(4)
    \ispeedv = 1 + Random(3)
    \coords\top    = 0 - \ilength
    \coords\left   = 0 - \ilength
    \coords\right  = 0
    \coords\bottom = 0
    ; Bubble 2
    AddElement(Bubbles())
    \hNorm2D = tempsprite
    \hNorm3D = CreateSprite3D(#PB_Any, \hNorm2D)
    \ilength = SpriteWidth(\hNorm2D)
    \iradius = (\ilength / 2) - 20
    \ispeedh = 2 + Random(4)
    \ispeedv = 1 + Random(3)
    \coords\top    = Desk_Height
    \coords\left   = 0 - \ilength
    \coords\right  = 0
    \coords\bottom = Desk_Height + \ilength
    ; Bubble 3
    AddElement(Bubbles())
    \hNorm2D = tempsprite
    \hNorm3D = CreateSprite3D(#PB_Any, \hNorm2D)
    \ilength = SpriteWidth(\hNorm2D)
    \iradius = (\ilength / 2) - 20
    \ispeedh = 2 + Random(4)
    \ispeedv = 1 + Random(3)
    \coords\top    = 0 - \ilength
    \coords\left   = Desk_Width
    \coords\right  = Desk_Width + \ilength
    \coords\bottom = 0
    ; Bubble 4
    AddElement(Bubbles())
    \hNorm2D = tempsprite
    \hNorm3D = CreateSprite3D(#PB_Any, \hNorm2D)
    \ilength = SpriteWidth(\hNorm2D)
    \iradius = (\ilength / 2) - 20
    \ispeedh = 2 + Random(4)
    \ispeedv = 1 + Random(3)
    \coords\top    = Desk_Height
    \coords\left   = Desk_Width
    \coords\right  = Desk_Width + \ilength
    \coords\bottom = Desk_Height + \ilength
  EndWith
  ; enough for now
  ForEach Bubbles()
    If Not IsSprite3D(Bubbles()\hNorm3D)
      ProcedureReturn #False
    EndIf
  Next
  ProcedureReturn #True
EndProcedure

Procedure.i GetDesktopBackgroundAsSprite()
  Shared Desk_Width
  Shared Desk_Height
  Define hDC.i
  Define DeskDC.i
  If Not IsImage(#DESKTOP_IMAGE)
    CreateImage(#DESKTOP_IMAGE, Desk_Width, Desk_Height)
  EndIf
  hDC    = StartDrawing(ImageOutput(#DESKTOP_IMAGE))
  DeskDC = GetDC_(GetDesktopWindow_())
  BitBlt_(hDC, 0, 0, Desk_Width, Desk_Height, DeskDC, 0, 0, #SRCCOPY)
  StopDrawing()
  ReleaseDC_(GetDesktopWindow_(), DeskDC)
  If IsImage(#DESKTOP_IMAGE)
    CreateSprite(#DESKTOP_SPRITE, Desk_Width, Desk_Height)
    If IsSprite(#DESKTOP_SPRITE)
      StartDrawing(SpriteOutput(#DESKTOP_SPRITE))
      DrawImage(ImageID(#DESKTOP_IMAGE), 0, 0)
      StopDrawing()
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.i GetCollisionBorderSide()
  Shared Bubbles()
  Shared Desk_Height
  Shared Desk_Width
  With Bubbles()
    ForEach Bubbles()
      If \coords\top <= 0 And \ispeedv < 0
        \ispeedv = \ispeedv * -1
      EndIf
      If \coords\bottom >= Desk_Height And \ispeedv > 0
        \ispeedv = \ispeedv * -1
      EndIf
      If \coords\left <= 0 And \ispeedh < 0
        \ispeedh = \ispeedh * -1
      EndIf
      If \coords\right >= Desk_Width And \ispeedh > 0
        \ispeedh = \ispeedh * -1
      EndIf
    Next
  EndWith
EndProcedure

Procedure.i CheckBubbleCollision()
  Shared Bubbles()
  NewList bubblecopy.BubbleInfo()
  Define CollDiffX.i
  Define CollDiffY.i
  CopyList(Bubbles(), bubblecopy())
  ForEach Bubbles()
    ForEach bubblecopy()
      If Bubbles()\hNorm3D = bubblecopy()\hNorm3D
        Continue
      EndIf
      CollDiffX = Bubbles()\coords\left - bubblecopy()\coords\left
      CollDiffY = Bubbles()\coords\top  - bubblecopy()\coords\top
      If Sqr((CollDiffX * CollDiffX) + (CollDiffY * CollDiffY)) < (Bubbles()\iradius + Bubbles()\iradius)
        If CollDiffX < 0 And Bubbles()\ispeedh > 0
          Bubbles()\ispeedh * -1
        EndIf
        If CollDiffX > 0 And Bubbles()\ispeedh < 0
          Bubbles()\ispeedh * -1
        EndIf
        If CollDiffY < 0 And Bubbles()\ispeedv > 0
          Bubbles()\ispeedv * -1
        EndIf
        If CollDiffY > 0 And Bubbles()\ispeedv < 0
          Bubbles()\ispeedv * -1
        EndIf
      EndIf
    Next
  Next
  ClearList(bubblecopy())
EndProcedure

Procedure.i CreateBubbleBackground()
  Shared Bubbles()
  Shared Desk_Width
  Shared Desk_Height
  Define size.i
  With Bubbles()
    ForEach Bubbles()
      If \coords\top < 0 Or \coords\left < 0 Or \coords\right > Desk_Width Or \coords\bottom > Desk_Height
        Continue
      EndIf
      size = \ilength - (#ZOOMINPX * 2)
      If IsImage(\hGrabImg)
        FreeImage(\hGrabImg)
      EndIf
      \hGrabImg = GrabImage(#DESKTOP_IMAGE, #PB_Any, \coords\left + #ZOOMINPX, \coords\top + #ZOOMINPX, size, size)
      If Not IsSprite(\hGrab2D)
        \hGrab2D = CreateSprite(#PB_Any, size, size, #PB_Sprite_Texture)
      EndIf
      StartDrawing(SpriteOutput(\hGrab2D))
      DrawingMode(#PB_2DDrawing_Default)
      DrawImage(ImageID(\hGrabImg), 0, 0)
      DrawingMode(#PB_2DDrawing_Outlined)
      Circle(size / 2, size / 2, (size - (#ZOOMINPX * 2)) / 2, #SPRITE2D_TRANSCOL)
      DrawingMode(#PB_2DDrawing_Default)
      FillArea(0, 0, #SPRITE2D_TRANSCOL, #SPRITE2D_TRANSCOL)
      StopDrawing()
      TransparentSpriteColor(\hGrab2D, #SPRITE2D_TRANSCOL)
      If IsSprite3D(\hGrab3D)
        FreeSprite3D(\hGrab3D)
      EndIf
      \hGrab3D = CreateSprite3D(#PB_Any, \hGrab2D)
      If Not IsSprite3D(\hGrab3D)
        CloseScreen()
        MessageRequester("ERROR", "Can't create internal surface!"+Chr(13)+Chr(10)+UCase(#PB_Compiler_Procedure), #MB_OK|#MB_ICONERROR)
        End
      EndIf
    Next
  EndWith
EndProcedure

Procedure.s GetFPS()
  Static timer.i
  Static counter.i
  Static lastFPS.s
  counter + 1
  If ElapsedMilliseconds() - timer >= 1000
    lastFPS = Str(counter)
    counter = 0
    timer   = ElapsedMilliseconds()
  EndIf
  ProcedureReturn lastFPS
EndProcedure

; data
DataSection
  BUBBLE:
  IncludeBinary "bubble3.bmp" ; Paint.NET Forum: http://forums.getpaint.net/index.php?/topic/12294-a-way-to-create-bubbles/
EndDataSection
Und hier die Grafik zum selber kompilieren: http://rllp.kilu.de/img/bubble3.bmp

Das Screensaver-Grundgerüst habe ich dem hier aus dem Forum (von Andreas Miethe) entlehnt, aber im wesentlich stark abgespeckt. Natürlich wäre hier eine Konfiguration (Größe der Lupe, Anzahl Bälle usw.) noch interessant, aber da es mit primär auf die Einarbeitung in Sprite3D ankam, habe ich mir das gespart.

Wünsche allen Interessierten viel Spass damit.
---
Windows 11 (64 bit)
Nach oben
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:
Kontaktdaten von RSBasic

Re: Windows Screensaver mit Sprite3D-Lib-Funktionen

Beitrag von RSBasic »

Sieht gut aus. ;)
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Nach oben
Antworten

Zurück zu „Feedback - Anwendungen“