|
Mostrar Mensajes
|
Páginas: 1 2 3 4 5 [6]
|
51
|
Programación / Programación Visual Basic / Salvar JPG con mucho menos peso sin perder calidad
|
en: 8 Mayo 2015, 19:37 pm
|
Hola a todos:
Os explico mi necesidad, y de paso esto os puede servir a muchos para diminuir mucho el peso de imágenes JPG hechas con cámaras digitales o móviles.
Por casualidad descubrí que abriendo una imagen JPG en msPaint de Windows XP, y sin hacer nada con ella, salvarla con Ctr+g o en el Menú...Archivo...Guardar, lógicamente con el mismo nombre, ahora esa imagen pesará entre el 30 al 85 % menos, un ejemplo real con una de mis imágenes hecha con una cámara Cannon EOS 600D: Imagen original pesa 8.89 Mb, la misma cargada en msPaint y salvada pesa 1.44 Mb, o sea 83,80 % menos. Comparadas en el visor de imágenes de Windows, son exactamente iguales no hay perdida de resolución, no eres capaz de distinguirlas, y con Zoom en Photosop son exactamente iguales y la ficha EXIF también.
Si alguien lo duda que haga la prueba, y si alguien sabe por que ocurre esto que me lo explique.
Entonces he hecho una aplicación, donde hago un Drag & Drop de una carpeta donde haya imagenes JPG, o de varios archivos seleccionados de una carpeta, y solo los que sean JPG se cargan sus rutas completas en un ListBox, luego al pulsar un botón, se genera una carpeta donde se copian todos los JPG's originales de la lista. Y a continuación se cargaran uno a uno en Paint, y se salvan mandando con SendKeys las pulsaciones Ctr+g, por que no he podido conseguir como mandarle el comando 'Guardar' a Paint desde vb6, si alguien sabe como hacerlo por favor explicármelo.
Pero necesito hacer esa misma aplicación para Windows 7, y el msPaint de Win7, utilizando el mismo 'truco' que el de XP, no reduce nada el peso, pero ejecutando una copia del msPaint de Win XP desde Win7, si funciona y lo hace igual que lo que he mencionado.
Entonces la idea es, tengo una copia de msPaint de Win XP, que se llama 'SDpaint.exe'
Y la aplicación al ejecutarse, abre 'SDpaint.exe' con Shell: Y lo que necesito, es que una vez 'SDpaint.exe' esta abierto, sin ninguna imagen, desde mi aplicación cargar una serie de imágenes.jpg una a una desde la lista de un ListBox (que tiene la ruta completa de la imagen), pero en el 'SDpaint.exe' abierto al principio, no me sirve cerrar 'SDpaint.exe' y cargar una imagen en un nuevo 'SDpaint.exe', cerrarlo y cargar la siguiente abriendo otro.
He probado capturando primero el hWnd del 'SDpaint.exe' abierto, en la variable LhWnd , para utilizarlo con ShellExecute así: L = ShellExecute(LhWnd, "Open", ListFiles.List(i), "", "", 0) Pero ejecuta el visor de imágenes de Windows, no carga la imagen en el Paint abierto, y creo que esto se debe poder hacer, no encuentro nada en Internet.
Agradecería cualquier ayuda, perdonad el tocho.
Un saludo.
|
|
|
52
|
Programación / Programación Visual Basic / Re: Como leer info del área de notificación
|
en: 17 Enero 2014, 14:43 pm
|
PD: No te ofendas, pero creo que deberias aprender cómo funciona el Sistema Operativo, antes de intentar programarlo... Hola MCKSys Argentina: No me ofendo, pero yo no pretendo programar el Sistema Operativo, sólo pretendía poder leer el tiempo de conexión de mi ADSL, y te agradezco mucho que hayas intentado ayudarme en esto. He copiado tu código, y en lugar de: If InStr(1, accName, "Threat detected by Sophos.") <> 0 Then 'compare propval with my text Form1.Label1.Caption = "Sophos Detectado!!!" 'jejeje End If He puesto: If InStr(1, accName, "Wanadoo ADSL está ahora conectado") <> 0 Then 'compare propval with my text Form1.Label1.Caption = "Wanadoo detectado!!!" 'jejeje End If Que sería el que yo necesito, pero este código no me sirve para lo que quiero, por que solo lo detecta, y además lo sigue detectando aunque el ADSL esté desconectado, y no haya icono en la barra de notificación. El poner este post con la pregunta, era para obtener info de como hacerlo, y pensaba que esto sería muy fácil a través de alguna API, pero veo que es más complicado, de hecho no encuentro info en Internet sobre esto, todo lo que encuentro es sobre como poner ana aplicación en el Systray, pero eso ya se como se hace. Yo tengo una aplicación que hice para capturar, ventanas abiertas, y al menos con esa aplicación, si puedo acceder a parte de los datos de una ventana. pego aquí el código por si esto da alguna pista para conseguirlo: Eset es el código del Form: Private Sub Timer1_Timer() Dim Ret As Long, i As Integer, mem 'Obtiene la coordenada del Mouse Ret = GetCursorPos(Cor) 'Recuperamos el HWND de la ventana asociada a esa coordenada Handle = WindowFromPoint(Cor.x, Cor.y) 'Handle de la ventana padre hParent = GetParent(Handle) 'Llenamos un Buffer ClassName = Space$(128) 'Recupera el Classname y lo devuelve en el Buffer Ret = GetClassName(Handle, ClassName, 128) 'Extraemos el nombre de la clase ClassName = LCase(Left$(ClassName, Ret)) ' Cantidad de caracteres del texto Caption_Ventana = String(GetWindowTextLength(Handle), Chr$(0)) 'Retorna el caption Call GetWindowText(Handle, Caption_Ventana, 100) 'Obtiene la coordenada del Mouse de la ventana activa Call ScreenToClient(Handle, Cor) 'detectar el teclado 'Consultamos el valor de la tecla mediante el Api. _ Si se presionó devuelve -32767 y mostramos el valor de i If GetAsyncKeyState(vbKeyBack) = -32767 Then Form1.Check1.Value = 0 coorX = Cor.x coorY = Cor.y mem = vbKeyBack 'Call ClickMouse(Handle) End If 'Imprimimos en el Form con los valores Me.Cls Me.Print " Hwnd : " & Handle Me.Print " Hwnd Parent : " & hParent Me.Print " Nombre de clase : " & ClassName Form1.Text1.Text = ClassName Me.Print " Caption de la ventana : " & Caption_Ventana Me.Print "x: " & Cor.x & " y: " & Cor.y Form1.Text3 = Caption_Ventana & vbNewLine & " Hwnd : " & Handle & vbNewLine & " Hwnd Parent : " & hParent & vbNewLine End Sub
Y este es el módulo.bas: 'Declaraciones APi
' Constantes para las teclas y otros Public Const KEYEVENTF_KEYUP = &H2 Public Const KEYEVENTF_EXTENDEDKEY = &H1 'Declaración del Api keybd_event para la presión de tecla Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, _ ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long) '--------------------------------------------------------------
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Public Declare Function SendMessageSTRING Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long Public Declare Function SendMessageLONG Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long Public Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Public Declare Function ScreenToClient Lib "user32" ( _ ByVal hwnd As Long, _ lpPoint As POINTAPI) As Long Public Declare Function ClientToScreen Lib "user32" ( _ ByVal hwnd As Long, _ lpPoint As POINTAPI) As Long ''''''''''''''''''''''''''''''''''''''''''''''''''' Public Declare Function GetComboBoxInfo Lib "user32" _ (ByVal hwndCombo As Long, _ CBInfo As COMBOBOXINFO) As Long
' Mensajes y valores para los ComboBox Public Const CB_GETCOUNT = &H146 Public Const CB_GETCURSEL = &H147 Public Const CB_GETLBTEXT = &H148 Public Const CB_GETLBTEXTLEN = &H149
Public n_Items As Long, Item_n As Long Public i As Integer Public Items As String Public El_Item As String Public Length As Long '''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Function SendMessage _ Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Obtiene el Handle de una ventana a partir de una coordenada Public Declare Function WindowFromPoint _ Lib "user32" ( _ ByVal xPoint As Long, _ ByVal yPoint As Long) As Long
'Recupera el nombre de la clase de Ventana a partir de su handle Public Declare Function GetClassName _ Lib "user32" _ Alias "GetClassNameA" ( _ ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long
'REcupera el Handle de la ventana padre de una ventana Public Declare Function GetParent _ Lib "user32" ( _ ByVal hwnd As Long) As Long
'Estas 2 funciones obtienen el Caption de la ventana Public Declare Function GetWindowText _ Lib "user32" _ Alias "GetWindowTextA" ( _ ByVal hwnd As Long, _ ByVal lpString As String, _ ByVal cch As Long) As Long
' Retorna la cantidad de caracteres del caption de la ventana Public Declare Function GetWindowTextLength _ Lib "user32" _ Alias "GetWindowTextLengthA" ( _ ByVal hwnd As Long) As Long
'Función Api GetAsyncKeyState para saber si se ha pulsado mouse o tecla Public Declare Function GetAsyncKeyState _ Lib "user32" ( _ ByVal vKey As Long) As Integer
Public Const WM_LBUTTONDOWN = &H201 Public Const WM_LBUTTONUP = &H202 Public Const WM_LBUTTONDBLCLK = &H203 Public Const WM_RBUTTONDOWN = &H204 Public Const WM_RBUTTONUP = &H205 Public Const WM_RBUTTONDBLCLK = &H206 Public Const WM_SETTEXT = &HC Public Const WM_MOUSEMOVE = &H200 Public Const WM_NCMOUSEMOVE = &HA0 Public Const WM_SETFOCUS = &H7
Public Declare Function PostMessageBynum Lib "user32" Alias "PostMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam _ As Long) As Long 'enviar mensajes al control Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal _ y As Long) As Long 'posicionar el puntero del ratón Public Declare Function GetCursorPos _ Lib "user32" ( _ lpPoint As POINTAPI) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
' Estructura POINTAPI para usar con WindowFromPoint Public Type POINTAPI x As Long y As Long End Type
Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type
Public CBI As COMBOBOXINFO Public Type COMBOBOXINFO cbSize As Long rcItem As RECT rcButton As RECT stateButton As Long hwndCombo As Long hwndEdit As Long hwndList As Long End Type '-------------------------------------------------------------------------------
Public Vip As String, N As Integer, s As String Public l As Long, PosXY As Long Public Cor As POINTAPI, Handle As Long Public hParent As Long, ClassName As String Public coorX As Long, coorY As Long, BcoorX As Long, BcoorY As Long Public rct As RECT, W_mixer As Integer, H_mixer As Integer, Mixer_H As Integer Public hwndMixer As Long, carpetaSkin As String, BackhWnd As Long, hwndMain As Long Public PrimeraVez As Boolean, Caption_Ventana As String Public No_select As Boolean, Skin_activo As Boolean Public tail As Integer, head_width As Integer, W_ancho As Integer, Path_Bitmap As String, Path_Mixer_ini As String Public H_Min As Integer, N_SnapShots As Integer, N_SnapScreen As Integer Public SkinLeido As Boolean, W_BotSnap As Integer, Xback As Integer, Yback As Integer Public SnapShot As Integer, Ejecuta As String, Banco As Integer
'Mandar la pulsación del mouse Public Sub ClickMouse(ByVal hwnd, cual As String, snap As String) Dim x As Integer, y As Integer, a As Integer 'simular el click del ratón 'If cual = "L" Then Select Case snap Case "MIXER" 'Para calcular el ancho y alto de la ventana del mixer Call GetClientRect(hwnd, rct) x = (rct.Right - rct.Left) - W_mixer y = coorY - (Mixer_H - (rct.Bottom - rct.Top)) Case "SCREEN" 'Para calcular el ancho y alto de la ventana del mixer Call GetClientRect(hwnd, rct) x = 5 'añade a la coordenada Left para que este centrada y = coorY - (Mixer_H - (rct.Bottom - rct.Top)) 'si tiene los snapscreen en la zona de generales If Form1B.CheckSnapScreen.Value = 1 Then x = (rct.Right - rct.Left) a = (x - tail) + coorX coorX = a x = 0 End If Case "BANCO" BcoorX = Cor.x BcoorY = Cor.y Call GetClientRect(hwnd, rct) If BcoorX > rct.Right Or BcoorX < rct.Left Or BcoorY > rct.Bottom Or BcoorY < rct.Top Then Exit Sub y = coorY - (Mixer_H - (rct.Bottom - rct.Top)) Cor.x = rct.Right - 30 Cor.y = y PosXY = Cor.x + (y * &H10000) 'Call SetForegroundWindow(hwnd) 'Foco a ventana del Mixer Call ClientToScreen(hwnd, Cor) Call SetCursorPos(Cor.x, Cor.y) GoTo bank End Select PosXY = (coorX + x) + (y * &H10000) Cor.x = coorX + x Cor.y = y bank: If cual = "L" Then l = PostMessageBynum(hwnd, WM_LBUTTONDOWN, 0&, PosXY) l = PostMessageBynum(hwnd, WM_LBUTTONUP, 0&, PosXY) End If If cual = "R" Then l = PostMessageBynum(hwnd, WM_RBUTTONDOWN, 0&, PosXY) l = PostMessageBynum(hwnd, WM_RBUTTONUP, 0&, PosXY) End If PosXY = 0 End Sub
Si puedes orientarme sobre esto, te lo agradezco, pero si estimas que es muy complicado, o no quieres responder, pues lo entiendo y repito: En cualquier caso muchas gracias por tu interés. Saludos.
|
|
|
53
|
Programación / Programación Visual Basic / Re: Como leer info del área de notificación
|
en: 16 Enero 2014, 22:35 pm
|
Perdona MCKSys Argentina, pero si no me pones un ejemplo de código, no entiendo tu respuesta y no se como empezar a probar, por que ni siquiera arranca el ejemplo de código te he puesto, o sea este: Private Sub Command1_Click() Dim r As Long r = EnumWindowsProc(Me.hwnd, 0) End Sub Por que sale este error: 'Error de compilación No se ha definido el tipo definido por el usuario' Y se resalta esta línea: objIA As IAccessible Gracias.
|
|
|
54
|
Programación / Programación Visual Basic / Re: Como leer info del área de notificación
|
en: 16 Enero 2014, 11:54 am
|
Hola MCKSys Argentina: Muchas gracias por reponder, he copiado este código a un módulo.bas. Pero no se que función tengo que llamar y como. Solo hay 2 funciones: EnumWindowsProc IAccessibleFromHwnd En el formulario he puesto un Command1 que llama a esta: Private Sub Command1_Click() Dim r As Long r = EnumWindowsProc(Me.hwnd, 0) End Sub Al compilar, sale 'Error de compilación No se ha definido el tipo definido por el usuario' Y se resalta esta línea: objIA As IAccessible Puedes ponerme un ejemplo de que llamada a que función, y por que sale este error al compilar. Saludos.
|
|
|
56
|
Programación / Programación Visual Basic / Como leer info del área de notificación
|
en: 15 Enero 2014, 13:18 pm
|
Hola a todos: He hecho una aplicación que necesita poder leer el tiempo de conexión de mi modem ADSL, he buscado por la red y no encuentro nada, ni siquiera se si esto es posible hacerlo con VB6. Agradecería mucho algo de información al respecto. Adjunto 2 imágenes para que se entienda bien lo que quiero.     Saludos.
No se ve bien la primera imagen, este es el link para poder verla a tamaño real. http://www.casimages.es/i/140115011940468355.jpg.html][IMG]http://nsae01.casimages.net/img/2014/01/15/mini_140115011940468355.jpg Lo que quiero poder leer es la duración que está señalada con una flecha roja en la imagen. Gracias, y perdón por mi torpeza con esto
|
|
|
|
|
|
|