Voici un code qui montre comment simuler la gravité,je viens juste de faire le cours sur les mouvements uniformements acceleré.
Tous est physique,ce n'est pas du pif
On peut regler la gravité(9,81 à paris)
-la hauteur de lachement
-la constante pixel<->metre
-le taux de rafraichissement(timer)
C'est pas trés amusant mais c'est surtout educatif.
Source / Exemple :
resultat = copier("c:\test.txt","c:\test2.txt") 'dans n'importe quel endroit de votre projet afin de copier un fichier
'Les lignes suivantes dans un module ( projet/ajouter un module)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Declarations
Public Const FO_COPY = &H2
Public Const FO_DELETE = &H3
Public Const FO_MOVE = &H1
Public Const FO_RENAME = &H4
Public Const FOF_CONFIRMMOUSE = &H2
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_FILESONLY = &H80
Public Const FOF_MULTIDESTFILES = &H1
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_NOCONFIRMMKDIR = &H200
Public Const FOF_NO_CONNECTED_ELEMENTS = &H1000
Public Const FOF_NOCOPYSECURITYATTRIBS = &H800
Public Const FOF_NOERRORUI = &H400
Public Const FOF_RENAMEONCOLLISION = &H8
Public Const FOF_SILENT = &H4
Public Const FOF_SIMPLEPROGRESS = &H100
Public Const FOF_WANTMAPPINGHANDLE = &H20
Public Const FOF_WANTNUKEWARNING = &H2000
Public Const FOF_NORECURSION = &H1000 '// don't recurse into directories.
Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(Dest As Any, Sourc As Any, ByVal Length As Long)
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As Any) As Long
Public Function copier(FROM As String, copie As String)
On Error GoTo erreur
Dim fso, msg
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(FROM) Then 'on verifie si le fichier existe
copier = "Le fichier n'existe pas"
Exit Function
erreur:
copier = "Une erreur c'est produite"
Exit Function
End If
Dim fos As SHFILEOPSTRUCT ' structure to pass to the function
Dim retval As Long ' return value
With fos
.hWnd = 0 'ou Me.hWnd si on a une Feuille par exemple
.wFunc = FO_COPY 'Action == Copie
.pFrom = FROM & vbNullChar 'Source path
.pTo = copie & vbNullChar 'Dest Path
.fFlags = FOF_NOCONFIRMMKDIR Or FOF_WANTMAPPINGHANDLE 'Flags de Copie
.fAnyOperationsAborted = 0
.hNameMappings = 0
.lpszProgressTitle = vbNullChar
End With
retval = SHFileOperation(fos)
copier = "OK"
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Conclusion :
le premier parametre entre guillemet est le fichier existant de source et le deuxieme la cible.
La variable resultat contient soit "ok" soit un message d'erreur
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.