by Sameer Bhatnagar (india) (1 Submission)
Category: Graphics
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 17th July 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Add a "ImageControl" Named as 'Img' and "ShapeControl" Named as 'ShapeImg'(On Image Control), This is Free Hand Too, to Select a Photo Size.
API Declarations
Dim iLeft As Integer, iTop As Integer
Dim bLeft As Boolean, bRight As Boolean, bTop As Boolean, bBottom As Boolean, bDefault As Boolean
VBcoders
On Error GoTo lbl 'X = Width , Y = Height
If Button = 1 Then 'Left Button of Mouse Pressed
Select Case True
Case bLeft 'Incr./Decr. Width From the Left
If X <= 0 Then GoTo LblSkeep
ShapeImg.Width = ShapeImg.Width + (iLeft - X)
ShapeImg.Left = Img.Left + X
Case bRight 'Incr./Decr. Width From the Right
If X >= Img.Width Then GoTo LblSkeep
ShapeImg.Width = ShapeImg.Width + (X - iLeft)
Case bTop 'Incr./Decr. Height From the Top
If Y <= 0 Then GoTo LblSkeep
ShapeImg.Height = ShapeImg.Height + (iTop - Y)
ShapeImg.Top = Img.Top + Y
Case bBottom 'Incr./Decr. Height From the Botom
If Y >= Img.Height Then GoTo LblSkeep
ShapeImg.Height = ShapeImg.Height + (Y - iTop)
Case bDefault 'Move Rectangle
ShapeImg.Left = ShapeImg.Left + (X - iLeft)
ShapeImg.Top = ShapeImg.Top + (Y - iTop)
End Select
'Restrict that ShapeImg should not Move Out Side of Image
If ShapeImg.Left < Img.Left Then ShapeImg.Left = Img.Left
If ShapeImg.Top < Img.Top Then ShapeImg.Top = Img.Top
If ShapeImg.Left + ShapeImg.Width > Img.Left + Img.Width Then ShapeImg.Left = Img.Left + Img.Width - ShapeImg.Width
If ShapeImg.Top + ShapeImg.Height > Img.Top + Img.Height Then ShapeImg.Top = Img.Top + Img.Height - ShapeImg.Height
End If
LblSkeep:
bDefault = IIf(X > ShapeImg.Left - Img.Left And X < ShapeImg.Left + ShapeImg.Width - Img.Left And _
Y > ShapeImg.Top - Img.Top And Y < ShapeImg.Top + ShapeImg.Height - Img.Top, True, False)
If ((X >= (ShapeImg.Left - Img.Left - 50) And X <= (ShapeImg.Left - Img.Left + 50)) Or _
(X >= (ShapeImg.Left + ShapeImg.Width - Img.Left - 50) And X <= (ShapeImg.Left + ShapeImg.Width - Img.Left + 50))) And _
Y >= ShapeImg.Top - Img.Top And Y <= (ShapeImg.Height + ShapeImg.Top - Img.Top) Then
bLeft = IIf(X >= (ShapeImg.Left - Img.Left - 50) And _
X <= (ShapeImg.Left - Img.Left + 50), True, False) 'Change Mouse Pointer(<->, Left-Right) From Left
bRight = Not bLeft: GoTo lbl 'Change Mouse Pointer(<->, Left-Right) From Right
Else
bRight = False: bLeft = False
End If
If ((Y >= (ShapeImg.Top - Img.Top - 50) And Y <= (ShapeImg.Top - Img.Top + 50)) Or (Y >= ShapeImg.Top + ShapeImg.Height - Img.Top - 50 And Y <= ShapeImg.Top + ShapeImg.Height - Img.Top + 50)) _
And X >= ShapeImg.Left - Img.Left And X <= (ShapeImg.Width + ShapeImg.Left - Img.Left) Then
bTop = IIf(Y >= (ShapeImg.Top - Img.Top - 50) And Y <= (ShapeImg.Top - Img.Top + 50), True, False) 'Change Mouse Pointer(Up-Down) From Top
bBottom = Not bTop: GoTo lbl 'Change Mouse Pointer(Up-Down) From Bottom
Else
bBottom = False: bTop = False
End If
lbl:
Screen.MousePointer = IIf(bLeft Or bRight, vbSizeWE, IIf(bTop Or bBottom, vbSizeNS, vbDefault))
iLeft = X: iTop = Y
End Sub
No comments have been posted about Add a ImageControl Named as 'Img' and ShapeControl Named as 'ShapeImg'(On Image Control), This . Why not be the first to post a comment about Add a ImageControl Named as 'Img' and ShapeControl Named as 'ShapeImg'(On Image Control), This .
