Mensajes

creo que se puede con dos cosas, o sabiendo la estructura de un PDF a la perfeccion (Puedo decir "casi imposible"), o checkando las dll del programa acrobat e incrustarlas en vbasic para saber que  funciones te pueden brindar. cosa que dudo

bueno ademas estuve checkando y la funcion rgb que viene el visual, pide paramentros integer, bueno eso no es pretexto, pero ademas es mejor comerese 3 bytes para poder sumarles y restarles numeros sin que ocurra un error

Con una variable global (Boolean) y unos cuantos If dentro de la rutina (inclidos los For, while, etc)

PD: Todas las rutinas no son iguales

lo que te dan alli es cierto, pero que no se te olvide la palabra magica "DoEvents" para que se puede editar dicha variable desde otro evento

[Encryptar y/o descifrar miles de MEGAS sin perder velocidad]

No se que hacer mas me he puesto a mejorar códigos así que pongo esta función es una función realmente rápida a comparación a las que se encuentran en google,  [blink]así que pueden Encryptar y/o descifrar miles de MEGAS sin perder velocidad ya que los códigos que se encuentran en google pierden velocidad de descifrado en el acto. [/blink]

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' ////////////////////////////////////////////////////////////////

Option Explicit
Enum ActionsHexStr
   HexToString = 0
   StringToHex
End Enum
Public Function HexAndString(ByVal vData As String, Optional Accion As ActionsHexStr = HexToString) As String
Dim LenBuffer               As Long
Dim LenOfBuffer             As Integer
Dim Puntero                 As Long
Dim I                       As Long
Dim vStep                   As Integer
   If CBool(IIf(Accion = HexToString And (Len(vData) Mod 2) = 0, True, IIf(Accion = StringToHex, True, False))) Then
       LenBuffer = IIf(Accion = HexToString, Len(vData) / 2, Len(vData) * 2)
       LenOfBuffer = IIf(Accion = HexToString, 1, 2)
       HexAndString = Space(LenBuffer)
       vStep = IIf(Accion = HexToString, 2, 1)
       Puntero = 1
       For I = 1 To Len(vData) Step vStep
           If Accion = HexToString Then
               Mid(HexAndString, Puntero, LenOfBuffer) = Chr$(Val("&H" & Mid$(vData, I, 2)))
               Puntero = Puntero + 1
           Else
               Mid(HexAndString, Puntero, LenOfBuffer) = Hex$(Asc(Mid$(vData, I, 1)))
               Puntero = Puntero + 2
           End If
       Next I
   End If
End Function



P.D.: Estoy aburrido me ire a jugar basketball nos vemos!¡.

Dulces Lunas!¡

El Code esta bueno para lo que es...
pero si de cifrar/descifrar yo uso esta funcion:

Código [Seleccionar] Expandir

Private Function cifrar(ByVal Cadena As String, _
                       ByVal Pass As String, Mode As Boolean) As String
Dim LC As Long
Dim LP As Long
Dim I As Long
Dim E As Long
Dim A As String
Dim B As String
Dim NewAscii As Byte
Dim S As Integer
LC = Len(Cadena)
LP = Len(Pass)

For I = 1 To LC
   E = E + 1
   A = Mid(Cadena, I, 1)
   
   If E > LP Then E = 1
   
   B = Mid(Pass, E, 1)
   
   If Mode Then
       S = Asc(A) + Asc(B)
       NewAscii = IIf(S > 255, S - Asc(B), S)
   Else
       S = Asc(A) - Asc(B)
       NewAscii = IIf(S < 0, S + Asc(B), S)
   End If
   cifrar = cifrar & Chr(NewAscii)
Next

End Function

ya que el resultado dependera de la contraseña, lo que la hace mas dificil de que alguien ajeno robe la informacion. la misma la tome de alguna pagina de internet que no recuerdo y tampoco tenia dicha funcion, es por eso que puede que no coincidan con la funcion original del autor

pues se me ocurre una idea, que seria usar la forma inversa de como  guarda en disco la imagen de la clase CJpg, combinada con el api SetPixel al HDC, en cuanto lo logre lo paso

Va la 2da vez que veo esto, ya lo vi de BlackZeroX cuando "optimizaba" un codigo.

Porque usan un Integer?  "Dim elRGB(2) As Integer" el valor de retorno tiene que ser en bytes...

si eso fue algo que se me paso sin querer, claro que lo pueden modificar, eso no es mucho de trascendecia

bien este es un code que uso en mis controles de usuario o en forms para hacerlo mas vistoso. publique hace algunos dias esto en el foro de leandro ascierto, y sabiendo que gran parte de usuarios del foro de leandro esta aqui pues lo cuelgo aqui ademas que tenia dos errores minimos y aqui presento la mini actualizacion. el code lo pueden editar para que se pueda hacer el degradado de forma horizontal o circular, alli esta la idea.

Código [Seleccionar] Expandir

'By xmbeat
'to foro.elhacker.net/programacion VB

Private Function Color(Col As Long) As Integer()
Const B As Long = 65536 'constante que es el resultado de 256 al Cuadrado
Const G As Long = 256
Dim elRGB(2) As Integer
Col = Abs(Col)
'aqui pueden usar el OleTranslateColor para usar los colores del sistema _
pero no lo use para no contradecir el titulo del post
elRGB(2) = Col \ B 'hacemos la operacion inversa de la funcion RGB()
elRGB(1) = (Col Mod B) \ G
elRGB(0) = (Col Mod B) Mod G
Color = elRGB
End Function

Sub Gradient(Formulario As Object, Inicio As OLE_COLOR, Final As OLE_COLOR, Optional Min As Long = 0, Optional _
Max As Long = 256)
With Formulario
.AutoRedraw = True
'min es donde empezará a pintar y Max es donde terminará de hacerlo
Dim I As Integer
Dim Ini() As Integer
Dim Fin() As Integer
Dim Dif As Long
Dim Ant As Long
Dim R As Byte, G As Byte, B As Byte

On Error Resume Next
Ant = .ScaleHeight
.ScaleHeight = 256
Ini = Color(Inicio)
Fin = Color(Final)
Dif = Max - Min

For I = Min To Max
R = Ini(0) + ((Fin(0) - Ini(0)) / Dif) * (I - Min)
G = Ini(1) + ((Fin(1) - Ini(1)) / Dif) * (I - Min)
B = Ini(2) + ((Fin(2) - Ini(2)) / Dif) * (I - Min)
Formulario.Line (0, I)-(.ScaleWidth, I + 1), RGB(R, G, B), BF

Next I

.ScaleHeight = Ant
End With
End Sub



Private Sub Form_Resize()
Const Text0 As String = "By Xmbeat"
Gradient Me, RGB(80, 80, 80), vbBlack, , 100
Gradient Me, vbBlack, RGB(10, 19, 50), 100
Me.FontSize = 24
Me.FontBold = True
Me.CurrentY = (Me.ScaleHeight - Me.TextHeight(Text0)) / 2
Me.CurrentX = (Me.ScaleWidth - Me.TextWidth(Text0)) / 2
Me.ForeColor = vbWhite
Print Text0
End Sub




aqui el link del otro post:
http://www.leandroascierto.com.ar/foro/index.php?topic=150.0
espero la bienvenida a este foro.

If X <>  0  then ....

eso debe ser

yo te hubiera sugerido usar el CopyMemory ya que es mas rapido que el bucle, ademas en mi opinion no hay que hacer doble bucle, pero como dices que eres principiante te hice esto:

Código [Seleccionar] Expandir



Private Sub Command1_Click()
Dim Vector() As String

Dim[I As Integer
Dim Mfinal As String
ReDim Vector(Len(Text1.Text))

For I = 1 To Len(Text1.Text)
   Vector(I) = Mid$(Text1.Text, I, 1)
   Mfinal = Mfinal & Asc(Vector(I)) & " "
Next
MsgBox "Finalizado"
Text2.Text = Mfinal
End Sub