Originally Posted by
yereverluvinuncleber
Show us what you are working on Niya rather than an another VB6/vs VB.NET chat. I don't mind if it is not VB6, let's have a quick look.
The last VB6 project I was working on was something intended for the CodeBank. Parts of it are written in assembly using Trick's add-in:-
Code:
;VB6 Prototype
;**************************************************************
;Public Function JenkinsHash(ByRef key As String) As Long
;**************************************************************
use32
push ebp
mov ebp, esp
push ebx ;We want to use EBX as the BSTR pointer
;----------------------------------
xor eax,eax ;Zero EAX. This will contain our hash
;digest.
xor edx, edx ;Zero the EDX register. The lower 16 bits
;will contain our current character
mov ebx, [ebp + 8] ;Get ByRef String pointer from 1st arg
mov ebx, [ebx] ;Dereference it to get BSTR pointer
cmp ebx, 0 ;Check if the BSTR is null.
;Null BSTRs are valid
jz exitFunc ;Exit the function if null
loopStart: ;***************************
mov dx, [ebx] ;Read the current character
cmp dx, 0 ;Is it the null terminator?
jz exitLoop ;If it is, then exit the loop
add eax, edx ;Add the current char code to the hash
mov ecx, eax ;Copy hash into ECX
shl ecx, 10 ;Shift ECX to the left by 10
add eax, ecx ;Add it to the original hash
mov ecx, eax
shr ecx, 6
xor eax, ecx
add ebx, 2 ;Advance pointer to next character
jmp loopStart
exitLoop: ;***************************
;**********************************************
;It should be obvious what all of this does.
;If not, then look at the C implementation of this
;function in the comments above this function's VB6 stub in the
;ASMHelpers module.
;**********************************************
mov ecx, eax
shl ecx, 3
add eax, ecx
mov ecx, eax
shr ecx, 11
xor eax, ecx
mov ecx, eax
shl ecx, 15
add eax, ecx
;**********************************************
exitFunc:
;----------------------------------
pop ebx
mov esp, ebp
pop ebp
ret 4
The above is an implementation of the Jenkins one at a time hash function meant for a hash table implementation I decided to do for fun. I wrote it in assembly on account of VB6's lack of dedicated bit shift operators.
Originally Posted by
yereverluvinuncleber
I don't mind if it is not VB6
Code:
Private Function CalcNewPosition(ByVal currentPos As PointF, ByVal previousPos As PointF, ByVal frictionCoeff As Single, ByVal forcesTotal As PointF, ByVal deltaTime As Single) As PointF
'************************* Formula Explanation *************************
' Calculates the new position using an adapted Verlet Integration formula with friction:
' newPosition = 2*currentPos - (currentPos - velocity * (1 - frictionCoeff)) + forcesTotal * deltaTime^2
' This version incorporates friction into the standard Verlet formula for motion under constant acceleration.
'***********************************************************************
' Calculate the velocity as the difference between the current and previous positions.
Dim velocity As PointF = VectorHelpers.Subtract(currentPos, previousPos)
' Apply friction to this velocity.
Dim frictionAdjustedVelocity As PointF = VectorHelpers.Multiply(velocity, (1 - frictionCoeff))
' Adjust the previous position as if friction had been applied in the previous step.
Dim frictionAdjustedPreviousPos As PointF = VectorHelpers.Subtract(currentPos, frictionAdjustedVelocity)
' Calculate the acceleration displacement, assuming forcesTotal is acceleration.
Dim accelerationDisplacement As PointF = VectorHelpers.Multiply(forcesTotal, deltaTime * deltaTime)
' Compute the new position using the Verlet integration formula, substituting the actual previous position
' with the friction-adjusted previous position in the calculation.
Dim newPosition As PointF = VectorHelpers.Add(
VectorHelpers.Add(
VectorHelpers.Multiply(currentPos, 2),
VectorHelpers.Multiply(frictionAdjustedPreviousPos, -1)
),
accelerationDisplacement
)
Return newPosition
End Function
End Class
Code:
Private Function CalcOverlapCorrections(ByVal b1 As Ball, ByVal b2 As Ball) As PointF()
'I'm particularly proud of this function. I came up with it
'completely on my own.
'It corrects overlapping balls by moving them away from each
'other based on the angle between their centers
'*********************************************************
'Written by Niya (05, Mar, 2024)
'*********************************************************
'The clostest the balls are allowed to each other
Dim minimumDist As Single = b1.Radius + b2.Radius
'Get the path from b1 to b2 as a vector
Dim positionVector = VectorHelpers.Subtract(b2.CurrentPosition, b1.CurrentPosition)
'Get the current distance between the two balls
Dim dist As Single = VectorHelpers.GetMagnitude(positionVector)
'The distance any ball needs to travel so they no longer overlap
Dim distDelta As Single = minimumDist - dist
'Get a unit vector from the position vector
Dim normPosVector = VectorHelpers.Normalize(positionVector)
'Lengthen normalized vector to cover half the distance needed and flip the
'direction. This is how b1 has to move.
Dim b1Move = VectorHelpers.Multiply(normPosVector, distDelta / 2 * -1)
'Lengthen normalized vector to cover half the distance needed but leave
'the direction unchanged. This is how b2 has to move.
Dim b2Move = VectorHelpers.Multiply(normPosVector, distDelta / 2)
'Calculate the new positions of the balls
Dim newPosBall1 As PointF = VectorHelpers.Add(b1.CurrentPosition, b1Move)
Dim newPosBall2 As PointF = VectorHelpers.Add(b2.CurrentPosition, b2Move)
Return {newPosBall1, newPosBall2}
End Function
A pair of extracts from a VB.Net project also intended for the CodeBank. It's part of a simple physics demo.
Things took a drastic turn in my life recently which has left me with very little time to write code so for the time being these pet projects are in limbo.
Reply With Quote