Foros del Web » Programación para mayores de 30 ;) » Programación General » Visual Basic clásico »

Cortar una imagen

Estas en el tema de Cortar una imagen en el foro de Visual Basic clásico en Foros del Web. Hola a todos y gracias de antemano por su ayuda. Sucede que necesito cortar una imagen. Específicamente una parte de un picturebox o un image. ...
  #1 (permalink)  
Antiguo 02/12/2010, 17:02
 
Fecha de Ingreso: junio-2008
Mensajes: 17
Antigüedad: 13 años, 1 mes
Puntos: 0
Cortar una imagen

Hola a todos y gracias de antemano por su ayuda.

Sucede que necesito cortar una imagen.
Específicamente una parte de un picturebox o un image.
He logrado copiarlas de un objeto a otro usando el clipboard, pero no la puedo cortar.
Si es necesaria alguna información mas, o las pruebas que he hecho, pero que no logran lo que necesito, las subo inmediatamente.
Desde ya muchas gracias.
Saludos.
  #2 (permalink)  
Antiguo 04/12/2010, 04:29
 
Fecha de Ingreso: junio-2008
Mensajes: 17
Antigüedad: 13 años, 1 mes
Puntos: 0
Respuesta: Cortar una imagen

Hola nuevamente, bueno, veo que no hay ninguna pista, entonces "ampliaré mi declaración"
Esto es lo que he hecho hasta ahora, por supuesto no me funciona.

Código:
Private Const IMAGE_BITMAP = 0
Private Const LR_COPYRETURNORG = &H4
Private Const CF_BITMAP = 2

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, _
                ByVal hMem As Long) As Long
                         
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, _
                ByVal imageType As Long, ByVal newWidth As Long, _
                ByVal newHeight As Long, ByVal lFlags As Long) As Long
                
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long


Private Sub cmdCortar_Click()
On Error Resume Next
Dim hNew As Long
    
    'creo una copia exacta de la imagen
    hNew = CopyImage(Image1.Picture, IMAGE_BITMAP, 160, 125, LR_COPYRETURNORG)
    'abro clipboard
    OpenClipboard Me.hwnd
    'borro clipboard
    EmptyClipboard
    'el picture en el clipboard
    SetClipboardData CF_BITMAP, hNew

    'Tener en cuenta que no tengo que llamar a DeleteObject (hNew)
    'De ahora en adelante, el portapapeles se encarga del mapa de bits
    
    'cierro clipboard
    CloseClipboard

    'traigo el picture desde el clipboard   funciona bien
    Image2.Picture = Clipboard.GetData(vbCFBitmap)
    'directamente desde un copyimage no funciona

'este ok
  With Picture1
   'o a un pitruebox 
   .Picture = Clipboard.GetData(vbCFBitmap)
    .PaintPicture .Image, t, l, .Width, .Height, , , .Width - t, .Height + l
    
    Image2.Picture = .Picture
    
  End With

Exit Sub
'esto es lo que he querido hacer, modificando los valores de un paintpicture
'a un picturebox o también directamente al form, pero no me funciona
'los valores t y l se modifican al mover la foto bajo un cuadrado (shape)

'orig     Form1.PaintPicture Image1.Picture, 0, 0, 1980, 1890, Image1.Top + t, Image1.Left + l, 1890, 1890
 X2 = 15730
 Y2 = 15150
 h2 = Image1.Height
 w2 = Image1.Width
 Form1.PaintPicture Image1.Picture, 0, 0, 1980, 1890, X2, Y2, h2, w2
 
 
'orig P    icture1.PaintPicture Image1.Picture, 0, 0, 1980, 1890, Image1.Top + t, Image1.Left + l, 1890, 1890
 Picture1.PaintPicture Image1.Picture, 0, 0, 1980, 1890, X2, Y2, h2, w2
 
 
 Image2.Picture = Picture1.Image
 Image2.Refresh
 
 'Picture1.Picture = Form1.Picture
 
End Sub

Private Sub cmdFlecha_Click(Index As Integer)
Dim t As Integer, l As Integer
On Error Resume Next

'en realidad el cuadrado queda quieto y la foto se mueve debajo de él
   Select Case Index
     Case 0
       Image1.Top = Image1.Top + 100
       t = t + 100
     Case 1
       Image1.Top = Image1.Top - 100
       t = t - 100
     Case 2
       Image1.Left = Image1.Left + 100
       l = l + 100
     Case 3
       Image1.Left = Image1.Left - 100
       l = l - 100
   End Select
 

End Sub

Private Sub Form_Load()
On Error Resume Next
Dim foto As String
'D1 es un commondialog

            D1.CancelError = True
            D1.ShowOpen
            If Err.Number = 0 Then
              Err.Clear
              foto = D1.FileName
              'P1.Picture = LoadPicture(foto)
                            
              Image1.Picture = LoadPicture(foto)
              
            End If
              
End Sub
Bueno, mil disculpas, como ven, todo muy desprolijo, pero es que ya he hecho mil pruebas, tengo tres formularios mas, uno usando

Código:
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, _
                ByVal imageType As Long, ByVal newWidth As Long, _
                ByVal newHeight As Long, ByVal lFlags As Long) As Long
tampoco lo logro, otro usando (tratando de usar)

Código:
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetRectEmpty Lib "user32" (lpRect As RECT) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function IsRectEmpty Lib "user32" (lpRect As RECT) As Long
Private Declare Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long
Private Declare Function GetRgnBox Lib "gdi32" (ByVal hRgn As Long, lpRect As RECT) As Long
para tratar de cortar un rectángulo a la foto, pero tampoco lo logro.

Un tercero, tratando de copiar unos bits menos usando:

Código:
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
pero tampoco doy en el clavo...

Bueno, hasta aquí, si es necesario que les muestre lo que he hecho en cada caso, a su disposición.

Saludos cordiales.
  #3 (permalink)  
Antiguo 04/12/2010, 08:43
Avatar de pkj
pkj
 
Fecha de Ingreso: julio-2006
Ubicación: Órbita sincrónica
Mensajes: 899
Antigüedad: 15 años
Puntos: 29
Respuesta: Cortar una imagen

He encontrado este código que te muestra como cortar o copiar parte de una imagen de un picturebox. Quizá te ayude.

http://www.recursosvisualbasic.com.a...tar-imagen.htm

Yo he separado esta parte y he creado una sub como ejemplo.
Esta sub, en teoria (no la he probado por separado), copia un trozo de un picture a otro:

Código vb:
Ver original
  1. Sub CopiarPicToPic(PicOrigen As PictureBox, PicDestino As PictureBox, ByVal x1 As Single, ByVal x2 As Single, ByVal y1 As Single, ByVal y2 As Single)
  2.        
  3.         PicDestino.Cls
  4.         DoEvents
  5.        
  6.         PicDestino.Width = Abs(x1 - x2)
  7.         PicDestino.Height = Abs(y1 - y2)
  8.    
  9.         If x1 < x2 And y1 < y2 Then
  10.             DoEvents
  11.            
  12.             PicDestino.PaintPicture PicOrigen.Picture, 0, 0, _
  13.                                                  Abs(x2 - x1), Abs(y2 - y1), _
  14.                                                  x1, y1, _
  15.                                                  Abs(x2 - x1), Abs(y2 - y1)
  16.                                                    
  17.         ElseIf x1 > x2 And y1 > y2 Then
  18.             DoEvents
  19.             PicDestino.PaintPicture PicOrigen.Picture, 0, 0, _
  20.                                                  Abs(x1 - x2), Abs(y1 - y2), _
  21.                                                  x2, y2, _
  22.                                                  Abs(x1 - x2), Abs(y1 - y2)
  23.  
  24.        
  25.         ElseIf x1 > x2 And y1 < y2 Then
  26.  
  27.             DoEvents
  28.            
  29.             PicDestino.PaintPicture PicOrigen.Picture, 0, 0, _
  30.                                                 x1 + x2, y1 + y2, _
  31.                                                 x2, y1, _
  32.                                                 x1 + x2, y1 + y2
  33.            
  34.         ElseIf x1 < x2 And y1 > y2 Then
  35.             DoEvents
  36.             PicDestino.PaintPicture PicOrigen.Picture, 0, 0, _
  37.                                                 x1 + x2, y1 + y2, _
  38.                                                 x1, y2, _
  39.                                                 x1 + x2, y1 + y2
  40.         End If
  41.         DoEvents
  42.            
  43. End Sub

Yo me la voy a guardar por ahí por si acaso...

Saludos
__________________
No hay preguntas tontas, solo gente estup..., ¡No!, ¿como era? No hay gente que pregunte a tontos... ¡Nooo!... ¡Vaya cabeza!
  #4 (permalink)  
Antiguo 04/12/2010, 17:41
 
Fecha de Ingreso: junio-2008
Mensajes: 17
Antigüedad: 13 años, 1 mes
Puntos: 0
Respuesta: Cortar una imagen

EXCELENTE pkj, muchas gracias por tu tiempo y por tu precisa respuesta.
Si no lo resuelvo con ese ejemplo al cual haces referencia, ya puedo colgar los botines y dedicarme a la agricultura.
Es precisamente lo que necesitaba.

Saludos cordiales y muchísimas gracias nuevamente.

Etiquetas: cortar
Atención: Estás leyendo un tema que no tiene actividad desde hace más de 6 MESES, te recomendamos abrir un Nuevo tema en lugar de responder al actual.
Respuesta




La zona horaria es GMT -6. Ahora son las 08:32.