PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Screensaver Preview ???

http://forums.purebasic.com/french/viewtopic.php?t=1154

Page 1 sur 1

Screensaver Preview ???

Publié : dim. 18/juil./2004 20:22
par Guimauve
Bonjour à tous,

J'ai un problème avec la création d'un Screensaver. Je voudrais faire afficher un image dans la zone des preview mais je ne sais vraiment pas comment faire. Est-ce que quelqu'un à un idée sur comment faire pour que ça marche ?

Voiçi le squelette que j'utilise :
(Merci à l'auteur)

Code : Tout sélectionner

; (c) 2001 - Franco's template - absolutely freeware
; PureBasic screensaver
;

Procedure OnlyOneSCRStart(Name$)
     Shared OnlyOneStartMutex.l
     OnlyOneStartMutex = CreateMutex_(0, 1, Name$)
     OnlyOneStartError.l = GetLastError_()
     If OnlyOneStartMutex <> 0 And OnlyOneStartError = 0
          ProcedureReturn 1
     Else
          CloseHandle_(OnlyOneStartMutex)
          End
     EndIf
EndProcedure

Procedure OnlyOneSCRStop()
     CloseHandle_(OnlyOneStartMutex)
EndProcedure


Procedure RunScreenSaver(ScreenSaverName$)
     
     If InitSprite() = 0
          MessageRequester("Error", "Can't open DirectX 7 Or later", 0)
          End
     EndIf
     
     If InitKeyboard() = 0
          MessageRequester("Error", "Can't open DirectX 7 Or later", 0)
          End
     EndIf
     
     If OpenScreen(GetSystemMetrics_(#SM_CXSCREEN), GetSystemMetrics_(#SM_CYSCREEN), 32, ScreenSaverName$)
          
          If LoadSprite(0, "FSW Blanc.bmp", 0) = 0
          MessageRequester("Error", "Can't open a sprite !", 0)
          EndIf
          Else
          MessageRequester("Error", "Can't open a screen !", 0)
     EndIf
EndProcedure


; MAIN PROGRAM
ScreenSaverName$ = "PureBasic ScreenSaver"

OnlyOneSCRStart(ScreenSaverName$)

; only the first 2 chars are interesting sometimes you have more as you see below
Parameter$ = Left(ProgramParameter(), 2)


; normal start of a screensaver
If Parameter$ = "/s"
     RunScreenSaver(ScreenSaverName$)
     Run = 10
     XMax = (GetSystemMetrics_(#SM_CXSCREEN) / 2) - (SpriteWidth(0) / 2)
     YMax = (GetSystemMetrics_(#SM_CYSCREEN) / 2) - (SpriteHeight(0) / 2)
     
     While Run > 0
          FlipBuffers()
          ClearScreen(0, 0, 0)
          ; all sprites moves syncron
          DisplaySprite(0, XMax + x, YMax + x)
          DisplaySprite(0, XMax - x, YMax - x)
          DisplaySprite(0, XMax + x, YMax - x)
          DisplaySprite(0, XMax - x, YMax + x)
          DisplaySprite(0, XMax + x, YMax)
          DisplaySprite(0, XMax - x, YMax)
          DisplaySprite(0, XMax, YMax + x)
          DisplaySprite(0, XMax, YMax - x)
          
          ; with the following code the srites will return to start and restart new
          If x < XMax And Pos = 0 : x + 1 : Pos = 0 : EndIf
          If x = XMax And Pos = 0 : x - 1 : Pos = 1 : EndIf
          If x < XMax And Pos = 1 : x - 1 : Pos = 1 : EndIf
          If x = 0 And Pos = 1 : x + 1 : Pos = 0 : EndIf
          ;- ----------------------------------------------
          
          If GetInputState_()
               Run = Run - 10
          EndIf
          
          If GetQueueStatus_(#QS_MOUSEMOVE)
               Run = Run - 1
          EndIf ; because of WinXp works under Win98 as well
          
          Delay(10)
     Wend
EndIf

; "/c:1340" under w98 don't know if it is always: ":1340" <- what is this?
; wenn you press the Settings button
; this is the settings window...
If Parameter$ = "/c"
     If OpenWindow(0, 200, 200, 320, 240, #PB_Window_SystemMenu, ScreenSaverName$)
          Repeat
               EventID.l = WaitWindowEvent()
          Until EventID = #PB_EventCloseWindow
     EndIf
EndIf

; "/p" when you mark the screensaver in the screensaver list
; and you have to show up something in the preview screen
; or if you leave the settings or the preview mode
If Parameter$ = "/p"
    ; Faut faire quelque chose ici mais quoi ????
 
EndIf


OnlyOneSCRStop()
End
Merci à l'avance.

A+
Guimauve

Publié : dim. 18/juil./2004 21:10
par filperj
J'avais vu un code qui faisait ça sur le forum anglais, mais ça fait un bon moment... Et je ne me souvient plus de l'auteur... Mais avec un peu de patience, ça doit se retrouver :roll:

Publié : dim. 18/juil./2004 21:17
par filperj
Ah! Tu pourras peut-être tirer quelquechose de ça:http://purebasic.myforums.net/viewtopic ... er+preview

Publié : dim. 18/juil./2004 23:24
par Guimauve
Bon je regarde ça. L'ennui c'est je vais devoir le tripatouiller pour lui passer un animation dans l'Imagegadget à la place d'une image statique.

Si j'y arrive je mettrai le code complet ici.

Merci

A+
Guimauve

Publié : lun. 19/juil./2004 0:59
par Guimauve
Voiçi à quoi ressemble l'écran de veille. Sans l'aperçu pour le moment.
Le code est présent mais en commentaire.

Le code pour le screensaver est de Franco et le code pour les étoiles est de Pupil (Forum anglais). Merci à eux pour leurs bout de code.

Et j'ai ajouté des éléments et adapté le tout pour que ça fonctionne.

A+
Guimauve

Code : Tout sélectionner

; (c) 2001 - Franco's template - absolutely freeware
; PureBasic screensaver
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Procédure de fonctionnement du Screensaver
; Ne pas modifier

Procedure OnlyOneSCRStart(Name$)
     Shared OnlyOneStartMutex.l
     OnlyOneStartMutex = CreateMutex_(0, 1, Name$)
     OnlyOneStartError.l = GetLastError_()
     If OnlyOneStartMutex <> 0 And OnlyOneStartError = 0
          ProcedureReturn 1
     Else
          CloseHandle_(OnlyOneStartMutex)
          End
     EndIf
EndProcedure

Procedure OnlyOneSCRStop()
     CloseHandle_(OnlyOneStartMutex)
EndProcedure


Procedure RunScreenSaver(ScreenSaverName$)
     
     If InitSprite() = 0
          MessageRequester("Error", "Can't open DirectX 7 Or later", 0)
          End
     EndIf
     
     If InitKeyboard() = 0
          MessageRequester("Error", "Can't open DirectX 7 Or later", 0)
          End
     EndIf
     
     If OpenScreen(GetSystemMetrics_(#SM_CXSCREEN), GetSystemMetrics_(#SM_CYSCREEN), 32, ScreenSaverName$) = 0
          MessageRequester("Error", "Can't open a screen !", 0)
     EndIf
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Début du programme

Declare CreateINI(Fichier$, StarsMax.l, StarSize.l, StarSpeed.l, StarRotation.l)
Declare rnd(min.w, max.w)
Declare Setup_stars(MAX_STAR.l, STAR_SIZE.l, Largeur.l, Hauteur.l, OutputID)
Declare UpdateStar(MAX_STAR.l, STAR_SPEED.l, sens.l, Largeur.l, Hauteur.l)

; Declare HandleError(result, text.s)
; Declare PreviewCallback(hWnd, Message, wParam, lParam)
; Declare ExecutePreview()

ScreenSaverName$ = "Étoiles en rotation"

OnlyOneSCRStart(ScreenSaverName$)

; only the first 2 chars are interesting sometimes you have more as you see below
Parameter$ = Left(ProgramParameter(), 2)


; normal start of a screensaver
If Parameter$ = "/s"
     
     ; Le fichier ini n'existe pas, créer celui par défaut
     If FileSize(ScreenSaverName$ + ".ini") = -1
          CreateINI(ScreenSaverName$ + ".ini", 5000, 2, 5, 1)
     EndIf
     
     OpenPreferences(ScreenSaverName$ + ".ini")
     Nb_max = ReadPreferenceLong("Nombre maximum d'étoiles", 5000)
     Grosseur = ReadPreferenceLong("Grosseur des étoiles", 2)
     Vitesse = ReadPreferenceLong("Vitesse des étoiles", 5)
     Sens_rotation = ReadPreferenceLong("Sens de rotation des étoiles", 1)
     ClosePreferences()
     
     Dim star_x.l(Nb_max)
     Dim star_y.l(Nb_max)
     Dim star_z.l(Nb_max)
     
     RunScreenSaver(ScreenSaverName$)
     Run = 10
     
     Setup_stars(Nb_max, Grosseur, GetSystemMetrics_(#SM_CXSCREEN), GetSystemMetrics_(#SM_CYSCREEN), ScreenOutput())
     
     While Run > 0
          FlipBuffers()
          ClearScreen(0, 0, 0)
          
          UpdateStar(Nb_max, Vitesse, Sens_rotation, GetSystemMetrics_(#SM_CXSCREEN), GetSystemMetrics_(#SM_CYSCREEN))
          
          ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
          ; On vérifie si l'utilisateur touche au clavier ou à la souris
          
          If GetInputState_()
               Run = Run - 10
          EndIf
          
          If GetQueueStatus_(#QS_MOUSEMOVE)
               Run = Run - 1
          EndIf ; because of WinXp works under Win98 as well
          
          ; Delay(10)
     Wend
EndIf

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Fenètre pour le paramétrage
Enumeration
     
     #Param_win
     
     #Txt_MaxStars
     #String_MaxStars
     
     #Txt_SizeStars
     #String_SizeStars
     
     #Txt_SpeedStars
     #String_SpeedStars
     
     #Frame3D_RotationStar
     #Option_CW
     #Option_CCW
     
     #Btn_Ok
     #Btn_Cancel
     
EndEnumeration

If Parameter$ = "/c"
     
     ; Le fichier ini n'existe pas, créer celui par défaut
     If FileSize(ScreenSaverName$ + ".ini") = -1
          CreateINI(ScreenSaverName$ + ".ini", 5000, 2, 5, 1)
     EndIf
     
     OpenPreferences(ScreenSaverName$ + ".ini")
     Nb_max = ReadPreferenceLong("Nombre maximum d'étoiles", 5000)
     Grosseur = ReadPreferenceLong("Grosseur des étoiles", 2)
     Vitesse = ReadPreferenceLong("Vitesse des étoiles", 5)
     Sens_rotation = ReadPreferenceLong("Sens de rotation des étoiles", 1)
     ClosePreferences()
     
     If OpenWindow(#Param_win, 0, 0, 230, 170, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, ScreenSaverName$)
          
          If CreateGadgetList(WindowID(#Param_win))
               TextGadget(#Txt_MaxStars, 10, 10, 140, 20, "Nombre maximum d'étoiles :", #PB_Text_Center)
               StringGadget(#String_MaxStars, 160, 10, 60, 20, Str(Nb_max))
               TextGadget(#Txt_SizeStars, 10, 30, 140, 20, "Grosseur des étoiles :", #PB_Text_Center)
               StringGadget(#String_SizeStars, 160, 30, 60, 20, Str(Grosseur))
               TextGadget(#Txt_SpeedStars, 10, 50, 140, 20, "Vitesse des étoiles :", #PB_Text_Center)
               StringGadget(#String_SpeedStars, 160, 50, 60, 20, Str(Vitesse))
               
               Frame3DGadget(#Frame3D_RotationStar, 10, 80, 210, 50, "Sens de rotation des étoiles :")
               OptionGadget(#Option_CW, 15, 100, 90, 20, "Sens Horaire")
               OptionGadget(#Option_CCW, 110, 100, 105, 20, "Sens Anti-Horaire")
               
               ButtonGadget(#Btn_Ok, 10, 140, 100, 20, "Ok")
               ButtonGadget(#Btn_Cancel, 120, 140, 100, 20, "Annuler")
               
          EndIf
          
     EndIf
     
     If Sens_rotation = 1
          SetGadgetState(#Option_CW, 1)
     Else
          SetGadgetState(#Option_CCW, 1)
     EndIf
     
     Repeat
          EventID.l = WaitWindowEvent()
          
          If EventID = #PB_EventGadget
               Select EventGadgetID()
                    Case #Btn_Ok
                         
                         Nb_max = Val(GetGadgetText(#String_MaxStars))
                         Grosseur = Val(GetGadgetText(#String_SizeStars))
                         Vitesse = Val(GetGadgetText(#String_SpeedStars))
                         
                         If GetGadgetState(#Option_CW) = 1
                              Sens_rotation = 1
                         Else
                              Sens_rotation = -1
                         EndIf
                         
                         CreateINI(ScreenSaverName$ + ".ini", Nb_max, Grosseur, Vitesse, Sens_rotation)
                         EventID = #PB_EventCloseWindow
                         
                    Case #Btn_Cancel
                         EventID = #PB_EventCloseWindow
                         
               EndSelect
          EndIf
     Until EventID = #PB_EventCloseWindow
     
EndIf

; "/p" when you mark the screensaver in the screensaver list
; and you have to show up something in the preview screen
; or if you leave the settings or the preview mode
If Parameter$ = "/p"
     ; ExecutePreview()
EndIf

OnlyOneSCRStop()
End


; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Procédure pour l'affichage

Procedure CreateINI(Fichier$, StarsMax.l, StarSize.l, StarSpeed.l, StarRotation.l)
     
     CreatePreferences(Fichier$)
     WritePreferenceLong("Nombre maximum d'étoiles", StarsMax)
     WritePreferenceLong("Grosseur des étoiles", StarSize)
     WritePreferenceLong("Vitesse des étoiles", StarSpeed)
     WritePreferenceLong("Sens de rotation des étoiles", StarRotation)
     ClosePreferences()
     
EndProcedure

Procedure rnd(min.w, max.w)
     a.w = max - Random (max - min)
     ProcedureReturn a
EndProcedure

Procedure Setup_stars(MAX_STAR.l, STAR_SIZE.l, Largeur.l, Hauteur.l, OutputID)
     For c.w = 0 To MAX_STAR
          star_x(c) = Rnd(-Largeur / 2, Largeur / 2) << 6
          star_y(c) = Rnd(-Hauteur / 2, Hauteur / 2) << 6
          star_z(c) = Rnd(2, 255)
     Next
     StartDrawing(OutputID)
          For i = 0 To 255
               FrontColor(i, i, i)
               Box(i * STAR_SIZE, 0, STAR_SIZE, STAR_SIZE)
          Next
     StopDrawing()
     For i = 0 To 255
          GrabSprite(i, i * STAR_SIZE, 0, STAR_SIZE, STAR_SIZE)
     Next
EndProcedure

Procedure UpdateStar(MAX_STAR.l, STAR_SPEED.l, sens.l, Largeur.l, Hauteur.l)
     
     cos.f = Cos(-sens * 0.025)
     sin.f = Sin(-sens * 0.025)
     
     For c = 0 To MAX_STAR
          star_z(c) = star_z(c) - STAR_SPEED
          x.l = star_x(c)
          y.l = star_y(c)
          star_y(c) = (y * cos - x * sin)
          star_x(c) = (x * cos + y * sin)
          If star_z(c) <= 2
               star_z(c) = 255
          EndIf
          s_x.w = (star_x(c) / star_z(c)) + (Largeur / 2)
          s_y.w = (star_y(c) / star_z(c)) + (Hauteur / 2)
          col.w = 255 - star_z(c)
          DisplaySprite(col, s_x, s_y)
     Next
EndProcedure


; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Global previewFlag.l
; Global parameter.s
; Global prevWinHndlString.s
; Global prevWinHndl.l
; Global prevThreadID.l
;
; ; simple error checking
; Procedure HandleError(result, text.s)
; If result = 0 : MessageRequester("Error", text, #PB_MessageRequester_Ok) : End : EndIf
; EndProcedure
;
; ; preview window callback
; Procedure PreviewCallback(hWnd, Message, wParam, lParam)
; Select Message
; Case #WM_CLOSE
; UnregisterClass_("PreviewWindowClass", GetModuleHandle_(#NULL))
; DestroyWindow_(hWnd)
; End
; EndSelect
; Result = DefWindowProc_(hWnd, Message, wParam, lParam)
; ProcedureReturn Result
; EndProcedure
;
; ; execute the preview in the little mini monitor in 'Display Properties'
; Procedure ExecutePreview()
; PreviewWindowSize.RECT
; GetClientRect_(PrevWinHndl, @PreviewWindowSize)
; PreviewWindowClass.WNDCLASS
; Classname.s = "PreviewWindowClass"
; PreviewWindowClass\style = #CS_HREDRAW | #CS_VREDRAW
; PreviewWindowClass\lpfnWndProc = @PreviewCallback()
; PreviewWindowClass\cbClsExtra = 0
; PreviewWindowClass\cbWndExtra = 0
; PreviewWindowClass\hInstance = GetModuleHandle_(#NULL)
; PreviewWindowClass\hIcon = 0
; PreviewWindowClass\hCursor = 0
; PreviewWindowClass\hbrBackground = 0
; PreviewWindowClass\lpszMenuName = 0
; PreviewWindowClass\lpszClassName = @Classname
; RegisterClass_(PreviewWindowClass)
; hWnd.l = CreateWindowEx_(0, "PreviewWindowClass", "", #WS_CHILD | #WS_VISIBLE, 0, 0, PreviewWindowSize\right, PreviewWindowSize\bottom, PrevWinHndl, 0, GetModuleHandle_(#NULL), 0)
; If hWnd
;
; CreateImage(3, PreviewWindowSize\right, PreviewWindowSize\bottom)
; StartDrawing(ImageOutput())
; Box(0, 0, PreviewWindowSize\right, PreviewWindowSize\bottom, RGB(0, 250, 0))
; StopDrawing()
;
; HandleError(CreateGadgetList(hWnd), "Gadget list in preview window could not be created!")
; ImageGadget(1, 0, 0, PreviewWindowSize\right, PreviewWindowSize\bottom, UseImage(3))
; While GetMessage_(Message.MSG, 0, 0, 0)
; TranslateMessage_(Message)
; DispatchMessage_(Message)
; Wend
; EndIf
; EndProcedure

Publié : lun. 19/juil./2004 14:41
par Guimauve
J'ai trouvé ça sur code archive, c'est un autre squelette.
Ça marche sauf que j'ai des problèmes avec ce code. :mad:
Le processus reste toujours actif même si on change de d'écran de veille.

Pourtant le code me semble correct. C'est peut-être dû à WinXP , sait-on jamais ?

Des idées ...

A+
Guimauve

Code : Tout sélectionner

;English forum: http://purebasic.myforums.net/viewtopic.php?t=8891&highlight=
; Author: eddy
; Date: 29. December 2003

; Note: need to be compiled to an executable first...

; Screensaver Preview... 3rd edition

;------------------- 
;-Preview Destructor 
;------------------- 

Procedure PreviewAutoDestruction(window, message, wParam, lParam) 
   Shared WM_DestroyPreview 
    
   Result = #PB_ProcessPureBasicEvents 
   Select message 
      Case #WM_CLOSE 
         DestroyWindow_(window) 
         End 
      Case WM_DestroyPreview 
         End 
   EndSelect 
   ProcedureReturn Result 
EndProcedure 

;------------------- 
;-Preview 
;------------------- 

Procedure Preview(preview) 
      
   ; ------------------------ 
   ; preview image 
   ; ------------------------ 
   UseGadgetList(preview) 
      
      GetClientRect_(preview,@rc.rect)    
      CreateImage(1,rc\right,rc\bottom) 
         StartDrawing(ImageOutput()) 
            For y=0 To ImageHeight() 
               Line(0,y,ImageWidth(),1,RGB($FF*y/ImageHeight(),$CC*y/ImageHeight(),0)) 
            Next 
         StopDrawing() 
      ImageGadget(1,0,0,0,0,ImageID())  

   CloseGadgetList() 


   ; ------------------------ 
   ; close previous previews 
   ; ------------------------ 
   Shared WM_DestroyPreview 
   WM_DestroyPreview=RegisterWindowMessage_(@"PREVIEW AUTO DESTRUCTION") 
   SendMessage_(#HWND_BROADCAST,WM_DestroyPreview,0,0)    

   ; ------------------------ 
   ; the empty child window will receive all messages 
   ; wait end of preview... 
   ; ------------------------        
   SetParent_(OpenWindow(0,0,0,0,0,#PB_WINDOW_INVISIBLE,"CHILD WINDOW"),preview)    
   SetWindowCallback(@PreviewAutoDestruction()) 
    
   Repeat 
      WaitWindowEvent() 
   ForEver    
EndProcedure 

;------------------- 
;-Main Program 
;------------------- 
FirstParam.s    =ProgramParameter() 
command.s       =LCase(Left(ReplaceString(FirstParam,"-","/"),2)) 
ParentWindow.l  =Val(StringField(FirstParam,2,":")) | Val(ProgramParameter()) 
        
Select command      
   Case "/p" 
      Preview(ParentWindow) 
   Case "/c" 
      ;Config(ParentWindow)      
   Default 
      ;Saver() 
EndSelect 

; ExecutableFormat=Windows
; FirstLine=1
; EOF
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru