Simulation de la barre de titre

Soyez le premier à donner votre avis sur cette source.

Vue 4 521 fois - Téléchargée 432 fois

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
206
Date d'inscription
mercredi 30 janvier 2002
Statut
Membre
Dernière intervention
4 décembre 2007

Je connais pas cet API, met moi un exemple en commentaitre stp
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
65
tu pourrais rajouter l'API DrawCaption , qui permet de dessiner u caption d'un fenêtre.(Je m'en sert dans une source....)
Messages postés
206
Date d'inscription
mercredi 30 janvier 2002
Statut
Membre
Dernière intervention
4 décembre 2007

Oups, j'ai oublier de gérer la propriété font
Call PropBag.WriteProperty("Font", titre.Font, Ambient.Font)

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.