Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Mensajes - cobein

#691
Aca tenes un ejemplo de como usar un icono en el systray http://planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=68948&lngWId=1 y por lo otro para sacar tu programa de la barra usa me.visible = false, y para ocultarlo al apretar "Close" en el evento QueryUnload if UnloadMode =0 es que el usuario apreto el boton close.
#692
Programación Visual Basic / Re: Randomize y Rnd
19 Septiembre 2007, 01:00 AM
En una implementacion de la funcion Rand de C.  Mas un shuffle, pero es lo que vos preguntas.
#693
Programación Visual Basic / Re: Randomize y Rnd
18 Septiembre 2007, 20:37 PM
A ver si esto te ayuda

'---------------------------------------------------------------------------------------
' Module    : mRand
' DateTime  : 06/07/2007 04:13
' Author    : Cobein
' Mail      : cobein27@yahoo.com
' Purpose   : Microsoft C v4.0 rand() + shuffle output
'---------------------------------------------------------------------------------------
Option Explicit

Private m_bvBox(255) As Byte
Private m_dSeed As Double

Public Function Rand() As Byte
    Dim lRet As Long
    '// Rand Function
    m_dSeed = CustomMod((214013 * m_dSeed + 2531011), 2 ^ 31)
    lRet = Int(m_dSeed / 2 ^ 16)
    '// Shuffle our box
    ShuffleBox lRet
    '// Return Value
    Rand = m_bvBox(0)
End Function

Public Sub Randomize(ByVal lVal As Long)
    Dim i As Long
    '// Initialize Box
    If m_dSeed = 0 Then '// Just to prevent from reorganizing the elements in the array once initialized.
        For i = 0 To 255
            m_bvBox(i) = i
        Next
    End If
    '// Set the seed
    m_dSeed = lVal
End Sub

'// Custom mod to prevent overflow
' This is not mine is from a RSA implementation I found on PSC
Private Function CustomMod(ByVal dVal1 As Double, ByVal dVal2 As Double) As Double
    CustomMod = dVal1 - (Int(dVal1 / dVal2) * dVal2)
End Function

Private Function ShuffleBox(ByVal lVal As Long)
    Dim lKeyLen As Long
    Dim bvKey() As Byte
    Dim i As Long
    Dim j As Long
    Dim bTemp As Byte
   
    bvKey() = StrConv(lVal, vbFromUnicode)
    lKeyLen = UBound(bvKey) + 1
   
    For i = 0 To 255
        '// Calculate the index
        j = (j + m_bvBox(i) + bvKey(i Mod lKeyLen)) Mod 256
        '// Swap values
        bTemp = m_bvBox(i): m_bvBox(i) = m_bvBox(j): m_bvBox(j) = bTemp
    Next
End Function
#694
Hola, mira esto lo saque de un modulo que tengo que es para otra cosa, asi que saca las declaraciones que esten de mas.

Private Const INPUT_KEYBOARD As Long = 1

Private Const KEYEVENTF_KEYDOWN As Long = 0
Private Const KEYEVENTF_KEYUP As Long = &H2

Private Const RSH_REGISTER_TASKMAN As Long = 3
Private Const HSHELL_WINDOWACTIVATED As Long = 4

Private Const GWL_WNDPROC As Long = -4
Private Const RSH_DEREGISTER As Long = 0

Private Const GHND As Long = &H42
Private Const CF_HDROP As Long = &HF

'---------------------------------------------------------------------------------------
' Types
'---------------------------------------------------------------------------------------
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(0 To 23) As Byte
End Type

Private Type POINTAPI
   x As Long
   y As Long
End Type

Private Type DROPFILES
   pFiles As Long
   pt As POINTAPI
   fNC As Long
   fWide As Long
End Type

'---------------------------------------------------------------------------------------
' Apis
'---------------------------------------------------------------------------------------
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

Private Declare Function GetShortPathName Lib "kernel32" Alias _
    "GetShortPathNameA" (ByVal lLongPath As String, ByVal lShortPath As String, _
    ByVal lBuffer As Long) As Long
   
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, _
    ByVal hMem As Long) As Long

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" ( _
    ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function RegisterWindowMessage Lib "user32" Alias _
    "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function RegisterShellHook Lib "Shell32" Alias "#181" ( _
    ByVal hwnd As Long, ByVal nAction As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
    ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
    ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, _
    pInputs As GENERALINPUT, ByVal cbSize As Long) As Long



'
'---------------------------------------------------------------------------------------
' Procedure : CopyClipboard
' Purpose   : Copy a coma delimited file list to the clipboard
'---------------------------------------------------------------------------------------
Private Function CopyClipboard(ByVal hwnd As Long, ByVal sData As String) As Boolean
    Dim hGlobal As Long
    Dim DF As DROPFILES
    Dim lpGlobal As Long
    Dim strFiles As String
   
    Dim svFiles() As String
    Dim i As Long
   
    Clipboard.Clear
    svFiles = Split(sData, ",")
    For i = 0 To UBound(svFiles)
        svFiles(i) = Trim$(svFiles(i))
        If File_Exists(svFiles(i)) Then
            strFiles = strFiles & svFiles(i) & Chr(0)
        End If
    Next

    Call OpenClipboard(hwnd)

    Call EmptyClipboard
   
    hGlobal = GlobalAlloc(GHND, Len(DF) + Len(strFiles))
   
    If hGlobal Then 'if the globalalloc worked
        lpGlobal = GlobalLock(hGlobal) 'lock the hGlobal
        DF.pFiles = Len(DF) 'set the size of the files
 
        Call CopyMem(ByVal lpGlobal, DF, Len(DF)) 'copy df to the lpglobal
        Call CopyMem(ByVal (lpGlobal + Len(DF)), ByVal strFiles, Len(strFiles)) 'copy strfiles to lpglobal
        Call GlobalUnlock(hGlobal) 'unlock hglobal again
 
        SetClipboardData CF_HDROP, hGlobal 'put files to the clipboard
        GlobalFree hGlobal
       
    End If
   
    Call CloseClipboard

End Function
#695
Programación Visual Basic / Re: Leer archivo .civ
9 Septiembre 2007, 12:08 PM
Ah algo que me olvidaba lo tenes que volver a guarda :D
#696
Programación Visual Basic / Re: Leer archivo .civ
9 Septiembre 2007, 12:05 PM
Ok, o compila o sigo suicidandome con cigarrillos y cervezas

Private Sub Command1_Click()
    Open Text2.Text For Binary Access Read As #1
    Read = Input(LOF(1), #1)
    Close #1
    Text1.Text = Read
    For x = 1 To Len(Text1.Text)
        num = Hex(Asc(Mid$(Text1.Text, x, 1)))
        Text3.Text = Text3.Text & num
    Next
End Sub
#697
Mira no se si es lo que buscas, es algo que hice hace un tiempo y no es perfecto ni en pedo pero funciona bien http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=64557&lngWId=1 miralo y fijate si te sirve.
#698
Programación Visual Basic / Re: Leer archivo .civ
9 Septiembre 2007, 10:54 AM
ops diculpa me la mande ahi esta

num = hex(chr$(Mid$(Text1.Text, x,1)))
#699
Programación Visual Basic / Re: Leer archivo .civ
9 Septiembre 2007, 10:20 AM
Donde esta el error? la verdad lo mire ahi en el momento pero acabo de ver otra cosa mas.... postea el codigo que tengas y te digo
#700
Compara la fecha actual con la que tenes como referencia y cuando sean iguales voila!