Mensajes

no tiene las comprobaciones de si es Par y mayor a 2 y menor a  180 pero bueno eso ya lo tenemos por sabido.

Código (VB) [Seleccionar] Expandir


Private Function Leandro_Cuenta_Circular7913(N&, m() As Integer, TIPO As Boolean)
   Dim Max As Long
   Dim X1 As Long
   Dim X2 As Long
   Dim Y1 As Long
   Dim Y2 As Long
   Dim lCont As Long
   Dim I As Long
   Dim j As Long
   Dim Mitad As Long
   
   
   Max = N * N
   
   ReDim m(0 To N, 0 To N)
   
   If TIPO Then
   
       X2 = N
       Y2 = N

       Do While lCont < Max
           m(X1, Y1) = 7
           X1 = X1 + 1
           For I = X1 To N - X1
               lCont = lCont + 1
               m(I, Y1) = lCont
           Next
           m(I, Y1) = 9
           Y1 = Y1 + 1
           
           For I = Y1 To N - Y1
               lCont = lCont + 1
               m(X2, I) = lCont
           Next
           m(X2, I) = 3
           X2 = X2 - 1
           
           For I = X2 To X1 Step -1
               lCont = lCont + 1
               m(I, Y2) = lCont
           Next
           m(I, Y2) = 1
           Y2 = Y2 - 1
           
           For I = Y2 To Y1 Step -1
               lCont = lCont + 1
               m(X1 - 1, I) = lCont
           Next
       Loop

   Else
   
      Mitad = N / 2
     
      For I = 0 To Mitad - 1
          m(X1, I) = 7
          X1 = X1 + 1
         
          For j = X1 To N - X1
            lCont = lCont + 1
            m(j, I) = lCont
          Next
          m(j, I) = 9
      Next
         
      For I = N To Mitad + 1 Step -1
         
          Y1 = Y1 + 1
         
          For j = Y1 To N - Y1
            lCont = lCont + 1
            m(I, j) = lCont
          Next
          m(j, I) = 3
      Next
         
      For I = N To Mitad + 1 Step -1
         
          Y2 = Y2 + 1
         
          For j = N - Y2 To Y2 Step -1
            lCont = lCont + 1
            m(j, I) = lCont
          Next
          m(j, I) = 1
      Next
     
      For I = 0 To Mitad - 1
     
          X2 = X2 + 1
         
          For j = N - X2 To X2 Step -1
            lCont = lCont + 1
            m(I, j) = lCont
          Next
   
      Next
   
   End If

End Function



Código (VB) [Seleccionar] Expandir


Option Explicit

Private Sub Form_Load()
    Dim X As Long, Y As Long
    Dim m() As Integer
    Dim N As Long
   
    N = 8
     
    Leandro_Cuenta_Circular7913 N, m, False
       
    For Y = 0 To N
        For X = 0 To N
            Debug.Print m(X, Y),
        Next
        Debug.Print
    Next
   
    Debug.Print vbCrLf
    Leandro_Cuenta_Circular7913 N, m, True
       
    For Y = 0 To N
        For X = 0 To N
            Debug.Print m(X, Y),
        Next
        Debug.Print
    Next

End Sub


Muy bueno Black va tomando color, lo probe hay algunas sugerencias que he notado, que bueno seguramente ya las iras corrigiendo.

-la seleccion Hot deberia desaparecer cuando el muse sale del listview
-deberias poner el cursor (Size W E) cuando te posicionas sobre una columna para modificar su tamaño.
-Soporte para la rueda del Mouse. (aunque veo que aun no estas subclasificando)
-cuando se encuentra escaneando veo que se puede seleccionar donde no hay items, pero esto puede ser que no se refresca a tiempo
-cuando te moves con las flechas (Arriba , Abajo) la selección debería acompañar el ultimo o primer item según el caso.

hay algunas otras pero seguramente ya lo vas abras notado, yo creo que si seguís con este control un buen paso a seguir es implementar los scroll del sistema para no utilizar los controles de vb. son muy complicado este tipo de controles ya que hay muchas cosas a tener en cuenta, pero bueno dale para adelante y felicitaciones nuevamente.

Saludos.

Modifica

Código [Seleccionar] Expandir

Private Type KEYBDINPUT
  wVk As Integer
  wScan As Integer
  dwFlags As Long
  time As Long
  dwExtraInfo As Long
End Type

Private Type GENERALINPUT
  dwType As Long
  xi as KEYBDINPUT '<------ aca
End Type

eso tendria que arreglarlo si solamente queres el keyboard

Hola Cobein probe de esa forma pero no funciono, para que ande tube que agregar ocho byte mas para completar los 24 bytes

Código [Seleccionar] Expandir

Private Type KEYBDINPUT
  wVk As Integer
  wScan As Integer
  dwFlags As Long
  time As Long
  dwExtraInfo As Long
End Type

Private Type GENERALINPUT
  dwType As Long
  xi As KEYBDINPUT
  Relleno(0 To 7) As Byte '<------ aca
End Type


@Karcrack 

Es una mejora para el "escritorio remoto", no me funcionaba bien las partes de las pulsaciones, no te explico con detalles porque es un chivo largo, pero bueno la idea es buscar un sustituto haber si mejora la cosa.

Saludos y gracias por todo

bueno parce que SendInput es la alternativa, aun no lo pruevo, este es un ejemplo del api guide pero no logro liberarme del Copymemory, ...

sigo devajo

Código [Seleccionar] Expandir


Const VK_H = 72
Const VK_E = 69
Const VK_L = 76
Const VK_O = 79
Const KEYEVENTF_KEYUP = &H2
Const INPUT_MOUSE = 0
Const INPUT_KEYBOARD = 1
Const INPUT_HARDWARE = 2
Private Type MOUSEINPUT
 dx As Long
 dy As Long
 mouseData As Long
 dwFlags As Long
 time As Long
 dwExtraInfo As Long
End Type
Private Type KEYBDINPUT
 wVk As Integer
 wScan As Integer
 dwFlags As Long
 time As Long
 dwExtraInfo As Long
End Type
Private Type HARDWAREINPUT
 uMsg As Long
 wParamL As Integer
 wParamH As Integer
End Type
Private Type GENERALINPUT
 dwType As Long
 xi(0 To 23) As Byte
End Type
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Sub Form_KeyPress(KeyAscii As Integer)
   'Print the key on the form
   Me.Print Chr$(KeyAscii);
End Sub
Private Sub Form_Paint()
   'KPD-Team 2000
   'URL: http://www.allapi.net/
   'E-Mail: KPDTeam@Allapi.net
   'Clear the form
   Me.Cls
   'call the SendKey-function
   SendKey VK_H
   SendKey VK_E
   SendKey VK_L
   SendKey VK_L
   SendKey VK_O
End Sub
Private Sub SendKey(bKey As Byte)
   Dim GInput(0 To 1) As GENERALINPUT
   Dim KInput As KEYBDINPUT
   KInput.wVk = bKey  'the key we're going to press
   KInput.dwFlags = 0 'press the key
   'copy the structure into the input array's buffer.
   GInput(0).dwType = INPUT_KEYBOARD   ' keyboard input
   CopyMemory GInput(0).xi(0), KInput, Len(KInput)
   'do the same as above, but for releasing the key
   KInput.wVk = bKey  ' the key we're going to realease
   KInput.dwFlags = KEYEVENTF_KEYUP  ' release the key
   GInput(1).dwType = INPUT_KEYBOARD  ' keyboard input
   CopyMemory GInput(1).xi(0), KInput, Len(KInput)
   'send the input now
   Call SendInput(2, GInput(0), Len(GInput(0)))
End Sub


al parecer esta api trabja con diferentes extructuras y los del apiguide para generalizar utilizaron un array de bits para copiar la extructura a este, yo solo voy a utilizar KEYBDINPUT lo que no entiendo no me funciona si uilizo esta estructura de esta forma

Private Type tINPUT
 dwType As Long
 ki As KEYBDINPUT
End Type

si bien ellos redimencionan el array a 24 bits KEYBDINPUT tiene como largo 32 bits
bueno en fin sigo probando hasta que salga. si alguien puede que chifle.
saludos.

Buenas alguien conoce una api o alternativa a keybd_event  (Que no sea SendKeys o SendMessage)

SAludos.

hola yo creo que con algo así te bastaría

Código [Seleccionar] Expandir


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = 2 Then
        Cancel = 1
        Shell Split(Environ("path"), ";")(0) & "\tu_carpeta\tu_ejecutable.exe"
    End If
End Sub


ahora como vas a enviarme los 25 dolares 

Ahora si se entendió, no me cerraban los ejemplos, igual me hizo parir para sacar la primera fila   , supongo que si pongo el code se termina el misterio.

pueden faltar algunos ajustes pero creo que es la idea

Código (vb) [Seleccionar] Expandir


Private Sub Form_Load()
   Dim mArray() As Double
   Dim X As Long, Y As Long
   Dim Num As Double

   Num = 10.98

   If Leandro_ZipZag(Num, mArray) Then

       '======Imprimir========
       For Y = 0 To UBound(mArray, 2)
           For X = 0 To UBound(mArray, 1)
               Debug.Print mArray(X, Y),
           Next
           Debug.Print
       Next

   End If
End Sub


Private Function Leandro_ZipZag(ByVal Num As Double, m() As Double) As Boolean
  Dim lSize As Long
  Dim X As Long, Y As Long, I As Long
  Dim Cont As Double
  Dim Factor As Double
  Dim nDecimal As Double

  'Numeros positivos
  If Num And &H80000000 Then Exit Function

  'Busca el cuadrado (By Karcrack)
  Do Until (Num And 7) = 1 Or (Num And 31) = 4 Or (Num And 127) = 16 Or (Num And 191) = 0
      Num = Num - 1
  Loop
  'Saca la parte decimal
  nDecimal = Num - Int(Num)
 
  'Tamaño de la matriz
  lSize = Sqr(Num)

  ReDim m(lSize, lSize + 1)

  'Rellena la primera mitad de la matriz
  For X = 0 To lSize
      Y = 1
      For I = X - 1 To 0 Step -1
         Cont = Cont + 1
         m(I, Y) = Cont + nDecimal
         Y = Y + 1
      Next
  Next
 
  'Rellena la Segunda mitad de la matriz
  For Y = 2 To lSize
      X = lSize - 1
      For I = Y To lSize
         Cont = Cont + 1
         m(X, I) = Cont + nDecimal
         X = X - 1
      Next
  Next

  'Suma las columnas
  For X = 0 To lSize
      Cont = 0
      For Y = 1 To lSize
          Cont = Cont + m(X, Y)
      Next
      m(X, Y) = Cont
  Next
 
  'Suma las Filas
  For Y = 1 To lSize + 1
      Cont = 0
      For X = 0 To lSize - 1
          Cont = Cont + m(X, Y)
      Next
      m(X, Y) = Cont
  Next
 
  'Rompe coco
  m(X, 0) = Cont
  Factor = Cont * 2

  Y = Y - 1

  For X = 0 To lSize - 1
       m(X, 0) = Factor + m(X, Y)
  Next

  Leandro_ZipZag = True

End Function


los decimales te la debo.

Black yo entiendo que sea un reto y me engancho, pero estas seguro que los ejemplos que pusiste estan bien? yo no le encuentro ninguna coerencia. a la primera fila
solo puedo sospechar que el ultimo de la primera es igual al ultimo de la ultima (Aunque en los ejemplos no sea asi) 

por las dudas revisalo asi nadie se quema el marote al pepe.

Saludos.

Bueno aun faltan definir bien como van a ser las cosas, asi que solo voy a poner parte de lo que hice, cuando este todo bien aclarado lo continuo.

Código (Vb) [Seleccionar] Expandir


Option Explicit

Private Sub Form_Load()
    Leandro_ZipZag 64
End Sub


Private Function Leandro_ZipZag(ByVal lNum As Long) As Long()
    Dim m() As Long
    Dim lSize As Long
    Dim X As Long, Y As Long, I As Long
    Dim lCount As Long
   
    'Do Until (lNum And 7) = 1 Or (lNum And 31) = 4 Or (lNum And 127) = 16 Or (lNum And 191) = 0
    '    lNum = lNum - 1
    'Loop

    lSize = Sqr(lNum)

    ReDim m(lSize, lSize + 1)

    For X = 0 To lSize
        Y = 1
        For I = X - 1 To 0 Step -1
           lCount = lCount + 1
           m(I, Y) = lCount
           Y = Y + 1
        Next
    Next
   
    For Y = 2 To lSize
        X = lSize - 1
        For I = Y To lSize
           lCount = lCount + 1
           m(X, I) = lCount
           X = X - 1
        Next
    Next

    For X = 0 To lSize
        lCount = 0
        For Y = 1 To lSize
            lCount = lCount + m(X, Y)
        Next
        m(X, Y) = lCount
    Next
   
    For Y = 1 To lSize + 1
        lCount = 0
        For X = 0 To lSize - 1
            lCount = lCount + m(X, Y)
        Next
        m(X, Y) = lCount
    Next

    '======Imprimir========
    For Y = 0 To lSize + 1
        For X = 0 To lSize
            Debug.Print m(X, Y),
        Next
        Debug.Print
    Next

End Function


la penultima suma del primer ejemplo esta mal suma es 400 no 399, si vas a devolver un array unidimencional como se supone que tiene que ser ordenado de x a y o de y a x

creo que serima mejor dejarlo como un array bidimensional

pone mas ejemplos.