|
681
|
Programación / Programación Visual Basic / Re: Temporalizador para Excel
|
en: 8 Diciembre 2006, 11:04 am
|
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
|
Programación / Programación Visual Basic / Re: Form semi-transparente en el q se vean los controles???
|
en: 8 Diciembre 2006, 10:57 am
|
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 Option 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=23372Ahora otra forma mas compatible con las verciones de window devido a las apis que utiliza Option 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
|
|
|
684
|
Programación / Programación Visual Basic / Re: Achicar Imagen
|
en: 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
|
|
|
686
|
Programación / Programación Visual Basic / Re: Archivos Grandes no se envian y pequeños si¡¡¡¡¡ Que honda??
|
en: 17 Noviembre 2006, 05:32 am
|
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 Cliente1 Winsock nombre =Ws 3 commandbutton command1, command2, command3 1 Textbox1 1 CommonDialog1 Option 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 Servidor1 Winsock nombre =Ws 1 Textbox1 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
|
Programación / Programación Visual Basic / Re: ¿Es posible recuperar el texto de un control label mediante API's?
|
en: 8 Noviembre 2006, 07:11 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 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
|
|
|
689
|
Programación / Programación Visual Basic / Broma para IExplorer ("esta buena") visual basic
|
en: 2 Noviembre 2006, 04:09 am
|
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) Option 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 F12lo dejo compilado por si es que no tienene el visual basic http://ar.geocities.com/leandroascierto/Broma_IExplorer.zipSaludos
|
|
|
690
|
Programación / Programación Visual Basic / Re: Comprimir en UPX
|
en: 26 Octubre 2006, 07:30 am
|
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
|
|
|
|
|
|
|