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 |
Scroll image avec directx et VB6
Répondre avec citation
Partager