Mensajes

[SetWindowText]

Buen trabajo  . Felicidades por le programa y la idea.

En cuanto a lo de cambiar el nombre yo siempre he usado la función API  SetWindowText.

Código (vb) [Seleccionar] Expandir

Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Tan sólo necesitas obtener el Handle de la ventana, en este caso del visor de imágenes de Windows. El Handle, como ya sabes puedes obtenerlo con FindWindow y necesitas el nombre de clase de la ventana que es "Photo_Lightweight_Viewer" y "ShlmgVw:CPreviewWnd" en XP, o bien el mismo título de la ventana.

Luego el código podría ser:

Código (vb) [Seleccionar] Expandir

Dim hwndViewer As Long
Do While hwndViewer = 0
hwndViewer = FindWindow("Photo_Lightweight_Viewer", vbNullString)
DoEvents
Loop
Call SetWindowText(hwndViewer, "Imagen 1 - Convertido")

*Recuerdo que si se sustituye "vbNullString" por el título de la ventana sólo se obtendrá el handle de una ventana que contenga dicho título.

Saludos

Quizás te interese este código. No es mío, es de un tal John Korejwa.  Puedes crear o convertir archivos JPG con diferentes niveles de compresión sin perder calidad. Es muy bueno, lo malo es que el como lo hace es muy complejo y resulta dificil de descifrar para luego modifiarlo y usarlo a tu manera. Utiliza módulos de clase y funciones GDI.


http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=50065&lngWId=1

Enlace de descarga:
http://www.planet-source-code.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=50065&strZipAccessCode=tp%2FJ500653091

Vaya 

Pues entonces es mejor tener más de una copia de lo que sea, porque si cae y por la razón que sea ya no puedo acceder a mis archivos, mal asunto.

["C:\Directorio\mspaint.exe"]

Hola #Fran1946#

Me alegro que te haya funcionado correctamente. El cambio puede venir bien para otros usuarios que usen W7 y buen detalle lo de incluir el nombre de clase, que lógicamente cambia. Si quieres, además, si quieres usar otra versión que no se encuentre en el directorio del sistema, puedes poner el directorio:

Call StartMSPaint("C:\Directorio\mspaint.exe", strFile, MS_SAVE)


En cuanto al código  57603-'Guardar' y el 57604- 'Guardar como', hay  varias formas de obtenerlo. Una es extrayendo el menú mediante código o bien usando Spy++, pero es difícil de explicar.

Mediante código, puedes usar este, de prueba. Ejecuta SDPaint y con el paint abierto ejecuta este código.

Código (vb) [Seleccionar] Expandir

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" _
(ByVal hMenu As Long, _
ByVal wIDItem As Long, _
ByVal lpString As String, _
ByVal nMaxCount As Long, _
ByVal wFlag As Long) As Long

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSubMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Const MF_BYPOSITION = &H400&
Const WM_COMMAND = &H111
Const MF_POPUP = &H10&



Private Sub Command1_Click()
   Dim hwnd As Long
   Dim hMainMenu As Long
   Dim hMenu As Long
   Dim MenuID As Long
   Dim szbuf As String * 128
   Dim szBufM As String * 128
   Dim I, Z
   Z = 0 'Posición del menú
   I = 2 'Posición del submenú
   hwnd = FindWindow("SDPaintApp", vbNullString)
   If hwnd = 0 Then Exit Sub
   hMainMenu = GetMenu(hwnd)
   hMenu = GetSubMenu(hMainMenu, Z)
   MenuID = GetMenuItemID(hMenu, I)
   Call GetMenuString(hMenu, MenuID, szbuf, 128, MF_BYPOSITION & MF_POPUP)

   MsgBox MenuID & "     " & szbuf
   
   'X& = SendMessage(hwnd, WM_COMMAND, MenuID, 0&)
   
End Sub


el valor Z representa el lugar del menú e I el lugar del submenú.

Puedes crear un bucle For/Next y repasar números del -1 al  1000 para I y de esa manera obtener todos los comandos.

Tengo varias cuentas para almacenar en una nube (Cloud computing) pero me pregunto si serán permanentes y pasará como con Megaupload o algo parecido, y un día me encuentre que el servidor de dicha nube ha cerrado.

[Download code]

Hola  

En un Form crea un Botón (CommandButton)


Mete esto en un Módulo:

Código (vb) [Seleccionar] Expandir


Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

'Funcición API para enviar un mensaje a MSPaint
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const SC_CLOSE = &HF060&
Const WM_COMMAND = &H111
Const WM_SYSCOMMAND = &H112

'Función API para obtener el nombre de un archivo a partir de un directorio
Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" _
(ByVal lpszFile As String, _
ByVal lpszTitle As String, _
ByVal cbBuf As Integer) As Integer

'Función para deternimnar si un proceso es una ventana
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
'Función para obtener el nombre corto de un directorio
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long


Public Const MS_SAVE = 0
Public Const MS_SAVE_AS = 1
Dim hwMsPaint As Long 'para el Handle de MsPaint

Public Function GetDirCorto(strPath) As String
Dim ShortName As String * 255
Call GetShortPathName(strPath, ShortName, 255)
GetDirCorto = Left$(ShortName, InStr(1, ShortName, Chr$(0)) - 1)
End Function


'Inicia MsPaint en modo oculto
Public Function StartMSPaint(ByVal PathMsPaint As String, ByVal strPathFile As String, ByVal Modo As Integer)
   On Error GoTo Error_sub
   Dim Count As Long
   Dim objStartup      As Object
   Dim objWMIService   As Object
   Dim objConfig       As Object
   Dim objProcess      As Object
   Dim Error           As Integer
   Dim strComputer     As String
   Dim intProcessID    As Long
   Dim Opcion          As Integer
   Dim sFile           As String
   Dim sDir            As String
   
   strComputer = "."
   hwMsPaint = 0
   Set objWMIService = GetObject("winmgmts:" _
   & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
   Set objStartup = objWMIService.Get("Win32_ProcessStartup")
   Set objConfig = objStartup.SpawnInstance_
   objConfig.ShowWindow = 12 'Iniciar en modo oculto (usar 1 para modo visible)
   Set objProcess = GetObject("winmgmts:root\cimv2:Win32_Process")
   
   sDir = GetDirCorto(strPathFile) 'Obtiene el directorio corto Ej.: "[Drive]:\Name~1.jpg"
       'Si el archivo no existe...
       If sDir = "" Then
           MsgBox "No se encuentra " & strPathFile, vbCritical
           Exit Function
       End If
       
   Error = objProcess.Create(PathMsPaint & " " & sDir, Null, objConfig, intProcessID)
       If Error Then
           MsgBox "No se encuentra " & PathMsPaint & "." & vbCrLf & vbCrLf & _
           "Compruebe que la aplicación existe o está correctamente escrito.", _
vbCritical, "Error"
           Exit Function
       End If
   
   'On Local Error Resume Next
   'Elimina las variables de objeto
   Set objStartup = Nothing
   Set objWMIService = Nothing
   Set objConfig = Nothing
   Set objProcess = Nothing
   
   'Obtiene el título del archivo a guardar
   sFile = gFileTitle(strPathFile)

   'Obtiene el handle de MSPaint que ha abierto el archivo
   Do While hwMsPaint = 0
       Count = Count + 1
       hwMsPaint = FindWindow("MSPaintApp", sFile & " - Paint")
       DoEvents
       If Count > 50000 Then Exit Function
   Loop
   
   'No pasa hasta el siguiente comando hasta que MsPaint se haya abierto
   Dim n&
   Do While n& = 1
       n& = IsWindow(hwMsPaint)
       DoEvents
   Loop
   
   'Envia el mensaje Guardar o Guardar como a MsPaint
   Call MsPaintSave(Modo)

   Do While n& = 0
   n& = IsWindow(hwMsPaint)
   CloseMsPaint
   DoEvents
   Loop
   
   Exit Function
     
Error_sub:
   MsgBox Err.Description, vbCritical

   On Local Error Resume Next
   'Elimina las variables de objeto
   
   Set objStartup = Nothing
   Set objWMIService = Nothing
   Set objConfig = Nothing
   Set objProcess = Nothing
End Function
 
Private Sub MsPaintSave(ByVal Modo As Integer)
Select Case Modo
Dim X&
Case 0
X& = SendMessage(hwMsPaint, WM_COMMAND, 57603, &H0) 'Guardar
Case 1
X& = SendMessage(hwMsPaint, WM_COMMAND, 57604, &H0) 'Guardar como...
End Select

End Sub

'Cierra MsPaint
Public Function CloseMsPaint()
'Envía el mensaje de Cerrar a MSPaint
SendMessage hwMsPaint, WM_SYSCOMMAND, SC_CLOSE, &H0
End Function

'Obtiene el nombre del archivo Ej.: E:\Paisaje.jpg" ->obtiene "Paisaje.jpg"
Private Function gFileTitle(ByVal strPathFile As String) As String
Dim strFileTitle As String
strFileTitle = Space(100)
GetFileTitle strPathFile, strFileTitle, 100
gFileTitle = Left$(strFileTitle, InStr(1, strFileTitle, Chr$(0)) - 1)
End Function





Mete esto en un Form:

Código (vb) [Seleccionar] Expandir



Private Sub Command1_Click()
Dim strFile As String
strFile = App.Path & "\Dock.jpg"

'MS_SAVE = Guardar (No aparecerá cuadro de diálogo)
'MS_SAVE_AS = Guardar como ...
Call StartMSPaint("mspaint.exe", strFile, MS_SAVE): CloseMsPaint

End Sub

Private Sub Form_Load()
Show
'Centrar formulario
Me.Move (Screen.Width / 2) - (Me.Width / 2), (Screen.Height / 2) - (Me.Height / 2)
Command1.Caption = "Guardar con MsPaint"
End Sub




Lo que hace...
1. Abre MSPaint en modo oculto (se ejecuta pero no se ve) con la imagen que quieras convertir. Mejor dicho, volver a guardar pero con MSPaint.

2.  Envía un mensaje a MSPaint mediante SendMessage. Que viene a ser el equivalente a pulsar "Guardar" o "Guardar como" del menú. (A elección)

3. Cierra MSPaint.

Download code:
https://mega.co.nz/#!WEllUYYB!JpyYKyzME3pBQc_Q9oZkoa4fnRGuapVAA19fM0Z98oQ

Yo he tenido el mismo problema al parecer es un bug y se da con win 8 porque yo he instalado en 7 y no tuve ningun problema.

Por el momento solo hay un camino para resolverlo segun he leido y es modificar y pintar los bordes del formato. la verdad  no se si vale la pena el esfuerzo creo que puedo vivir con el titulo al centro jejeje
bueno te dejo el link donde lei esto y esta el codigo si tu quieres hacerlo saludos

https://social.msdn.microsoft.com/Forums/en-US/f612c65a-d946-47a2-ad21-71898c73f93f/alignment-of-windows-form-text-property?forum=vbgeneral

Es de agradecer que hayas encontrado el problema y lo hayas comentado. 

[Administrador]

Hola Josino

Lee en este Foro:
http://www.vbforums.com/showthread.php?599664-reading-writing-sectors-on-a-USB-memory-stick-including-MBR


Código de ejemplo:
http://www.vbforums.com/attachment.php?attachmentid=75666&d=1263714614

Introduce un PenDrive (vacío) y sustituye la letra "H:" por la letra del PenDrive en esta línea:

Código (vb) [Seleccionar] Expandir

If SplitMapping(0) = "H:" Then

Al hacer clic en el botón se leerán los dos primeros bytes del MBR. La línea "DirectWriteDriveNT SplitMapping (2), 0, 511, hex2ascii ("AA")" está desactivada porque es para escribir. "Ojo con eso".

El código debe iniciarse como "Administrador", así que si usas un cuenta de usuario limitada el programa no funcionará.

En cuanto a tu queja, entiendo tu malestar. A mi me pasa lo mismo. A veces pregunto y me contestan diciendo "haz un Read Truck" o algo así y es como si me dijeran "haz un chung ching chang". Vamos que me quedo igual. Pero a veces a pesar que la respuesta sea superbásica y vaga me sirve de referéncia para buscar en google, es decir, te indica un poco el camino.

Me recuerda un poco cuando estudiaba y usaba el Yahoo Respuestas para algo muy concreto y me contestaban "mira en le wikipedia" y se quedaban tan anchos  

Yo siempre que puedo pongo ejemplos, porque me encantan lo ejemplos y aporto código e incluso programas completos. Siempre se ha de suponer que el que pregunta no pregunta por gusto, si no porque no sabe.

Te sugiero que cuando busques algo y no encuentres busques en Google en inglés. Por ejemplo pones "Read MBR VB6", incluso en chino o coreano. Encontrás mucha más información y código. Hazlo desde Chrome y cuando entres en la página en cuestión pulsa con el botón derecho del ratón y selecciona "Traducir esta página" y se pondrá en castellano (español). Lo malo es que si hay código de ejemplo también se traducirá "If i= 6 then" -> "Si i=6  entonces" ten en cuenta eso.

[InternetOpen]

Hola,
Necesito saber el estado de la conexión, si es limitada o no. Pero de forma que no se cuelgue el programa. Por ejemplo, supongamos que tengo conexión a la red  y trato de abrir una web mediante InternetOpen desde el Timer y si no se puede da valor falso, en cuyo caso tengo conexión a la red LIMITADA. Pero ocurre que como uso el timer constantemente trata de abrir la web y como no puede se el programa se cuelga.

gracias

Nada no he sacado nada en claro del artículo.

De todas formas no lo entiendo, en todos los videotutoriales que veo, cuando se crea el formulario, el título está a la izquierda

¿Por qué a mi se me queda centrado ?

no lo entiendo

Hola #jefe1024

Ahora no tengo instalado VB.net, lo desinstalé temporalmente por diversas razones que no hace falta comentar.  Pero yo supongo que deberías mirar en las opciones de VB (que tiene muchas) haber si lo tienes configurado para que se muestre centrado. Ya que si VB lo centra por defecto por fuerza debe ser por eso.

Quizás sea una característica nueva en VB, ya que en VB.NET 2010 que es el que yo tengo, no recuerdo haber visto esa opción.