Merci Mesa.
J'espère que la doc fr sera traduite en français dans la version 4.61 finale...
Ce serait sympa aussi que pour un tel gadget, plusieurs exemples soient donnés. Faire défiler des images chargées précédemment, un petit 'slideshow' par exemple (c'est ce que j'essaye de faire depuis 2 jours sans succès).
Je sais ô combien faire une doc n'est pas aisée et je salue le boulot de Fantesie Software mais PB étant destiné à tous les programmeurs (débutant et avancés), un plus gros effort serait appréciable. Un exemple concret pour chaque fonction (voir chaque Flag) devrait être mis en place. Cela fait maintenant plusieurs années que je possède et pratique du PB. Je ne suis pas un "codeur dans l'âme" mais je m'accroche.
Je ne pense pas non plus être plus con qu'un autre pour comprendre une doc et c'est souvent que certains exemples ne sont pas assez parlant (en ce qui me concerne). Pour finir sur une note plus fun, je tiens tout de même à redire que je trouve PB formidable, et c'est sans doute de ne pas arriver à l'exploiter plein pot qui me frustre.
Pour en revenir à du code, voilà ou j'en suis.
But du programme :
- Afficher une image dans le canvas, à chaque clique gauche, l'image scroll laissant place à l'image suivante.
Or seule la 1ere image est affichée, et elle scroll uniquement lorsque je bouge la souris. Et vous verrez que l'image se répète, ça fait un affichage tout moisi. (pour le test mon répertoire ne comprend que 4 images).
Merci pour votre aide.
Code : Tout sélectionner
; SlideShow Ar-S
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageEncoder()
Enumeration 100
#WIN
#CANVAS
#REPIMAGE
EndEnumeration
; ****************************************************
;- INITIALISATION
; ****************************************************
;- CHEMIN A MODIFIER -
Global ImgPath.s = "E:\MULTIMEDIA\PUREBASIC\4.40\Album_photo\" ;PathRequester("Repertoire",path$)
;---------------------
Global path$ = GetCurrentDirectory()
Global NewList Fichier.s()
Global LargSP, HautSP, NbrSprite, NbrFichiers, imgX
#COULFOND = $F0DFD9
quite = 0
LargSP = 1680
HautSP = 1050
If InitSprite() = 0 Or InitKeyboard()=0 Or InitMouse()=0 Or InitSprite3D()=0
MessageRequester("Error","Error DirectX",0)
EndIf
ExamineDesktops()
; xmax = DesktopWidth(0)
; ymax = DesktopHeight(0)
#CANVAS_ESC = 27 ; 27 = escape
; ****************************************************
;- PROCEDURES
; ****************************************************
Procedure OpenFullScreenCanvas(Fenetre_num, Canvas_num, Titre_Fenetre.s)
LS.i = DesktopWidth(0) ; GetSystemMetrics_(#SM_CXSCREEN)
HS.i = DesktopHeight(0) ; GetSystemMetrics_(#SM_CYSCREEN)
If OpenWindow(Fenetre_num, #PB_Ignore, #PB_Ignore, LS, HS, Titre_Fenetre, #PB_Window_BorderLess|#PB_Window_ScreenCentered)
CanvasGadget(Canvas_num, 0, 0, LS, HS, #PB_Canvas_ClipMouse|#PB_Canvas_Keyboard )
AddKeyboardShortcut(Fenetre_num, #PB_Shortcut_Escape, #CANVAS_ESC )
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
; ****************************************************
;- STRUCTURE
; ****************************************************
Structure Pic
L.i
h.i
X.i
Y.i
; Rot.i
Vit.i
EndStructure
NbrSprite = 0 : NbrFichiers = 0 : Position = 0
; ****************************************************
;- CREATION LISTE IMAGES
; ****************************************************
ExamineDirectory(#REPIMAGE, ImgPath,"*.jpg")
While NextDirectoryEntry(#REPIMAGE)
If DirectoryEntryType(#REPIMAGE) = #PB_DirectoryEntry_File
AddElement(Fichier())
Fichier() = ImgPath + DirectoryEntryName(#REPIMAGE)
NbrFichiers + 1
EndIf
Debug Fichier()
Wend
FinishDirectory(#REPIMAGE)
NbrSprite = NbrFichiers - 1
Global Dim SP.Pic(NbrSprite)
; ****************************************************
;- OUVERTURE FENETRE
; ****************************************************
Lancement = OpenFullScreenCanvas(#WIN, #CANVAS, "test")
If Lancement = 0
Debug "Erreur"
End
EndIf
; ****************************************************
;- CHARGEMENT DES IMAGES
; ****************************************************
For NumIMG = 0 To NbrSprite
LoadImage(NumIMG, Fichier())
Debug "NumIMG : " + Str(NumIMG) + " " + Fichier() ;-TEST NumIMG
Largeur = ImageWidth(NumIMG)
Hauteur = ImageHeight(NumIMG)
If Largeur > Hauteur
NewL = LargSP
NewH = NewL * Hauteur / Largeur
ElseIf Hauteur > Largeur
NewH = HautSP
NewL = NewH * Largeur / Hauteur
ElseIf Hauteur = Largeur
NewL = LargSP
NewH = HautSP
EndIf
SP(NumIMG)\L = NewL
SP(NumIMG)\h = NewH
SP(NumIMG)\X = LS
SP(NumIMG)\Y = 0
SP(NumIMG)\Vit = 10
Debug "L : "+ Str(SP(NumIMG)\L) ;-TEST L
Debug "Position X : " + Str(Position)
ResizeImage(NumIMG, SP(NumIMG)\L, SP(NumIMG)\h)
Next
; ****************************************************
;- BOUCLE
; ****************************************************
NumIMG = 0
Repeat
Delay(1)
Debug "NumIMG : "+Str(NumIMG)
Debug "imageId : "+ Str(ImageID(NumIMG))
MouseCx = GetGadgetAttribute(#CANVAS, #PB_Canvas_MouseX)
MouseCy = GetGadgetAttribute(#CANVAS, #PB_Canvas_Mousey)
StartDrawing(CanvasOutput(#CANVAS))
DrawImage(ImageID(NumIMG), SP(NumIMG)\X, SP(NumIMG)\Y , SP(NumIMG)\L, SP(NumIMG)\h)
;DrawImage(ImageID(NumIMG), MouseCx - (SP(NumIMG)\L / 2) , MouseCy - (SP(NumIMG)\h / 2) , SP(NumIMG)\L, SP(NumIMG)\h)
StopDrawing()
SP(NumIMG)\X - SP(NumIMG)\Vit
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case #CANVAS ; Le canvasgadget
; SP(NumIMG)\X - SP(NumIMG)\Vit
; If SP(NumIMG)\X > 0
; SP(NumIMG)\X = 0
; EndIf
Select EventType()
Case #PB_EventType_LeftButtonDown
Debug "Clique gauche => NbrSprite : " + Str(NbrSprite)
NumIMG + 1
If NumIMG > NbrSprite
NumIMG = 0
EndIf
Case #PB_EventType_rightButtonDown
For i = 0 To NbrDeSprite
FreeImage(i)
Next
quite = 1
Case #PB_EventType_KeyUp
quitte = GetGadgetAttribute(#CANVAS, #PB_Canvas_Key)
;Debug quitte
If quitte = #CANVAS_ESC
quite=1
EndIf
EndSelect
EndSelect
If Event = EventWindow()
CloseWindow(#WIN)
Break
EndIf
EndIf
Until quite = 1
.
)
