Mensajes

Otra opción.

Código [Seleccionar] Expandir


Sub MidScreenClick()
  Call SendMessage(WindowFromPoint(MidScreenX, MidScreenY), WM_LBUTTONDOWN, ByVal 0&, ByVal 0&)
  Call SendMessage(WindowFromPoint(MidScreenX, MidScreenY), WM_LBUTTONUP, ByVal 0&, ByVal 0&)
End Sub


Código [Seleccionar] Expandir


Property Get MidScreenX()As Long
  MidScreenX = (Screen.Width / Screen.TwipsPerPixelX) / 2
End Sub

Property Get MidScreenY()As Long
  MidScreenY = (Screen.Height / Screen.TwipsPerPixelY) / 2
End Sub


Cierto, es que fue copy paste del code anterior casi. Crea una variable iCnt y aumentala en 1 cada iteracción de bucle.

Código [Seleccionar] Expandir


     Dim iCnt%

  ...

  For ... ....
    btData(iCnt)= ....
    iCnt=iCnt+1
  Next
  ...


Código [Seleccionar] Expandir


Function RegWriteBin(ByVal Data As String) As Boolean
  On Error Resume Next
 
      Dim btData() As Byte
      Dim hKey&, r&
      Dim i&

  Data = Replace$(Data, " ", vbNullString)

  If (Len(Data) Mod 2) <> 0 Then Data = Data & "0"

  r = RegCreateKeyEx(HKEY_LOCAL_MACHINE, "Software\MyApp\", 0&, vbNullString, _
                     0&, KEY_ALL_ACCESS, 0&, hKey, REG_CREATED_NEW_KEY)

  If r = ERROR_SUCCESS Then
    ReDim btData(Len(Data) \ 2) As Byte
   
    For i = 1 To (Len(Data) \ 2) Step 2
      btData(i) = Val("&H" & Mid$(Data, i, 2))
    Next
   
    r = RegSetValueEx(hKey, "MyBinValue", 0&, REG_BINARY, btData(0), Len(Data) \ 2)
    r = RegCloseKey(hKey)
   
    RegWriteBin = (r = ERROR_SUCCESS)
  End If
End Function


Pensé que usabas los espacios (01 00 14 80 90)

Código [Seleccionar] Expandir


Function RegReadBin() As String
      Dim btData() As Byte
      Dim lBufferLen&, i&
      Dim hKey&, r&

  r = RegCreateKeyEx(HKEY_LOCAL_MACHINE, "Software\MyApp\", 0&, vbNullString, _
                     0&, KEY_ALL_ACCESS, 0&, hKey, REG_CREATED_NEW_KEY)

  If r = ERROR_SUCCESS Then
    lBufferLen = 2048
   
    ReDim btData(lBufferLen) As Byte
   
    sData = String$(lBufferLen, 0)
   
    r = RegQueryValueExByte(hKey, "MyBinValue", 0&, REG_BINARY, btData(0), lBufferLen)
   
    If r = ERROR_SUCCESS Then
      RegReadBin = Left$(StrConv(btData, vbUnicode), lBufferLen)
    End If
 
    r = RegCloseKey(hKey)
 
  End If
End Function


Código [Seleccionar] Expandir


Function RegWriteBin(ByVal Data As String) As Boolean
      Dim btData() As Byte
      Dim sChar$(), i&
      Dim hKey&, r&

  r = RegCreateKeyEx(HKEY_LOCAL_MACHINE, "Software\MyApp\", 0&, vbNullString, _
                     0&, KEY_ALL_ACCESS, 0&, hKey, REG_CREATED_NEW_KEY)

  If r = ERROR_SUCCESS Then
    sChar = Split(Data, " ")
    ReDim btData(UBound(sChar)) As Byte
   
    For i = 0 To UBound(sChar) - 1
      btData(i) = Val("&H" & sChar(i))
    Next
   
    r = RegSetValueEx(hKey, "MyBinValue", 0&, REG_BINARY, btData(0), UBound(sChar))
    r = RegCloseKey(hKey)
   
    RegWriteBin = (r = ERROR_SUCCESS)
  End If
End Function


Código [Seleccionar] Expandir


Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, ByVal lpdwDisposition As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Byte, ByVal cbData As Long) As Long

Function RegWriteBin(ByVal Data As String) As Boolean
      Dim btData() As Byte
      Dim hKey&, r&

  btData = StrConv(Data, vbFromUnicode)
 
  r = RegCreateKeyEx(HKEY_LOCAL_MACHINE, "Software\MyApp\", 0&, vbNullString, _
                     0&, KEY_ALL_ACCESS, 0&, hKey, REG_CREATED_NEW_KEY)

  If r = ERROR_SUCCESS Then
    r = RegSetValueEx(hKey, "MyBinValue", 0&, REG_BINARY, btData(0), Len(Data))
    r = RegCloseKey(hKey)
   
    RegWriteBin = (r = ERROR_SUCCESS)
  End If
End Function


Bueh no pensaba postear más pero los desafíos me gustan xD, y pensé que era más dificil esto pero la verdad que el algoritmo es más simple de lo que creía -_-

No lo terminé completo porque esto suena a tarea del colegio y no quiero ayudar a la pereza, pero con esta base es más que suficiente. Lo único que falta es agregar los números aleatorios y comprobar que no se repitan números en regiones, que también es muy sencillo.

Para implementar este ejemplo se necesita lo siguiente:

Un formulario con las siguientes propiedades:

BorderStyle = 0 (None)
KeyPreview = True
ShowInTaskBar = True


Un cuadro de texto con las siguientes propiedades:

Nombre: txtNum
Index = 0
Appearance = 0 (Flat)


Luego sólo peguen el siguiente código en el formulario y voilà. Por cierto, dije que el código era de ejemplo por lo que debería estar lo más reducido posible, pero le agregué un par de elementos visuales para mejorar la interfaz, así que aumentó un poco, pero en sí el algoritmo de comprobación es la función RightValue.

Screenshot:

Código [Seleccionar] Expandir


Option Explicit

Private iCurCol   As Integer
Private iCurLin   As Integer
Private iCurIndex As Integer

Private sLastVal As String

Sub LoadInterface()
      Dim snLeft!, snTop!
      Dim iAddH%, iAddY%
      Dim iLin%, i%

  For i = 1 To 80
    If (i Mod 9) = 0 Then
      iLin = iLin + 1
    End If
   
    Call Load(txtNum(i))
   
    With txtNum(i)
      If (i Mod 3) = 0 Then
        iAddH = (10 * (i Mod 9))
      End If
     
      If (iLin Mod 3) = 0 Then
        iAddY = (10 * (iLin Mod 9))
      End If
     
      snLeft = (.Width * (i Mod 9)) + iAddH
      snTop = iLin * .Height + iAddY
     
      Call .Move(snLeft, snTop)
     
      .Visible = True
    End With
  Next
 
  Width = txtNum(0).Width * 9 + iAddH
  Height = Width
End Sub

Function RightVal(ByVal Col As Integer, ByVal Lin As Integer, ByVal Index As Integer, ByVal Value As Integer) As Boolean
          Dim iIndex%, i%
          Dim iSelIndex%
          Dim iVal%

  iIndex = Index
 
  If (iIndex Mod 9) > 0 Then
    Do While ((iIndex Mod 9) <> 0)
      iIndex = iIndex - 1
    Loop
  End If
 
  For i = iIndex To iIndex + 8
    If txtNum(i) <> vbNullString Then
      If (Val(txtNum(i)) = Value) And (i <> Index) Then
        Exit Function
      End If
    End If
  Next
 
  For i = 0 To 8
    iSelIndex = (i * 9) + Col
   
    If txtNum(iSelIndex) <> vbNullString Then
      If Val(txtNum(iSelIndex)) = Value And (iSelIndex <> Index) Then
        Exit Function
      End If
    End If
  Next
 
  RightVal = True
End Function

Sub HighlightLin(ByVal Col As Integer, ByVal Lin As Integer, ByVal Index As Integer)
          Dim iIndex%, i%
          Dim iSelIndex%
          Dim iVal%

  iIndex = Index
 
  If (iIndex Mod 9) > 0 Then
    Do While ((iIndex Mod 9) <> 0)
      iIndex = iIndex - 1
    Loop
  End If
 
  For i = 0 To 80
    txtNum(i).BackColor = vbWindowBackground
  Next
 
  For i = iIndex To iIndex + 8
    txtNum(i).BackColor = vbCyan
  Next
 
  For i = 0 To 8
    iSelIndex = (i * 9) + Col
    txtNum(iSelIndex).BackColor = vbCyan
  Next
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyEscape Then End
End Sub

Private Sub Form_Load()
  txtNum(0) = vbNullString
  Call txtNum(0).Move(0, 0, 360, 360)
  BackColor = 0
 
  Call LoadInterface
End Sub

Private Sub txtNum_GotFocus(Index As Integer)
  txtNum(Index).SelStart = 0
  txtNum(Index).SelLength = Len(txtNum(Index))
 
  iCurIndex = Index
  iCurCol = (iCurIndex Mod 9)
  iCurLin = (iCurIndex \ 9)
 
  Call HighlightLin(iCurCol, iCurLin, iCurIndex)
 
  sLastVal = txtNum(Index)
End Sub

Private Sub txtNum_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
  On Error Resume Next
 
  Select Case KeyCode
    Case vbKeyUp:     Call txtNum(Index - 9).SetFocus
    Case vbKeyDown:   Call txtNum(Index + 9).SetFocus
    Case vbKeyLeft:   Call txtNum(Index - 1).SetFocus
    Case vbKeyRight:  Call txtNum(Index + 1).SetFocus
  End Select
End Sub

Private Sub txtNum_LostFocus(Index As Integer)
        Dim i%
       
  If txtNum(Index) = vbNullString Then Exit Sub
 
  iCurCol = (iCurIndex Mod 9)
  iCurLin = (iCurIndex \ 9)
 
  If Not RightVal(iCurCol, iCurLin, iCurIndex, Val(txtNum(Index))) Then
    Call MsgBox("El número ingresado no es correcto", vbExclamation)
   
    txtNum(Index) = sLastVal
  Else
    For i = 0 To 80
      If txtNum(i) = vbNullString Then Exit Sub
    Next
   
    Call MsgBox("Felicitaciones, ganaste!!", vbExclamation)
    Call Clipboard.SetData(Image, vbCFBitmap)
  End If
End Sub


Otra cosa, no se necesita nada de IA, esto es lógica xD, ya dejen de decir pendejadas, si no saben cómo hacer algo no inventen ni respondan para aumentar el nº de post.

Cualquier duda consulte a su médico porque en este foro no soy bienvenido xD.

Saludos.