Scroll image avec directx et VB6

Version imprimable

Bonjour à tous ,
Pour ceux que cela intéresse , voici un code source qui permet de faire défiler une image de fond d'écran de droite à gauche et vice versa avec DIRECTX et VB6
Milles excuses si la manière pour envoyer ce code n'est pas correcte mais une explication de votre part serait la bienvenue pour cette manip.
Cordialement
Yvanovitch

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
 
dans le code du module
xxxxxxxxxxxxxxxxxxx on utilise 3 touches du clavier xxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxx TOUCHE B...... on sort du programme ..........xxxxxxxxxx
'xxxxxxxxxxxxxx TOUCHE A....... marche avant du décor........xxxxxxxxxx
'xxxxxxxxxxxxxx TOUCHE C....... marche arrière du décor......xxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
 
 
 
Option Explicit
 
Public DX As New DirectX7
Public DD As DirectDraw7
Public Primary As DirectDrawSurface7    'Surface primaire visible a l'écran
Public Backbuffer As DirectDrawSurface7 'Surface brouillon invisible
Public ximage1 As Long ' coordonnées d'affichage du fond
Public touche  As Integer ' touche du clavier
Public flag As Integer ' sert à l'affichage des portions d'images ( quand on affiche le début et la fin d'une image sur le mème écran )
Public vitesse As Integer ' vitesse de déplacement du décor
Public largeur_image As Long ' largeur de l'image de fond
Public hauteur_image As Long ' hauteur de l'image de fond
Public largeur_ecran As Long
'xxxxxxxxxxx...........si on prend une autre image de fond , il faut simplement changer les valeurs.......xxxxxx
'xxxxxxxxxxx...........ci-dessous pour que les calculs s'adaptent aux nouvelles dimensions..................xxxxxx
Sub Main() 'initialisation des variables et boucle de jeu
'xxxxxxxxxxxx ATTENTION , pour une raison inconnu , la largeur de l'image ne doit pas dépasser 4000 pixels , sinon image inexploitable xxxxxxxxxxxx
largeur_image = 4000 ' modifier ces valeurs pour adapter à une nlle image(attention pour ne pas avoir de noir entre les images , la largeur de l'image doit etre au minimum égale à la largeur de l'écran
hauteur_image = 805 ' mettre ici un maximum = a la  hauteur_ecran mème si l'image est plus haute sinon pas d'affichage
vitesse = 3 ' vitesse de défilement
largeur_ecran = 1280 ' fonction de la résolution de l'écran
Form1.Show ' il le faut impératif?
ximage1 = 0
flag = 0
Set DD = DX.DirectDrawCreate("")
DD.SetCooperativeLevel Form1.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE Or DDSCL_ALLOWREBOOT ' plein écran
DD.SetDisplayMode 1280, 1024, 32, 0, DDSDM_DEFAULT ' pour une compabilité avec tous les écrans , mettre 640,480,16 mais alors modifier la variable largeur_ecran
Dim ddsd As DDSURFACEDESC2
ddsd.lFlags = DDSD_BACKBUFFERCOUNT Or DDSD_CAPS
ddsd.lBackBufferCount = 1
ddsd.ddscaps.lCaps = DDSCAPS_COMPLEX Or DDSCAPS_FLIP Or DDSCAPS_PRIMARYSURFACE Or DDSCAPS_VIDEOMEMORY
Set Primary = DD.CreateSurface(ddsd)
Dim ddscaps As DDSCAPS2
ddscaps.lCaps = DDSCAPS_BACKBUFFER Or DDSCAPS_VIDEOMEMORY
Set Backbuffer = Primary.GetAttachedSurface(ddscaps)
 'création des images
 Dim noufond As DirectDrawSurface7 ' le fond
 Dim noufondddsd As DDSURFACEDESC2
 Set noufond = DD.CreateSurfaceFromFile("c:\scroll_décor\sans.bmp", noufondddsd) ' mettre ici le chemin de l'image a charger
Do
If touche = 66 Then ' si on appui sur B on quitte
GoTo fin
End If
Backbuffer.BltColorFill ddRect(0, 0, 0, 0), RGB(0, 0, 0) 'couleur fixe pour le fond noir de la fenetre(Bleu ,vert,rouge)
Backbuffer.SetForeColor RGB(255, 255, 0) ' couleur pour les explications ici c'est l'inverse rouge,vert,bleu
If touche = 65 Then decale_gauche ' on appui sur A on défile vers la gauche
If touche = 67 Then decale_droite ' on appui sur C on défile vers la droite
'xxxxxxxxxxxxxxxxxxxxxxx image se décale à gauche xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If ximage1 < 0 Then GoTo droite ' si l'image saute à la transition à modifier
If ximage1 >= largeur_image - largeur_ecran Then GoTo suite ' si l'image saute à la transition à modifier
Backbuffer.BltFast 0, 0, noufond, ddRect(ximage1, 0, largeur_ecran + ximage1, hauteur_image), DDBLTFAST_NOCOLORKEY 'affichage du noufonden entier
flag = 0
GoTo suite2
suite:
If touche = 65 Then flag = flag + vitesse Else flag = flag - vitesse
Backbuffer.BltFast 0, 0, noufond, ddRect(ximage1, 0, largeur_image, hauteur_image), DDBLTFAST_NOCOLORKEY  'affichage du grand morceau
Backbuffer.BltFast largeur_ecran - flag, 0, noufond, ddRect(0, 0, 0 + flag, hauteur_image), DDBLTFAST_NOCOLORKEY 'affichage du petit morceau
If ximage1 >= largeur_image - 5 Then ximage1 = 0 ' si l'image saute à la transition à modifier
GoTo suite2
'xxxxxxxxxxxxxxxxxxxxxxxxx fin décalage à gauche xxxxxxxxxxxxxxxx
droite:
'xxxxxxxxxxxxxxxxxxxxxxxxx image de décale à droite xxxxxxxxxxxxxx
Backbuffer.BltFast 0, 0, noufond, ddRect(largeur_image - Abs(ximage1), 0, largeur_image, hauteur_image), DDBLTFAST_NOCOLORKEY 'affichage du noufonden entier
Backbuffer.BltFast Abs(ximage1), 0, noufond, ddRect(0, 0, largeur_ecran - Abs(ximage1), hauteur_image), DDBLTFAST_NOCOLORKEY 'affichage du noufonden entier
If ximage1 < -largeur_ecran + 5 Then ximage1 = largeur_image - largeur_ecran ' si l'image saute à la transition à modifier
suite2:
DoEvents
Primary.Flip Nothing, DDFLIP_WAIT
Loop
fin:
'ShowCursor True ' réaffiche le curseur de la souris
Unloade
Unload Form1
End Sub
Sub Unloade() ' on décharge propement directx
 Set DD = Nothing
 Set Primary = Nothing
 Set Backbuffer = Nothing
 Set DX = Nothing
End Sub
Public Function ddRect(x1 As Long, y1 As Long, x2 As Long, y2 As Long) As RECT
ddRect.Left = x1
ddRect.Right = x2
ddRect.Top = y1
ddRect.Bottom = y2
End Function
Private Sub decale_droite()
ximage1 = ximage1 - vitesse
End Sub
 
Private Sub decale_gauche()
ximage1 = ximage1 + vitesse
End Sub

Code:

1
2
3
4
5
6
 
dans le code de la form
Option Explicit
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
touche = KeyCode ' sert a gérer les touches A et B pour entrer et sortir du jeu
End Sub

25/11/2007, 11h44
SfJ5Rpw8

Citation:

Envoyé par yvanovitch

...
Milles excuses si la manière pour envoyer ce code n'est pas correcte mais une explication de votre part serait la bienvenue pour cette manip...

:merci: pour ta contribution ..

pas de problème cette manière nous conviens très bien .

pour des sujets plus "gros" tu peu en plus mettre un "zip" du projet VB en pièce jointe de ton message. ;)

Salut yvanovitch
Je comprend mieux les informations que tu donnais dans ton message hier.
Ce code m'interresse c'est sympa de l'avoir mis ici, je t'en remerci aussi (comme bbil, salut en passant).

Voila une petite transformation pour me facilité ton code (que la partie modifiée).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Public LargEcran As Long, HautEcran As Long
Public LargImage As Long, HautImage As Long
Public CheminFichier As String, NameFichier As String
Public Sub Main()
Load Form1
LargEcran = Form1.ScaleX(Screen.Width, vbTwips, vbPixels)
HautEcran = Form1.ScaleY(Screen.Height, vbTwips, vbPixels)
'recuperé sur DVP, necessite d'activer reference Microsoft Shell Controls and Automation
Dim objShell As Shell
Dim objFolder As Folder
Dim strFileName As FolderItem
 
CheminFichier = "C:\PersoFrancis"
NameFichier = "MontageChatillion.bmp"
'NameFichier = "MontageChatillion.jpg"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(CheminFichier) 'adapter le chemin
Set strFileName = objFolder.Items.Item(NameFichier) 'adapter le fichier
 
LargImage = CLng(Val(Trim$(objFolder.GetDetailsOf(strFileName, 27))))
HautImage = CLng(Val(Trim$(objFolder.GetDetailsOf(strFileName, 28))))
'LargImage = 3050
'HautImage = 1321
 
Set objShell = Nothing: Set objFolder = Nothing: Set strFileName = Nothing
'xxxxxxxxxxxxxx TOUCHE F/f ou échap.... on sort du programme ........xxxxxxxxxx
'xxxxxxxxxxxxxx TOUCHE <- ............. marche avant du décor........xxxxxxxxxx
'xxxxxxxxxxxxxx TOUCHE -> ............. marche arrière du décor......xxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
vitesse = 3 ' vitesse de défilement
Form1.Show ' il le faut impératif?
ximage1 = 0
flag = 0
Set DD = DX.DirectDrawCreate("")
DD.SetCooperativeLevel Form1.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE Or DDSCL_ALLOWREBOOT ' plein écran
DD.SetDisplayMode LargEcran, HautEcran, 32, 0, DDSDM_DEFAULT  ' pour une compabilité avec tous les écrans , mettre 640,480,16 mais alors modifier la variable largeur_ecran
Dim ddsd As DDSURFACEDESC2
ddsd.lFlags = DDSD_BACKBUFFERCOUNT Or DDSD_CAPS
ddsd.lBackBufferCount = 1
ddsd.ddscaps.lCaps = DDSCAPS_COMPLEX Or DDSCAPS_FLIP Or DDSCAPS_PRIMARYSURFACE Or DDSCAPS_VIDEOMEMORY
Set Primary = DD.CreateSurface(ddsd)
Dim ddscaps As DDSCAPS2
ddscaps.lCaps = DDSCAPS_BACKBUFFER Or DDSCAPS_VIDEOMEMORY
Set Backbuffer = Primary.GetAttachedSurface(ddscaps)
'création des images
Dim noufond As DirectDrawSurface7 ' le fond
Dim noufondddsd As DDSURFACEDESC2
Set noufond = DD.CreateSurfaceFromFile(CheminFichier & "\" & NameFichier, noufondddsd) ' mettre ici le chemin de l'image a charger
Do
 If touche = 70 Or touche = 27 Then GoTo fin ' si on appui sur F/échap on quitte
 Backbuffer.BltColorFill ddRect(0, 0, 0, 0), RGB(0, 0, 0) 'couleur fixe pour le fond noir de la fenetre(Bleu ,vert,rouge)
 Backbuffer.SetForeColor RGB(255, 255, 0) ' couleur pour les explications ici c'est l'inverse rouge,vert,bleu
 If touche = 37 Then decale_gauche ' on appui sur <- on défile vers la gauche
 If touche = 39 Then decale_droite ' on appui sur -> on défile vers la droite
 'xxxxxxxxxxxxxxxxxxxxxxx image se décale à gauche xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
 If ximage1 < 0 Then GoTo droite ' si l'image saute à la transition à modifier
 If ximage1 >= LargImage - LargEcran Then GoTo suite ' si l'image saute à la transition à modifier
 'Backbuffer.BltFast 0, 0, noufond, ddRect(ximage1, 0, LargEcran + ximage1, HautImage), DDBLTFAST_NOCOLORKEY 'affichage du noufonden entier
 Backbuffer.BltFast 0, 0, noufond, ddRect(ximage1, 0, 1024 + ximage1, 768), DDBLTFAST_NOCOLORKEY  'affichage du noufonden entier
 flag = 0
 GoTo suite2
suite:
 If touche = 37 Then flag = flag + vitesse Else flag = flag - vitesse
 Backbuffer.BltFast 0, 0, noufond, ddRect(ximage1, 0, LargImage, HautImage), DDBLTFAST_NOCOLORKEY  'affichage du grand morceau
 Backbuffer.BltFast LargEcran - flag, 0, noufond, ddRect(0, 0, 0 + flag, HautImage), DDBLTFAST_NOCOLORKEY 'affichage du petit morceau
 If ximage1 >= LargImage - 5 Then ximage1 = 0 ' si l'image saute à la transition à modifier
 GoTo suite2
 'xxxxxxxxxxxxxxxxxxxxxxxxx fin décalage à gauche xxxxxxxxxxxxxxxx
droite:
 'xxxxxxxxxxxxxxxxxxxxxxxxx image de décale à droite xxxxxxxxxxxxxx
 Backbuffer.BltFast 0, 0, noufond, ddRect(LargImage - Abs(ximage1), 0, LargImage, HautImage), DDBLTFAST_NOCOLORKEY 'affichage du noufonden entier
 Backbuffer.BltFast Abs(ximage1), 0, noufond, ddRect(0, 0, LargEcran - Abs(ximage1), HautImage), DDBLTFAST_NOCOLORKEY 'affichage du noufonden entier
 If ximage1 < -LargEcran + 5 Then ximage1 = LargImage - LargEcran ' si l'image saute à la transition à modifier
suite2:
 DoEvents
 Primary.Flip Nothing, DDFLIP_WAIT
Loop
fin:
 'ShowCursor True ' réaffiche le curseur de la souris
 Unloade
 Unload Form1
End Sub

Une question d'un novice, si j'essais de charger la même image en .jpg, j'ai le message: Erreur d'execution 53, Fichier introuvable.
Il est donc impossible de charger une image autre qu'en .BMP ?
Autre question,

Code:

1
2
 'Backbuffer.BltFast 0, 0, noufond, ddRect(ximage1, 0, LargEcran + ximage1, HautImage), DDBLTFAST_NOCOLORKEY 'affichage du noufonden entier
 Backbuffer.BltFast 0, 0, noufond, ddRect(ximage1, 0, 1024 + ximage1, 768), DDBLTFAST_NOCOLORKEY  'affichage du noufonden entier

si je dérem la ligne: 'Backbuffer.BltFast 0, 0, noufond, ddRect(ximage1, 0, LargEcran + ximage1, HautImage), DDBLTFAST_NOCOLORKEY , et rem la ligne qui la suit, je me retrouve avec un ecran noir, cela me semble vraiment curieux car la ligne:
droite:
'xxxxxxxxxxxxxxxxxxxxxxxxx image de décale à droite xxxxxxxxxxxxxx
Backbuffer.BltFast 0, 0, noufond, ddRect(LargImage - Abs(ximage1), 0, LargImage, HautImage), DDBLTFAST_NOCOLORKEY 'affichage du noufonden entier
ici Backbuffer.BltFast Abs(ximage1), 0, noufond, ddRect(0, 0, LargEcran - Abs(ximage1), HautImage), DDBLTFAST_NOCOLORKEY 'affichage du noufonden entier
elle est acsepté.
Je confirme que pour moi non plus, les image .BMP plus grandes que 4000 pixels ne sont pas affichées ou complétement déformées.

Motif de l'edit
Là ou je pensais y avoir un probléme, c'était parcque je n'avais pas mise la bonne variable.
J'ai trouvé l'erreur, non pas HautImage mais HautEcran, donc on peut suprimer la ligne

Code:

Backbuffer.BltFast 0, 0, noufond, ddRect(ximage1, 0, 1024 + ximage1, 768), DDBLTFAST_NOCOLORKEY  'affichage du noufonden entier

et la remplacer par

Code:

Backbuffer.BltFast 0, 0, noufond, ddRect(ximage1, 0, LargEcran + ximage1, HautEcran), DDBLTFAST_NOCOLORKEY

26/11/2007, 17h55
yvanovitch

Scroll en directX et VB6

Salut à tous,
Pour répondre à ProgElect , le différence entre les deux lignes conçernées se résume à ceci :
Dans l'une ou utilise les variables "largeur_ecran et hauteur_image " et dans l'autre on place des valeurs.
A mon avis , les valeurs passées par la ligne ou tu supprime le REM ne sont pas valables, et en DIRECTX , il suffit qu'une seule valeur soit plus grande que la zone d'affichage pour avoir un beau tableau noir.
En ce qui concerne les fichiers JPG , il me semble avoir vu quelque part dans le forum , un code qui permet de charger les JPG , mais comme maintenant , nous n'avons plus de problème de place sur nos disques , je ne me suis pas posé la question, par contre je penses effectivement qu'en chargeant des JPEG , la vitesse d'exécution doit s'en trouver améliorée quoi que , il faut voir la taille du code pour réaliser cela
Salutations
Et a bientot ,