Mostrar Mensajes
Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.
Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const TH32CS_INHERIT = &H80000000
Private Const MAX_PATH As Integer = 260
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const SYNCHRONIZE As Long = &H100000
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Private Const INFINITE = &HFFFF
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
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)
Private Function GetPIDFromName(ByVal sName As String, _
ByRef lPID As Long) As Boolean
Dim lSnap As Long
Dim pProcess As PROCESSENTRY32
Dim lReturn As Long
Dim sExeName As String
lSnap = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
With pProcess
.dwSize = Len(pProcess)
lReturn = Process32First(lSnap, pProcess)
Do While lReturn
sExeName = Left$(.szExeFile, IIf(InStr(1, .szExeFile, Chr$(0)) > 0, InStr(1, .szExeFile, Chr$(0)) - 1, 0))
If StrComp(sExeName, sName, vbTextCompare) = 0 Then
GetPIDFromName = True
lPID = .th32ProcessID
Call CloseHandle(lSnap)
Exit Function
End If
lReturn = Process32Next(lSnap, pProcess)
Loop
End With
Call CloseHandle(lSnap)
End Function
Private Function WaitForExe(ByVal sName As String) As Boolean
Dim lPID As Long
Dim lProcHandle As Long
If Not GetPIDFromName("notepad.exe", lPID) Then
Exit Function
End If
lProcHandle = OpenProcess(SYNCHRONIZE, 0, lPID)
If lProcHandle = 0 Then
Exit Function
End If
Call WaitForSingleObject(lProcHandle, INFINITE)
Call CloseHandle(lProcHandle)
WaitForExe = True
End Function
.Hola, muchas ideas ambiciosas, creo que no es para tanto, tendria que ser algo que este mas al alcance, porque no empezamos con algo mas sencillo y chiquito por ejemplo, un usercontrol con una pagina de propiedades en el cual le cargas una imagen PNG o ICO el array de la imagen lo almacena en una propertybag y luego al ejecutar el form contenedor le pone el icono chico y el grande a este.
Es algo sencillo, util y nos da la posibilidad de poner iconos de 32bits.
Disculpa la duda... que no es lo que tiene el control de Cobein? el ucImage. Aunque cierto no tiene el array de imagenes en ese caso se podria partir desde ese UC. Salvo que no halla entendido bien la propuesta.
Option Explicit
Private Const INFINITE = &HFFFF
Private Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Function RunProcess(ByVal sFile As String, ByVal sArguments As String, ByVal sPath As String) As Long
Dim pStartInfo As STARTUPINFO
Dim pProcInfo As PROCESS_INFORMATION
Dim pSec1 As SECURITY_ATTRIBUTES
Dim pSec2 As SECURITY_ATTRIBUTES
RunProcess = -1
pSec1.nLength = Len(pSec1)
pSec2.nLength = Len(pSec2)
With pStartInfo
.cb = Len(pStartInfo)
.dwFlags = STARTF_USESHOWWINDOW
.wShowWindow = 1
End With
If CreateProcessA(vbNullString, FixPath(sPath) & sFile & " " & sArguments, _
pSec1, pSec2, False, NORMAL_PRIORITY_CLASS, 0&, sPath, _
pStartInfo, pProcInfo) Then
RunProcess = pProcInfo.hProcess
End If
End Function
Public Sub WaitInfinite(ByVal hHandle As Long)
Call WaitForSingleObject(hHandle, INFINITE)
End Sub
Public Function ShellAndWait(ByVal sFile As String, ByVal sArguments As String, ByVal sPath As String) As Boolean
Dim lPID As Long
lPID = RunProcess(sExec, sParams, sPath)
If lPID = -1 Then
Debug.Print "Error ejecutando el programa """ & sPath & sExec & """!"
Exit Function
End If
Call WaitInfinite(lPID)
ShellAndWait = True
End Function