Trucos - 1ra Parte

Se Recomienda Resolución de 800x600 pixels

1ra PARTE

1.-Mover un Form sin caption ¡Al fin un método sencillo!

---------------------------------------------------------------------

NOTAS:

Listado a insertar en un módulo (.bas)

si se quiere poner en un formulario (.frm)

declarar la función como Private y quitar el Global de las constantes

---------------------------------------------------------------------

'Constantes y declaración de función:

'Constantes para SendMessage

Global Const WM_LBUTTONUP = &H202

Global Const WM_SYSCOMMAND = &H112

Global Const SC_MOVE = &HF010

Global Const MOUSE_MOVE = &HF012

#If Win32 Then

Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

#Else

Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long

#End If

'Este código se pondrá en el Control_MouseDown...

' Dim lngRet As Long

'Simular que se mueve la ventana, pulsando en el Control

If Button = 1 Then

'Envía un MouseUp al Control

lngRet = SendMessage(Control.hWnd, _

WM_LBUTTONUP, 0, 0)

'Envía la orden de mover el form

lngRet = SendMessage(FormX.hWnd, _

WM_SYSCOMMAND, MOUSE_MOVE, 0)

End If

2.-Mover y soltar controles con Drag & Drop (AL FIN!)

--------------------------------------------------------------------

Me ha costado cogerle el tranquillo al tema del Drag & Drop,

ya que los ejemplos no ayudaban mucho para lo que yo lo quería.

Se usan: DragOver, DragDrop, MouseDown y MouseUp.

El único coñazo es tener que poner código en todos los controles...

--------------------------------------------------------------------

'Variables a nivel del módulo

Dim DY As Single

Dim DX As Single

Private Sub CancelarDrag(Source As Control)

Source.Visible = True

Source.Drag vbCancel

End Sub

Private Sub FinalizarDrag(Source As Control, Button As Integer)

If Button = vbLeftButton Then

Source.Visible = True

Source.ZOrder

Source.Drag vbEndDrag

End If

End Sub

Private Sub IniciarDrag(Source As Control, Button As Integer, X As Single, Y As Single)

If Button = vbLeftButton Then

DX = X

DY = Y

'Permitir la operación de Drag & Drop

Source.Drag vbBeginDrag

'Cambiar a no visible, ya que si no, el form no detectaría que se ha soltado, si el puntero del ratón no sale del control.

Source.Visible = False

'Comienza el espectáculo

Source.Drag

End If

End Sub

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)

'Si se quieren excluir algunos controles,

'hacer aquí la comparación.

Source.Visible = True

Source.Move X - DX -60, Y - DY -60

Source.Drag vbEndDrag

Source.ZOrder

End Sub

'En cada control poner este código:

(cambiar %Control% por el nombre apropiado)

Private Sub %Control%_DragDrop(Source As Control, X As Single, Y As Single)

CancelarDrag Source

End Sub

Private Sub %Control%_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

IniciarDrag %Control%, Button, X, Y

End Sub

Private Sub %Control%_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

FinalizarDrag %Control%, Button

End Sub

'Se puede añadir DragOver para que muestre un icono no permitiendo que se suelte.

3.-Cambiar el tamaño de un Picture usando el API de Windows

--------------------------------------------------------------------

Redimensionar un Picture usando el API de Windows

Funciones usadas: GetWindowLong, SetWindowLong y SetWindowPos

El ejemplo tiene en el Form los siguientes objetos:

Label1() y Text1() en cada PicColumn()

Label2() en el form

--------------------------------------------------------------------

Option Explicit

'Prueba para redimensionar Pictures

Dim NumColumnas As Integer

Dim NumFilas As Integer

Dim bIniciando As Boolean

#If Win32 Then

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 SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long

#Else

Private Declare Function GetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer) As Long

Private Declare Function SetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Long) As Long

Private Declare Function SetWindowPos Lib "User" (ByVal hwnd%, ByVal hWndInsertAfter%, ByVal X%, ByVal Y%, ByVal cX%, ByVal cY%, ByVal wFlags%) As Integer

#End If

Const GWL_STYLE = (-16)

Const WS_THICKFRAME = &H40000

Const WS_CHILD = &H40000000

Const SWP_DRAWFRAME = &H20

Const SWP_NOMOVE = &H2

Const SWP_NOSIZE = &H1

Const SWP_NOZORDER = &H4

Private Sub Form_Load()

Dim Style as Long

bIniciando = True

Style = GetWindowLong(PicColum(0).hwnd, GWL_STYLE)

Style = Style& Or WS_THICKFRAME

Style = SetWindowLong(PicColum(0).hwnd, GWL_STYLE, Style)

Style = SetWindowPos(PicColum(0).hwnd, _

Me.hwnd, 0, 0, 0, 0, SWP_NOZORDER Or _

SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME)

NumFilas = 2

Load Text1(1)

Set Text1(1).Container = PicColum(0)

Text1(1).Visible = True

Text1(1).Top = Text1(0).Top + Text1(0).Height

Load Label2(1)

Label2(1).Visible = True

Label2(1).Top = Label2(0).Top + Label2(0).Height

Label2(1) = "Fila 2"

NumColumnas = 1

bIniciando = False

End Sub

Private Sub PicColum_Resize(Index As Integer)

Dim k As Integer

Dim i As Integer

If bIniciando Then Exit Sub

'ajustar el ancho del Label y los texts

Label1(Index).Width = PicColum(Index).Width

For i = 0 To NumFilas - 1

k = i * NumColumnas + Index

Text1(k).Width = PicColum(Index).Width

PicColum(0).Left = Label2(0).Width

For i = 0 To NumColumnas - 1

If i > 0 Then

PicColum(i).Left = PicColum(i - 1).Left + PicColum(i - 1).Width

End If

PicColum(i).Top = 0

End Sub

4.-Métodos para usar el CommonDialog de Visual Basic

--------------------------------------------------------------------

Ejemplos de los métodos para Seleccionar Impresora, Abrir, Guardar

--------------------------------------------------------------------

'Seleccionar impresora

On Local Error Resume Next

CommonDialog1.CancelError = True

CommonDialog1.Flags = cdlPDPrintSetup

CommonDialog1.ShowPrinter

Err = 0

'Abrir

On Local Error Resume Next

CommonDialog1.CancelError = True

'Especificar las extensiones a usar

CommonDialog1.DefaultExt = "*.crd"

CommonDialog1.Filter = "Cardfile (*.crd)|*.crd|Textos (*.txt)|*.txt|Todos los archivos (*.*)|*.*"

CommonDialog1.ShowOpen

If Err Then

'Cancelada la operación de abrir

Else

sArchivo = CommonDialog1.FileName

End If

'Guardar

On Local Error Resume Next

CommonDialog1.CancelError = True

'Especificar las extensiones a usar

CommonDialog1.DefaultExt = "*.crd"

CommonDialog1.Filter = "Cardfile (*.crd)|*.crd|Textos (*.txt)|*.txt|Todos los archivos (*.*)|*.*"

CommonDialog1.FileName = sArchivo

CommonDialog1.ShowSave

If Err Then

'Cancelada la operación de guardar

Else

sArchivo = CommonDialog1.FileName

End If

5.-Crear controles que se pueden cambiar de tamaño usando el API de Windows

--------------------------------------------------------------------

Convertir controles en VENTANAS. Poder cambiar el tamaño, etc.

Funciones usadas: GetWindowLong, SetWindowLong y SetWindowPos

--------------------------------------------------------------------

'Declaraciones globales a nivel de módulo

#If Win32 Then

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

#Else

Declare Function GetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer) As Long

Declare Function SetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Long) As Long

Declare Function SetWindowPos Lib "User" (ByVal hwnd%, ByVal hWndInsertAfter%, ByVal X%, ByVal Y%, ByVal cX%, ByVal cY%, ByVal wFlags%) As Integer

#End If

Global Const GWL_STYLE = (-16)

Global Const WS_THICKFRAME = &H40000

Global Const WS_CHILD = &H40000000

Global Const SWP_DRAWFRAME = &H20

Global Const SWP_NOMOVE = &H2

Global Const SWP_NOSIZE = &H1

Global Const SWP_NOZORDER = &H4

Private Sub Form_Load()

Dim Style&, ret&

'Cambiar %Control% por el control a usar: (Text, Picture...)

Style& = GetWindowLong(%Control%.hWnd, GWL_STYLE)

Style& = Style& Or WS_THICKFRAME

Style& = SetWindowLong(%Control%.hWnd, GWL_STYLE, Style&)

ret& = SetWindowPos(%Control%.hWnd, _

Me.hWnd, 0, 0, 0, 0, SWP_NOZORDER Or _

SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME)

End Sub

6.-Extraer iconos usando librerías del API de Windows

-----------------------------------------------------------------------

Extraer iconos de una aplicación o librería y dibujarlo en un picture.

Usando librerías del Api de Windows (ExtractIcon GetClassWord DrawIcon)

-----------------------------------------------------------------------

'Declaraciones para extraer iconos de los programas

'Versión 32 bits

'hIcon el número de icono a extraer, el 0 es el primero.

Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

Declare Function GetClassWord Lib "user32" Alias "GetClassWord" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Declare Function DrawIcon Lib "user32" Alias "DrawIcon" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long

Const GCW_HMODULE = (-16&)

Function ExtraerIcono (quePicture As Integer, sPrograma As String, queIcon As Long) As Long

'Cargar el icono del programa

Dim myhInst As Long

Dim hIcon As Long

Dim i As Long

myhInst = GetClassWord(hWnd, GCW_HMODULE)

hIcon = ExtractIcon(myhInst, sPrograma, queIcon)

If hIcon Then

Picture1(quePicture).Picture = LoadPicture("")

Picture1(quePicture).AutoRedraw = -1

i = DrawIcon(Picture1(quePicture).hDC, 0, 0, hIcon)

Picture1(quePicture).Refresh

End If

ExtraerIcono = hIcon

End Function

'Versión para 16 bits

'hIcon el número de icono a extraer, el 0 es el primero.

Declare Function ExtractIcon Lib "Shell" (ByVal hInstance As Integer, ByVal pszExeName As String, ByVal hIcon As Integer) As Integer

Declare Function GetClassWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer

Declare Function DrawIcon Lib "User" (ByVal hDC As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal hIcon As Integer) As Integer

Const GCW_HMODULE = (-16)

Function ExtraerIcono (quePicture As Integer, sPrograma As String, queIcon As Integer) As Integer

'Cargar el icono del programa

Dim myhInst As Integer

Dim hIcon As Integer

Dim i As Integer

myhInst = GetClassWord(hWnd, GCW_HMODULE)

hIcon = ExtractIcon(myhInst, sPrograma, queIcon)

If hIcon Then

Picture1(quePicture).Picture = LoadPicture("")

Picture1(quePicture).AutoRedraw = -1

i = DrawIcon(Picture1(quePicture).hDC, 0, 0, hIcon)

Picture1(quePicture).Refresh

End If

ExtraerIcono = hIcon

End Function

7.-Añadir a la lista de un Combo el texto escrito

--------------------------------------------------------------------

Añadir a la lista de un combo, el texto escrito, si es que no está.

Usarlo del tipo: 0-DropDown Combo

--------------------------------------------------------------------

Sub ActualizarCombo()

'Actualizar el contenido del Combo

Dim sTmp As String

Dim i As Integer

Dim j As Integer

Dim hallado As Boolean

Dim k As Integer

For k = 0 To 1

hallado = False

sTmp = Combo1(k).Text

If Len(Trim$(sTmp)) Then

j = Combo1(k).ListCount - 1

For i = 0 To j

If StrComp(Trim$(sTmp), Trim$(Combo1(k).List(i))) = 0 Then

hallado = True

Exit For

End If

If Not hallado Then

Combo1(k).AddItem sTmp

End If

End Sub

8.-Imitar un Combo Box al estilo del de ayuda.

--------------------------------------------------------------------

Para imitar un ComboBox parecido al de Buscar en Ayuda de Windows,

(va cambiando según las letras escritas).

El form debe tener un Textbox y un Listbox.

--------------------------------------------------------------------

'Código en un Módulo (.BAS):

Option Explicit

Global CHClickList As Integer

Global CHInChange As Integer

Sub CtrlTB_Change (OTB As TextBox, OLB As ListBox)

Dim Pos As Integer, I As Integer, L As Integer

Dim Aux As String

If CHClickList Then

CHClickList = False

Exit Sub

End If

Aux = OTB.Text

L = Len(Aux)

For I = 0 To (OLB.ListCount - 2)

If Not StrComp(Aux, Left$(OLB.List(I), L), 1) > 0 Then

Exit For

End If

Next I

OLB.TopIndex = I

OLB.ListIndex = I

End Sub

Sub CtrlTB_KeyPress (OTB As TextBox, OLB As ListBox, KeyAscii As Integer)

If KeyAscii = 13 Then

OTB.Text = Left$(OLB.List(OLB.ListIndex), 60)

CHInChange = False

Else

CHInChange = True

End If

End Sub

Sub CtrlLB_Click (OTB As TextBox, OLB As ListBox)

If Not CHInChange Then

OTB.Text = Left$(OLB.List(OLB.ListIndex), 60)

Else

CHInChange = False

End If

End Sub

Sub CtrlLB_MouseDown ()

CHClickList = True

End Sub

'Código en el Form (.FRM):

Sub List1_Click ()

CtrlLB_Click Text1, List1

End Sub

Sub List1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)

CtrlLB_MouseDown

End Sub

Sub Text1_Change ()

CtrlTB_Change Text1, List1

End Sub

Sub Text1_KeyPress (KeyAscii As Integer)

CtrlTB_KeyPress Text1, List1, KeyAscii

End Sub

El Codigo del Mes

Aqui le mostraremos el Codigo Fuente del Mes, Votalo Ya!!!

Preguntar

Tutoriales

Bajate el manual de VB

Contactenos

Enviar Codigos Fuente

Links y Banners

Publicite en nuestro Site

Pone Tu link Gratis!!!

Crea tu Web

Redirecciona tu Pagina Gratis!!!

Votanos en La web del Programador

Sugerencias