Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Mensajes - LeandroA

#681
puedes usar el api del SetTimer  el problema es que no tienes un hwnd pues lo que puedes hacer es usar el api findwindow con el titulo del la la ventana de excel

tengo un ejemplo pero como no tengo excel instalado no te lo puedo pasar
#682
buenas para empezar la transparencia no se puede aplicar a los controles esto solo vale para las ventanas padres y no las hijas si se puede hacer algunas trampitas con el api AlphaBlend como por ejemplo la que hice con este ocx
http://www.canalvisualbasic.net/forum/forum_posts.asp?TID=24458

En cuanto a lo que viene la pregunta del post no conozco manera de hacerlo de forma que el formulario se mitad transparente y los controles no, pero si hacer totalmente transparente el form y no los controles

dos ejemplos

este primero es facil y rapido pero solo valido para win xp

CitarOption Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Const LW_KEY = &H1
Const G_E = (-20)
Const W_E = &H80000

Private Sub Form_Load()
Skin Me, vbRed
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'para mover el form de cualquier parte
ReleaseCapture
SendMessage hWnd, 161, 2, 0
End Sub
Sub Skin(Frm As Form, Color As Long)
Frm.BackColor = Color
Dim Ret As Long
Ret = GetWindowLong(Frm.hWnd, G_E)
Ret = Ret Or W_E
SetWindowLong Frm.hWnd, G_E, Ret
SetLayeredWindowAttributes Frm.hWnd, Color, 0, LW_KEY
End Sub

bien este codigo lo que hace es eliminar regiones de color rojo (rojo en este caso) que se encuentre en el formulario por lo que si un label es de color rojo tambien lo hara transparente ,este ejemplo mas bien viene con otro proposito como el que pueden ver en el siguiente
http://www.canalvisualbasic.net/forum/forum_posts.asp?TID=23372

Ahora otra forma mas compatible con las verciones de window devido a las apis que utiliza

CitarOption Explicit

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Public Sub GlassifyForm(frm As Form)
Const RGN_DIFF = 4
Const RGN_OR = 2

Dim outer_rgn As Long
Dim inner_rgn As Long
Dim wid As Single
Dim hgt As Single
Dim border_width As Single
Dim title_height As Single
Dim ctl_left As Single
Dim ctl_top As Single
Dim ctl_right As Single
Dim ctl_bottom As Single
Dim control_rgn As Long
Dim combined_rgn As Long
Dim ctl As Control

    If WindowState = vbMinimized Then Exit Sub

    ' Create the main form region.
    wid = ScaleX(Width, vbTwips, vbPixels)
    hgt = ScaleY(Height, vbTwips, vbPixels)
    outer_rgn = CreateRectRgn(0, 0, wid, hgt)

    border_width = (wid - ScaleWidth) / 2
    title_height = hgt - border_width - ScaleHeight
    inner_rgn = CreateRectRgn(border_width, title_height, wid - border_width, hgt - border_width)

    ' Subtract the inner region from the outer.
    combined_rgn = CreateRectRgn(0, 0, 0, 0)
    CombineRgn combined_rgn, outer_rgn, inner_rgn, RGN_DIFF

    ' Create the control regions.
    For Each ctl In Controls
        If ctl.Container Is frm Then
            ctl_left = ScaleX(ctl.Left, frm.ScaleMode, vbPixels) + border_width
            ctl_top = ScaleX(ctl.Top, frm.ScaleMode, vbPixels) + title_height
            ctl_right = ScaleX(ctl.Width, frm.ScaleMode, vbPixels) + ctl_left
            ctl_bottom = ScaleX(ctl.Height, frm.ScaleMode, vbPixels) + ctl_top
            control_rgn = CreateRectRgn(ctl_left, ctl_top, ctl_right, ctl_bottom)
            CombineRgn combined_rgn, combined_rgn, control_rgn, RGN_OR
        End If
    Next ctl

    ' Restrict the window to the region.
    SetWindowRgn hWnd, combined_rgn, True
End Sub

Private Sub Form_Resize()
    GlassifyForm Me
End Sub

saludos
#683
hola te paso un ejemplo

http://ar.geocities.com/leandroascierto/HTMLEvents.zip

si quieres otras clases de ejemplo

http://ar.geocities.com/leandroascierto/Tagmodell_des_Webbrowsers.zip

y por ultimo te paso otro que es el que estuve trabajando ultimamente mas complicado y fuera de tema dira pero puedes sacar algunos provechos

http://ar.geocities.com/leandroascierto/EditorHTML.zip
#684
Programación Visual Basic / Re: Achicar Imagen
29 Noviembre 2006, 00:44 AM
puedes usar el metodo paintpicture por ejemplo

Picture1.AutoRedraw = True
Picture1.PaintPicture Clipboard.GetData, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
SavePicture Picture1.Image, "C:\Captura.bmp"

obiamente las medias del picture seran el tamaño de la imagen
#685
bueno ya que esta yo hice un explorador remoto hace un tiempo realmente lo hice con lo que savia hasta el momento pero bueno a veces aprendiendo uno se da cuenta cuantas cosas se pueden corregir y mejorar por ejemplo yo utilize otra forma para el envio de archivos 
con lo cual me gusto mas de esta forma que vos usaste , tambien solo es balido para xp ya que usa GDIPluss para comprimir imagenes pero bien ya queda como esta jeje, fijate tiene muchas opciones

http://www.recursosvisualbasic.com.ar/htm/utilidades-codigo-fuente/explorador-remoto.htm

una versión un poco mas nueva (con la opcion de enviar comandos D.O.S

http://ar.geocities.com/leandroascierto/Explorador-Remoto.zip
#686
hola haber yo hice la prueba y no tuve ningún problema quizás te falto declarar alguna variable en el general , prova de nuevo como lo pongo yo con dos proyectos nuevos

Cliente

1 Winsock   nombre =Ws
3 commandbutton command1, command2, command3
1 Textbox1
1 CommonDialog1

CitarOption Explicit
Dim DataFile As String, LenFile As Long, Envio As Boolean, NombreDescarga As String, Send As String

Private Sub Command1_Click()
WS.Connect "127.0.0.1", 1000
End Sub

Private Sub Command2_Click()
NombreDescarga = "C:\" & Right(Text1, Len(Text1) - InStrRev(Text1, "\"))
WS.SendData "Descargar" & "|" & Text1.Text
End Sub

Private Sub Command3_Click()
On Error GoTo Salir
CommonDialog1.CancelError = True
CommonDialog1.ShowOpen
Text1 = CommonDialog1.FileName
Dim NombreEnvio As String
NombreEnvio = Right(Text1, Len(Text1) - InStrRev(Text1, "\"))
WS.SendData "archivo" & "|" & FileLen(Text1) & "|" & NombreEnvio
Exit Sub
Salir:

End Sub

Private Sub Form_Load()
'--------Cliente--------
Command1.Caption = "Conectar"
Command2.Caption = "Descargar"
Command3.Caption = "Subir al Servidor"
End Sub

Private Sub WS_Close()
WS.Close
Me.Caption = "Cliente Desconectado"
End Sub

Private Sub WS_Connect()
Me.Caption = "Cliente Conectado"
End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
'On Error Resume Next
Dim Data As String
WS.GetData Data

'------------------------------ ENVIO----------------------------------
If Data = "SendFile" Then
Dim Send As String
Open Text1.Text For Binary As #1
Send = Space(LOF(1))
Get #1, , Send
Close #1
WS.SendData Send
End If
'--------------------------------RECIVIR-------------------------------
If Envio = True Then

DataFile = DataFile & Data
Me.Caption = "Recibiendo " & Len(DataFile) & " DE " & LenFile
If Len(DataFile) = LenFile Then
Open NombreDescarga For Binary As #1
Put #1, , DataFile
Close #1
DataFile = ""
MsgBox "El Fichero se a Enviado Correctamente y se guardo en " & NombreDescarga
Me.Caption = "Cliente Conectado"
Envio = False
End If
End If

If Left(Data, 3) = "Tam" Then
Dim dato As Variant
dato = Split(Data, "|")
LenFile = dato(1)
Envio = True
WS.SendData "SendFile"
End If
End Sub

Servidor

1 Winsock   nombre =Ws
1 Textbox1

Citar
Option Explicit
Dim directorioarchivo As String
Dim Send As String, DataFile As String, Namee As String, LenFile As Long, Envio As Boolean
Private Sub ws_ConnectionRequest(ByVal requestID As Long)
Ws.Close
Ws.Accept requestID
Me.Caption = "Servidor Conectado"
End Sub

Private Sub Form_Load()
'--------Servidor--------
Ws.LocalPort = 1000
Ws.Listen
End Sub

Private Sub Ws_Close()
Ws.Close
Ws.Listen
Me.Caption = "Servidor Desconectado"
End Sub

Private Sub Ws_Connect()
Me.Caption = "Servidor Conectado"
End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim Data As String, Dato As Variant
Ws.GetData Data
'----------------------------------RECIVE----------------------------------------
If Envio = True Then
DataFile = DataFile & Data
Me.Caption = "Recibiendo " & Len(DataFile) & " DE " & LenFile
If Len(DataFile) = LenFile Then
Open Text1.Text For Binary As #1
Put #1, , DataFile
Close #1
DataFile = ""
MsgBox "El Fichero se a Recibido Correctamente y se guardo en" & Text1
Me.Caption = "Servidor Conectado"
Envio = False
End If
End If

If Left(Data, 7) = "archivo" Then

Dato = Split(Data, "|")
LenFile = Dato(1)
Text1.Text = "c:\" & Dato(2)
Envio = True
Ws.SendData "SendFile"
End If
'1-----------------------------------ENVIA---------------------------------------
If Left(Data, 9) = "Descargar" Then
Dato = Split(Data, "|")
directorioarchivo = Dato(1)
Ws.SendData "Tam" & "|" & FileLen(directorioarchivo)
End If

If Left(Data, 8) = "SendFile" Then
Open directorioarchivo For Binary As #1
Send = Space(LOF(1))
Get #1, , Send
Close #1
Ws.SendData Send
End If

End Sub


Saludos
#687
Cita de: NekroByte en  8 Noviembre 2006, 00:41 AM
Un Label no es ningún dibujo ni nada, es una ventana, por lo tanto tiene un hWnd.

Lo que ocurre es que es una ventana hija de la instancia de tu aplicación, y para encontrar su hWnd primero debes encontrar el de la madre y luego usar la api EnumChildWindows para que te liste todos. O más fácil: con Label.hWnd y listo, jaja, sin tanta complicación.

Para obtener lo que tiene escrito es con GetWindowName().


mmm, que error  ;D hay ventanas que no poseen hwnd una de ellas es el label (que si te fijas no posee la propiedad label1.hwnd)y otra por ejemplo es el control image, si has echo alguna ves un ocx fijate en la ventana del usercontrol que tienen una propiedad llamada  windowless y veras que es ta pierde las propiedades de una ventana convencional (hija o no ) es masomenos como una forma de dibujo y no una ventana , y fijate que quita el hwnd
#688
HOLA NO SE PUEDE PUES NO TINE HWND

sALUDOS
#689
Hola el otro dia encontre una rutina javascript que esta buena asi que la adapte en parte en visual basic para hacer una borma para IExplorer

Antetodo es inofenciva no me gustan los virus (un poquito si los troyanos), se trata de una rutina javascript que lo que hace es rotar en forma de circulos todas las imagnes de navegador, bien si esta la ponesmos en la barra del explorador y le damos click al boton ir se ejecuta, asi que cree una rutina para que vaya verficando si se encuentra el explorador IE este ponga la rutina en la barra de navegacion y haga click en el boton ir y asi se ejecuta en cada ventana que pase al frente de IE


Agreguen este codigo a un modulo bas y hagan que el proyecto se ejecute desde el Sub Main (osea no hace falta formulario)

CitarOption Explicit

Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETTEXT = &HC
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202

Private Const Script = _
    "javascript:R=0;%20x1=.01;%20y1=.005;%20x2=.25;%20y2=.24;%20x3=1.6;%20y3=.24;%20x4=300;%20y4=200;%20x5=300;%20y5=200;%20DI=" _
    & "document.images;%20DIL=DI.length;%20function%20A(){for(i=0;%20i<DIL;%20i++){DIS=DI[%20i%20].style;%20DIS.position='absolute';" _
    & "%20DIS.left=Math.sin(R*x1+i*x2+x3)*x4+x5;%20DIS.top=Math.cos(R*y1+i*y2+y3)*y4+y5}R++}setInterval('A()',5%20);%20void(0)"

Dim TextEdit As Long, BotonIr As Long, StatuBarHwnd As Long, TextStatuBar As String, OldHandle As Long


Public Function ClassName(Handle As Long) As String
Dim retval As Long, lpClassName As String
lpClassName = Space(256)
retval = GetClassName(Handle, lpClassName, 256)
ClassName = Left$(lpClassName, retval)
End Function


Public Function GetWindowText(Handle As Long) As String
Dim retval As Long, StrLen As Long, URL As String
StrLen = SendMessage(Handle, WM_GETTEXTLENGTH, ByVal CLng(0), ByVal CLng(0)) + 1
URL = Space(StrLen)
retval = SendMessage(Handle, WM_GETTEXT, ByVal StrLen, ByVal URL)
GetWindowText = Left(URL, Len(URL) - 1)
End Function

Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
If ClassName(hWnd) = "ToolbarWindow32" And ClassName(GetParent(hWnd)) = "ComboBoxEx32" Then BotonIr = hWnd
If ClassName(hWnd) = "Edit" And ClassName(GetParent(hWnd)) = "ComboBox" Then TextEdit = hWnd
If ClassName(hWnd) = "msctls_statusbar32" Then StatuBarHwnd = hWnd
TextStatuBar = GetWindowText(StatuBarHwnd)
EnumChildProc = 1
End Function

Public Function EjecutarScript() As Boolean
Dim TempText As String, retval As Long
TempText = GetWindowText(TextEdit)
If TempText <> "" Then
    retval = SendMessage(TextEdit, WM_SETTEXT, ByVal Len(Script), ByVal Script)
    retval = SendMessage(BotonIr, WM_LBUTTONDOWN, ByVal CLng(0), ByVal CLng(0))
    retval = SendMessage(BotonIr, WM_LBUTTONUP, ByVal CLng(0), ByVal CLng(0))
    DoEvents
    Sleep 20
    retval = SendMessage(TextEdit, WM_SETTEXT, ByVal Len(TempText), ByVal TempText)
Else
    OldHandle = 0
End If
End Function



Private Sub Main()
Dim Handle As Long, Salir As Boolean

If App.PrevInstance = True Then End

Do While Not Salir
DoEvents
Sleep 20


If GetAsyncKeyState(123) = -32767 Then End

Handle = GetForegroundWindow

If Handle <> OldHandle Then

    If ClassName(Handle) = "IEFrame" Then

        EnumChildWindows Handle, AddressOf EnumChildProc, ByVal 0&
         
        If TextStatuBar = "Listo" Or TextStatuBar = "" Then
            OldHandle = Handle
            EjecutarScript
        Else
            OldHandle = 0
        End If
   
    End If
End If

Loop

End Sub



Para detener el programa apreten F12

lo dejo compilado por si  es que no tienene el visual basic

http://ar.geocities.com/leandroascierto/Broma_IExplorer.zip

Saludos



#690
Programación Visual Basic / Re: Comprimir en UPX
26 Octubre 2006, 07:30 AM
Cita de: VirucKingX en 25 Octubre 2006, 22:35 PM
Lamentablemente no se C++


:-(

con visual se puede hacer todo lo mencionado, solo vasta con que comprimas ambos ejecutables con el upx y luego escrvies el segundo de forma binaria dentro del primero (con una tercera aplicacion) y cuando quieres as que el primer programa lo extraiga de si mimsmo cuando quieras

Saludos