Mensajes

Usa geshi hermano:

code=vb

Edito:

Tu código se puede optimizar bastante deja lo recreo a mi manera ( Ya pongo aquí el código):

Temibles unas!¡
.

.
Espero te sirve este codigo que reaize hace tiempo es similar a lo que deseas solo que es una ilera  xP

se nesesta:
1 picturebox llamado PIC con index = 0
1 Timer

En un formulario pegar:

Código (vb) [Seleccionar] Expandir



'
' /////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este Codigo siempre y cuando //
' // no se eliminen los creditos originales de este codigo //
' // No importando que sea modificado/editado o engrandesido //
' // o achicado, si es en base a este codigo es requerido //
' // el agradacimiento al autor. //
' /////////////////////////////////////////////////////////////
'

Option Explicit

Private Declare Function IntersectRect Lib "user32" (lpDestRect As Rect, lpSrc1Rect As Rect, lpSrc2Rect As Rect) As Long
Private Type Rect
    left                As Long
    top                 As Long
    Right               As Long
    Bottom              As Long
End Type
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
    X                   As Long
    Y                   As Long
End Type
'Private Declare Function GetWindowRect Lib "user32"  (ByVal hwnd As Long, lpRect As Rect) As Long
Dim lBtActual           As Integer
Dim By                  As Long
'Dim Bx                  As Long
Const Anchura           As Long = 80
Const Altura            As Long = 20
Const CantZones         As Integer = 10
Dim PostR()             As Rect

Private Sub Form_Load()
Dim i       As Integer
    ReDimPostR (CantZones - 1)
    ScaleMode = 3
   
    For i = 0 To CantZones - 1
        If i > 0 Then
            Load Pic(i)
            Pic(i).Visible = True
        End If
        ' // Estas Son las Regiones
        With PostR(i)
            .left = 25
            If i = 0 Then
                .top = 25
            Else
                .top = PostR(i - 1).Bottom + 25
            End If
            .Right = .left + Anchura
            .Bottom = .top + Altura
        End With
        ' // Posicionamos los Label en las Regiones
        Call PosPic(i)
    Next i
    Timer1.Interval = 20
    Timer1.Enabled = False
End Sub

Private Sub pic_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim PT              As POINTAPI
    PosPic Index ' // Actualizamos la region
    GetCursorPos PT
    ScreenToClient hwnd, PT
    By = PT.Y - Pic(Index).top
    'Bx = PT.X - pic(Index).left
    lBtActual = Index
    Timer1.Enabled = True
End Sub

Private Sub pic_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    PosPic Index ' // Actualizamos la region
    Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
Dim PT                  As POINTAPI
Dim Rect(2)             As Rect
Dim i                   As Integer
Dim AreCambio           As Integer

    GetCursorPos PT
    ScreenToClient hwnd, PT
    With Pic(lBtActual)
        .Visible = True
        '.left = PT.X - Bx
        .top = PT.Y - By
        .Visible = True
    End With
    With Rect(2)
        ' // Calculamos el Area de Cambio
        AreCambio = (Altura / 2) - IIf(Altura < 10, 0, 10)
        .top = Pic(lBtActual).top + AreCambio
        .left = Pic(lBtActual).left
        .Right = Pic(lBtActual).left + Pic(lBtActual).Width
        .Bottom = Pic(lBtActual).top + Pic(lBtActual).Height - AreCambio
    End With
    For i = 0 To CantZones - 1
        If lBtActual <> i And _
            IntersectRect(Rect(0), Rect(2), PostR(i)) Then
            Rect(0) = PostR(lBtActual) ' // Hacemos un Respaldo
            PostR(lBtActual) = PostR(i)
            PostR(i) = Rect(0)
            Call PosPic(i)
            Call PosPic(lBtActual)
            Exit For
        End If
    Next i
End Sub

Private Sub PosPic(ByVal i As Integer)
    With Pic(i)
        .left = PostR(i).left
        .BackColor = RGB(255 / (i + 1), 255 / (i + 1), 255 / (i + 1))
        If i = 0 Then
            .top = PostR(i).top
        Else
            .top = PostR(i).top
            .top = .top
        End If
        .Width = PostR(i).Right - PostR(i).left
        .Height = PostR(i).Bottom - PostR(i).top
    End With
End Sub



Temibles Lunas!¡.
.

[getcursosPos]

.
Espero que no busques códigos por que solo te soltare una idea

Yo en lugar de mover el picturebox dibujaría el contenido de este en las coordenas propuestas con el api BitBlt() teniendo el autoredraw=true para que no se borre el DC del control

Edito:
Tambien usa lo que es getcursosPos y ScreenToClient para que se te facilite el Drag &Drop

y por ultimo

IntersectRect para verificar la coordenada con respecto en las celdas para ver donde dibujar con el api BitBlt.


Nota: usa la estructura RECT si usas mi idea se te facilitara.

temibles Lunas!¡.
.

[tanto así que no te diste ni cuentaq ue el codigo que estabas usando era para poner la imagen a blanco y negro jojojo]

NsTeam si sabes leer y por que he visto estas usando el codigo

Convert Image to Dithered Black and White (1-bit)

te dice algo?, porque crees que pierden os colores? ¬¬"

mejor usa el otro

Convert Pic to Toon

por que tus preguntas se resuelven leyendo  y no con Copy And Paste que por lo visto solo eso haces ¬¬".

Temibles Lunas!¡.
.

Copy And Paste ??

creo q estas equivocado man

porque yo tamb le agrego algunas funciones

tanto así que no te diste ni cuentaq ue el codigo que estabas usando era para poner la imagen a blanco y negro jojojo

Date una vuelta por aca...

http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=24962&lngWId=1

http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=71920&lngWId=1

Cualquier cosa postea...!

gracias

el resultado qe tube fue este xD



cuando lo guardaba de photoshop la IMG no perdia sus colores

NsTeam si sabes leer y por que he visto estas usando el codigo

Convert Image to Dithered Black and White (1-bit)

te dice algo?, porque crees que pierden os colores? ¬¬"

mejor usa el otro

Convert Pic to Toon

por que tus preguntas se resuelven leyendo  y no con Copy And Paste que por lo visto solo eso haces ¬¬".

Temibles Lunas!¡.
.

[Private Sub cmdBuscar_Click()]

a mi me a gustado aun que le quite el botón ver por que me molestaba estar cambiando y dando click a dicho boton para ver mi horóscopo, le puse la acción de que se visualice el horóscopo 'X' con girar la scroll del mouse o al secionar el horóscopo solo si esta con el foco en el ComboBox.

Solo modifique estos dos procesos quitando el proceso Private Sub cmdBuscar_Click()

Código (vb) [Seleccionar] Expandir



Private Sub cboSignos_Click()
Static SignoPrev As String
   If Not SignoPrev = cboSignos.Text Then
       Call oHoroscopo.DescripcionSigno(cboSignos.ListIndex)
   
       lblDescripcion.Caption = oHoroscopo.Descripcion
       lblTitulo.Caption = cboSignos.Text
   
       Set picSignos.Picture = oHoroscopo.ImagenSigno
       SignoPrev = cboSignos.Text
   End If
End Sub

Private Sub Form_Load()
   Set oHoroscopo = New cHoroscopo
   
   Call CargarSignos
   Call cboSignos_Click
End Sub



Saludos

Temibles Lunas!¡.
.

Que tal, deseaba saber si alguien tuvo la necesidad de querer controlar el uso de banda ancha de cada pc que existe en una red, es decir por ejemplo en un cyber, hay muchas veces en que una maquina se "come" todo el ancho por que esta viendo 20 videos en youtube, hay alguna manera de limitarlo en ese momento y darle un ancho de por ejemplo 20kb/s  asi evitar que toda la red de 20 maquinas se ponga my lento???

Saludos.

si si la hay y es una configuración de windows deberías pasarte en ese subforo. ya que tu duda no es de VB o si no lo creo?

igual puedes hacer conectarse las pc a un proxy en una PC maestra, pero ojo si limitas seguro se te dan a revuelta y te abandonan el cyber mejor contrata una conexión mas rápida en lugar de ofrecer un servicio pésimo bueno es mi punto de vista¡. este ultimo

lee lo que cite y no hables por hablar ¬¬"

Simon, por eso lo borre... ¬¬

Te estaré vigilando como un sabueso a un hueso AAaa ( jajajaja )

[estaba viendo el code, pero no entiendo cual es de que boton :/]

@ Shell Root
lee lo que cite y no hables por hablar ¬¬"

osea , el primer code borra el contenido de "%temp%" y el segundo, borra la carpeta "%temp%" pero la cosa es q ninguno borra nada  

Acabo de encontrar esto :

http://codigosvisualbasic.com.ar/index.php?s=de9ec0f4edd6400c30b2c7ba01f09220&showtopic=183
estaba viendo el code, pero no  entiendo cual es de que boton :/

Ok? ¬¬"!

.

osea , el primer code borra el contenido de "%temp%" y el segundo, borra la carpeta "%temp%" pero la cosa es q ninguno borra nada  

Acabo de encontrar esto :

http://codigosvisualbasic.com.ar/index.php?s=de9ec0f4edd6400c30b2c7ba01f09220&showtopic=183
estaba viendo el code, pero no  entiendo cual es de que boton :/

me vas a odiar pero lee algo de matriz de controles y sobre el select case en vb6, otra cosa Kill y RMDir Eliminar rutas Explicitas y un solo archivo!¡.

P.D.: para que pones exit sub una linea antes de end sub ¬¬" no tiene caso es código basura ¬¬!

Temibles Lunas!¡.

perdon lo acabe de ediatr es una mal vicio mio siempre se me ocurre engrandeserlo cuando le doy a enviar xP

Temibles unas!¡.
.