Otra de mis aplicaciones, estoy practicando VB6 con lo que aprendo cada dia asi con la practica no se me olvida..
Bien, consiste en algo simple, uso dos API's SendMessage y ReleaseCapture para hacer Drag del formulario.., la barra de titulo se crea usando Lines, cambiando el color usando la función RGB(ByteR, ByteG, ByteB), y el Titulo del Form y la sombra del titulo son dos Label que tambien se crean en tiempo de ejecucion, ha y el boton de cerrar formulario tambien es un Label
Dejo un Screen, y luego dejo el Codigo:
Código:
Option Explicit
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
Private Declare Sub ReleaseCapture Lib "User32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private WithEvents FormStyleCaption As Label
Private WithEvents ButtonUnloadForm As Label
Private Sub ButtonUnloadForm_Click()
End
End Sub
Private Sub Form_Initialize()
With Form1
.ScaleMode = 1
If .BorderStyle <> 0 Then
Err.Raise 1, Me.Name, "Establece la propiedad de BorderStyle de tu Form a 0-None. ;)"
End If
End With
End Sub
Private Sub Form_Load()
Dim I As Long
Set ButtonUnloadForm = Me.Controls.Add("VB.Label", "ButtonUnloadForm")
With ButtonUnloadForm
.Top = 40
.Left = Me.Width - (.Width / Screen.TwipsPerPixelX) - 220
.Height = 220
.Width = 260
.Alignment = 2
.BackStyle = 1
.BorderStyle = 0
.Appearance = 0
.Font.Name = "Microsoft Sans Serif"
.BackColor = RGB(250, 0, 0)
.ForeColor = RGB(255, 255, 255)
.Caption = "X"
.Visible = True
End With
Set FormStyleCaption = Me.Controls.Add("VB.Label", "FormStyleCaption")
With FormStyleCaption
.Top = 80
.Left = 80
.Height = 250
.Width = Me.Width
.BackStyle = 0
.Font.Name = "Microsoft Sans Serif"
.ForeColor = RGB(255, 255, 255)
.Caption = Me.Caption
.Visible = True
End With
With Me.Controls.Add("VB.Label", "FormStyleCaption2")
.Top = 80
.Left = 60
.Height = 240
.Width = Me.Width
.BackStyle = 0
.Font.Name = "Microsoft Sans Serif"
.Caption = Me.Caption
.Visible = True
End With
For I = 10 To 280 Step 15
With Me.Controls.Add("VB.Line", "LineBorder_Title" & I)
.Y1 = I: .Y2 = I
.X1 = 10: .X2 = Me.Width - 20
.BorderColor = RGB(I, I, I + 50)
.Visible = True
End With
DoEvents
Next
With Me.Controls.Add("VB.Shape", "ShapeBorder")
.Top = 0
.Left = 0
.Height = Me.Height
.Width = Me.Width
.BorderColor = RGB(50, 100, 200)
.BorderWidth = 1
.FillStyle = 0
.FillColor = RGB(220, 220, 255)
.Visible = True
End With
End Sub
Private Sub FormStyleCaption_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Dim Ret As Long
Call ReleaseCapture
If Button = vbLeftButton Then
Call SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
No necesitamos agregar controles, para probar, Copy And Paste..
y lo mas importante que se me olvidaba, deben establecer la propiedad BorderStyle del Form a "1-None"
Espero les sirva, otra idea mas de como hacer nuestros Skin's
SaluDOS!!!