Voila enfin une toute premiere version d'un composant tou fait super pratique...
Mettez le sur votre form et vous pourez la deplacer, avoir un icone dans le System Tray, et empecher votre form de sortir de l'écran, configurer le dégrader, etc....
Fonctions
System Tray
Dégradé Horizontal Ou Vertical et couleurs configurables
Déplacement de la form
Empeche la form de sortir de l'écran
Bouton réduire et fermer spéciaux (bientot skinables...)
Voici le code mais vous ne pouvez pas vous en servir sans le zip a cause des controls...
Source / Exemple :
'Version BETA1
'Copyright OverDarck 2003 (réalisé le 14/06/2003 et achevé le 17/08)
'[www.OverDarck.fr.st(=>En panne) DarckOver@yahoo.fr]
'
'
'
'Ce contrôl fait serie de +ieurs controls qui a terme reprendronts les principaux
' contrôles de VB
'A venir (surement dans l'ordre) :
'-AdvCmd (Tout configurable, couleur de chaques relief du fond du text et de son relief et du cadre de survol)
'-AdvTextBox (pareil)
'-AdvFrame (rien de spécial pour cette frame sauf les couleur paramétrables)
'-AdvLabel (Label avec un relief parametrable)
'Et d'autre pour plus tard
'
'
'Merci de parler de moi si vous vous servez de ce control dans votre prog,
'A part sa ce control est libre de diffusion et d'exploitation...
'Bonne prog a tous et @+
'
'
'Declaration des Types, Enum et APIs
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Private Type POINT_TYPE
X As Long
Y As Long
End Type
Private Const NIM_ADD = 0
Private Const NIM_MODIFY = 1
Private Const NIM_DELETE = 2
Private Const NIF_MESSAGE = 1
Private Const NIF_ICON = 2
Private Const NIF_TIP = 4
Private Const GWL_WNDPROC = -4
Private Const WM_ONMOUSEOVER = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTON1CLK = &H202
Private Const WM_LBUTTON2CLK = &H203
Private Const WM_RBUTTON2CLK = &H204
Private Const WM_RBUTTON1CLK = &H205
Private Const TPM_RIGHTALIGN = &H8&
Private lpPrevWndProc As Long
Private ghWnd As Long, TheForm As Form
Private Declare Function Shell_NotifyIconA Lib "shell32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Integer
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT_TYPE) As Long
Public Enum THAlign
[Left Justify] = 0
[Right Justify] = 1
Center = 2
End Enum
Public Enum TVAlign
[Top Justify] = 0
[Bottom Justify] = 1
Center = 2
End Enum
Public Enum TBSe
Horizontal = 0
Vertical = 1
End Enum
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SetCursorPos& Lib "user32" (ByVal X As Long, ByVal Y As Long)
Private Declare Sub ClipCursorRect Lib "user32" Alias "ClipCursor" (lpRect As RECT)
Private Declare Sub ClipCursorClear Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long)
Public Enum TitleStyle
Default = 0
Custom = 1
End Enum
'déclaration des variable (Ce paquet !!!!)
Private IsMovable As Boolean, VAlign As TVAlign, TBC As ColorConstants
Private BBC As ColorConstants, CadreActivate As Boolean, XX As Variant, YY As Variant ', BtCaption As Variant
Private FirstColor As ColorConstants, SecondColor As ColorConstants, Sens As TBSe
Private p As POINT_TYPE, i As Variant, OK As Boolean, IsMouseLocked As Boolean
'Déclaration des Evenement du control
Public Event Change()
Public Event Click()
Public Event ClickMinButton()
Public Event ClickCloseButton()
Public Event DblClick()
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event Move(X As Single, Y As Single, Button As Integer)
Public Event OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
Public Event OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
Public Event OLEStartDrag(Data As DataObject, AllowedEffects As Long)
Public Event OLESetData(Data As DataObject, DataFormat As Integer)
Public Event OLECompleteDrag(Effect As Long)
'System Tray
Public Sub SystemTray(Stat As Boolean, Tform As Form, Optional Visible As Boolean, Optional STCaption As String)
If Stat Then
Call STIn(STCaption, Tform, Visible)
Else
Call STOut(Tform, Visible)
End If
End Sub
'Evènement soumis au control
Private Sub Label1_Change()
Label2.Caption = Label1.Caption
RaiseEvent Change
End Sub
Private Sub Label1_Click()
RaiseEvent Click
End Sub
Private Sub Label1_DblClick()
RaiseEvent DblClick
End Sub
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
If Button = vbRightButton Then
OK = False
XX = 0
YY = 0
Call ClipCursorClear(0&)
Exit Sub
ElseIf Movable Then
OK = True
XX = X
YY = Y
End If
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
If OK = True And Movable Then
If IsMouseLocked Then
'définit le cadre a apliquer au curseur en fonction de la position de la form sur l'écrant et de la position de la souris par raport a la form ainsi que des dimensions de la form
Dim CursorX As Integer, CursorY As Integer, lpRect As RECT, i As Integer
lpRect.Left = (XX + 60) / Screen.TwipsPerPixelX
lpRect.Top = (YY + 15) / Screen.TwipsPerPixelY
lpRect.Right = (Screen.Width - (UserControl.Width - XX) + 75) / Screen.TwipsPerPixelX
lpRect.Bottom = (Screen.Height - (UserControl.Height - YY)) / Screen.TwipsPerPixelY
Call ClipCursorRect(lpRect) 'Empeche la souris de sortir d'une zone definie et donc par 'illusion' de l'ecrant
End If
Call mov(X, Y, Button)
End If
End Sub
Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
On Error Resume Next
OK = False
XX = 0
YY = 0
Call ClipCursorClear(0&)
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Label1_MouseDown(Button, Shift, X, Y)
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Label1_MouseMove(Button, Shift, X, Y)
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Label1_MouseUp(Button, Shift, X, Y)
End Sub
Private Sub mov(X As Single, Y As Single, Button As Integer)
If Not Button = 1 Or Not Movable Then Exit Sub
RaiseEvent Move(X - XX, Y - YY, Button)
'obj.Move X + obj.Left - XX, Y + obj.Top - YY
End Sub
Private Sub Label1_OLECompleteDrag(Effect As Long)
RaiseEvent OLECompleteDrag(Effect)
End Sub
Private Sub Label1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent OLEDragDrop(Data, Effect, Button, Shift, X, Y)
End Sub
Private Sub Label1_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
RaiseEvent OLEDragOver(Data, Effect, Button, Shift, X, Y, State)
End Sub
Private Sub Label1_OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
RaiseEvent OLEGiveFeedback(Effect, DefaultCursors)
End Sub
Private Sub Label1_OLESetData(Data As DataObject, DataFormat As Integer)
RaiseEvent OLESetData(Data, DataFormat)
End Sub
Private Sub Label1_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
RaiseEvent OLEStartDrag(Data, AllowedEffects)
End Sub
'Pour les deux boutons réduire et fermer
Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line10.BorderColor = &HFDA04F
Line11.BorderColor = &HFDA04F
Shape2.BorderColor = &H755433
UserControl.Refresh
End Sub
Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X >= 0 And X <= 210 And Y >= 0 And Y <= Height Then
If Not Shape1.Visible Then Shape1.Visible = True
End If
Timer1.Enabled = True
UserControl.Refresh
End Sub
Private Sub Label3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line10.BorderColor = &H755433
Line11.BorderColor = &H755433
Shape2.BorderColor = &HFDA04F
If X <= 0 Or X >= 210 Or Y <= 0 Or Y >= Height Then
If Shape1.Visible Then Shape1.Visible = False
End If
RaiseEvent ClickMinButton
UserControl.Refresh
End Sub
Private Sub Label4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line12.BorderColor = &HFDA04F
Line13.BorderColor = &HFDA04F
Shape4.BorderColor = &H755433
UserControl.Refresh
End Sub
Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X >= 0 And X <= 210 And Y >= 0 And Y <= Height Then
If Not Shape3.Visible Then Shape3.Visible = True
End If
Timer1.Enabled = True
UserControl.Refresh
End Sub
Private Sub Label4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line12.BorderColor = &H755433
Line13.BorderColor = &H755433
Shape4.BorderColor = &HFDA04F
If X <= 0 Or X >= 210 Or Y <= 0 Or Y >= Height Then
If Shape3.Visible Then Shape3.Visible = False
End If
RaiseEvent ClickCloseButton
UserControl.Refresh
End Sub
Private Sub Timer1_Timer()
If Shape1.Visible Then Shape1.Visible = False
If Shape3.Visible Then Shape3.Visible = False
Timer1.Enabled = False
End Sub
'Proprietées du cotnrol
'Public Property Let Style(Val As TitleStyle)
''TheStyle (Val)
'End Property
'Public Property Get Style() As TitleStyle
''If Me.BackColor = &H8F6100 And Me.SelColor = &H0& And Me.TopBorderColor = &HFDA04F And Me.BottomBorderColor = &H755433 And Me.TxtForeColor = &HFFFFFF And Me.TxtBackColor = &H0& And Me.Relief = True And Me.Cadre = True Then Style = Default Else Style = Custom
'End Property
Public Property Let MinButton(Stat As Boolean)
Image1.Visible = Stat
Line10.Visible = Stat
Line11.Visible = Stat
Label3.Visible = Stat
'Shape1.Visible = Stat
Shape2.Visible = Stat
End Property
Public Property Get MinButton() As Boolean
MinButton = Image1.Visible
End Property
Public Property Let CloseButton(Stat As Boolean)
Image2.Visible = Stat
Line12.Visible = Stat
Line13.Visible = Stat
Label4.Visible = Stat
'Shape3.Visible = Stat
Shape4.Visible = Stat
End Property
Public Property Get CloseButton() As Boolean
CloseButton = Image2.Visible
End Property
Public Property Let TxtBackColor(Color As OLE_COLOR)
Label2.ForeColor = Color
End Property
Public Property Get TxtBackColor() As OLE_COLOR
TxtBackColor = Label2.ForeColor
End Property
Public Property Let LockMouse(Stat As Boolean)
IsMouseLocked = Stat
End Property
Public Property Get LockMouse() As Boolean
LockMouse = IsMouseLocked
End Property
Public Property Let TxtForeColor(Color As OLE_COLOR)
Label1.ForeColor = Color
End Property
Public Property Get TxtForeColor() As OLE_COLOR
TxtForeColor = Label1.ForeColor
End Property
Public Property Let Relief(Stat As Boolean)
Label2.Visible = Stat
End Property
Public Property Get Relief() As Boolean
Relief = Label2.Visible
End Property
Public Property Let AlignmentH(Align As THAlign)
Label1.Alignment = Align
Label2.Alignment = Align
End Property
Public Property Get AlignmentH() As THAlign
AlignmentH = Label1.Alignment
End Property
'Public Property Let AlignmentV(Align As TVAlign)
'VAlign = Align
'Label1.Top = WherePutThisLabel(Label1)
'Label2.Top = WherePutThisLabel(Label2)
'End Property
'Public Property Get AlignmentV() As TVAlign
'AlignmentV = VAlign
'End Property
'Sens
Public Property Let Orientation(Val As TBSe)
Sens = Val
Degrade Picture1, FirstColor, SecondColor, Sens 'False
End Property
Public Property Get Orientation() As TBSe
Orientation = Sens
End Property
Public Property Let BackFirstColor(FColor As OLE_COLOR)
FirstColor = FColor
Degrade Picture1, FirstColor, SecondColor, Sens 'False
End Property
Public Property Get BackFirstColor() As OLE_COLOR
BackFistColor = FirstColor
End Property
Public Property Let BackSecondColor(SColor As OLE_COLOR)
SecondColor = SColor
Degrade Picture1, FirstColor, SecondColor, Sens
End Property
Public Property Get BackSecondColor() As OLE_COLOR
BackSecondColor = SecondColor
End Property
Public Property Let Movable(Stat As Boolean)
IsMovable = Stat
End Property
Public Property Get Movable() As Boolean
Movable = IsMovable
End Property
Public Property Let Caption(Txt As String)
Label1.Caption = Txt
'Label2.Caption = Txt
End Property
Public Property Get Caption() As String
Caption = Label1.Caption
End Property
'Gestion des fonctions de bases du control
Private Sub UserControl_Initialize()
Picture1.Top = 0
Picture1.Left = 0
Me.MinButton = True
Me.CloseButton = True
Me.LockMouse = True
Me.Movable = True
Me.Relief = True
Me.BackFirstColor = &H0&
Me.BackSecondColor = &H8F6100
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
'Chargement
Me.Caption = PropBag.ReadProperty("Caption", "Caption")
Me.BackFirstColor = PropBag.ReadProperty("BFC", &H0&)
Me.BackSecondColor = PropBag.ReadProperty("BSC", &H8F6100)
Me.AlignmentH = PropBag.ReadProperty("HAlign", 2)
Me.Relief = PropBag.ReadProperty("Relief", 1)
Me.TxtForeColor = PropBag.ReadProperty("FC", &HFFFFFF)
Me.TxtBackColor = PropBag.ReadProperty("RC", &H80000012)
'Me.Style = PropBag.ReadProperty("Style", 0)
Me.Movable = PropBag.ReadProperty("Movable", True)
Me.LockMouse = PropBag.ReadProperty("ML", True)
Me.Orientation = PropBag.ReadProperty("Orientation", False)
Me.MinButton = PropBag.ReadProperty("MinB", True)
Me.CloseButton = PropBag.ReadProperty("CloseB", True)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
'Sauvergarde
PropBag.WriteProperty "Caption", Label1.Caption, Name
PropBag.WriteProperty "BFC", FirstColor, &H0&
PropBag.WriteProperty "BSC", SecondColor, &H8F6100
PropBag.WriteProperty "HAlign", Label1.Alignment, 2
PropBag.WriteProperty "Relief", Label2.Visible, True
PropBag.WriteProperty "FC", Label1.ForeColor, &HFFFFFF
PropBag.WriteProperty "RC", Label2.ForeColor, &H80000012
'PropBag.WriteProperty "Style", Style, 0
PropBag.WriteProperty "Movable", IsMovable, True
PropBag.WriteProperty "ML", IsMouseLocked, True
PropBag.WriteProperty "Orientation", Sens, False
PropBag.WriteProperty "MinB", Image1.Visible, True
PropBag.WriteProperty "CloseB", Image2.Visible, True
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
'Divers
Picture1.Top = 0
Picture1.Left = 0
Height = 225 + 50 '40
Picture1.Width = Width
If Picture1.Height <> 265 Then Picture1.Height = 265
Label1.Height = Height
Label1.Width = Width - 615 '60
Label2.Height = Height
Label2.Width = Width - 615 '60
'Ligne horizontale supérieure
Line1.Y1 = 0
Line1.Y2 = 0
Line1.X2 = Width - 20
'Ligne verticale droite
Line2.Y2 = Height
Line2.X1 = Width - 10
Line2.X2 = Line2.X1
'1er ligne horizontale inferieure
Line3.Y1 = Height - 30 'Pr pas etre dessus l'autre ligne
Line3.Y2 = Line3.Y1
Line3.X2 = Width
'2nd ligne horizontale inferieure
Line4.Y1 = Height - 10
Line4.Y2 = Line4.Y1
Line4.X2 = Width - 10 'Pour pas etres dessus la ligne verticale droite
'Ligne verticale Gauche
Line5.Y2 = Height - 30
Line5.X1 = 0
Line5.X2 = 0
'les 2 boutons
'Fermer
Line12.X1 = Width - 240
Line12.X2 = Line12.X1 + 165
Line13.X1 = Width - 90
Line13.X2 = Width - 90
Label4.Left = Width - 255
Shape3.Left = Width - 255
Shape4.Left = Width - 240
Image2.Left = Width - 225
'Minimiser
Line10.X1 = Width - 240 - 30 - 210
Line10.X2 = Line10.X1 + 165
Line11.X1 = Width - 90 - 30 - 210
Line11.X2 = Width - 90 - 30 - 210
Label3.Left = Width - 255 - 30 - 210
Shape1.Left = Width - 255 - 30 - 210
Shape2.Left = Width - 240 - 30 - 210
Image1.Left = Width - 225 - 30 - 210
'Dégradé de la barre de titre
Degrade Picture1, FirstColor, SecondColor, Sens
UserControl.Refresh
End Sub
Private Sub UserControl_AmbientChanged(PropertyName As String)
UserControl.Refresh
End Sub
'Fonctions a part
'Private Function WherePutThisLabel(LblN As Label) As Integer
'Select Case VAlign
'Case 0
' WherePutThisLabel = 90
'Case 1
' WherePutThisLabel = Height - LblN.Height - 90
'Case 2
' WherePutThisLabel = (Height - LblN.Height) / 2
'End Select
'End Function
'Private Sub TheStyle(Val As TitleStyle)
'Select Case Val
'Case Custom
''
'Case Default
' Me.BackColor = &H8F6100
' Me.SelColor = &H0&
' Me.TopBorderColor = &HFDA04F
' Me.BottomBorderColor = &H755433
' Me.TxtForeColor = &HFFFFFF
' Me.TxtBackColor = &H0&
' Me.Relief = True
' Me.Cadre = True
'End Select
'End Sub
Private Sub Degrade(Objet As Object, DebCol As Long, FinCol As Long, Vertical)
'Cette procedure n'est pas de moi je l'est emprunté il y alogntemp à fabiin que je remerci au pasage ;-)
On Error Resume Next
Dim a As Integer, R As Double, V As Double, b As Double, r2 As Double, v2 As Double, b2 As Double, decR As Double, decV As Double, decB As Double, Scal As Byte, Vcalc As Long
b = DebCol \ 65536
V = (DebCol - b * 65536) \ 256
R = DebCol - b * 65536 - V * 256
b2 = FinCol \ 65536
v2 = (FinCol - b2 * 65536) \ 256
r2 = FinCol - b2 * 65536 - v2 * 256
Scal = Objet.ScaleMode
Objet.ScaleMode = 3
If Vertical = False Then Vcalc = Objet.ScaleWidth Else Vcalc = Objet.ScaleHeight
decR = (r2 - R) / Vcalc
decV = (v2 - V) / Vcalc
decB = (b2 - b) / Vcalc
'Tracage du dégradé
If Vertical = False Then 'Horizontal
For a = 0 To Objet.ScaleWidth
Objet.Line (a, 0)-(a + 1, Objet.ScaleHeight), RGB(R, V, b), BF
R = Abs(R + decR): V = Abs(V + decV): b = Abs(b + decB)
Next a
Else 'Vertical
For a = 0 To Objet.ScaleHeight
Objet.Line (0, a)-(Objet.ScaleWidth, a + 1), RGB(R, V, b), BF
R = Abs(R + decR): V = Abs(V + decV): b = Abs(b + decB) '
Next a
End If
Objet.ScaleMode = Scal
End Sub
Private Sub IconToTray(frx As Form, msgTip$, Flag As Boolean)
Dim nd As NOTIFYICONDATA
Dim dMSG As Long
Dim RetVal As Integer
'
With nd
.szTip = msgTip$ & Chr$(0)
.cbSize = Len(nd)
.hwnd = frx.hwnd
.uID = 1
.uCallbackMessage = WM_LBUTTON2CLK
.hIcon = frx.Icon
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
End With
'
If Flag Then dMSG = NIM_ADD Else dMSG = NIM_DELETE
RetVal = Shell_NotifyIconA(dMSG, nd) 'Affiche lico avec les parametre definis
End Sub
Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If hw = TheForm.hwnd Then
Select Case lParam
Case WM_LBUTTON2CLK
STOut
Case WM_RBUTTON1CLK
'Ici vous pouvez afficher un menu qui sera bientot fournit avec
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End If
End Function
Private Sub HookWindow()
lpPrevWndProc = SetWindowLong(ghWnd, GWL_WNDPROC, AddressOf WindowProc) 'Cree un Sous-Handle virtuel pour le ST
End Sub
Private Sub Unhookwindow()
Dim RetVal As Long
RetVal = SetWindowLong(ghWnd, GWL_WNDPROC, lpPrevWndProc) 'efface le Handle et kill l'ico
End Sub
Private Sub STIn(StText As String, Tform As Form, Visible As Boolean)
TheForm = Tform
ghWnd = Tform.hwnd
HookWindow
'On renseigne le system Tray sur le nb de process actifs (Threads)
IconToTray Tform, StText, True
If Not Visible Then Tform.Hide 'cache laform selon la valeur de visible
End Sub
Private Sub STOut(Tform As Form, Optional ShowTheForm As Boolean = True) 'Le parmetre est optionel vu qu'il ny a qu'un cas ou on veut pas la revoir
TheForm = Tform
IconToTray Tform, "", False
ghWnd = Tform.hwnd
Unhookwindow
If ShowTheForm Then Tform.Show vbModeless 'evite de montrer cette fenetre lorque on appel cette procedure lors de la fermeture du prog
End Sub
Conclusion :
Voila dites mois se que vous en pencez mais noubliez pas que c'est une version Beta...
De plus pour que la form bouge vous devez ajouter sa :
Private Sub TitleBar1_Move(X As Single, Y As Single, Button As Integer)
Me.Move X + Left, Y + Top
DoEvents
End Sub
Sinon sa marche pas :-(
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.