Publié : lun. 21/févr./2005 23:37
j'ai hate de voir le code 

Code : Tout sélectionner
;Comtois le 26/02/05
;Pour l'écran de veille , j'ai trouvé de l'aide sur les sites suivants
;http://nono40.developpez.com/tutoriel/delphi/screensaver/
;http://purebasicforums.com/english/viewtopic.php?t=8891
;http://purebasicforums.com/english/viewtopic.php?t=6010
;http://purebasic.hmt-forum.com/viewtopic.php?t=2439
;Merci à tous
;{-Include
Declare Erreur(Message$)
Declare Limite(*Valeur.LONG, Min.l, Max.l)
Declare TracePolygone()
Declare AffPoints()
Declare TestPoint(X1.l, Y1.l, X2.l, Y2.l, d.l)
Declare PolygoneConvexe()
Declare Repartition()
Declare SauvePreference()
Declare ChargePreference()
Declare OnlyOneSCRStart(ScreensaverName.s)
Declare OnlyOneSCRStop()
Declare ExecutePreview()
Declare ExecuteScreenSaver()
Declare Config()
Enumeration
#Window_0
#TrackBar_NbBoules
#Radio_CoulBoule
#Frame3D_Lignes
#Radio_AutreCoul
#Frame3D_Boules
#TrackBar_Sprite
#Button_Ok
#Button_Annuler
#Button_Infos
#Image_Conf
#Button_CoulFond
#Button_CoulLigne
#Frame3D_Fond
#String_NbBoules
#String_Sprite
EndEnumeration
#Taille = 20
Structure NewPoint
x.l
y.l
dx.l
dy.l
EndStructure
Structure Conf
NbBoules.l ; de 2 à 50
Sprite.l ; 1 à 8 sprites possibles
CoulFond.l ;
CoulSprite.l[8] ; Mémorise la couleur des sprites
SelectCoulLigne.l ; Couleur identique aux boules = 0 , autre = 1
CoulLigne.l
EndStructure
NewList ListPoint.NewPoint()
NewList Polygone.NewPoint()
Dim TexteCouleur.s(8)
Global Conf.Conf
Global ScreenWidth.l
Global ScreenHeight.l
Global previewFlag.l
Global Parameter.s
Global prevWinHndlString.s
Global prevWinHndl.l
Global prevThreadID.l
Global Couleur.l
ScreensaverName.s = "Polygone convexe"
ScreenWidth.l = GetSystemMetrics_(#SM_CXSCREEN)
ScreenHeight.l = GetSystemMetrics_(#SM_CYSCREEN)
Restore RgbCouleurs
For i=0 To 7
Read Conf\CoulSprite[i]
Next i
Restore TxtCouleurs
For i=0 To 7
Read TexteCouleur(i)
Next
LoadFont(0, "Comic sans MS", 10)
;}
;{- Gestion écran de veille
;Récupère le paramètre passé au programme
Parameter = UCase(ProgramParameter())
If Len(Parameter) > 2
prevWinHndlString = RemoveString(Parameter, Left(Parameter, 3), 1)
Parameter = RemoveString(Parameter, Left(Parameter, 1), 1)
Parameter = Left(Parameter, 1)
Else
Parameter = RemoveString(Parameter, Left(Parameter, 1), 1)
prevWinHndlString = ProgramParameter()
If FindString(prevWinHndlString, "-", 0) <> 0 : prevWinHndlString = RemoveString(prevWinHndlString, "-", 1) : EndIf
If FindString(prevWinHndlString, "/", 0) <> 0 : prevWinHndlString = RemoveString(prevWinHndlString, "/", 1) : EndIf
EndIf
prevWinHndl = Val(prevWinHndlString)
;}
;Une seule instance du programme !
OnlyOneSCRStart(ScreensaverName)
;Gestion des paramètres passés au programme
Select Parameter
Case "" ;double click
Config()
Case "A" ;Mot de passe
End
Case "C" ;Configuration
Config()
Case "P" ;Prévisualisation
ExecutePreview()
Case "S" ;Ecran de veille
ExecuteScreenSaver()
EndSelect
OnlyOneSCRStop()
End
;-PROCEDURES
;Une seule instance de l'écran de veille
Procedure OnlyOneSCRStart(ScreensaverName.s)
;repris entièrement d'un code de Kale
*MutexName = @ScreensaverName
Shared OnlyOneStartMutex.l
OnlyOneStartMutex = CreateMutex_(0, 1, *MutexName)
OnlyOneStartError.l = GetLastError_()
If OnlyOneStartMutex <> 0 And OnlyOneStartError = 0
ProcedureReturn 1
Else
CloseHandle_(OnlyOneStartMutex)
End
EndIf
EndProcedure
;Ferme l'écran de veille
Procedure OnlyOneSCRStop()
;repris entièrement d'un code de Kale
CloseHandle_(OnlyOneStartMutex)
EndProcedure
;preview window callback
Procedure PreviewCallback(hWnd, message, wParam, lParam)
;repris entièrement d'un code de Kale
Select message
Case #WM_CLOSE
UnregisterClass_("PreviewWindowClass", GetModuleHandle_(#Null))
DestroyWindow_(hWnd)
End
EndSelect
Result = DefWindowProc_(hWnd, message, wParam, lParam)
ProcedureReturn Result
EndProcedure
;Lance la prévisualisation
Procedure ExecutePreview()
;repris d'un code de Kale
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(1,previewWindowSize\right, previewWindowSize\bottom)
StartDrawing(ImageOutput())
For y=0 To ImageHeight()
Line(0,y,ImageWidth(),1,RGB(0,$FF*y/ImageHeight(),$CC*y/ImageHeight()))
Next
DrawingMode(1)
DrawingFont(UseFont(0))
FrontColor(255, 255, 255)
T$="Polygone convexe"
Locate((ImageWidth() - TextLength(T$)) / 2, (ImageHeight() / 2) - 20)
DrawText(T$)
T$="H.Demarche - 19/02/05"
Locate((ImageWidth() - TextLength(T$)) / 2, (ImageHeight() / 2) + 20)
DrawText(T$)
StopDrawing()
If CreateGadgetList(hWnd) = 0
Erreur("Gadget list in preview window could not be created!")
EndIf
ImageGadget(1, 0, 0, previewWindowSize\right, previewWindowSize\bottom, UseImage(1))
While GetMessage_(message.MSG, 0, 0, 0)
TranslateMessage_(message)
DispatchMessage_(message)
Wend
EndIf
EndProcedure
;Lance l'écran de veille
Procedure ExecuteScreenSaver()
Shared ScreensaverName
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
Erreur("Impossible d'initialiser DirectX 7 Ou plus")
ElseIf OpenScreen(ScreenWidth, ScreenHeight, 32, ScreensaverName) = 0
Erreur("impossible d'ouvrir le mode plein écran!")
EndIf
;Informe le système que l'on est en écran de veille
SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, 1, @oldval, 0)
;Cache la souris
ShowCursor_(0)
ChargePreference()
Repartition()
;/Sprite
UsePNGImageDecoder()
TransparentSpriteColor(-1, 255, 0, 255)
If CatchSprite(10, ?Boules)=0
Erreur("CatchSprite")
EndIf
ClipSprite(10,Conf\Sprite * 40, 0, 40, 40)
Repeat
ClearScreen(Red(Conf\CoulFond), Green(Conf\CoulFond), Blue(Conf\CoulFond))
AffPoints()
PolygoneConvexe()
TracePolygone()
ForEach ListPoint()
DisplayTransparentSprite(10, ListPoint()\x - #Taille, ListPoint()\y - #Taille)
Next
FlipBuffers()
Delay(1)
ExamineKeyboard()
ExamineMouse()
Until KeyboardPushed(#PB_Key_All) Or MouseDeltaX() <> 0 Or MouseDeltaY() <> 0 Or MouseWheel() <> 0 Or MouseButton(1) <> 0 Or MouseButton(2) <> 0
;Montre la souris
ShowCursor_(1)
;Informe le système que l'on est plus en écran de veille
SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, 0, @oldval, 0)
End
EndProcedure
;Lance la configuration
Procedure ImageConf()
If Conf\SelectCoulLigne = 0
Conf\CoulLigne = Conf\CoulSprite[Conf\Sprite]
EndIf
UseImage(0)
StartDrawing(ImageOutput())
d = 15
Box(0,0,ImageWidth(),ImageHeight(),Conf\CoulFond)
LineXY(ImageWidth() / 2, d, d, ImageHeight() - d, Conf\CoulLigne)
LineXY(ImageWidth() / 2, d, ImageWidth() - d, ImageHeight() - d, Conf\CoulLigne)
LineXY(10, ImageHeight() - d, ImageWidth() - d, ImageHeight() - d, Conf\CoulLigne)
Circle(ImageWidth() / 2, d, 12, Conf\CoulSprite[Conf\Sprite])
Circle(ImageWidth() - d, ImageHeight() - d, 12, Conf\CoulSprite[Conf\Sprite])
Circle(d, ImageHeight() - d, 12, Conf\CoulSprite[Conf\Sprite])
StopDrawing()
SetGadgetState(#Image_Conf, ImageID())
EndProcedure
Procedure Config()
Shared ScreensaverName
CreateImage(0,200,200)
If OpenWindow(#Window_0, 216, 0, 472, 235, #PB_Window_SystemMenu | #PB_Window_WindowCentered , ScreensaverName)
If CreateGadgetList(WindowID())
Frame3DGadget(#Frame3D_Boules, 10, 10, 220, 70, "Boules")
TrackBarGadget(#TrackBar_Sprite, 20, 50, 130, 20, 0, 7, #PB_TrackBar_Ticks)
GadgetToolTip(#TrackBar_Sprite, "Sélection couleur des boules")
TrackBarGadget(#TrackBar_NbBoules, 20, 30, 130, 20, 2, 50)
GadgetToolTip(#TrackBar_NbBoules, "Nombre de boules")
StringGadget(#String_NbBoules, 160, 30, 60, 20, "", #PB_String_Numeric )
GadgetToolTip(#String_NbBoules, "Nombre de boules")
StringGadget(#String_Sprite, 160, 50, 60, 20, "", #PB_String_ReadOnly)
GadgetToolTip(#String_Sprite, "Nombre de boules")
Frame3DGadget(#Frame3D_Lignes, 10, 80, 220, 70, "Lignes")
OptionGadget(#Radio_AutreCoul, 20, 120, 90, 20, "Autre couleur")
OptionGadget(#Radio_CoulBoule, 20, 100, 100, 20, "Couleur boules")
ButtonGadget(#Button_CoulLigne, 130, 120, 90, 20, "Couleur lignes")
GadgetToolTip(#Button_CoulLigne, "Couleur des lignes")
Frame3DGadget(#Frame3D_Fond, 10, 150, 220, 50, "Fond")
ButtonGadget(#Button_CoulFond, 20, 170, 200, 20, "Couleur du fond")
GadgetToolTip(#Button_CoulFond, "Couleur du fond")
ButtonGadget(#Button_Ok, 10, 210, 60, 20, "Ok")
ButtonGadget(#Button_Annuler, 90, 210, 60, 20, "Annuler")
ButtonGadget(#Button_Infos, 170, 210, 60, 20, "Infos")
ImageGadget(#Image_Conf, 250, 20, 200, 200, ImageID(), #PB_Image_Border)
EndIf
ChargePreference()
SetGadgetState(#TrackBar_NbBoules, Conf\NbBoules)
SetGadgetState(#TrackBar_Sprite, Conf\Sprite)
If Conf\SelectCoulLigne = 1
SetGadgetState(#Radio_CoulBoule, 0)
SetGadgetState(#Radio_AutreCoul, 1)
HideGadget(#Button_CoulLigne, 0)
Else
SetGadgetState(#Radio_CoulBoule, 1)
SetGadgetState(#Radio_AutreCoul, 0)
EndIf
SetGadgetText(#String_NbBoules, Str(Conf\NbBoules))
SetGadgetText(#String_Sprite, TexteCouleur(Conf\Sprite))
ImageConf()
Repeat
EventID.l = WaitWindowEvent()
Select EventID
Case 0
Delay(1)
Case #PB_EventCloseWindow
Quit = 1
Case #PB_Event_Gadget
Select EventGadgetID()
Case #Button_Annuler
ChargePreference()
Quit = 1
Case #Button_Ok
SauvePreference()
Quit = 1
Case #Button_Infos
MessageRequester("Infos","Merci à djes pour ces dessins , et un grand merci à la communauté Purebasic", 0)
Case #TrackBar_NbBoules
Conf\NbBoules = GetGadgetState(#TrackBar_NbBoules)
SetGadgetText(#String_NbBoules,Str(Conf\NbBoules))
Case #String_NbBoules
Conf\NbBoules = Val(GetGadgetText(#String_NbBoules))
Conf\NbBoules = M3D_MinMax(Conf\NbBoules, 2, 50)
SetGadgetState(#TrackBar_NbBoules, Conf\NbBoules)
Case #TrackBar_Sprite
Conf\Sprite = GetGadgetState(#TrackBar_Sprite)
SetGadgetText(#String_Sprite, TexteCouleur(Conf\Sprite))
ImageConf()
Case #Radio_CoulBoule
Conf\SelectCoulLigne = 0
HideGadget(#Button_CoulLigne, 1)
Conf\CoulLigne = Conf\CoulSprite[Conf\Sprite]
ImageConf()
Case #Radio_AutreCoul
Conf\SelectCoulLigne = 1
HideGadget(#Button_CoulLigne, 0)
Case #Button_CoulLigne
Color.l = ColorRequester(Conf\CoulLigne)
If Color > -1
Conf\CoulLigne = Color
EndIf
ImageConf()
Case #Button_CoulFond
Color.l = ColorRequester(Conf\CoulFond)
If Color > -1
Conf\CoulFond = Color
EndIf
ImageConf()
EndSelect
EndSelect
Until Quit
EndIf
End
EndProcedure
Procedure Erreur(Message$)
MessageRequester("Erreur", Message$, 0)
End
EndProcedure
Procedure SauvePreference()
FichierPreference.s = Space(255)
GetModuleFileName_(0, @FichierPreference, 255)
FichierPreference = GetPathPart(FichierPreference)
If Right(FichierPreference, 1) <> "\"
FichierPreference + "\"
EndIf
Fichier$ = FichierPreference + "Polygone.ini"
If CreatePreferences(Fichier$)
PreferenceComment("Couleur de l'écran")
WritePreferenceLong("Couleur de l'écran", Conf\CoulFond)
PreferenceComment(" ")
PreferenceComment("de 2 à 50 boules")
WritePreferenceLong("Nombre de boules", Conf\NbBoules)
PreferenceComment(" ")
PreferenceComment("Sélection boule : de 0 à 7")
WritePreferenceLong("Sélection boule",Conf\Sprite)
PreferenceComment(" ")
PreferenceComment("Sélection Couleur des lignes ( couleur identique aux boules = 0 , autre = 1")
WritePreferenceLong("Sélection couleur lignes",Conf\SelectCoulLigne)
PreferenceComment(" ")
PreferenceComment("Couleur des lignes")
WritePreferenceLong("Couleur des lignes", Conf\CoulLigne)
ClosePreferences()
Else
Erreur("sauve préférence")
EndIf
EndProcedure
Procedure ChargePreference()
FichierPreference.s = Space(255)
GetModuleFileName_(0, @FichierPreference, 255)
FichierPreference = GetPathPart(FichierPreference)
If Right(FichierPreference, 1) <> "\"
FichierPreference + "\"
EndIf
Fichier$= FichierPreference + "Polygone.ini"
If OpenPreferences(Fichier$)
Conf\CoulFond = ReadPreferenceLong("Couleur de l'écran", 0)
Limite(@Conf\CoulFond, 0, $FFFFFF)
Conf\NbBoules = ReadPreferenceLong("Nombre de boules", 6)
Limite(@Conf\NbBoules, 2, 50)
Conf\Sprite = ReadPreferenceLong("Sélection boule", 1)
Limite(@Conf\Sprite, 0, 7)
Conf\SelectCoulLigne = ReadPreferenceLong("Sélection couleur lignes", 0)
Limite(@Conf\SelectCoulLigne, 0, 1)
Conf\CoulLigne = ReadPreferenceLong("Couleur des lignes", $FFFFFF)
Limite(@Conf\CoulLigne, 0, $FFFFFF)
ClosePreferences()
EndIf
EndProcedure
Procedure Repartition()
;Répartition des boules sur l'écran
For i = 1 To Conf\NbBoules
AddElement(ListPoint())
*MemPos.NewPoint = ListPoint()
MemIndex = ListIndex(ListPoint())
Repeat
Collision = #False
x = #Taille + Random(ScreenWidth - #Taille * 2)
y = #Taille + Random(ScreenHeight - #Taille * 2)
If CountList(ListPoint()) > 1
ForEach ListPoint()
If ListIndex(ListPoint()) = MemIndex
Continue
EndIf
If Sqr(Pow(ListPoint()\x - x, 2.0) + Pow(ListPoint()\y - y, 2.0)) <= #Taille * 2
Collision = #True
Break
EndIf
Next
EndIf
Until Collision = #False
SelectElement(ListPoint(), MemIndex)
ListPoint()\x = x
ListPoint()\y = y
ListPoint()\dx = 2 + Random(2)
ListPoint()\dy = 2 + Random(2)
Next
EndProcedure
Procedure PolygoneConvexe()
If CountList(ListPoint()) < 2
ProcedureReturn #False
EndIf
;Initialise
*Min.NewPoint = #Null
*p0.NewPoint = #Null
*pi.NewPoint = #Null
*pc.NewPoint = #Null
;Trouve le point le plus bas dans la liste des points
FirstElement(ListPoint())
*Min = ListPoint()
ForEach ListPoint()
*p0 = ListPoint()
;Mémorise le point le plus bas , ou le plus à gauche s'il y a égalité
If (*p0\y < *Min\y) Or ((*p0\y = *Min\y) And (*p0\x < *Min\x))
*Min = *p0
EndIf
Next
;Initialise la liste pour le contour convexe
ClearList(Polygone())
;Effectue la progression de Jarvis pour calculer le contour
*p0 = *Min
Repeat
;Insertion du nouveau p0 dans le contour convexe
If AddElement(Polygone()) = 0
Erreur("plus de mémoire pour ajouter un élément dans polygone")
Else
Polygone()\x = *p0\x
Polygone()\y = *p0\y
EndIf
;Trouve le point pc dans le sens des aiguilles d'une montre
*pc = #Null
ForEach ListPoint()
*pi = ListPoint()
;Saute p0
If *pi = *p0
Continue
EndIf
;Sélectionne le premier point
If *pc = #Null
*pc = ListPoint()
Continue
EndIf
;Teste si pi est dans le sens des aiguilles d'une montre par rapport à pc
z=(((*pi\x - *p0\x) * (*pc\y - *p0\y)) - ((*pi\y - *p0\y) * (*pc\x - *p0\x)))
If z > 0
;pi est dans le sens des aiguilles d'une montre par rapport à pc
*pc = *pi
ElseIf z = 0
;Si pi et pc sont colinéaires , on choisit le plus éloigné de p0
longueurpi = Pow(*pi\x - *p0\x, 2.0) + Pow(*pi\y - *p0\y, 2.0)
longueurpc = Pow(*pc\x - *p0\x, 2.0) + Pow(*pc\y - *p0\y, 2.0)
If longueurpi > longueurpc
*pc = *pi
EndIf
EndIf
Next
;Cherche le point suivant
*p0 = *pc
Until *p0 = *Min
EndProcedure
Procedure TracePolygone()
If Conf\SelectCoulLigne
CouleurPolygone = Conf\CoulLigne
Else
CouleurPolygone = Conf\CoulSprite[Conf\Sprite]
EndIf
StartDrawing(ScreenOutput())
SelectElement(Polygone(), 0)
*mem0.NewPoint = Polygone()
*mem.NewPoint = Polygone()
While NextElement(Polygone())
LineXY(*mem\x, *mem\y, Polygone()\x, Polygone()\y, CouleurPolygone)
*mem = Polygone()
Wend
LineXY(*mem0\x, *mem0\y, *mem\x, *mem\y, CouleurPolygone)
StopDrawing()
EndProcedure
Procedure.l Limite(*Valeur.LONG, Min.l, Max.l)
If *Valeur\l < Min
*Valeur\l = Min
ProcedureReturn #True
ElseIf *Valeur\l > Max
*Valeur\l = Max
ProcedureReturn #True
EndIf
EndProcedure
Procedure AffPoints()
ForEach ListPoint()
ListPoint()\x + ListPoint()\dx
ListPoint()\y + ListPoint()\dy
If Limite(@ListPoint()\x, #Taille, ScreenWidth - #Taille)
ListPoint()\dx * -1
EndIf
If Limite(@ListPoint()\y, #Taille, ScreenHeight - #Taille)
ListPoint()\dy * -1
EndIf
*MemPos.NewPoint = ListPoint()
MemIndex = ListIndex(ListPoint())
ForEach ListPoint()
If ListIndex(ListPoint()) = MemIndex
Continue
EndIf
;Calcul la distance
Distance = Sqr(Pow(ListPoint()\x - *MemPos\x, 2.0) + Pow(ListPoint()\y - *MemPos\y, 2.0))
If Distance <= #Taille * 2
*MemPos\dx * -1
*MemPos\dy * -1
*MemPos\x + *MemPos\dx
*MemPos\y + *MemPos\dy
EndIf
Next
SelectElement(ListPoint(), MemIndex)
Next
EndProcedure
Procedure TestPoint(X1.l, Y1.l, X2.l, Y2.l, d.l)
If X1 > X2 - d And X1 < X2 + d And Y1 > Y2 - d And Y1 < Y2 + d
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
;-Datas
DataSection
RgbCouleurs:
Data.l $D6, $D6D6, $D600, $D64500, $C700D6, $5FF4, $C2D600, $6B6B6B
TxtCouleurs:
Data.s "Rouge", "Jaune", "Vert", "Bleu", "Violet", "Orange", "Cyan", "Gris"
Boules:
IncludeBinary "0100_boules.PNG"
EndDataSection
Mets la fenêtre avec le flag #PB_Window_Invisiblecomtois a écrit : J'ai une petite question , quand j'ouvre la fenêtre configuration , je vois les gadgets s'afficher un par un , comment faire pour que la fenêtre s"affiche avec tous les gadgets en une fois ?
Code : Tout sélectionner
HideWindow(WindowID(), 0)