Hola, eh intentado crear un tilemap y lo eh conseguido (Dejo el Código)

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Const SRCERASE = &H440328
Private Const SRCINVERT = &H660046
Private Const SRCPAINT = &HEE0086
Private Const SRCAND = &H8800C6
Private Const CLR_WATER = &HFF
Private Const CLR_GRASS = &HFF00
Private Const CLR_DIRT = &HC0C000
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
 
 
Public Sub DibujarMapa()
 
 
 
 
For y = 0 To 15
For x = 0 To 15
 
z = GetPixel(Form1.Picture2.hdc, x, y)
Debug.Print z
 
Select Case z
 
 
    Case RGB(0, 0, 255)
 
        EsAgua x * 32, y * 32
 
 
    Case RGB(128, 128, 128)
 
        EsCamino x * 32, y * 32
 
 
    Case RGB(0, 255, 0)
 
        EsLlegada x * 32, y * 32
 
End Select
 
Next x
Next y
 
End Sub
Sub EsAgua(x, y)
 
 
BitBlt Form1.Render.hdc, x, y, 32, 32, Form1.pic(0).hdc, 0, 0, SRCCOPY
 
 
 
End Sub
Sub EsLlegada(x, y)
 
 
BitBlt Form1.Render.hdc, x, y, 32, 32, Form1.pic(1).hdc, 0, 0, SRCCOPY
 
End Sub
Sub EsCamino(x, y)
 
 
 
BitBlt Form1.Render.hdc, x, y, 32, 32, Form1.pic(2).hdc, 0, 0, SRCCOPY
 
End Sub
 

Y Funciona muy Bien (Les dejo una Foto)



(Si se dan Cuenta, lo que hace es Leer Pixel x Pixel la imagen del picture 2, y depende a que pixel sea, Carga una textura.)

Bien, pero Ahora mi Duda:

¿Como Hago para hacer una especie de Parallax Scrolling? Porque de esta manera solo estaria limitando al mapa a ese tamaño que ustedes ven ):?

Bien, espero que me puedan ayudar, y gracias de AnteMano

Hola Gente, Algien tiene el juego del laberinto de MCKSys Argentina  o el mismo MCKSys Argentina  si visita el thread xD.

Necesito el codigo que se me ocurrio una idea y justo en ese juegito estaba.!!

Bueno. desde ya gracias

Hola! Como andan?

Bueno, mi problema es que quiero rellenar los campos de esta pagina:

http://www.radiosabalera.com.ar/sms/

Eh Intentado con este Codigo:

En el Evento Click del Command 1:

Me.WebBrowser1.Document.Forms(0).numtel.Value = Text1
Me.WebBrowser1.Document.Forms(0).mensaje.Value = Text2
Me.WebBrowser1.Document.Forms(0).remitente.Value = Text3
Me.WebBrowser1.Document.Forms(0).submit

En el Evento Load_Form:

WebBrowser1.Navigate "http://www.radiosabalera.com.ar/sms/"

Pero no tira error, pero tampoco pasa nada :S Una Idea como para que andE?

Hola, quisiera crear un archivo excel de solo lectura, pero los datos serian los que estan en un listbox, nada de bases de datos y eso ... 

Hola, yo tengo un Txt asi miren;

00000
00010
10000
00100
00000

Cada numerito representaria un tile

Bueno, el 0 Representaria que el Personaje puede caminar, y el 1 significa que esta bloqueado, osea que no puede caminar.

Bien, ahora, el problema, soy bastante principiante en esto, y tengo entendido que se podria hacer con una matriz bidimencional, pero nose ni por donde empezar ;S

lo que querria hacer es leer el .txt y si dice 1, el personaje no puede avanzar.

El personaje ya lo programe, lo que quisiera es que lea linea x linea y si dice 1 que el personaje no pueda avanzar, lo que nose como seria para bloquear.

Desde ya muchas Gracias

Hola, Alguien se le ocurre una manera de Silenciar un Webbrowser?

Puse este Codigo pero no anda 

Private Sub Command1_Click()
WebBrowser1.Silent = True
End Sub
 
Private Sub Command2_Click()
WebBrowser1.Silent = False
End Sub

Desde ya muchas gracias

Como Verán, lo que quiero hacer es que si en txtlog(label) el caption dice "Arriba" x ejemplo se presione VbKeyUp

Me dan Alguna idea o corregirme este código? (Se me Ocurrio a mi de esa Manera, pero no anda :S)

Código:

Const KEYEVENTF_KEYUP = &H2
Const KEYEVENTF_EXTENDEDKEY = &H1
 
 
 
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)
 
Sub Pulsar_Tecla(Tecla As Long)
 
    Call keybd_event(Tecla, 0, 0, 0)
 
    Call keybd_event(Tecla, 0, KEYEVENTF_KEYUP, 0)
 
End Sub
 
Private Sub AbajoT_Timer()
Call Pulsar_Tecla(vbKeyDown)
End Sub
 
Private Sub ArribaT_Timer()
Call Pulsar_Tecla(vbKeyUp)
End Sub
 
Private Sub bntListen_Click()
On Error GoTo errorSub
 
    With Winsock1
        .Close
        .LocalPort = txtPort
        .Listen
    End With
 
Exit Sub
errorSub:
MsgBox "Error : " & Err.Description, vbCritical
End Sub
 
Private Sub bntSend_Click()
On Error GoTo errorSub
 
    Winsock1.SendData txtSend
 
    txtlog = txtlog & "Servidor : " & txtSend & vbCrLf
    txtSend = ""
 
Exit Sub
errorSub:
MsgBox "Error : " & Err.Description
 
Winsock1_Close
End Sub
 
 
Private Sub DerechaT_Timer()
Call Pulsar_Tecla(vbKeyRight)
End Sub
 
Private Sub Form_Load()
 
Call bntListen_Click
 
AbajoT.Enabled = False
ArribaT.Enabled = False
DerechaT.Enabled = False
IzquierdaT.Enabled = False
 
If txtlog.Caption = "Abajo" Then
AbajoT.Enabled = True
ArribaT.Enabled = False
DerechaT.Enabled = False
IzquierdaT.Enabled = False
End If
 
If txtlog.Caption = "Arriba" Then
AbajoT.Enabled = False
ArribaT.Enabled = True
DerechaT.Enabled = False
IzquierdaT.Enabled = False
End If
 
If txtlog.Caption = "Derecha" Then
AbajoT.Enabled = False
ArribaT.Enabled = False
DerechaT.Enabled = True
IzquierdaT.Enabled = False
End If
 
If txtlog.Caption = "Izquierda" Then
AbajoT.Enabled = False
ArribaT.Enabled = False
DerechaT.Enabled = False
IzquierdaT.Enabled = True
End If
 
End Sub
 
Private Sub IzquierdaT_Timer()
Call Pulsar_Tecla(vbKeyLeft)
End Sub
 
Private Sub Winsock1_Close()
    ' Finaliza la conexión
    Winsock1.Close
 
    txtlog = txtlog & "*** Desconectado" & vbCrLf
 
End Sub
 
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
 
    If Winsock1.State <> sckClosed Then
        Winsock1.Close ' close
    End If
 
    Winsock1.Accept requestID
 
    txtlog = "Cliente conectado. IP : " & _
              Winsock1.RemoteHostIP & vbCrLf
 
 
 
End Sub
 
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim dat As String
 
    Winsock1.GetData dat, vbString
    txtlog = dat & vbCrLf
 
 
 
 
End Sub
 
' cuando se produce un error lo envía
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Winsock1_Error(ByVal Number As Integer, _
                           Description As String, _
                           ByVal Scode As Long, _
                           ByVal Source As String, _
                           ByVal HelpFile As String, _
                           ByVal HelpContext As Long, _
                           CancelDisplay As Boolean)
 
    txtlog = txtlog & "*** Error : " & Description & vbCrLf
 
    Winsock1_Close
 
End Sub

Gracias de Antemano

Tengo un problema, yo estaba haciendo un programita que le envie a mi NOTBUK que teclas estoy apretando (Arriba,Abajo,Derecha,Izquierda) probé poniendo la IP de mi notbuk y no funciona. Después puse la ip de mi pc fija y tampoco anda y más tarde puse 127.0.0.1 y tampoco :S.

Les dejo los Codigos del cliente y Servidor:

CLIENTE:

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vbkey As Long) As Integer
 
Private Sub Form_Load()
With Winsock1
        .Close
        .RemoteHost = "127.0.0.1" ' También probe poniendo "localhost"
        .RemotePort = "1660"
        .Connect
    End With
 
    Winsock1.SendData Label1
 
End Sub
 
Private Sub Timer1_timer()
 
 
 
Dim i As Integer
'
For i = 8 To 222
 
x = GetAsyncKeyState(i)
 
If x = -32767 Then
 
Select Case i
Case vbKeyLeft: Label1.Caption = "Izquierda"
Case vbKeyUp: Label1.Caption = "Arriba "
Case vbKeyDown: Label1.Caption = "Abajo"
Case vbKeyRight: Label1.Caption = "Derecha"
End Select
 
End If
Next
End Sub
 

SERVIDOR:

Private Sub Form_Load()
With Winsock1
        .Close
        .LocalPort = "1660"
        .Listen
    End With
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim dat As String
 
    Winsock1.GetData dat, vbString
    Label1 = dat & vbCrLf
 
End Sub

Espero que me puedan ayudar.

Hola, como dice el titulo quisiera que me expliquen como puedo hacer Drag & Drop, pero no cualquiera,quisiera que lo haga de un Picturebox hasta una cuadricula dibujada con lineas (Ver Imagen)



Como ven, quisiera que el picture que tiene cargada una Imagen verde copie esa Imagen al cuadrado que dibujé(Está Señalado con una Flecha, igual es un ejemplo, quisiera hacerlo con todos los cuadrados que quiera  ).

Si precisan el codigo de como dibujé los cuadrados se los paso:

Sub Dibujar_cuadricula( _
    Objeto As Object, _
    CountX As Single, _
    CountY As Single, _
    Optional x_Color As Long = vbBlack, _
    Optional y_Color As Long = vbBlack)
 
    Dim i As Integer
    Dim mx As Long
    Dim my As Long
 
    ' limpiar objeto
    Objeto.Cls
 
    mx = CLng(Objeto.ScaleWidth / CountX)
    my = CLng(Objeto.ScaleHeight / CountY)
 
 
    Objeto.ForeColor = x_Color
 
 
    For i = 0 To CountX
        Objeto.Line (i * mx, 0)-(i * mx, Objeto.ScaleHeight)
    Next i
 
    Objeto.ForeColor = y_Color
 
 
    For i = 0 To CountY
        Objeto.Line (0, i * my)-(Objeto.ScaleWidth, i * my)
    Next i
 
End Sub
 
 
Private Sub Form_Load()
 
With Picture1
.BackColor = vbWhite
.ForeColor = vbBlue
.FontSize = 12
.AutoRedraw = True
End With
' la cuadricula (osea los cuadraditos las dibuja en un picture grande (picture1 xd)
Call Dibujar_cuadricula(Picture1, 15, 15, vbRed, vbRed)
 
End Sub
 

PD: Para mi abria que hacer como algo para que cada cuadrado simule un CONTROL  (igual ni idea yo :S)

Hola, como dice el titulo alguien conoce un manual de esta dll que te permite crear juegos 2d?

O expliquenmen poniendo codigos  de ejemplo nose, la verdad que investigue sobre la dll y me intereso mucho, pero no encontre ni un manual.

GRacias de antemano