Just invert the Y value when you hit the top or bottom, and invert the X value when you hit the left or right.
Thanks for the reply .
In your opinion, the return of the exact line goes back to the same angle
How many codes I tried in this way were not accurate
If you do not mind, you can put the source code here, thank you
C++ programmers will dismiss you as a cretinous simpleton for your inability to keep track of pointers chained 6 levels deep and Java programmers will pillory you for buying into the evils of Microsoft. Meanwhile C# programmers will get paid just a little bit more than you for writing exactly the same code and VB6 programmers will continue to whitter on about "footprints". - FunkyDexter
There's just no reason to use garbage like InputBox. - jmcilhinney
The threads I start are Niya and Olaf free zones. No arguing about the benefits of VB6 over .NET here please. Happiness must reign. - yereverluvinuncleber
Download the file. Can I explain more?
I mean draw the line until it hits the wall and returns at the same angle link download
And that is what I told you.
If you're drawing a line, you're adding a constant X and Y value to the previous point to get to another point in the line.
Since the Incident Angle and the Angle of Reflection are equal, just a negative reflection of the other, then the change in X or Y is also equal, but one is the reflection of the other.
So you change the sign of delta X or Y, but the magnitude will state the same.
"Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930
theres no gravity or friction, so we could say the ball is moving like in space, it need "force" and since its 2D we only need x and y.
lets push the ball, lets say xforce=1 and yforce=1 and time interval of 1/second.
movement is x =x + xforce and y = y + yforce
now u need to create a way to determine the walls or hit-area. this can be a bit complicated, but if everything is lines and we know the radius of the ball, we can make use that to determine when the ball hits the walls.
nx = x + xforce
ny = y + yforce
if nx + r => width it means the ball is about to go through the wall, so we need to bounce it back, simple by making xforce = -1
if ny + r => height the same but height
if nx - r <= 0 for the left wall, and return xforce = 1
if ny - r <= 0 for the top wall
Since your code is using line controls and not drawing lines, that complicates things.
I guess the question is how you want the user interface to work, and how many lines do you want to draw.
Here, your example is change so that mousemove is just selecting the x value of where the first line ends, and the y value of the first line is set to the bottom of the form, so your first line draws from the start location to the bottom of the form.
The change in X is noted and just added to the X value to "double the angle", so is a reflection off the bottom. The starting Y is used as the end of the second line, so the slope of the line matches the reflection angle.
I don't know if that helps at all.
Code:
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim dx As Single
dx = x - Line1.X1
Line1.X2 = x
Line1.Y2 = ScaleHeight
Line2.X1 = x
Line2.Y1 = ScaleHeight
Line2.X2 = x + dx
Line2.Y2 = Line1.Y1
End Sub
"Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930
FWIW, below is a simple snippet which renders a bouncing ball - using the simple reflection-formula, passel already gave you...
Though the problem is now already split into: BallRadius 'R', BallPosition-Vector 'c' and a BallSpeedVector 'v' ...
(because one usually wants a given object to move with a certain speed)
Code:
Option Explicit
Private WithEvents TRender As VB.Timer 'for dynamic creation
Private Type tV2D
x As Single
y As Single
End Type
Private R!, c As tV2D, v As tV2D 'Ball-Radius, Ball-Center and Ball-Velocity in Pixels per TimerStep
Private Sub Form_Load()
'Inits for our Form-Canvas
AutoRedraw = True: ScaleMode = vbPixels
FillColor = vbYellow: FillStyle = vbFSSolid
R = 16 'set the Radius
c.x = 100: c.y = 100 'set the center-point
v.x = 200: v.y = 200 'set the speed-vector
Set TRender = Controls.Add("VB.Timer", "TRender") 'create the RenderLoop-Timer dynamically...
TRender.Interval = 10 '... set a small interval
End Sub
Private Sub TRender_Timer()
Cls
DrawBasedOn GetTimeDelta(Timer) 'determine a time-delta, to achieve constant speed
Refresh
End Sub
Function GetTimeDelta(ByVal curT As Single)
Static lastT: If lastT = 0 Then lastT = Timer
GetTimeDelta = curT - lastT: lastT = curT
End Function
Sub DrawBasedOn(ByVal dT As Single) 'ensure constant speed per "ds = v * dT"
c.x = c.x + v.x * dT
c.y = c.y + v.y * dT
If c.x < R Then v.x = -v.x: c.x = R 'left border-collision
If c.x > ScaleWidth - R Then v.x = -v.x: c.x = ScaleWidth - R 'right border-collision
If c.y < R Then v.y = -v.y: c.y = R 'top border-collision
If c.y > ScaleHeight - R Then v.y = -v.y: c.y = ScaleHeight - R 'bottom border-collision
Circle (c.x, c.y), R, &HD0D0D0
End Sub
For more advanced "applied physics", the usage of a physics-engine helps to shorten code significantly...
There's an example of this category in the codebank: https://www.vbforums.com/showthread....hysics-Engine)
(the most recent Demo-Zip in that CodeBank-thread is sitting in post #9)
that has nothing to do with ball bouncing, but more of a Trajectory.
without gravity or other forces applied, this is quite easy.
mouse x/y is the starting position, the center position that is fixed, will be used to know the x/y factors and after that u calculate the edges.
a recursive function can be used to allow the line to continue until a exit condition is met.
I dont make any examples because I know others will do it, without giving u a chance to figure it out yourself.
No, I do not mean the movement of the ball. See the movement and return of the line when it hits the wall of the code above
It's the same thing basically ... just:
- don't paint the ball-circle
- but step along the initial direction-vector (with much more simulated speed if you want)
- then gather the newly calculated coords of the center-point after each wall collision
- into a Polygon-Array or a Collection
- and stop gathering the resulting trajectory-coords in that path after a certain "depth of collisions"
its the bare minimum, if u follow what Olaf posted.
its impossible to make it smaller. u need to do some calculations, theres no AI that understand what u need and will do it for u.
the video that u posted, needs a bit of coding to recreate that.
that video also require u to "hold and release" the circle, so u also need to work on the mouse-triggers.
sure, that circle can be the starting point, so u can start with that. place a circle anywhere and make the center point as the starting x/y. make another circle, that will be static and place that in the middle, that x/y will be the reference point, so u know the trajectory.
and lastly u create the lines, since u know the center point and the rectangle, and if the rectangle has a fixed Rect, u can easily calculate the line length.
theres no shortcuts here.
When eating an object, return the code. How to do this on the line other than x, y
Because x, y is the starting and ending point of a line
How to use the scale on the line ?
- rename the TEXT File to "filename.FRM" (and double click to open it)
Code:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 7110
ClientLeft = 120
ClientTop = 465
ClientWidth = 9855
LinkTopic = "Form1"
ScaleHeight = 474
ScaleMode = 3 'Pixel
ScaleWidth = 657
StartUpPosition = 3 'Windows Default
Begin VB.Shape Shape
FillStyle = 0 'Solid
Height = 270
Index = 3
Left = 3120
Shape = 2 'Oval
Top = 960
Width = 270
End
Begin VB.Line MyLine
Index = 3
X1 = -16
X2 = 114
Y1 = 152
Y2 = 368
End
Begin VB.Shape Shape
FillStyle = 0 'Solid
Height = 270
Index = 2
Left = 2520
Shape = 2 'Oval
Top = 960
Width = 270
End
Begin VB.Line MyLine
Index = 2
X1 = 8
X2 = 138
Y1 = 112
Y2 = 328
End
Begin VB.Line MyLine
Index = 1
X1 = 0
X2 = 130
Y1 = 0
Y2 = 216
End
Begin VB.Shape Shape
FillStyle = 0 'Solid
Height = 270
Index = 1
Left = 2040
Shape = 2 'Oval
Top = 720
Width = 270
End
Begin VB.Shape Shape
FillStyle = 0 'Solid
Height = 270
Index = 0
Left = 1560
Shape = 2 'Oval
Top = 1560
Width = 270
End
Begin VB.Shape Shape2
FillStyle = 0 'Solid
Height = 270
Left = 4350
Shape = 2 'Oval
Top = 3075
Width = 270
End
Begin VB.Line MyLine
Index = 0
X1 = 297
X2 = 427
Y1 = 214
Y2 = 430
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Roberto Mior
' reexre
Private Function LinesIntersect(L1X1!, L1Y1!, _
L1X2!, L1Y2!, _
L2X1!, L2Y1!, _
L2X2!, L2Y2!, RX!, RY!) As Boolean
Dim s1_x!, s1_y!, s2_x!, s2_y!
Dim s!, t!
Dim den As Single
s1_x = L1X2 - L1X1: s1_y = L1Y2 - L1Y1
s2_x = L2X2 - L2X1: s2_y = L2Y2 - L2Y1
den = (-s2_x * s1_y + s1_x * s2_y)
If den Then
den = 1! / den
s = (-s1_y * (L1X1 - L2X1) + s1_x * (L1Y1 - L2Y1)) * den
If s > 0! Then
If s < 1! Then
t = (s2_x * (L1Y1 - L2Y1) - s2_y * (L1X1 - L2X1)) * den
If t > 0! Then
If t < 1! Then
' Collision detected
RX = L1X1 + (t * s1_x)
RY = L1Y1 + (t * s1_y)
LinesIntersect = True
End If
End If
End If
End If
End If
End Function
Private Function LineIntersectRect(x1!, y1!, x2!, y2!, RX!, RY!, Invert As Long)
Dim XX!, YY!
XX! = ScaleWidth - 9
YY! = ScaleHeight - 9
' horizontal
If LinesIntersect(x1, y1, x2, y2, 9, 9, XX, 9, RX, RY) Then Invert = -1: Exit Function
If LinesIntersect(x1, y1, x2, y2, 9, YY, XX, YY, RX, RY) Then Invert = -1: Exit Function
'Vertical
If LinesIntersect(x1, y1, x2, y2, 9, 9, 9, YY, RX, RY) Then Invert = 1: Exit Function
If LinesIntersect(x1, y1, x2, y2, XX, 9, XX, YY, RX, RY) Then Invert = 1: Exit Function
End Function
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim dx As Single
Dim dy As Single
Dim NewX As Single
Dim NewY As Single
Dim D As Single
Dim RX!, RY!
Dim Invert As Long
Dim L As Long
If Button <> 2 Then
For L = 0 To 3
If L = 0 Then
dx = (x - MyLine(0).x1)
dy = (y - MyLine(0).y1)
Else
If Invert = 1 Then
dx = -(MyLine(L - 1).x1 - MyLine(L - 1).x2)
dy = (MyLine(L - 1).y1 - MyLine(L - 1).y2)
Else
dx = (MyLine(L - 1).x1 - MyLine(L - 1).x2)
dy = -(MyLine(L - 1).y1 - MyLine(L - 1).y2)
End If
MyLine(L).x1 = MyLine(L - 1).x2
MyLine(L).y1 = MyLine(L - 1).y2
End If
D = Sqr(dx * dx + dy * dy)
If D Then
D = 1 / D
dx = dx * D
dy = dy * D
NewX = MyLine(L).x1 - dx * 2000 'Max screen
NewY = MyLine(L).y1 - dy * 2000
LineIntersectRect MyLine(L).x1, MyLine(L).y1, NewX, NewY, RX, RY, Invert
MyLine(L).x2 = RX
MyLine(L).y2 = RY
Shape(L).Left = RX - Shape(L).Width * 0.5
Shape(L).Top = RY - Shape(L).Height * 0.5
End If
Next
Else
MyLine(0).x1 = x
MyLine(0).y1 = y
Shape2.Left = x - Shape2.Width * 0.5
Shape2.Top = y - Shape2.Height * 0.5
End If
End Sub
Right button to move starting point
---------------------------------------------------
v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v EDIT:
For fun and challenge with myself I wanted to try doing it with sloped contour lines (not just a rectangle).
[To get the Form proceed same as above]
Code:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 8280
ClientLeft = 120
ClientTop = 465
ClientWidth = 11280
LinkTopic = "Form1"
ScaleHeight = 552
ScaleMode = 3 'Pixel
ScaleWidth = 752
StartUpPosition = 1 'CenterOwner
Begin VB.Line ContourLine
BorderWidth = 2
Index = 0
Visible = 0 'False
X1 = 320
X2 = 520
Y1 = 80
Y2 = 40
End
Begin VB.Line MyLine
Index = 4
X1 = -16
X2 = 114
Y1 = 192
Y2 = 408
End
Begin VB.Shape ShapeMouse
BorderWidth = 2
Height = 270
Left = 6600
Shape = 2 'Oval
Top = 1560
Width = 270
End
Begin VB.Line MyLine
Index = 3
X1 = -8
X2 = 122
Y1 = 136
Y2 = 352
End
Begin VB.Line MyLine
Index = 2
X1 = 0
X2 = 130
Y1 = 72
Y2 = 288
End
Begin VB.Line MyLine
Index = 1
X1 = 0
X2 = 130
Y1 = 0
Y2 = 216
End
Begin VB.Shape Shape
FillStyle = 0 'Solid
Height = 120
Index = 0
Left = 1680
Shape = 2 'Oval
Top = 960
Width = 120
End
Begin VB.Shape Shape2
FillStyle = 0 'Solid
Height = 270
Left = 4350
Shape = 2 'Oval
Top = 3075
Width = 270
End
Begin VB.Line MyLine
Index = 0
X1 = 297
X2 = 427
Y1 = 214
Y2 = 430
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Roberto Mior
' reexre
Private Type tPoint
x As Single
y As Single
End Type
Private Type tLine
P1 As Long
P2 As Long
nDX As Single
nDY As Single
End Type
Private Lines() As tLine
Private Points() As tPoint
Private NL As Long
Private NP As Long
Private LineContact As Long
Private Sub Addpoint(x!, y!)
NP = NP + 1
ReDim Preserve Points(NP)
With Points(NP)
.x = x
.y = y
End With
End Sub
Private Sub AddLine(P1&, P2&)
Dim DX!, DY!, D!
NL = NL + 1
ReDim Preserve Lines(NL)
With Lines(NL)
.P1 = P1
.P2 = P2
DX = Points(P2).x - Points(P1).x
DY = Points(P2).y - Points(P1).y
D = 1 / Sqr(DX * DX + DY * DY)
.nDX = -DY * D
.nDY = DX * D
End With
End Sub
Private Function LinesIntersect(L1X1!, L1Y1!, _
L1X2!, L1Y2!, _
L2X1!, L2Y1!, _
L2X2!, L2Y2!, RX!, RY!) As Boolean
Dim s1_x!, s1_y!, s2_x!, s2_y!
Dim s!, t!
Dim den As Single
s1_x = L1X2 - L1X1: s1_y = L1Y2 - L1Y1
s2_x = L2X2 - L2X1: s2_y = L2Y2 - L2Y1
den = (-s2_x * s1_y + s1_x * s2_y)
If den Then
den = 1! / den
s = (-s1_y * (L1X1 - L2X1) + s1_x * (L1Y1 - L2Y1)) * den
If s > 0! Then
If s < 1! Then
t = (s2_x * (L1Y1 - L2Y1) - s2_y * (L1X1 - L2X1)) * den
If t > 0! Then
If t < 1! Then
' Collision detected
RX = L1X1 + (t * s1_x)
RY = L1Y1 + (t * s1_y)
LinesIntersect = True
End If
End If
End If
End If
End If
End Function
Private Function LineIntersectRect(x1!, y1!, x2!, y2!, RX!, RY!, Invert As Long)
Dim XX!, YY!
XX! = ScaleWidth - 9
YY! = ScaleHeight - 9
' horizontal
If LinesIntersect(x1, y1, x2, y2, 9, 9, XX, 9, RX, RY) Then Invert = -1: Exit Function
If LinesIntersect(x1, y1, x2, y2, 9, YY, XX, YY, RX, RY) Then Invert = -1: Exit Function
'Vertical
If LinesIntersect(x1, y1, x2, y2, 9, 9, 9, YY, RX, RY) Then Invert = 1: Exit Function
If LinesIntersect(x1, y1, x2, y2, XX, 9, XX, YY, RX, RY) Then Invert = 1: Exit Function
End Function
Private Function LineIntersectANY(x1!, y1!, x2!, y2!, RX!, RY!, rNDX!, rNDY!, PL&)
Dim tRX!, tRY!
Dim D!, minD!, DX!, DY!, I&
Dim LX1!, LY1!, LX2!, LY2!
Dim wLine&
minD = 1E+32
For I = 1 To NL
If I <> PL Then 'EXLUDE PREVIOUS CONTACT
With Lines(I)
LX1 = Points(.P1).x
LY1 = Points(.P1).y
LX2 = Points(.P2).x
LY2 = Points(.P2).y
End With
If LinesIntersect(x1, y1, x2, y2, LX1, LY1, LX2, LY2, tRX, tRY) Then
DX = tRX - x1
DY = tRY - y1
D = DX * DX + DY * DY
If D < minD Then
minD = D
RX = tRX
RY = tRY
wLine = I
End If
End If
End If
Next
rNDX = Lines(wLine).nDX
rNDY = Lines(wLine).nDY
PL = wLine
End Function
Private Sub Form_Load()
Dim I As Long
Randomize Timer
For I = 1 To 4
Load Shape(I)
Shape(I) = Shape(0)
Shape(I).Visible = True
Next
End Sub
Private Sub Form_Resize()
Dim x As Single
Dim y As Single
Dim RndOFF!
Dim I As Long
For I = NL To 1 Step -1
Unload ContourLine(NL) '<<< ERROR !!! ( Correct way ? )
Next
NP = 0
NL = 0
RndOFF = 40
For x = 30 To ScaleWidth - 30
Addpoint x, 10 + Rnd * RndOFF
x = x + 40 + Rnd * 20
Next
For y = 30 To ScaleHeight - 30
Addpoint ScaleWidth - Rnd * RndOFF, y
y = y + 40 + Rnd * 20
Next
For x = ScaleWidth - 30 To 10 Step -1
Addpoint x, ScaleHeight - Rnd * RndOFF
x = x - (40 + Rnd * 20)
Next
For y = ScaleHeight To 30 Step -1
Addpoint 10 + Rnd * RndOFF, y
y = y - (40 + Rnd * 20)
Next
' Points(0) = Points(NP)
For I = 1 To NP
AddLine I, (I Mod NP) + 1
Load ContourLine(I)
ContourLine(I) = ContourLine(0)
ContourLine(I).Visible = True
ContourLine(I).x1 = Points(Lines(I).P1).x
ContourLine(I).y1 = Points(Lines(I).P1).y
ContourLine(I).x2 = Points(Lines(I).P2).x
ContourLine(I).y2 = Points(Lines(I).P2).y
Next
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim DX As Single
Dim DY As Single
Dim NewX As Single
Dim NewY As Single
Dim D As Single
Dim RX!, RY!, rNDX!, rNDY!
Dim Invert As Long
Dim L As Long
Dim dot!
If Button <> 2 Then
For L = 0 To MyLine.Count - 1
If L = 0 Then
DX = MyLine(0).x1 - x
DY = MyLine(0).y1 - y
Else
DX = (MyLine(L - 1).x2 - MyLine(L - 1).x1)
DY = (MyLine(L - 1).y2 - MyLine(L - 1).y1)
'-------------- REFLECT DX,DY along Normal
dot = DX * rNDX + DY * rNDY
DX = DX - rNDX * 2 * dot
DY = DY - rNDY * 2 * dot
MyLine(L).x1 = MyLine(L - 1).x2
MyLine(L).y1 = MyLine(L - 1).y2
End If
D = Sqr(DX * DX + DY * DY)
If D Then
D = 1 / D
DX = DX * D
DY = DY * D
NewX = MyLine(L).x1 + DX * 2000 'Max screen
NewY = MyLine(L).y1 + DY * 2000
'LineIntersectRect MyLine(L).x1, MyLine(L).y1, NewX, NewY, RX, RY, Invert
LineIntersectANY MyLine(L).x1, MyLine(L).y1, NewX, NewY, RX, RY, rNDX, rNDY, LineContact
MyLine(L).x2 = RX
MyLine(L).y2 = RY
Shape(L).Left = RX - Shape(L).Width * 0.5
Shape(L).Top = RY - Shape(L).Height * 0.5
End If
Next
Else
MyLine(0).x1 = x
MyLine(0).y1 = y
Shape2.Left = x - Shape2.Width * 0.5
Shape2.Top = y - Shape2.Height * 0.5
End If
ShapeMouse.Left = x - ShapeMouse.Width * 0.5
ShapeMouse.Top = y - ShapeMouse.Height * 0.5
End Sub
Last edited by reexre; Dec 22nd, 2020 at 07:33 PM.
♠ Roberto Mior Reexre ♠
I have another question for you
Much easier than the previous question
Other friends can also answer the body. Thank you. I said because this question is related to this article, I should ask here link download
Watch the movie
Two circles on the line that are still on the line as the line moves
Last edited by Mojtaba; Dec 22nd, 2020 at 10:03 AM.
♠ Roberto Mior Reexre ♠
I have another question for you
Much easier than the previous question
Other friends can also answer the body. Thank you. I said because this question is related to this article, I should ask here link download
Watch the movie
Two circles on the line that are still on the line as the line moves
I don't know if I understand well the question.
If you want a circle to stay at a certain distance from one of the point of a line (along it):
Let's assume line points are X1 Y1 - X2 Y2
and you want your circle to stay at a certain distance STAYAT from point X1 Y1 along the line (direction).
Code:
'---First of all we have to normalize the line direction
DX = X2 - X1
DY = Y2 - Y1
D = sqr(DX * DX + DY * DY)
'---The normalized (Vector of length 1) direction then is
NDX = DX / D
NDY = DY / D
'---Now we can find the circle position:
CircleX = X1 + NDX * STAYAT
CircleY = Y1 + NDY * STAYAT
HTH
PS:
I edited my post #22
I add a second block of code that works with slanted contour lines.
Last edited by reexre; Dec 22nd, 2020 at 07:28 PM.
---------------------------------------------------
v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v EDIT:
For fun and challenge with myself I wanted to try doing it with sloped contour lines (not just a rectangle).
[To get the Form proceed same as above]
[CODE]VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 8280
ClientLeft = 120
ClientTop = 465
ClientWidth = 11280
LinkTopic = "Form1" ...
-----------------------------------
This is great
You are a professional programmer, thank you
You should be more specific about what's your final goal.
Create something like billiards game ? or what ?
Try to specify what goal you want to achieve.
PS: maybe later I'll "upgrade" to vbRichClient the examples I provided.
I upgraded to vbRichClient, no problem.
Just the second question, I have a problem with two dots on the line
By moving and changing the angle of the line, the circles should be on the line
Last edited by Mojtaba; Dec 23rd, 2020 at 07:50 AM.
And it seems like your scenario is similar to a "bubble-shooting-game", where:
- balls can be fired from some rotating "cannon-like thing"
- with the goal, to "hit some bubbles, including some help from the walls where the shot balls bounce off"
- including a "trajectory-preview for beginners" (showing where the bouncing ball might hit).
Anyways, the code below covers the "rotating-cannon-problem", as shown in the ScreenShot:
The problem of "rotating a complex Object, which consists of SubObjects" can be easily solved with:
- CC.Save/Restore wrapping
- followed by a coord-transformation
- followed by "Sub-Routines" which draw "SubObjects" (without knowing that an outer transform is in place)
Code:
Public Sub Draw(CC As cCairoContext, Optional ForcePt As cControlPoint)
If Not ForcePt Is Nothing Then CalcAngleAndForceLength ForcePt
CC.Save
CC.TranslateDrawings AnchorPt.X, AnchorPt.Y 'all drawing-coords and rotations are now relative to this anchor-point
CC.RotateDrawings Angle
'due to the outer coord-transformations above, the 3 routines below
'can always assume to "draw the Cannon, as if it lies horizontally"
RenderCannonContour CC
If Not ForcePt Is Nothing Then CC.DrawLine 0, 0, -ForceLength, 0, , 1, vbRed
RenderCannonBalls CC
CC.Restore
End Sub
Ideally, such a complex Object is sitting in its own Class, so let's do this in a Class, name cCannon:
Code:
Option Explicit
Public AnchorPt As cControlPoint, BoreRadius As Double, Length As Double
Public Angle As Double, ForceLength As Double, BallCount As Long
Public Sub Draw(CC As cCairoContext, Optional ForcePt As cControlPoint)
If Not ForcePt Is Nothing Then CalcAngleAndForceLength ForcePt
CC.Save
CC.TranslateDrawings AnchorPt.X, AnchorPt.Y 'all drawing-coords are now relative to this anchor-point
CC.RotateDrawings Angle
'due to the outer coord-transformations above, the 3 routines below
'can always assume to "draw the Cannon, as if it lies horizontally"
RenderCannonContour CC
If Not ForcePt Is Nothing Then CC.DrawLine 0, 0, -ForceLength, 0, , 1, vbRed
RenderCannonBalls CC
CC.Restore
End Sub
Private Sub RenderCannonContour(CC As cCairoContext)
Const LW As Double = 3: CC.SetLineWidth LW
Dim Poly As cArrayList
Set Poly = New_c.ArrayList(vbDouble, _
0, -BoreRadius - LW / 2, _
-Length, -BoreRadius - LW / 2, _
-Length, BoreRadius + LW / 2, _
0, BoreRadius + LW / 2)
CC.PolygonPtr Poly.DataPtr, Poly.Count \ 2, , splNormal, True, True 'use splNone, for straight PolyPt-connections
CC.Stroke , Cairo.CreateSolidPatternLng(vbMagenta)
End Sub
Private Sub RenderCannonBalls(CC As cCairoContext)
Const LW As Double = 2: CC.SetLineWidth LW
Dim i As Long
For i = 1 To BallCount
CC.TranslateDrawings -BoreRadius, 0
CC.Arc 0, 0, BoreRadius - LW / 2
CC.Stroke , Cairo.CreateSolidPatternLng(vbBlue)
CC.TranslateDrawings -BoreRadius, 0
Next
End Sub
Private Sub CalcAngleAndForceLength(ForcePt As cControlPoint)
Dim dx#: dx = AnchorPt.X - ForcePt.X
Dim dy#: dy = AnchorPt.Y - ForcePt.Y
Angle = Cairo.CalcArc(dy, dx)
ForceLength = Sqr(dx * dx + dy * dy)
End Sub
The remaining code in a virginal Form is then relatively simple:
Code:
Option Explicit
Private CC As cCairoContext, CPs As cControlPoints, WithEvents tmrRefresh As cTimer
Private Cannon As New cCannon
Private Sub Form_Load()
ScaleMode = vbPixels 'use Pixel-Scalemode on the Form (for an exactly matching CC.Surface)
Set CPs = New_c.ControlPoints 'ensure a ControlPoints-Collection-instance
'now set-up the Cannon-Props
Set Cannon.AnchorPt = CPs.Add("AnchorPt", ScaleWidth / 2, ScaleHeight / 2, vbGreen, 6)
Cannon.BoreRadius = 15
Cannon.Length = 90
Cannon.BallCount = 2
Set tmrRefresh = New_c.Timer(40, True) 'simple timer-based "game-loop"
End Sub
Private Sub RedrawScene(CC As cCairoContext) 'here is, where your own UserDrawings (on the passed "clean CC") will start
Cannon.Draw CC, CPs("ForcePt")
CPs.Draw CC 'this can be commented out, in case one wants to "hide" the ControlPoints
End Sub
'the 3 Mouse-Events below inform the CP-Collection about Mouse-Interactions (ensuring automatic CP-Move-Support)
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim CP As cControlPoint
Set CP = CPs.CheckControlPointUnderCursor(X, Y, False)
If CP Is Nothing Then Set CP = CPs.Add("ForcePt", X, Y, vbRed)
CP.SetMouseDownPoint X, Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
CPs.CheckControlPointUnderCursor X, Y, True
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If CPs.Exists("ForcePt") Then CPs.Remove "ForcePt"
CPs.EnsureMouseUpState
End Sub
Private Sub tmrRefresh_Timer()
CC.Paint 1, Cairo.CreateSolidPatternLng(vbWhite) 'clear the back-buffer
RedrawScene CC 'user-drawings on a cleared canvas
CC.Surface.DrawToDC Me.hDC 'refresh the form with the current bbuf-content
End Sub
Private Sub Form_Resize()
Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext
End Sub
Private Sub Form_Terminate()
New_c.CleanupRichClientDll
End Sub
♣ Olaf ♣
Thank you, that is exactly what I mean
But it would have been better if less code could have been used
Is there no way to use shorter code?
It does not have to be vbRichClient
Anyway, thank you very much for writing and taking the time to ask this question . That was Perfect
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
I am not a professional vb6 and I can not have as much information as you, but I am skilled in site design and graphics, I will be at your service if you have any problems .
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Last edited by Mojtaba; Dec 23rd, 2020 at 04:23 PM.
if anyone is Olaf if you are asking for "as little possible for good result" sources.
as I wrote, theres no shortcuts, we need to tell the IDE what to do and how to do and include restrictions, triggers, "what ifs".
less will always mean that u remove something, that is needed for certain situations.
usually we add more, error-handling is one or a function that can be reused, we make it flexible, this so, in another situation we can use it again.
so, the question should not be can it be shorter but can it be smarter, faster, without vbRichClient, etc.
but Olaf is a genius in programming, everything he do is of high quality and looking at the code her posted, its quite "little", not sure what you expect.