Problemas con Picturebox

[fallen61]

Amigos, tengo un Picturebox, el cual al insertar una imagen quiero que me la centre o me la achique con respecto al Picturebox. El problema es que quiero achicar concretamente la imagen y no que cambie de tamaño el picturebox. Hay algun comando para hacerlo?
Trate de hacerlo con el stretch, pero segun vi, el stretch funciona con Imagenes (Imagen1). Y el autosize me cambie el tamaño del Picturebox...

Como puedo hacer para que me autoajuste la imagen sin necesidad de cambiar mi picturebox?

[truskyvb]

Lo encontré hace tiempo y creo que hace lo que necesitas.
Espero que te sirva.

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.

#If Win32 Then

'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)

#Else

'WinAPI RECT for ClipCursor().
Private Type RECT
x1 As Integer
y1 As Integer
x2 As Integer
y2 As Integer
End Type

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

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

#End If

'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%

[truskyvb]

Segunda parte:

Private Sub Form_Load()

'Set form ScaleMode to pixels.
Hotspot.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

[truskyvb]

Y tercera y última parte del código:

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)

'USE: Return the smaller of two integers.

If (u < v) Then
Min = u
Else
Min = v
End If

End Function

Private Function Max(ByVal u, ByVal v)

'USE: Return the larger of two integers.

If (u < v) Then
Max = v
Else
Max = u
End If

End Function


Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub mnuAbout_Click()

'Show About Box.
frmAbout.Show vbModal

End Sub


Private Sub mnuExit_Click()
End
End Sub

[pkj]

No me paro a mirarlo, pero imagino que si sirve, el método de truskyvb será más completo que el mio.
Sin embargo para solo mostrar imagenes stretchadas en picturebox mi sistema es algo más cómodo.

Se usa asi:
Una vez cargada la imagen en el picture (Picture1)...
StretcheaPictureBox Picture1

Código vb:

Sub StretcheaPictureBox(ControlPictureBox As PictureBox)
  ' ESTA SUB NO SE PUEDE LLAMAR DESDE UN EVENTO RESIZE O NO SE DEJARÁ ELIMINAR EL PICTEMPORAL
  Dim PicTemp As VB.PictureBox
  On Local Error Resume Next
  Set PicTemp = ControlPictureBox.Container.Controls.Add("VB.PictureBox", "PicTempStretcheaPictureBox", ControlPictureBox.Container)
  PicTemp.AutoSize = True
  PicTemp.Picture = ControlPictureBox.Picture
  ControlPictureBox.AutoRedraw = True
  ControlPictureBox.PaintPicture PicTemp.Picture, 0, 0, ControlPictureBox.ScaleWidth, ControlPictureBox.ScaleHeight, _
  0, 0, PicTemp.ScaleWidth, PicTemp.ScaleHeight
  
  ' ESTA SUB NO SE PUEDE LLAMAR DESDE UN EVENTO RESIZE O NO SE DEJARÁ ELIMINAR EL PICTEMPORAL (AQUI)
  ControlPictureBox.Container.Controls.Remove ("PicTempStretcheaPictureBox")
End Sub
 

Como podeis leer, esta sub no se debe llamar desde el evento resize del form. Si tienes que resizar y "re-stretchear" los pictures al cambiar de tamaño el formulario, pon un timer que los stretchee y lo activas al finalizar el evento resize para que se haga despues de salir de el.

Saludos

[fallen61]

Solucionado...
Agregue este codigo al Load, mas las barras de movimiento horizontales y verticales:


Private Sub mnuInsertimage_Click()
Picture2.Picture = LoadPicture

With CommonDialog1

.Filter = "BMP|*.bmp|JPG|*.JPG|GIF|*.GIF"
.DialogTitle = " seleccionar el mapa de bits para cragr en el Picture "
.ShowOpen

If .FileName = "" Then Exit Sub

'Carga la imagen el control Picture
Picture2.Picture = LoadPicture(.FileName)

End With
' -- Cargar imagen
With CommonDialog1

.ShowOpen
If .FileName = "" Then Exit Sub
Picture2.Picture = LoadPicture(.FileName)
End With

' -- Establecer los valores Min y Max a las barras
VScroll1.Value = 0
VScroll1.Max = Picture2.Height - Picture1.Height
HScroll1.Value = 0
HScroll1.Max = Picture2.Width - Picture1.Width

Call VScroll1_Scroll
Call HScroll1_Scroll

VScroll1.LargeChange = Picture2.Height \ 10
HScroll1.LargeChange = Picture2.Width \ 10
VScroll1.SmallChange = Picture2.Height \ 10
HScroll1.SmallChange = Picture2.Width \ 10

HScroll1.Visible = ((Picture2.Width - VScroll1.Width) > (Picture1.Width))
VScroll1.Visible = (Picture2.Height - HScroll1.Height) > (Picture1.Height)

With VScroll1
.Left = Picture1.Width - .Width - 60
.Top = 0
If HScroll1.Visible Then
.Height = (Picture1.Height - HScroll1.Height) - 60
Else
.Height = (Picture1.Height) - 60
End If
.ZOrder 0
End With

With HScroll1
.Left = 0
.Width = Picture1.Width - 60
.Top = (Picture1.Height - .Height) - 60
.ZOrder 0
End With

End Sub


Codigo de las barras de movimiento:

Private Sub Form_Initialize()
Call SetErrorMode(2)
Call InitCommonControls
End Sub



Private Sub HScroll1_Change()
HScroll1_Scroll
End Sub
Private Sub HScroll1_Scroll()
Picture2.Left = Not HScroll1.Value
End Sub

Private Sub VScroll1_Change()
VScroll1_Scroll
End Sub
Private Sub VScroll1_Scroll()
Picture2.Top = Not VScroll1.Value
End Sub


Gracias igual ^^