Resize de form sans bordure propre

Télécharger le projet
Commenter

Description

Je n'avais jamais vu de codes propres pour les redim de forms et puis après quelques recherches, G trouvé ca. Ca devrait aider quelque uns...

J'ai meme mis les curseurs. Vous pouvez modif qq constantes...

Je mets le code ici pour les users de la compil (et les otres [:)] )

Source / Exemple : 


'>> feuille

Private Sub Form_Load()
'>> Juste pour faire bô
Me.Print "Test Form" & vbNewLine & vbNewLine & "Try to resize/move the window"
Me.Line (0, 20)-(Screen.Width, 20)
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'>> Transmet les informations vers le module
FormMouseDown Me, Button, X, Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormMouseMove Me, X, Y
End Sub

'> module

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" ()

Private Const WM_NCLBUTTONDOWN = &HA1

Private Const HTCAPTION = 2
Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Const HTTOP = 12
Private Const HTTOPLEFT = 13
Private Const HTTOPRIGHT = 14
Private Const HTBOTTOM = 15
Private Const HTBOTTOMLEFT = 16
Private Const HTBOTTOMRIGHT = 17

Const BorderWidth = 5   '>> C'est la distance 'sensible' par rapport au bord
                        '>> là, G mit 5, à vous de le modif si ca vous chante
Const MoveLeft = 5
Const MoveRight = 5     '>> Marge de la zone de mouvement
Const MoveTop = 5       '>> Modèle pour feuille standard
Const MoveHeight = 15

Public Sub FormMouseDown(MForm As Form, Button As Integer, X As Single, Y As Single)

If Button = 1 Then
    '>> Pour le redimensionnement
    Dim VerifAr(3)
    VerifAr(0) = X < BorderWidth
    VerifAr(1) = Y < BorderWidth
    VerifAr(2) = X > MForm.ScaleWidth - BorderWidth
    VerifAr(3) = Y > MForm.ScaleHeight - BorderWidth
    
    Dim MsgToSend
    If VerifAr(0) And Not (VerifAr(1) Or VerifAr(3)) Then MsgToSend = HTLEFT
    If VerifAr(1) And Not (VerifAr(0) Or VerifAr(2)) Then MsgToSend = HTTOP
    If VerifAr(2) And Not (VerifAr(1) Or VerifAr(3)) Then MsgToSend = HTRIGHT
    If VerifAr(3) And Not (VerifAr(0) Or VerifAr(2)) Then MsgToSend = HTBOTTOM
    If VerifAr(0) And VerifAr(1) Then MsgToSend = HTTOPLEFT
    If VerifAr(0) And VerifAr(3) Then MsgToSend = HTBOTTOMLEFT
    If VerifAr(2) And VerifAr(1) Then MsgToSend = HTTOPRIGHT
    If VerifAr(2) And VerifAr(3) Then MsgToSend = HTBOTTOMRIGHT
    
    Call ReleaseCapture
    SendMessage MForm.hwnd, WM_NCLBUTTONDOWN, MsgToSend, 0&
    
    '>> Pour le mouvement
    VerifAr(0) = X > MoveLeft
    VerifAr(1) = Y > MoveTop
    VerifAr(2) = X < MForm.ScaleWidth - MoveRight
    VerifAr(3) = Y < MoveHeight
    
    If VerifAr(0) And VerifAr(1) And VerifAr(2) And VerifAr(3) Then
        Call ReleaseCapture
        SendMessage MForm.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    End If
End If

End Sub

Public Sub FormMouseMove(MForm As Form, X As Single, Y As Single)

'>> Les zolis curseurs
Dim NoWhere As Boolean
'>> Pour le redimensionnement
Dim VerifAr(7)
VerifAr(0) = X < BorderWidth
VerifAr(1) = Y < BorderWidth
VerifAr(2) = X > MForm.ScaleWidth - BorderWidth
VerifAr(3) = Y > MForm.ScaleHeight - BorderWidth

If (VerifAr(0) Or VerifAr(2)) And Not (VerifAr(1) Or VerifAr(3)) Then MForm.MousePointer = 9: NoWhere = True
If (VerifAr(1) Or VerifAr(3)) And Not (VerifAr(0) Or VerifAr(2)) Then MForm.MousePointer = 7: NoWhere = True
If (VerifAr(0) And VerifAr(1)) Or (VerifAr(2) And VerifAr(3)) Then MForm.MousePointer = 8: NoWhere = True
If (VerifAr(0) And VerifAr(3)) Or (VerifAr(2) And VerifAr(1)) Then MForm.MousePointer = 6: NoWhere = True

'>> Pour le mouvement
VerifAr(4) = X > MoveLeft
VerifAr(5) = Y > MoveTop
VerifAr(6) = X < MForm.ScaleWidth - MoveRight
VerifAr(7) = Y < MoveHeight

If VerifAr(4) And VerifAr(5) And VerifAr(6) And VerifAr(7) Then MForm.MousePointer = 15: NoWhere = True

'>> Bah... rien
If Not (NoWhere) And MForm.MousePointer <> 0 Then MForm.MousePointer = 0

End Sub

Conclusion :


je vais essayer de mettre un zip, mais, déjà que j'ai du mal a poster cette maudite source !

PS: remarker la répartition aléatoire des constantes comme HTTOPLEFT, impossible d'appliquer des masques binaires : rien, voyez le bordel...
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 (Alan71)