Ir a la comunidad

Visual Basic

Espacio para programadores novatos o experimentados (o cualquiera que quiera aprender) en el lenguaje BASIC (o cualquier otro lenguaje de programación: C/C++, Java, PHP...) den a conocer sus nuevos programas, pidan ayuda, den información, etc...

Ver más
  • 1,548 Miembros
  • 711 Temas
  • 417 Seguidores
Hace más de 5 meses
  • 0

Creé mi propio formato de mapa de bits

Todavía no me ocupe de ponerle extensión o demás detalles pero cree la función para cargar y guardar los archivos las funciones son las siguientes:

dijo:


Option Explicit

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 GuardarImagen(Path As String, Picture As PictureBox)

Dim Line As String

Dim X, Y As Single

Dim PID As Long

Open App.Path & "imagen.tmp" For Output As #1

For Y = 0 To Picture.Height - 1 Step 1

For X = 0 To Picture.Width - 1 Step 1

Line = Line & GetPixel(Picture.hdc, X, Y) & "|"

Next

Print #1, Line

Line = ""

Next

Close #1

Call Shell(App.Path & "rar.exe a -y -p1281 -m5 -ep " & Chr(34) & Path & Chr(34) & " " & Chr(34) & App.Path & "imagen.tmp" & Chr(34))

End Sub

Public Sub CargarImagen(Path As String, Picture As PictureBox)

Dim Lines As String

Dim Line() As String

Dim X, Y As Single

Dim PID As Long

PID = Shell(App.Path & "rar.exe x -y -p1281 " & Chr(34) & Path & Chr(34) & " " & Chr(34) & App.Path & Chr(34))

While DetectarProceso(PID) = True

'Espera

Wend

DoEvents

Y = 0

Open App.Path & "imagen.tmp" For Input As #1

While Not EOF(1)

Line Input #1, Lines

Line = Split(Lines, "|"

For X = 0 To UBound(Line) - 1 Step 1

Call SetPixel(Picture.hdc, X, Y, Line(X))

Next

Y = Y + 1

Wend

Close #1

End Sub



Eso va en un módulo para poder usarlas. Lo siguiente que haré es ver si puedo adaptarlas para crear un formato de video y mi meta es hacer una dll que cargue recursos en tiempo de ejecución, me refiero a un archivo del cual un programa pueda extraer una imagen por ejemplo pero sin extraerla a un archivo externo, sino a una variable parecido a como funcionan los archivos .mpq que usa la empresa blizzard con el storm.dll en juegos como el Warcraft 3 o el Wow.
  • 0
  • 1Calificación
  • 1Seguidores
  • 150Visitas
  • 0Favoritos

3 respuestas

@MilangaConPapas dijo Hace más de 5 meses:

Muy interesante, está muy buena la idea. Igual, te falto definir DetectarProceso que debe ser algún procedimiento que no lo encuentro en el código.

Salu2 y +Bytes.

@xsunderx dijo Hace más de 5 meses:

dijo:


Option Explicit

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPheaplist = &H1
Private Const TH32CS_SNAPthread = &H4
Private Const TH32CS_SNAPmodule = &H8
Private Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule
Private Const MAX_PATH As Integer = 260

Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type

Public Function DetectarProceso(PID As Long) As Boolean

Dim proc As PROCESSENTRY32

Dim ret As Long
Dim snap As Long
Dim Flag_Process As Long

DetectarProceso = False

snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0)

proc.dwSize = Len(proc)

Flag_Process = ProcessFirst(snap, proc)

While Flag_Process <> 0

If PID = proc.th32ProcessID Then

DetectarProceso = True

Call CloseHandle(snap)

Exit Function

End If

Flag_Process = ProcessNext(snap, proc)

Wend

Call CloseHandle(snap)

End Function


Perdón se me olvido, esto va en otro módulo

@sceik dijo Hace más de 3 meses:

No entiendo que hace podés ser más explícito... Es para cambiar de resolución ?? Lo que querés hacer es inyectar una aplicación o mejor dicho un programa y poder cambiarle de resolución?? Si es así para que ?? Se ve complicado el código.. jaaaa

Tienes que ser miembro para responder en este tema