Vb
cs_ellissa
Messages postés
7
Date d'inscription
samedi 31 décembre 2005
Statut
Membre
Dernière intervention
2 janvier 2006
-
31 déc. 2005 à 09:25
Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 - 31 déc. 2005 à 21:54
Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 - 31 déc. 2005 à 21:54
4 réponses
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
27
31 déc. 2005 à 14:52
31 déc. 2005 à 14:52
Bonjour,
Ce code permet de dimentionner un PictureBox et un TextBox en mode exécution.
Option Explicit
Dim Sx As Long
Dim Sy As Long
Dim Lx As Long
Dim Ly As Long
Dim XX As Long
Dim YY As Long
Dim Pointer As Long
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pointer = 0
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then
Pointer = 0
If X > Picture1.Width - 150 Then
XX X: Pointer 9
End If
If Y > Picture1.Height - 150 Then
YY Y: If Pointer 0 Then Pointer = 7 Else Pointer = 8
End If
Else
If Pointer 9 Or Pointer 8 Then
Picture1.Width Picture1.Width + X - XX: XX X
End If
If Pointer 7 Or Pointer 8 Then
Picture1.Height Picture1.Height + Y - YY: YY Y
End If
End If
Picture1.MousePointer = Pointer
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pointer = 0
Picture1.MousePointer = 0
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then
Pointer = 0
If X > Text1.Width - 150 Then
XX X: Pointer 9
End If
If Y > Text1.Height - 150 Then
YY Y: If Pointer 0 Then Pointer = 7 Else Pointer = 8
End If
Else
If Pointer 9 Or Pointer 8 Then
Text1.Width Text1.Width + X - XX: XX X
End If
If Pointer 7 Or Pointer 8 Then
Text1.Height Text1.Height + Y - YY: YY Y
End If
End If
Text1.MousePointer = Pointer
End Sub
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pointer = 0
Text1.MousePointer = 0
End Sub
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move X - xTemp, Y - yTemp
End Sub
jpleroisse
Si une réponse vous convient, cliquez Réponse Acceptée.
Ce code permet de dimentionner un PictureBox et un TextBox en mode exécution.
Option Explicit
Dim Sx As Long
Dim Sy As Long
Dim Lx As Long
Dim Ly As Long
Dim XX As Long
Dim YY As Long
Dim Pointer As Long
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pointer = 0
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then
Pointer = 0
If X > Picture1.Width - 150 Then
XX X: Pointer 9
End If
If Y > Picture1.Height - 150 Then
YY Y: If Pointer 0 Then Pointer = 7 Else Pointer = 8
End If
Else
If Pointer 9 Or Pointer 8 Then
Picture1.Width Picture1.Width + X - XX: XX X
End If
If Pointer 7 Or Pointer 8 Then
Picture1.Height Picture1.Height + Y - YY: YY Y
End If
End If
Picture1.MousePointer = Pointer
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pointer = 0
Picture1.MousePointer = 0
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then
Pointer = 0
If X > Text1.Width - 150 Then
XX X: Pointer 9
End If
If Y > Text1.Height - 150 Then
YY Y: If Pointer 0 Then Pointer = 7 Else Pointer = 8
End If
Else
If Pointer 9 Or Pointer 8 Then
Text1.Width Text1.Width + X - XX: XX X
End If
If Pointer 7 Or Pointer 8 Then
Text1.Height Text1.Height + Y - YY: YY Y
End If
End If
Text1.MousePointer = Pointer
End Sub
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pointer = 0
Text1.MousePointer = 0
End Sub
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move X - xTemp, Y - yTemp
End Sub
jpleroisse
Si une réponse vous convient, cliquez Réponse Acceptée.
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
31 déc. 2005 à 16:40
31 déc. 2005 à 16:40
trés étrange,
ça me rappelle quelque chose !!!!
mais c'est encore loin d'être parfait
Dim XX As Long
Dim YY As Long
Dim Pointer As Long
Dim X1 As Long
Dim Y1 As Long
Dim Curs5 As Boolean
Dim d As Long
Dim dx As Long
Dim dy As Long
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pointer = 0
Picture1.BorderStyle = 0
Me.Caption = X & " : " & XX & " : " & Pointer
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'nouveau
If Curs5 = True Then
Curs5 = False
Else
Curs5 = True
X1 = X
Y1 = Y
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then
Pointer = 0:
'nouveau
Picture1.BorderStyle = 1
If X > Picture1.Width - 150 Then
XX X - 15: Pointer 9
End If
If Y > Picture1.Height - 150 Then
YY Y - 15: If Pointer 0 Then Pointer = 7 Else Pointer = 8
End If
Else
If Pointer 9 Or Pointer 8 Then
dx X - XX: Text1 dx
d = Picture1.Width + X - XX
If d > 300 And d < Me.ScaleWidth Then
Picture1.Width d: XX X
End If
End If
If Pointer 7 Or Pointer 8 Then
dy Y - YY: Text2 dy
d = Picture1.Height + Y - YY
If d > 300 And d < Me.ScaleHeight Then
Picture1.Height d: YY Y
End If
End If
'Déplacement
If Curs5 And Pointer = 0 Then
Picture1.Top = Picture1.Top + Y - Y1
Picture1.Left = Picture1.Left + X - X1
End If
End If
Me.Caption = X & " - " & XX & " - " & Pointer
Picture1.MousePointer = Pointer
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pointer = 0
Picture1.MousePointer = 0
Curs5 = False
End Sub
Daniel
ça me rappelle quelque chose !!!!
mais c'est encore loin d'être parfait
Dim XX As Long
Dim YY As Long
Dim Pointer As Long
Dim X1 As Long
Dim Y1 As Long
Dim Curs5 As Boolean
Dim d As Long
Dim dx As Long
Dim dy As Long
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pointer = 0
Picture1.BorderStyle = 0
Me.Caption = X & " : " & XX & " : " & Pointer
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'nouveau
If Curs5 = True Then
Curs5 = False
Else
Curs5 = True
X1 = X
Y1 = Y
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then
Pointer = 0:
'nouveau
Picture1.BorderStyle = 1
If X > Picture1.Width - 150 Then
XX X - 15: Pointer 9
End If
If Y > Picture1.Height - 150 Then
YY Y - 15: If Pointer 0 Then Pointer = 7 Else Pointer = 8
End If
Else
If Pointer 9 Or Pointer 8 Then
dx X - XX: Text1 dx
d = Picture1.Width + X - XX
If d > 300 And d < Me.ScaleWidth Then
Picture1.Width d: XX X
End If
End If
If Pointer 7 Or Pointer 8 Then
dy Y - YY: Text2 dy
d = Picture1.Height + Y - YY
If d > 300 And d < Me.ScaleHeight Then
Picture1.Height d: YY Y
End If
End If
'Déplacement
If Curs5 And Pointer = 0 Then
Picture1.Top = Picture1.Top + Y - Y1
Picture1.Left = Picture1.Left + X - X1
End If
End If
Me.Caption = X & " - " & XX & " - " & Pointer
Picture1.MousePointer = Pointer
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pointer = 0
Picture1.MousePointer = 0
Curs5 = False
End Sub
Daniel
cs_ellissa
Messages postés
7
Date d'inscription
samedi 31 décembre 2005
Statut
Membre
Dernière intervention
2 janvier 2006
31 déc. 2005 à 20:12
31 déc. 2005 à 20:12
merci bien pour vos réponse , mais je veux que les modifications effectuer par l'utilisateur seront enregistré dans une base de donné access ( le changement va etre enregistrer au niveau de la table propriétés bouton)
merci pour vos aide
merci pour vos aide
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
31 déc. 2005 à 21:54
31 déc. 2005 à 21:54
Bonjour
désolé, les bases de donnée et Access je ne connais pas
j'ai tout refait le traitement.
un pointeur par contrôle, ici un PictureBox et un CommandButton
contrôle Resizable et Déplaçable, y compris la Forme elle même.
Option Explicit
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim posX As Long
Dim posY As Long
Dim XX As Long
Dim YY As Long
Dim Pointer1 As Long
Dim Pointer2 As Long
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 Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "User32" (ByVal vKey As Long) As Integer
Private Sub Form_Load()
Me.ScaleMode = 3
Timer1.Interval = 10
Timer1.Enabled = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim P As Long
P = Pointer1 + Pointer2
If Button = 1 Then TestDeplacement P, Me
' Picture1.BorderStyle = 0
End Sub
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then TestDeplacement Pointer1, Command1
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then TestDeplacement Pointer2, Picture1
End Sub
Private Sub Timer1_Timer()
Dim pt As POINTAPI
GetCursorPos pt
posX = pt.X - Me.Left / 15 - 4
posY = pt.Y - Me.Top / 15 - 30
If GetAsyncKeyState(1) < 0 Then
TestResizer Pointer1, Command1
TestResizer Pointer2, Picture1
Else
TestPointer Pointer1, Command1
If Pointer1 > 0 Then Exit Sub
TestPointer Pointer2, Picture1
If Pointer2 > 0 Then Exit Sub
End If
End Sub
Private Sub TestPointer(pointer As Long, obj As Control)
Dim zX As Long
Dim zY As Long
pointer = 0
zX = posX - obj.Left
zY = posY - obj.Top
If zX > 0 And zX < obj.Width + 20 And _
zY > 0 And zY < obj.Height + 20 Then
' obj.BorderStyle = 1
If zX > obj.Width - 20 Then
XX zX: pointer 9
End If
If zY > obj.Height - 20 Then
YY zY: If pointer 0 Then pointer = 7 Else pointer = 8
End If
End If
obj.MousePointer = pointer
End Sub
Private Sub TestResizer(pointer, obj As Control)
Dim zX As Long
Dim zY As Long
Dim d As Long
If pointer 9 Or pointer 8 Then
zX = posX - obj.Left
d = obj.Width + zX - XX
If d > 20 And d < Me.ScaleWidth Then obj.Width d: XX zX
End If
If pointer 7 Or pointer 8 Then
zY = posY - obj.Top
d = obj.Height + zY - YY
If d > 20 And d < Me.ScaleHeight Then obj.Height d: YY zY
End If
End Sub
Private Sub TestDeplacement(pointer, obj As Object)
If pointer = 0 Then
Call ReleaseCapture
SendMessage obj.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub
joyeuses fêtes
Daniel
désolé, les bases de donnée et Access je ne connais pas
j'ai tout refait le traitement.
un pointeur par contrôle, ici un PictureBox et un CommandButton
contrôle Resizable et Déplaçable, y compris la Forme elle même.
Option Explicit
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim posX As Long
Dim posY As Long
Dim XX As Long
Dim YY As Long
Dim Pointer1 As Long
Dim Pointer2 As Long
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 Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "User32" (ByVal vKey As Long) As Integer
Private Sub Form_Load()
Me.ScaleMode = 3
Timer1.Interval = 10
Timer1.Enabled = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim P As Long
P = Pointer1 + Pointer2
If Button = 1 Then TestDeplacement P, Me
' Picture1.BorderStyle = 0
End Sub
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then TestDeplacement Pointer1, Command1
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then TestDeplacement Pointer2, Picture1
End Sub
Private Sub Timer1_Timer()
Dim pt As POINTAPI
GetCursorPos pt
posX = pt.X - Me.Left / 15 - 4
posY = pt.Y - Me.Top / 15 - 30
If GetAsyncKeyState(1) < 0 Then
TestResizer Pointer1, Command1
TestResizer Pointer2, Picture1
Else
TestPointer Pointer1, Command1
If Pointer1 > 0 Then Exit Sub
TestPointer Pointer2, Picture1
If Pointer2 > 0 Then Exit Sub
End If
End Sub
Private Sub TestPointer(pointer As Long, obj As Control)
Dim zX As Long
Dim zY As Long
pointer = 0
zX = posX - obj.Left
zY = posY - obj.Top
If zX > 0 And zX < obj.Width + 20 And _
zY > 0 And zY < obj.Height + 20 Then
' obj.BorderStyle = 1
If zX > obj.Width - 20 Then
XX zX: pointer 9
End If
If zY > obj.Height - 20 Then
YY zY: If pointer 0 Then pointer = 7 Else pointer = 8
End If
End If
obj.MousePointer = pointer
End Sub
Private Sub TestResizer(pointer, obj As Control)
Dim zX As Long
Dim zY As Long
Dim d As Long
If pointer 9 Or pointer 8 Then
zX = posX - obj.Left
d = obj.Width + zX - XX
If d > 20 And d < Me.ScaleWidth Then obj.Width d: XX zX
End If
If pointer 7 Or pointer 8 Then
zY = posY - obj.Top
d = obj.Height + zY - YY
If d > 20 And d < Me.ScaleHeight Then obj.Height d: YY zY
End If
End Sub
Private Sub TestDeplacement(pointer, obj As Object)
If pointer = 0 Then
Call ReleaseCapture
SendMessage obj.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub
joyeuses fêtes
Daniel
