Solved: Resize picture on MDI Form.

I once downloaded this some code but don't remember the site so I'll post the whole code to you.

You only need to place apicture box on your form (in the example called "picFlag")
--------------------------------------------------
Option Explicit

'Initial bounding box position and size. The width and height are the
'size of the picture control holding the Canadian flag image.
Const INIT_BBOX_LEFT = 64
Const INIT_BBOX_TOP = 64
Const INIT_BBOX_WIDTH = 217
Const INIT_BBOX_HEIGHT = 145

'States to track dragging.
Const WAITING = 0
Const DRAGGING = 1

'Names for hot spots, with a different kind of drag for each. DON'T
'CHANGE -- used as array indices in the Cursor() array, return values
'from PtinHotSpot(), and elsewhere. Stored in global variable hs.
Const TOP_LEFT = 0
Const TOP_MID = 1
Const TOP_RT = 2
Const MID_RT = 3
Const BOT_RT = 4
Const BOT_MID = 5
Const BOT_LEFT = 6
Const MID_LEFT = 7
Const TRANSLATE = 8
Const NO_HIT = 9

'The following three constants determine the size of the little black
'boxes and their distance from the bounding box. The size of the little
'boxes is one more than BOXSIZE; HALF_BOXSIZE is half of that; and
'MARGIN = BOXSIZE + 1 + (number of pixels between the bbox and the
'little boxes). Here the boxes are 5 pixels square and they are 2 pixels
'from the bbox -- resetting to (6, 3, 8) respectively gives boxes 7
'pixels square and 1 pixel from the bbox.
Const BOXSIZE = 4
Const HALF_BOXSIZE = 2
Const MARGIN = 7

'Type for bounding box holding image.
Private Type box
Left As Integer
Top As Integer
width As Integer
height As Integer
End Type

'16-bit Windows (Win31) and 32-bit Windows (Win95 / WIN NT) have
'different type and function declarations. Use conditional compilation
'to compile either way, depending on which VB compiler is being used.
'WinAPI RECT for ClipCursor().
Private Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type

'WinAPI POINT for ClientToScreen().
Private Type wpoint
x As Long
y As Long
End Type

'WinAPI calls for restricting cursor.
Private Declare Sub ClipCursor Lib "User32" (r As RECT)
Private Declare Sub ClearCursor Lib "User32" Alias "ClipCursor" (ByVal lpr&)
Private Declare Sub ClientToScreen Lib "User32" (ByVal hwnd As Long, lpp As wpoint)

'Bounding box holding image.
Dim Bbox As box

'Array of cursors for each hot spot.
Dim Cursor%(NO_HIT)

'State variable to track drag.
Dim State%

'Hot spot index.
Dim hs%

'Mouse deltas relative to bbox top left (used to translate).
Dim dx%, dy%

Private Sub Form_Load()

'Set form ScaleMode to pixels.
Me.ScaleMode = vbPixels

'Make picture box invisible, use pixels.
picFlag.BorderStyle = 0
picFlag.Visible = False
picFlag.ScaleMode = vbPixels

'Init bounding box to size of Canadian flag, located in middle of screen.
Bbox.Left = INIT_BBOX_LEFT
Bbox.Top = INIT_BBOX_TOP
Bbox.width = INIT_BBOX_WIDTH
Bbox.height = INIT_BBOX_HEIGHT

'Init Cursors as appropriate for each hot spot.
Cursor(TOP_LEFT) = vbSizeNWSE
Cursor(TOP_MID) = vbSizeNS
Cursor(TOP_RT) = vbSizeNESW
Cursor(MID_RT) = vbSizeWE
Cursor(BOT_RT) = vbSizeNWSE
Cursor(BOT_MID) = vbSizeNS
Cursor(BOT_LEFT) = vbSizeNESW
Cursor(MID_LEFT) = vbSizeWE
Cursor(TRANSLATE) = vbSizePointer
Cursor(NO_HIT) = vbArrow

End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim r As RECT 'clip rect for ClipCursor
Dim p As wpoint 'for ClientToScreen
Dim q As wpoint 'for ClientToScreen

'Grab hot spot index.
hs = PtInHotSpot(Bbox, x, y)

'Exit immediately if not in hot spot.
If hs = NO_HIT Then
Exit Sub
End If

If State = WAITING Then
'If get here, user has buttoned-down in one of the hot spots. Do
'the common logic for all hot spots.
State = DRAGGING
'Set xor mode, erase bbox frame.
DrawMode = vbNotXorPen
DrawFrame Bbox
'Redraw frame without hot spots.
DrawStyle = vbDot
Line (Bbox.Left, Bbox.Top)-Step(Bbox.width, Bbox.height), , B

'User is starting to drag one of the hot spots; set points p and q
'appropriately for each one, to determine how cursor will be restricted.
'In each case, set p to top left, q to bottom right of clip rect.
Select Case hs
Case TOP_LEFT
'Set p to client top left.
p.x = 0
p.y = 0
'Set q to bbox bottom right.
q.x = Bbox.Left + Bbox.width
q.y = Bbox.Top + Bbox.height
Case TOP_MID
'Set p to client top left.
p.x = 0
p.y = 0
'Set q to client right, bbox bottom.
q.x = ScaleWidth
q.y = Bbox.Top + Bbox.height
Case TOP_RT
'Set p to client top right.
p.x = Bbox.Left
p.y = 0
'Set q to bbox bottom left.
q.x = ScaleWidth
q.y = Bbox.Top + Bbox.height
Case MID_RT
'Set p bbox left, client top.
p.x = Bbox.Left
p.y = 0
'Set q to client bottom right.
q.x = ScaleWidth
q.y = ScaleHeight
Case BOT_RT
'Set p to bbox left top.
p.x = Bbox.Left
p.y = Bbox.Top
'Set q to client bottom right.
q.x = ScaleWidth
q.y = ScaleHeight
Case BOT_MID
'Set p to client left, bbox top.
p.x = 0
p.y = Bbox.Top
'Set q to client bottom right.
q.x = ScaleWidth
q.y = ScaleHeight
Case BOT_LEFT
'Set p to client left, bbox top.
p.x = 0
p.y = Bbox.Top
'Set q to client bottom, bbox right.
q.x = Bbox.Left + Bbox.width
q.y = ScaleHeight
Case MID_LEFT
'Set p to client top left.
p.x = 0
p.y = 0
'Set q to bbox right, client bottom.
q.x = Bbox.Left + Bbox.width
q.y = ScaleHeight
Case TRANSLATE
'Set p to client top left.
p.x = 0
p.y = 0
'Set q to client bottom right.
q.x = ScaleWidth
q.y = ScaleHeight
'Also set global deltas of mouse relative to top left.
dx = x - Bbox.Left
dy = y - Bbox.Top
End Select

'Force px >= 0, p.y >= 0, q.x <= ScaleWidth, q.y <= ScaleHeight.
p.x = Max(p.x, 0)
p.y = Max(p.y, 0)
q.x = Min(q.x, ScaleWidth)
q.y = Min(q.y, ScaleHeight)

'Convert p and q to screen coords expected by ClipCursor().
ClientToScreen hwnd, p
ClientToScreen hwnd, q
'Set clip rect from p and q, restrict cursor to it.
r.x1 = p.x: r.y1 = p.y: r.x2 = q.x: r.y2 = q.y
ClipCursor r

End If 'If State = WAITING

End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

If State = DRAGGING Then
'Erase previous bbox.
Line (Bbox.Left, Bbox.Top)-Step(Bbox.width, Bbox.height), , B
'Reset bbox depending on mouse position and type of drag.
Select Case hs
Case TOP_LEFT
Bbox.width = Bbox.width + (Bbox.Left - x)
Bbox.height = Bbox.height + (Bbox.Top - y)
Bbox.Left = x
Bbox.Top = y
Case TOP_MID
Bbox.height = Bbox.height + (Bbox.Top - y)
Bbox.Top = y
Case TOP_RT
'Add 1 to width to keep it greater than 0.
Bbox.width = x - Bbox.Left + 1
Bbox.height = Bbox.height + (Bbox.Top - y)
Bbox.Top = y
Case MID_RT
'Add 1 to width to keep it greater than 0.
Bbox.width = x - Bbox.Left + 1
Case BOT_RT
'Add 1 to width and height to keep them greater than 0.
Bbox.width = x - Bbox.Left + 1
Bbox.height = y - Bbox.Top + 1
Case BOT_MID
'Add 1 to height to keep it greater than 0.
Bbox.height = y - Bbox.Top + 1
Case BOT_LEFT
Bbox.width = Bbox.width + (Bbox.Left - x)
'Add 1 to height to keep it greater than 0.
Bbox.height = y - Bbox.Top + 1
Bbox.Left = x
Case MID_LEFT
Bbox.width = Bbox.width + (Bbox.Left - x)
Bbox.Left = x
Case TRANSLATE
'Reset top left using deltas from MouseDown.
Bbox.Left = x - dx
Bbox.Top = y - dy
End Select
'Draw new bbox.
Line (Bbox.Left, Bbox.Top)-Step(Bbox.width, Bbox.height), , B
Else
'Set mouse appropriate to hot spot if moving across.
MousePointer = Cursor(PtInHotSpot(Bbox, x, y))
End If

End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

'If drag finalized, release cursor and paint.
If State = DRAGGING Then
State = WAITING
DrawMode = vbCopyPen
'Equivalent to API call ClipCursor(NULL) to free cursor.
ClearCursor 0&
Form_Paint
End If

End Sub
Private Sub Form_Paint()

'Clear screen.
Cls
'Draw flag.
PaintPicture picFlag.Picture, Bbox.Left, Bbox.Top, Bbox.width, Bbox.height
'Draw outline with little black boxes.
DrawFrame Bbox
End Sub

Private Function PtInHotSpot%(b As box, ByVal x%, ByVal y%)

'USE: Given box, return hot spot index for point.
'IN: b = bounding box (bbox) around which hot spots are defined
' (x,y) = point to test
'RET: index of hot spot (TOP_LEFT...TRANSLATE, NO_HIT if not in any)
'NOTE: The hot spots are the given box and 8 little boxes around it.
' NO_HIT is returned if the point is in none of these hot spots.

Dim lbb As box 'to define little black boxes
Dim mx% 'x-coord of little box at middle
Dim my% 'y-coord of little box at middle

'First check for point outside extended bbox (quick reject).
If x < b.Left - MARGIN Or x > b.Left + b.width + MARGIN Or _
y < b.Top - MARGIN Or y > b.Top + b.height + MARGIN Then
PtInHotSpot = NO_HIT
Exit Function
End If

'Next check for point within bbox (quick reject).
If PtInBox(b, x, y) Then
PtInHotSpot = TRANSLATE
Exit Function
End If

'Most points will satisfy one of the conditions above. All other
'points lie along a thin border MARGIN pixels wide around the bbox.
'This border contains all the hot spots except the bbox itself; so
'next check them in order, starting at the upper left and proceeding
'clockwise.

'Check for point in top left hot spot.
lbb.Left = b.Left - MARGIN
lbb.Top = b.Top - MARGIN
lbb.width = BOXSIZE
lbb.height = BOXSIZE
If PtInBox(lbb, x, y) Then
PtInHotSpot = TOP_LEFT
Exit Function
End If

'Calc middle x and y (-2 to line up at left/top edge of box).
mx = Bbox.Left + Bbox.width / 2 - HALF_BOXSIZE
my = Bbox.Top + Bbox.height / 2 - HALF_BOXSIZE

'Check for point in top middle hot spot.
'Note width and height stay at BOXSIZE, as set above.
lbb.Left = mx
lbb.Top = b.Top - MARGIN
If PtInBox(lbb, x, y) Then
PtInHotSpot = TOP_MID
Exit Function
End If

'Check for point in top right hot spot.
lbb.Left = b.Left + b.width + MARGIN - BOXSIZE
lbb.Top = b.Top - MARGIN
If PtInBox(lbb, x, y) Then
PtInHotSpot = TOP_RT
Exit Function
End If

'Check for point in middle right hot spot.
lbb.Left = b.Left + b.width + MARGIN - BOXSIZE
lbb.Top = my
If PtInBox(lbb, x, y) Then
PtInHotSpot = MID_RT
Exit Function
End If

'Check for point in bottom right hot spot.
lbb.Left = b.Left + b.width + MARGIN - BOXSIZE
lbb.Top = b.Top + b.height + MARGIN - BOXSIZE
If PtInBox(lbb, x, y) Then
PtInHotSpot = BOT_RT
Exit Function
End If

'Check for point in bottom middle hot spot.
lbb.Left = mx
lbb.Top = b.Top + b.height + MARGIN - BOXSIZE
If PtInBox(lbb, x, y) Then
PtInHotSpot = BOT_MID
Exit Function
End If

'Check for point in bottom left hot spot.
lbb.Left = b.Left - MARGIN
lbb.Top = b.Top + b.height + MARGIN - BOXSIZE
If PtInBox(lbb, x, y) Then
PtInHotSpot = BOT_LEFT
Exit Function
End If

'Check for point in middle left hot spot.
lbb.Left = b.Left - MARGIN
lbb.Top = my
If PtInBox(lbb, x, y) Then
PtInHotSpot = MID_LEFT
Exit Function
End If

'If get thru to here, not in any of the hot spots.
PtInHotSpot = NO_HIT

End Function

Private Function PtInBox%(b As box, ByVal x%, ByVal y%)

'USE: Returns True if given point is in the box, False otherwise.
'IN: b = box to find point in
' (x,y) = given point to test

PtInBox = x >= b.Left And x <= b.Left + b.width And _
y >= b.Top And y <= b.Top + b.height

End Function

Private Sub DrawFrame(b As box)

'USE: Draw dotted rectangle and little black boxes.
'IN: b = rectangle to draw
'NOTE: Eight little black boxes drawn at corners and middle of
' edges. Constants BOXSIZE and MARGIN determine size of the
' boxes and how close they are to the rectangle.

Dim mx% 'x-coord of little box at middle
Dim my% 'y-coord of little box at middle
Dim pRight% 'right edge
Dim pBottom% 'bottom edge

'Outline box with dotted rectangle (VB builds in margin).
DrawStyle = vbDot
Line (b.Left, b.Top)-Step(b.width, b.height), , B

'Calc middle x and y (-HALF_BOXSIZE to line up at left/top of box).
mx = b.Left + b.width / 2 - HALF_BOXSIZE
my = b.Top + b.height / 2 - HALF_BOXSIZE

'Calc right and bottom edges.
pRight = b.Left + b.width
pBottom = b.Top + b.height

'Draw little black boxes at corners and middle of edges -- start
'at upper left and proceed clockwise.
DrawStyle = vbSolid
Line (b.Left - MARGIN, b.Top - MARGIN)-Step(BOXSIZE, BOXSIZE), , BF
Line (mx, b.Top - MARGIN)-Step(BOXSIZE, BOXSIZE), , BF
Line (pRight + MARGIN, b.Top - MARGIN)-Step(-BOXSIZE, BOXSIZE), , BF
Line (pRight + MARGIN, my)-Step(-BOXSIZE, BOXSIZE), , BF
Line (pRight + MARGIN, pBottom + MARGIN)-Step(-BOXSIZE, -BOXSIZE), , BF
Line (mx, pBottom + MARGIN)-Step(BOXSIZE, -BOXSIZE), , BF
Line (b.Left - MARGIN, pBottom + MARGIN)-Step(BOXSIZE, -BOXSIZE), , BF
Line (b.Left - MARGIN, my)-Step(BOXSIZE, BOXSIZE), , BF
End Sub

Private Function Min(ByVal u, ByVal v)
If (u < v) Then
Min = u
Else
Min = v
End If
End Function

Private Function Max(ByVal u, ByVal v)
If (u < v) Then
Max = v
Else
Max = u
End If
End Function
--------------------------------------

Te set a minimum width, just precalculate, in a temporary variable, the witdth for each case in the form's mousemove event, if the width is smaller then the desired limit you call "Exit Sub".

Trillo

team_idc

ASKER

No,
please read the question carefully.
A picture on a MDIForm, resize of pic within MDI.

kesonline

A question - what kind of picture is this, and could you send a sample with just the pic and a little code. I can program it straight into the program - easier than posting here. ben@kescom.net is my email.

TDragon

Resize pic within MDI_FORM (or any form for that matter)
create a new MDI_FORM
place a picture box(picture1) and a line object(line1) on the form and add the following code...

Public bMovingSeparator As Boolean
Public lToolbarHeight As Long

Private Sub Form_Load()
lToolbarHeight = 500

Form_Resize
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Abs(Y - lToolbarHeight) < 50 Then
bMovingSeparator = True
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If bMovingSeparator And Y > 0 And Y < Me.Height Then
lToolbarHeight = Y
Form_Resize
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
bMovingSeparator = False
End Sub

Private Sub Form_Resize()
Static bAlreadyHere As Boolean

If bAlreadyHere Then Exit Sub
bAlreadyHere = True

Picture1.Top = 0
Picture1.Left = 0
Picture1.Width = Me.Width - 140
Picture1.Height = lToolbarHeight

Line1.Y1 = lToolbarHeight + 30
Line1.Y2 = lToolbarHeight + 30
Line1.X1 = 0
Line1.X2 = Me.Width
Line1.BorderWidth = 3

bAlreadyHere = False

End Sub

If you are asking how to set the minimum width for the form itself add the following commands to the resize event just after the bAlreadyHere=True statement...
If me.width<MIN_WIDTH then Me.width=MIN_WIDTH

and add the MIN_WIDTH to the declaration section at the top.

TDragon

Of course you'd probably also want to change the MousePointer to the appropriate value while in the bMovingSepartor state.

TDragon

Oops... MDI Form ehh...

well the following code works... to a point the actual border of the picture box does not trigger an event to the picture box or the form so you cant click right on the line to move it...here is the code anyway (similar to the above code minus the line1 object)

Public bMovingSeparator As Boolean
Public lToolbarHeight As Long

Private Sub MDIForm_Load()
lToolbarHeight = 500

MDIForm_Resize
End Sub

Private Sub MDIForm_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Y < 50 Then
bMovingSeparator = True
End If
End Sub

Private Sub MDIForm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bMovingSeparator Then
lToolbarHeight = lToolbarHeight + Y
MDIForm_Resize
End If
End Sub

Private Sub MDIForm_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
bMovingSeparator = False
End Sub

Private Sub MDIForm_Resize()
Static bAlreadyHere As Boolean

If bAlreadyHere Then Exit Sub
bAlreadyHere = True

Picture1.Height = lToolbarHeight

bAlreadyHere = False

End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Y > lToolbarHeight - 100 Then
bMovingSeparator = True
End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bMovingSeparator And Y > 0 Then
lToolbarHeight = Y
MDIForm_Resize
End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
bMovingSeparator = False
End Sub

trillo

I don't know why but I read MDI form, but thaught on a MDI child..... anyway, Sorry... and sorry for everyone that loads this page has to load also a lot of bytes extra.
I tested the code from TDragon, and didn't work (maybe I did something wrong), that's why I now post my proposal.

Create a MDIForm with a picturebox( Picture1)... (with it's default Align Top property set) and paste this code.... I did it and it worked fine, as you see, it's very easy
--------------Begin of code-------------
Dim CanDrag As Boolean

Private Sub MDIForm_Load()
CanDrag = False
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (Picture1.Height - Y) < 150 Then CanDrag = True
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If CanDrag = True Then Picture1.Height = Y
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
CanDrag = False
End Sub
----------------End of code---------------

I hope this time it's OK.....

Trillo

team_idc

ASKER

Could someone please show me how to make it work but
for the width.

What I mean is that your examples are for a horizontal
picture.
My picture is vertical and on the left side of the MDI Form.

Thank you.

trillo

This will work for a vertical picturebox on the left side

-----------Begin of code---------
Dim CanDrag As Boolean

Private Sub MDIForm_Load()
CanDrag = False
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (Picture1.Width - X) < 150 Then CanDrag = True
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If CanDrag = True Then Picture1.Width = X
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
CanDrag = False
End Sub
------------End of code--------------

Trillo

team_idc

ASKER

The picture is on the RIGHT side.
Above code has weird effect on RIGHT side, but works for
the left side.

Mirkwood

Bought This Question.