I want to ask if it is possible to drag the image on picbox, when mouse cursor point to the certain object, so when I select the X-textbox, y-textbox, and select pin text
it will displat accourding my coordinate n pin number i selected.
But I want to drag them on picturebox. When mouse cursor touches that certain IC image, it can be drag. But not all the image on picbox drag together.
Can anyone give me some suggestion?
My full code below:
Option Explicit
Private mPic As Picture
Private mPicWidth As Single
Private mPicHeight As Single
Private mCurrentX As Single
Private mCurrentY As Single
Private mLeft As Single
Private mTop As Single
Private Sub Command5_Click()
Call draw_ic(Val(Text5), Val(Text6), Val(Text7))
End Sub
Private Sub Form_Load()
Picture1.AutoRedraw = True
Set mPic = Picture1.Image
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
mPicWidth = Me.ScaleX(mPic.Width, vbHimetric, Picture1.ScaleMode)
mPicHeight = Me.ScaleY(mPic.Height, vbHimetric, Picture1.ScaleMode)
ShowPictureAtPosition mLeft, mTop
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 0 Then
mCurrentX = X
mCurrentY = Y
ElseIf Button = vbLeftButton Then
ShowPictureAtPosition X + mLeft - mCurrentX, Y + mTop - mCurrentY
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
mLeft = X + mLeft - mCurrentX: mTop = Y + mTop - mCurrentY
End Sub
Private Sub ShowPictureAtPosition(pX As Single, pY As Single)
With Picture1
.Cls
.PaintPicture mPic, pX + 1, pY + 1, mPicWidth, mPicHeight
End With
End Sub
Function draw_ic(X, Y, pincount)
If pincount = 8 Then
Picture1.Line (X, Y)-(X + 120, Y + 48), vbBlack, B
Picture1.Line (X + 8, Y)-(X + 24, Y - 16), vbBlack, B
Picture1.Line (X + 34, Y)-(X + 50, Y - 16), vbBlack, B
Picture1.Line (X + 60, Y)-(X + 76, Y - 16), vbBlack, B
Picture1.Line (X + 86, Y)-(X + 102, Y - 16), vbBlack, B
Picture1.Line (X + 8, Y + 48)-(X + 24, Y + 64), vbBlack, B
Picture1.Line (X + 34, Y + 48)-(X + 50, Y + 64), vbBlack, B
Picture1.Line (X + 60, Y + 48)-(X + 76, Y + 64), vbBlack, B
Picture1.Line (X + 86, Y + 48)-(X + 102, Y + 64), vbBlack, B
ElseIf pincount = 12 Then
Picture1.Line (X, Y)-(X + 158, Y + 64), vbBlack, B
Picture1.Line (X + 8, Y)-(X + 16, Y - 8), vbBlack, B
Picture1.Line (X + 32, Y)-(X + 40, Y - 8), vbBlack, B
Picture1.Line (X + 56, Y)-(X + 64, Y - 8), vbBlack, B
Picture1.Line (X + 80, Y)-(X + 88, Y - 8), vbBlack, B
Picture1.Line (X + 104, Y)-(X + 112, Y - 8), vbBlack, B
Picture1.Line (X + 128, Y)-(X + 136, Y - 8), vbBlack, B
Picture1.Line (X + 8, Y + 64)-(X + 16, Y + 72), vbBlack, B
Picture1.Line (X + 32, Y + 64)-(X + 40, Y + 72), vbBlack, B
Picture1.Line (X + 56, Y + 64)-(X + 64, Y + 72), vbBlack, B
Picture1.Line (X + 80, Y + 64)-(X + 88, Y + 72), vbBlack, B
Picture1.Line (X + 104, Y + 64)-(X + 112, Y + 72), vbBlack, B
Picture1.Line (X + 128, Y + 64)-(X + 136, Y + 72), vbBlack, B
ElseIf pincount = 16 Then
Picture1.Line (X, Y)-(X + 222, Y + 72), vbBlack, B
Picture1.Line (X + 8, Y)-(X + 24, Y - 16), vbBlack, B
Picture1.Line (X + 34, Y)-(X + 50, Y - 16), vbBlack, B
Picture1.Line (X + 60, Y)-(X + 76, Y - 16), vbBlack, B
Picture1.Line (X + 86, Y)-(X + 102, Y - 16), vbBlack, B
Picture1.Line (X + 112, Y)-(X + 128, Y - 16), vbBlack, B
Picture1.Line (X + 138, Y)-(X + 154, Y - 16), vbBlack, B
Picture1.Line (X + 164, Y)-(X + 180, Y - 16), vbBlack, B
Picture1.Line (X + 190, Y)-(X + 206, Y - 16), vbBlack, B
Picture1.Line (X + 8, Y + 72)-(X + 24, Y + 88), vbBlack, B
Picture1.Line (X + 34, Y + 72)-(X + 50, Y + 88), vbBlack, B
Picture1.Line (X + 60, Y + 72)-(X + 76, Y + 88), vbBlack, B
Picture1.Line (X + 86, Y + 72)-(X + 102, Y + 88), vbBlack, B
Picture1.Line (X + 112, Y + 72)-(X + 128, Y + 88), vbBlack, B
Picture1.Line (X + 138, Y + 72)-(X + 154, Y + 88), vbBlack, B
Picture1.Line (X + 164, Y + 72)-(X + 180, Y + 88), vbBlack, B
Picture1.Line (X + 190, Y + 72)-(X + 206, Y + 88), vbBlack, B
End If
End Function
This is a very interesting project !
Consider the coordinates of the following image.
Every time that you create a new IC, if you save its top-left and bottom-right coordinates, it will help you to determine when the mouse pointer reaches its area by using the following code.
Private Function MouseCursorInsideRectangle(topLeftX As Integer, topLeftY As Integer, bottomRightX As Integer, bottomRightY As Integer, mouseX As Integer, mouseY As Integer) As Boolean
If mouseX >= topLeftX And mouseX <= bottomRightX And mouseY >= topLeftY And mouseY <= bottomRightY Then
MouseCursorInsideRectangle = True
Else
MouseCursorInsideRectangle = False
End If
End Function
This will resolve the issue of overlapping ICs, since you can check the coordinate of the IC that you want to draw and disallow the drawing, if it's over another one.
To solve the issue of moving only a certain IC and not the whole PictureBox image, you can clear the image when a drag event is in progress and draw all the ICs again (by using the coordinates that you saved during their creation) through iteration.
(Although it is not in your requirements, consider also saving the coordinates of the pins of each IC, so you can draw lines between ICs in the future).
EDIT
Try the below code
Option Explicit
Option Base 0
Private Type ICData
topLeftX As Integer
topLeftY As Integer
bottomRightX As Integer
bottomRightY As Integer
pinCount As Integer
End Type
Dim ICs() As ICData
Dim ICsIndex As Integer
Dim DraggedICIndex As Integer
Dim Xdifference As Integer
Dim Ydifference As Integer
Dim InitialX As Integer
Dim InitialY As Integer
Private Sub Form_Load()
ICsIndex = -1
DraggedICIndex = -1
Picture1.ScaleMode = 3
Picture1.AutoRedraw = True
End Sub
Private Sub Command5_Click()
Call save_ic(Val(text5), Val(text6), Val(text7))
Call draw_ics(-1)
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DraggedICIndex = GetICIndex(CSng(X), CSng(Y))
If DraggedICIndex > -1 Then
InitialX = ICs(DraggedICIndex).topLeftX
InitialY = ICs(DraggedICIndex).topLeftY
Xdifference = Abs(X - ICs(DraggedICIndex).topLeftX)
Ydifference = Abs(Y - ICs(DraggedICIndex).topLeftY)
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton And DraggedICIndex > -1 Then
Picture1.Cls
Call draw_ics(DraggedICIndex)
Call draw_ic(X - Xdifference, Y - Ydifference, ICs(DraggedICIndex).pinCount)
Dim ICWidth As Integer
Dim ICHeight As Integer
ICWidth = ICs(DraggedICIndex).bottomRightX - ICs(DraggedICIndex).topLeftX
ICHeight = ICs(DraggedICIndex).bottomRightY - ICs(DraggedICIndex).topLeftY
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If DraggedICIndex > -1 Then
Dim ICWidth As Integer
Dim ICHeight As Integer
ICWidth = ICs(DraggedICIndex).bottomRightX - ICs(DraggedICIndex).topLeftX
ICHeight = ICs(DraggedICIndex).bottomRightY - ICs(DraggedICIndex).topLeftY
ICs(DraggedICIndex).topLeftX = X - Xdifference
ICs(DraggedICIndex).topLeftY = Y - Ydifference
ICs(DraggedICIndex).bottomRightX = ICWidth + X - Xdifference
ICs(DraggedICIndex).bottomRightY = ICHeight + Y - Ydifference
End If
End Sub
Private Function MouseCursorInsideRectangle(location As ICData, mouseX As Integer, mouseY As Integer) As Boolean
If mouseX >= location.topLeftX And mouseX <= location.bottomRightX And mouseY >= location.topLeftY And mouseY <= location.bottomRightY Then
MouseCursorInsideRectangle = True
Else
MouseCursorInsideRectangle = False
End If
End Function
Private Function GetICIndex(mouseX As Integer, mouseY As Integer) As Integer
Dim i As Integer
For i = 0 To ICsIndex
If MouseCursorInsideRectangle(ICs(i), mouseX, mouseY) = True Then
GetICIndex = i
Exit Function
End If
Next
GetICIndex = -1
End Function
Sub save_ic(X, Y, pinCount)
If pinCount = 8 Then
ICsIndex = ICsIndex + 1
ReDim Preserve ICs(ICsIndex)
ICs(ICsIndex).topLeftX = X
ICs(ICsIndex).topLeftY = Y
ICs(ICsIndex).bottomRightX = X + 120
ICs(ICsIndex).bottomRightY = Y + 80
ICs(ICsIndex).pinCount = pinCount
ElseIf pinCount = 12 Then
ICsIndex = ICsIndex + 1
ReDim Preserve ICs(ICsIndex)
ICs(ICsIndex).topLeftX = X
ICs(ICsIndex).topLeftY = Y
ICs(ICsIndex).bottomRightX = X + 158
ICs(ICsIndex).bottomRightY = Y + 80
ICs(ICsIndex).pinCount = pinCount
ElseIf pinCount = 16 Then
ICsIndex = ICsIndex + 1
ReDim Preserve ICs(ICsIndex)
ICs(ICsIndex).topLeftX = X
ICs(ICsIndex).topLeftY = Y
ICs(ICsIndex).bottomRightX = X + 222
ICs(ICsIndex).bottomRightY = Y + 104
ICs(ICsIndex).pinCount = pinCount
End If
End Sub
Sub draw_ic(X, Y, pinCount)
If pinCount = 8 Then
Picture1.Line (X, Y + 16)-(X + 120, Y + 64), vbBlack, B
Picture1.Line (X + 8, Y + 16)-(X + 24, Y), vbBlack, B
Picture1.Line (X + 34, Y + 16)-(X + 50, Y), vbBlack, B
Picture1.Line (X + 60, Y + 16)-(X + 76, Y), vbBlack, B
Picture1.Line (X + 86, Y + 16)-(X + 102, Y), vbBlack, B
Picture1.Line (X + 8, Y + 64)-(X + 24, Y + 80), vbBlack, B
Picture1.Line (X + 34, Y + 64)-(X + 50, Y + 80), vbBlack, B
Picture1.Line (X + 60, Y + 64)-(X + 76, Y + 80), vbBlack, B
Picture1.Line (X + 86, Y + 64)-(X + 102, Y + 80), vbBlack, B
ElseIf pinCount = 12 Then
Picture1.Line (X, Y + 8)-(X + 158, Y + 72), vbBlack, B
Picture1.Line (X + 8, Y + 8)-(X + 16, Y), vbBlack, B
Picture1.Line (X + 32, Y + 8)-(X + 40, Y), vbBlack, B
Picture1.Line (X + 56, Y + 8)-(X + 64, Y), vbBlack, B
Picture1.Line (X + 80, Y + 8)-(X + 88, Y), vbBlack, B
Picture1.Line (X + 104, Y + 8)-(X + 112, Y), vbBlack, B
Picture1.Line (X + 128, Y + 8)-(X + 136, Y), vbBlack, B
Picture1.Line (X + 8, Y + 72)-(X + 16, Y + 80), vbBlack, B
Picture1.Line (X + 32, Y + 72)-(X + 40, Y + 80), vbBlack, B
Picture1.Line (X + 56, Y + 72)-(X + 64, Y + 80), vbBlack, B
Picture1.Line (X + 80, Y + 72)-(X + 88, Y + 80), vbBlack, B
Picture1.Line (X + 104, Y + 72)-(X + 112, Y + 80), vbBlack, B
Picture1.Line (X + 128, Y + 72)-(X + 136, Y + 80), vbBlack, B
ElseIf pinCount = 16 Then
Picture1.Line (X, Y + 16)-(X + 222, Y + 88), vbBlack, B
Picture1.Line (X + 8, Y + 16)-(X + 24, Y), vbBlack, B
Picture1.Line (X + 34, Y + 16)-(X + 50, Y), vbBlack, B
Picture1.Line (X + 60, Y + 16)-(X + 76, Y), vbBlack, B
Picture1.Line (X + 86, Y + 16)-(X + 102, Y), vbBlack, B
Picture1.Line (X + 112, Y + 16)-(X + 128, Y), vbBlack, B
Picture1.Line (X + 138, Y + 16)-(X + 154, Y), vbBlack, B
Picture1.Line (X + 164, Y + 16)-(X + 180, Y), vbBlack, B
Picture1.Line (X + 190, Y + 16)-(X + 206, Y), vbBlack, B
Picture1.Line (X + 8, Y + 88)-(X + 24, Y + 104), vbBlack, B
Picture1.Line (X + 34, Y + 88)-(X + 50, Y + 104), vbBlack, B
Picture1.Line (X + 60, Y + 88)-(X + 76, Y + 104), vbBlack, B
Picture1.Line (X + 86, Y + 88)-(X + 102, Y + 104), vbBlack, B
Picture1.Line (X + 112, Y + 88)-(X + 128, Y + 104), vbBlack, B
Picture1.Line (X + 138, Y + 88)-(X + 154, Y + 104), vbBlack, B
Picture1.Line (X + 164, Y + 88)-(X + 180, Y + 104), vbBlack, B
Picture1.Line (X + 190, Y + 88)-(X + 206, Y + 104), vbBlack, B
End If
End Sub
Sub draw_ics(exceptICIndex As Integer)
If ICsIndex > -1 Then
Dim i As Integer
For i = 0 To ICsIndex
If i <> exceptICIndex Then
Call draw_ic(ICs(i).topLeftX, ICs(i).topLeftY, ICs(i).pinCount)
End If
Next
End If
End Sub
I leave the IC overlap implementation on you :).
I have an ODE and I solve it with NDSolve, then I plot the solution on a simplex in 2D.
Valid XHTML http://ompldr.org/vY2c5ag/simplex.jpg
Then I need to transform (align or just plot) this simplex in 3D at coordinates (1,0,0),(0,1,0),(0,0,1), so it looks like this scheme:
Valid XHTML http://ompldr.org/vY2dhMg/simps.png
I use ParametricPlot to do my plot so far. Maybe all I need is ParametricPlot3D, but I don't know how to call it properly.
Here is my code so far:
Remove["Global`*"];
phi[x_, y_] = (1*x*y)/(beta*x + (1 - beta)*y);
betam = 0.5;
betaf = 0.5;
betam = s;
betaf = 0.1;
sigma = 0.25;
beta = 0.3;
i = 1;
Which[i == 1, {betam = 0.40, betaf = 0.60, betam = 0.1,
betaf = 0.1, sigma = 0.25 , tmax = 10} ];
eta[x2_, y2_, p2_] = (betam + betaf + sigma)*p2 - betam*x2 -
betaf*y2 - phi[x2, y2];
syshelp = {x2'[t] == (betam + betaf + sigma)*p2[t] - betam*x2[t] -
phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*x2[t],
y2'[t] == (betaf + betam + sigma)*p2[t] - betaf*y2[t] -
phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*y2[t],
p2'[t] == -(betam + betaf + sigma)*p2[t] + phi[x2[t], y2[t]] -
eta[x2[t], y2[t], p2[t]]*p2[t]};
initialcond = {x2[0] == a, y2[0] == b, p2[0] == 1 - a - b};
tmax = 50;
solhelp =
Table[
NDSolve[
Join[initialcond, syshelp], {x2, y2, p2} , {t, 0, tmax},
AccuracyGoal -> 10, PrecisionGoal -> 15],
{a, 0.01, 1, 0.15}, {b, 0.01, 1 - a, 0.15}];
functions =
Map[{y2[t] + p2[t]/2, p2[t]*Sqrt[3]/2} /. # &, Flatten[solhelp, 2]];
ParametricPlot[Evaluate[functions], {t, 0, tmax},
PlotRange -> {{0, 1}, {0, 1}}, AspectRatio -> Automatic]
Third day with Mathematica...
You could find a map from the triangle in the 2D plot to the one in 3D using FindGeometricTransformation and use that in ParametricPlot3D to plot your function, e.g.
corners2D = {{0, 0}, {1, 0}, {1/2, 1}};
corners3D = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
fun[pts1_, pts2_] := FindGeometricTransform[Append[pts2, Mean[pts2]],
PadRight[#, 3] & /# Append[pts1, Mean[pts1]],
"Transformation" -> "Affine"][[2]]
ParametricPlot3D[Evaluate[fun[corners2D, corners3D][{##, 0}] & ### functions],
{t, 0, tmax}, PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]
Since your solution has the property that x2[t]+y2[t]+p2[t]==1 it should be enough to plot something like:
functions3D = Map[{x2[t], y2[t], p2[t]} /. # &, Flatten[solhelp, 2]];
ParametricPlot3D[Evaluate[functions3D], {t, 0, tmax},
PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]