Screensaver erstellen?

[Janno]

Wie erstelle ich einen Screensaver?
Geht das? Kann mir das jemand erklären?

MFG Jan

[mk-soft]

Hi,

Der Screensaver ist eigentlich auch nur eine exe. Allerdings mit ein Paar Funktionen die ausgeführt werden sollten.

Aus den Code-Archiv:

Code: Alles auswählen

;*******************************************************************
;Einfacher Bildschirmschoner, der aber alles enthaellt was ein
;Schoner so braucht. Vorschau, Passwort-Abfrage, Passwort-Aenderung
;usw.
;Ist als Grundgeruest gedacht !
;Nach dem Compilieren die EXE in SCR umbenennen !
;Andreas Miethe * Dezember 2002
;*******************************************************************

Declare setBlack(wnd)
Declare SetPassword()
Declare ConfigSaver()
Declare.l VerifyPassword(wnd)
Declare.l CloseSaver(wnd)
Declare ExecuteSaver(wnd)
Declare.l PreviewCallback(Wnd, Message, wParam, lParam)
Declare Preview(wnd)
Declare.l WindowCallback(Wnd, Message, wParam, lParam)
Declare Main()

Global Param$,Param1$;Startparameter
Global Hwnd.l,SHwnd.l,SParanet.l;Hauptfenster,Vorschaufenster,Elternfenster(Vorschau)
Global PreviewDC.l;Devicecontext Vorschau
Global TI.l;Thread fuer Aktionen
Global Preview.l,HHDC.l;Flag,Devicecontext-Hauptfenster
Global MaxMouse.l;maximale Mausbewegung

Dim MousePos.Point(0);Mausposition-Start
Dim CurrentMousePos.Point(0);aktuelle Mausposition
#MainWindow = 1000
#PreviewWindow = 1001

Procedure SetTransparent(Window.l ,Value.l)

  SetWindowLong_(Window,#GWL_EXSTYLE,GetWindowLong_(Window,#GWL_EXSTYLE) | #WS_EX_LAYERED)
  SetLayeredWindowAttributes_(Window, 0, (255 * Value) / 100, #LWA_ALPHA)

EndProcedure

Procedure SetPassword()
    ;Password setzen
    If OpenLibrary(0,"mpr.dll")
        CallFunction(0 ,"PwdChangePasswordA","SCRSAVE",ScrWnd,0,0)
        CloseLibrary(0)
    EndIf
    End
EndProcedure

Procedure ConfigSaver()
    ;Konfiguration des Schoners
    MessageRequester("Screensaver","© 2002 by ampsoft"+Chr(13)+"Nichts einzurichten",64)
    End
EndProcedure

Procedure.l VerifyPassword(wnd)
    ;Passwort abfragen
    If (OSVersion()=#PB_OS_Windows_95) Or (OSVersion()=#PB_OS_Windows_98)Or (OSVersion()=#PB_OS_Windows_ME)
        Retval = 0
        hKey.l=0
        If RegOpenKeyEx_(#HKEY_CURRENT_USER,"'Control Panel\desktop",0,#KEY_READ,@hKey)
            ;Ist Passwortschutz aktiv ?
            If OpenLibrary(0,"Password.cpl")
                ;Abfrage
                ShowCursor_(1)
                Retval = CallFunction(0,"VerifyScreenSavePwd",wnd)
                ShowCursor_(Retval)
                CloseLibrary(0)
            EndIf
            RegCloseKey_(hKey)
        EndIf
    EndIf
    ProcedureReturn Retval
EndProcedure

Procedure Main()
    
  ;Hauptfenster-Prozedur
  ShowCursor_(0)
  If ExamineDesktops
    dx = DesktopWidth(0)
    dy = DesktopHeight(0)
  Else
    dx = 1600
    dy = 1280
  EndIf

  style = #PB_Window_BorderLess
  If OpenWindow(#MainWindow, 0, 0, dx, dy, "Fenster", style)
    
    StickyWindow(#MainWindow, 1)
    SetWindowColor(#MainWindow, 0)
    SetTransparent(WindowID(#MainWindow), 50)
    
    SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, 1, @oldval, 0)
  
    Repeat
      event   = WaitWindowEvent()
      window  = EventWindow()
      menu    = EventMenu()
      type    = EventType()
      Select event
        Case #WM_LBUTTONUP
          Exit = 1
        Case #PB_Event_CloseWindow
          Exit = 1
      
      EndSelect
    
    Until Exit
    
    SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, 0, @oldval, 0)
            
  EndIf

EndProcedure


Procedure setBlack(wnd)
    ;schwarzer Hintergrund
    R1.rect
    dc = GetDC_(wnd)
    Blackbrush.l = GetStockObject_(#BLACK_BRUSH)
    r1\left = 0
    r1\top = 0
    r1\right = GetSystemMetrics_(#SM_CXSCREEN)
    r1\bottom = GetSystemMetrics_(#SM_CYSCREEN)
    SetBkColor_(dc,RGB(0,0,0))
    FillRect_(dc,r1,blackbrush)
    ReleaseDC_(wnd,dc)
EndProcedure

Procedure PreviewCallback(Wnd, Message, wParam, lParam)
    ;Callback fuer Vorschau
    Select message
    Case #WM_PAINT
    setBlack(Wnd)
    Case #WM_CLOSE
        DeleteDC_(PreviewDC)
        DeleteObject_(Hrgn)
        DeleteDC_(GGDC)
        KillThread(TI)
        UnregisterClass_("MyScrClass",GetModuleHandle_(0))
        DestroyWindow_(wnd)
        End
    EndSelect
    Result = DefWindowProc_(wnd,message,wParam,lParam)
    ProcedureReturn Result
EndProcedure

Procedure Preview(wnd)
    ;Vorschau-Prozedur
    ;Eigene Fensterklasse fuer die Vorschau anlegen
    Dim ScrClass.WNDCLASS(0)
    Classname$ = "MyScrClass"
    ScrClass(0)\style = #CS_HREDRAW | #CS_VREDRAW
    ScrClass(0)\lpfnWndProc = @PreviewCallback()
    ScrClass(0)\cbClsExtra = 0
    ScrClass(0)\cbWndExtra = 0
    ScrClass(0)\hInstance = GetModuleHandle_(0)
    ScrClass(0)\hIcon = 0
    ScrClass(0)\hCursor = 0
    ScrClass(0)\hbrBackground = 0
    ScrClass(0)\lpszMenuName = 0
    ScrClass(0)\lpszClassName = @Classname$
    RegisterClass_(ScrClass(0));Fensterklasse registrieren
    
    r.RECT
    GetWindowRect_(wnd,r)
    r\right = r\right - r\left
    r\bottom = r\bottom - r\top
    SHwnd  = CreateWindowEx_(0, "MyScrClass", "",#WS_CHILD|#WS_VISIBLE, 0, 0, r\right,r\bottom, wnd, 0, GetModuleHandle_(0), 0)
    If Shwnd
      While GetMessage_(m.MSG,0,0,0)
        TranslateMessage_(m)
        DispatchMessage_(m)
      Wend
    EndIf
EndProcedure


;Mehrfachstart verhindern
MutextString$ = "PB-Screensaver"
MutexHandle.l = CreateMutex_(0,1,MutexString$)
If GetLastError_() = #ERROR_ALREADY_EXISTS ;Programm läuft schon
    End
EndIf

;Start-Parameter aufbereiten
;Die Parameter können mit einem - oder / beginnen und zwischen erstem
;und zweitem Parameter können sich entweder ein Doppelpunkt
;oder ein Leerzeichen befinden.
;Sind sie mit einem Doppelpunkt verbunden,
;erkennt sie PB nicht als zwei Parameter,
;und speichert beide in ProgrammParameter 1

Param$ = UCase(ProgramParameter())

If Len(Param$) > 2
    Param1$ = RemoveString(Param$, Left(Param$,2),1)
Else
    Param1$ = ProgramParameter()
EndIf

Param$ = RemoveString(Param$, Left(Param$,1),1)
Param$ = Left(Param$,1)

Select Param$
Case ""
    ConfigSaver()
Case "C"
    ;Einstellungen
    ConfigSaver()
Case "P"
    ;Vorschau
    Preview = 1
    SParent = Val(Param1$)
    PreView(SParent)
Case "A"
    ;Passwort
    SetPassword()
Case "S"
    ;Hauptprogramm
    Preview = 0
    Main()
EndSelect

FF

P.S. Habe an den Code etwas gebastelt. Original im Codearchiv.