My First Screen Saver

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
BarryG
Addict
Addict
Posts: 3293
Joined: Thu Apr 18, 2019 8:17 am

Re: My First Screen Saver

Post by BarryG »

Thanks for the fixes!
User avatar
J. Baker
Addict
Addict
Posts: 2178
Joined: Sun Apr 27, 2003 8:12 am
Location: USA
Contact:

Re: My First Screen Saver

Post by J. Baker »

BarryG wrote:Thanks for the fixes!
No problem! ;)
www.posemotion.com

PureBasic Tools for OS X: PureMonitor, plist Tool, Data Maker & App Chef

Mac: 10.13.6 / 1.4GHz Core 2 Duo / 2GB DDR3 / Nvidia 320M
PC: Win 7 / AMD 64 4000+ / 3GB DDR / Nvidia 720GT


Even the vine knows it surroundings but the man with eyes does not.
User avatar
J. Baker
Addict
Addict
Posts: 2178
Joined: Sun Apr 27, 2003 8:12 am
Location: USA
Contact:

Re: My First Screen Saver

Post by J. Baker »

Version 1.4.2 fixes the DPI issue I had for the screen saver preview. Also added a fix for the screen scaling in PureBasic 5.72 x86. Screen saver template source has been updated as well.
www.posemotion.com

PureBasic Tools for OS X: PureMonitor, plist Tool, Data Maker & App Chef

Mac: 10.13.6 / 1.4GHz Core 2 Duo / 2GB DDR3 / Nvidia 320M
PC: Win 7 / AMD 64 4000+ / 3GB DDR / Nvidia 720GT


Even the vine knows it surroundings but the man with eyes does not.
User avatar
J. Baker
Addict
Addict
Posts: 2178
Joined: Sun Apr 27, 2003 8:12 am
Location: USA
Contact:

Re: My First Screen Saver

Post by J. Baker »

PoseMotion Christmas Screen Saver Update v1.5.0

What’s new…
  • Screen saver and installer are now signed.
  • Added a wall clock.
  • Added 10 Christmas songs.
  • Added music settings.
  • Windows 10 DPI added/updated.
  • Fixed some issues with graphics scaling.
Download Screen Saver
www.posemotion.com

PureBasic Tools for OS X: PureMonitor, plist Tool, Data Maker & App Chef

Mac: 10.13.6 / 1.4GHz Core 2 Duo / 2GB DDR3 / Nvidia 320M
PC: Win 7 / AMD 64 4000+ / 3GB DDR / Nvidia 720GT


Even the vine knows it surroundings but the man with eyes does not.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: My First Screen Saver

Post by mk-soft »

I found this on my collection and updated as for x64

Rename YourScreensaver.exe to .src and copy this to C:\Window\System32

Code: Select all

; German forum:
; Author: Andreas Miethe
; Date: 04. December 2002
; Update: 20.06.2021 by mk-soft

;******************************************************************* 
;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 VerifyPassword(wnd) 
Declare CloseSaver(wnd) 
Declare ExecuteSaver(wnd) 
Declare PreviewCallback(Wnd, Message, wParam, lParam) 
Declare Preview(wnd) 
Declare WindowCallback(Wnd, Message, wParam, lParam) 
Declare Main() 

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

Global Dim MousePos.Point(0);Mausposition-Start 
Global Dim CurrentMousePos.Point(0);aktuelle Mausposition 
#MainWindow = 10 
#PreviewWindow = 11 

Procedure setBlack(wnd) 
  ;schwarzer Hintergrund 
  R1.rect 
  dc = GetDC_(wnd) 
  Blackbrush.i = 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 SetPassword() 
  ;Password setzen 
  If OpenLibrary(0,"mpr.dll") 
  CallFunction(0 ,"PwdChangePasswordW",@"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.i 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.i=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.i CloseSaver(wnd) 
  ;Schoner beenden und Resourcen freigeben 
  If (OSVersion()=#PB_OS_Windows_95) Or (OSVersion()=#PB_OS_Windows_98)Or (OSVersion()=#PB_OS_Windows_ME) 
    If VerifyPassword(wnd) 
      DeleteDC_(GGDC) 
      KillThread(TI) 
      SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, 0, @oldval, 0) 
      ShowWindow_(wnd,0) 
      DestroyWindow_(wnd) 
      RedrawWindow_(0,0,0,$0581) 
      PostQuitMessage_(0) 
      End 
    Else 
      SetBlack(wnd) 
    EndIf 
  EndIf 
  If (OSVersion()=#PB_OS_Windows_NT_4) Or (OSVersion()=#PB_OS_Windows_2000)Or (OSVersion()<>#PB_OS_Windows_XP)Or (OSVersion()<>#PB_OS_Windows_NT3_51) 
    DeleteDC_(GGDC) 
    KillThread(TI) 
    SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, 0, @oldval, 0) 
    ShowWindow_(wnd,0) 
    DestroyWindow_(wnd) 
    RedrawWindow_(0,0,0,$0581) 
    PostQuitMessage_(0) 
    End 
  EndIf 
  ProcedureReturn Retval 
EndProcedure 

Procedure ExecuteSaver(wnd) 
  ;Hiew laeuft alles ab was beim "Schonen" passieren soll. 
  ;Angepasst an das Elternfenster ( Vorschau oder Vollbild ) 
  HHwnd = CreateWindowEx_(0,"Static","",#WS_VISIBLE|#WS_CHILD|#WS_CLIPSIBLINGS,0,0,0,0,wnd,0,GetModuleHandle_(0),0) 
  HHDC = GetDC_(HHwnd) 
  SetBlack(wnd) 
  Brush = GetStockObject_(#BLACK_BRUSH) 
  wr.RECT 
  GetWindowRect_(wnd,wr) 
  If Preview 
    wr\right = wr\right - wr\left 
    wr\bottom = wr\bottom - wr\top 
  Else 
    wr\left = 0 
    wr\top = 0 
    wr\right = GetSystemMetrics_(#SM_CXSCREEN) 
    wr\bottom = GetSystemMetrics_(#SM_CYSCREEN) 
  EndIf 
  rr.RECT 
  Repeat 
    rr\right = ww 
    rr\bottom = hh 
    FillRect_(HHDC,rr,brush) 
    WW = wr\right / (Random(6)+2) 
    HH = wr\bottom / (Random(6)+2) 
    XX = Random(wr\right) - ww 
    YY = Random(wr\bottom) - hh 
    MoveWindow_(HHWnd,XX,YY,WW,HH,0) 
    PaintDesktop_(HHDC) 
    UpdateWindow_(HHwnd) 
    Delay(500) 
  ForEver 
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 
    TI = CreateThread(@ExecuteSaver(),SHWnd) 
    While GetMessage_(m.MSG,0,0,0) 
      TranslateMessage_(m) 
      DispatchMessage_(m) 
    Wend 
  EndIf 
EndProcedure 

Procedure.i WindowCallback(Wnd, Message, wParam, lParam) 
  ;Callback fuer Hauptfenster 
  Result = DefWindowProc_(wnd,message,wParam,lParam) 
  Select message 
    Case #WM_KEYUP 
      If wparam <> 17 ;Strg abfangen 
        result = CloseSaver(wnd) 
      EndIf 
    Case #WM_SYSKEYUP 
      result = CloseSaver(wnd) 
    Case #WM_LBUTTONDOWN
        result = CloseSaver(wnd)
    Case #WM_MOUSEMOVE 
      GetCursorPos_(CurrentMousePos(0)) 
      If ((CurrentMousePos(0)\x - Mousepos(0)\x) > MaxMouse) Or ((CurrentMousePos(0)\y - Mousepos(0)\y) > MaxMouse) 
        result = CloseSaver(wnd) 
        GetCursorPos_(MousePos(0)) 
      EndIf 
  EndSelect 
  ProcedureReturn Result 
EndProcedure 

Procedure Main() 
  ;Hauptfenster-Prozedur 
  ShowCursor_(0) 
  Hwnd = OpenWindow(#MainWindow, 0, 0, GetSystemMetrics_(#SM_CXSCREEN),GetSystemMetrics_(#SM_CYSCREEN), "", #PB_Window_BorderLess) 
  If Hwnd 
    SetWindowCallback(@WindowCallback()) 
    SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, 1, @oldval, 0) 
    ;Windows mitteilen dass ein Schoner laeuft 
    SetWindowPos_(Hwnd,#HWND_TOPMOST,0,0,GetSystemMetrics_(#SM_CXSCREEN),GetSystemMetrics_(#SM_CYSCREEN),#SWP_SHOWWINDOW) 
    ;Fenster ganz nach "Oben" bringen 
    GetCursorPos_(MousePos(0)) 
    ;Mausposition ermitteln 
    MaxMouse = 10 
    ;maximale Mausbewegung einstellen 
    setBlack(hwnd) 
    ;Hintergrund schwarz 
    TI = CreateThread(@ExecuteSaver(),Hwnd) 
    ;Thread fuer Aktionen starten 
    While GetMessage_(m.MSG,0,0,0) 
      TranslateMessage_(m) 
      DispatchMessage_(m) 
    Wend 
  EndIf 
EndProcedure 


;Mehrfachstart verhindern 
MutextString$ = "PB-Screensaver" 
MutexHandle.i = 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 ""
    Main()
    ;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
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
J. Baker
Addict
Addict
Posts: 2178
Joined: Sun Apr 27, 2003 8:12 am
Location: USA
Contact:

Re: My First Screen Saver

Post by J. Baker »

Very nice, mk-soft! ;)
www.posemotion.com

PureBasic Tools for OS X: PureMonitor, plist Tool, Data Maker & App Chef

Mac: 10.13.6 / 1.4GHz Core 2 Duo / 2GB DDR3 / Nvidia 320M
PC: Win 7 / AMD 64 4000+ / 3GB DDR / Nvidia 720GT


Even the vine knows it surroundings but the man with eyes does not.
Post Reply