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 |
Partager