Simulation de la barre de titre

Télécharger le projet
Commenter

Description

Ce code vous permet de remplacer votre barre de titre par un petit activeX qui gère bioen évidement les évènement de mouse, contrairement à votre ancienne barre, on y voit que du feu !

Ce code est entièrement de moi, j'ai juste trouver l'idée sur un autre site présent dans l'annuaire de VB, mais ma solution est totalement différente.

Source / Exemple : 


Option Explicit

Private Type POINTAPI
        X As Long
        Y As Long
End Type

Dim CursorStart As POINTAPI

'Déclarations d'événements:
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event DblClick()
Event Click()
Event CloseClick()

Private Sub fermer_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
fermer(1).ZOrder
End Sub

Private Sub fermer_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
fermer(0).ZOrder
RaiseEvent CloseClick
Unload UserControl.Parent
End Sub

Private Sub titre_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
    CursorStart.X = X
    CursorStart.Y = Y
End Sub

Private Sub titre_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
    If Button = 1 And CursorStart.X <> 0 And CursorStart.Y <> 0 Then
        UserControl.Parent.Move UserControl.Parent.left - CursorStart.X + X, UserControl.Parent.tOp - CursorStart.Y + Y
    End If
End Sub

Private Sub titre_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
    CursorStart.X = 0
    CursorStart.Y = 0
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    titre.Caption = PropBag.ReadProperty("Texte", "Titre par défaut")
End Sub

Private Sub UserControl_Resize()
With UserControl
    titre.Width = .Width
    titre.Height = .Height
    fermer(0).tOp = 25
    fermer(0).left = .Width - fermer(0).Width - 30
    fermer(1).tOp = 25
    fermer(1).left = fermer(0).left
End With
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "Texte", titre.Caption, "Titre par défaut"
    Call PropBag.WriteProperty("Font", titre.Font, Ambient.Font)
End Sub

Public Property Get titreCaption() As String
titreCaption = titre.Caption
End Property

Public Property Let titreCaption(ByVal vNewValue As String)
titre.Caption = vNewValue
End Property

Conclusion :


PS : cette source est simple, donc ne cherchez pas à la compliquez comme toujours, je sais que j'aurais pu foutre la couleur , etc etc
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (leptidev)