[API] rectangle arrondi

Salut,

Voici un controle signé Francois (je le poste e PJ à ds mon prochain
message) :

'---------------------------------------------------------------------------------------
' Module : SFrame
' DateTime : 29/02/2004 21:09
' Author : François Picalausa
' Purpose : Remplace le contrôle Frame standart, corrige les bugs
' de design sous WinXP en style XP
'---------------------------------------------------------------------------------------

Option Explicit

Private Const DT_CALCRECT = &H400
Private Const DT_END_ELLIPSIS = &H8000&
Private Const DT_SINGLELINE = &H20

Private Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type

Private Declare Function RoundRect _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal nLeftRect As Long, _
ByVal nTopRect As Long, _
ByVal nRightRect As Long, _
ByVal nBottomRect As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long _
) _
As Long

Private Declare Function DrawText _
Lib "user32" _
Alias "DrawTextA" _
( _
ByVal hdc As Long, _
ByVal lpString As String, _
ByVal nCount As Long, _
lpRect As RECT, _
ByVal uFormat As Long _
) _
As Long

Private m_RoundRectEllipseHeight As Long
Private m_RoundRectEllipseWidth As Long
Private m_Caption As String
Dim m_RoundRectColor As OLE_COLOR
Dim m_TextColor As OLE_COLOR

Const m_def_Caption = "Frame"
Const m_def_RoundRectEllipseWidth = 10
Const m_def_RoundRectEllipseHeight = 10
Const m_def_RoundRectColor = 0
Const m_def_TextColor = 0

Public Sub Refresh()
Dim TextRect As RECT

UserControl.Cls

'Calcule le rectangle de destination pour le texte
TextRect.top = 0
TextRect.left = m_RoundRectEllipseWidth / 2 + 5
DrawText UserControl.hdc, m_Caption, Len(m_Caption), TextRect,
DT_CALCRECT

'Trace le roundrect à partir des données retrouvées
UserControl.ForeColor = m_RoundRectColor
Call RoundRect(UserControl.hdc, _
0, _
(TextRect.bottom - TextRect.top) / 2, _
UserControl.ScaleWidth, _
UserControl.ScaleHeight, _
m_RoundRectEllipseWidth, _
m_RoundRectEllipseHeight - TextRect.bottom + TextRect.top)

'Si le text est plus grand que le contrôle, on réduit le rectangle
'If (TextRect.right - TextRect.left) > UserControl.ScaleWidth - 2 *
m_RoundRectEllipseWidth Then
' TextRect.right = TextRect.left + UserControl.ScaleWidth - 2 *
m_RoundRectEllipseWidth

'Si le text est plus grand que le contrôle, on réduit le rectangle
If (TextRect.right - TextRect.left) > UserControl.ScaleWidth -
m_RoundRectEllipseWidth Then
TextRect.right = TextRect.left + UserControl.ScaleWidth -
m_RoundRectEllipseWidth

'S'il n'y a pas de place pour afficher le texte, on ne l'affiche pas
If TextRect.right > TextRect.left Then
'Vide le fond
UserControl.Line (TextRect.left, TextRect.top)-(TextRect.right,
TextRect.bottom), UserControl.BackColor, BF
UserControl.ForeColor = m_TextColor

'Trace le texte
DrawText UserControl.hdc, m_Caption, Len(m_Caption), TextRect,
DT_END_ELLIPSIS Or DT_SINGLELINE
End If
Else
'Vide le fond
UserControl.Line (TextRect.left, TextRect.top)-(TextRect.right,
TextRect.bottom), UserControl.BackColor, BF
UserControl.ForeColor = m_TextColor

'Trace le texte
DrawText UserControl.hdc, m_Caption, Len(m_Caption), TextRect,
DT_SINGLELINE
End If
End Sub

Public Property Get Caption() As String
Caption = m_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
m_Caption = New_Caption
Refresh
PropertyChanged "Caption"
End Property

Public Property Get RoundRectEllipseWidth() As Long
RoundRectEllipseWidth = m_RoundRectEllipseWidth
End Property

Public Property Let RoundRectEllipseWidth(ByVal New_RoundRectEllipseWidth As
Long)
If New_RoundRectEllipseWidth > 0 Then
m_RoundRectEllipseWidth = New_RoundRectEllipseWidth
Refresh
PropertyChanged "RoundRectEllipseWidth"
End If
End Property

Public Property Get RoundRectEllipseHeight() As Long
RoundRectEllipseHeight = m_RoundRectEllipseHeight
End Property

Public Property Let RoundRectEllipseHeight(ByVal New_RoundRectEllipseHeight
As Long)
If New_RoundRectEllipseHeight > 0 Then
m_RoundRectEllipseHeight = New_RoundRectEllipseHeight
Refresh
PropertyChanged "RoundRectEllipseHeight"
End If
End Property

Private Sub UserControl_Initialize()
UserControl.ScaleMode = 3 'on travaille en pixel
End Sub

Private Sub UserControl_InitProperties()
m_Caption = m_def_Caption
m_RoundRectEllipseWidth = m_def_RoundRectEllipseWidth
m_RoundRectEllipseHeight = m_def_RoundRectEllipseHeight
Set UserControl.Font = Ambient.Font
m_RoundRectColor = m_def_RoundRectColor
m_TextColor = m_def_TextColor
Refresh
End Sub

Private Sub UserControl_Paint()
Refresh
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
m_RoundRectEllipseWidth = PropBag.ReadProperty("RoundRectEllipseWidth",
m_def_RoundRectEllipseWidth)
m_RoundRectEllipseHeight =
PropBag.ReadProperty("RoundRectEllipseHeight", m_def_RoundRectEllipseHeight)
Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
m_RoundRectColor = PropBag.ReadProperty("RoundRectColor",
m_def_RoundRectColor)
m_TextColor = PropBag.ReadProperty("TextColor", m_def_TextColor)
UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
End Sub

Private Sub UserControl_Resize()
Refresh
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
Call PropBag.WriteProperty("RoundRectEllipseWidth",
m_RoundRectEllipseWidth, m_def_RoundRectEllipseWidth)
Call PropBag.WriteProperty("RoundRectEllipseHeight",
m_RoundRectEllipseHeight, m_def_RoundRectEllipseHeight)
Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
Call PropBag.WriteProperty("RoundRectColor", m_RoundRectColor,
m_def_RoundRectColor)
Call PropBag.WriteProperty("TextColor", m_TextColor, m_def_TextColor)
Call PropBag.WriteProperty("BackColor", UserControl.BackColor,
&H8000000F)
End Sub

Public Property Get Font() As Font
Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
Set UserControl.Font = New_Font
PropertyChanged "Font"
Refresh
End Property

Public Property Get RoundRectColor() As OLE_COLOR
RoundRectColor = m_RoundRectColor
End Property

Public Property Let RoundRectColor(ByVal New_RoundRectColor As OLE_COLOR)
m_RoundRectColor = New_RoundRectColor
PropertyChanged "RoundRectColor"
Refresh
End Property

Public Property Get TextColor() As OLE_COLOR
TextColor = m_TextColor
End Property

Public Property Let TextColor(ByVal New_TextColor As OLE_COLOR)
m_TextColor = New_TextColor
PropertyChanged "TextColor"
Refresh
End Property

Public Property Get BackColor() As OLE_COLOR
BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
UserControl.BackColor() = New_BackColor
PropertyChanged "BackColor"
Refresh
End Property



--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/

Flex wrote:

bonjour tout le monde,
voila, j'ai décidé de me lancer dans la création d'un ocx.
Il s'agira d'une version améliorée du controle frame.
J'ai réfléchi déja à différents options du genre:
modifier l'apparence,
incorporer des images,
définir les contours,
définir l'alignement du titre et plein d'autres choses

Pour ce qui concerne les contours, j'ai cherché du coté des API et
j''ai vu qu'il y en a pas mal:
CreateRoundRectRgn
RoundRect
...

Deux choses:
1) Est ce qu'il vaut mieux mettre dans mon usercontrol des label,
shape, textbox,...etc
ou
2)Tout créer avec l'aide de fonctions API

Dans le 2ème cas, quelle est la stratégie(et ou quelle fonction api) à
adopter si on veut pouvoir choisir le coin à arrondir.

j'attends vos réponses.
Merci

PS: existe t-il un site vb FR oui on peut developper en communauté

ReSalut,

1) Est ce qu'il vaut mieux mettre dans mon usercontrol des label, shape,
textbox,...etc
ou
2)Tout créer avec l'aide de fonctions API

Oui en général il vaut mieux tout redessiner soit mm.

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/

Flex wrote:

bonjour tout le monde,
voila, j'ai décidé de me lancer dans la création d'un ocx.
Il s'agira d'une version améliorée du controle frame.
J'ai réfléchi déja à différents options du genre:
modifier l'apparence,
incorporer des images,
définir les contours,
définir l'alignement du titre et plein d'autres choses

Pour ce qui concerne les contours, j'ai cherché du coté des API et
j''ai vu qu'il y en a pas mal:
CreateRoundRectRgn
RoundRect
...

Deux choses:
1) Est ce qu'il vaut mieux mettre dans mon usercontrol des label,
shape, textbox,...etc
ou
2)Tout créer avec l'aide de fonctions API

Dans le 2ème cas, quelle est la stratégie(et ou quelle fonction api) à
adopter si on veut pouvoir choisir le coin à arrondir.

j'attends vos réponses.
Merci

PS: existe t-il un site vb FR oui on peut developper en communauté

ng je te remercie
je vais voir le control que tu m'as passé et voir si j'en apprend un peu
plus.
Merci encore
"ng" <ng@ngsoft-fr.com> a écrit dans le message de news:
%23WMF98i3EHA.2804@TK2MSFTNGP15.phx.gbl...

ReSalut,

1) Est ce qu'il vaut mieux mettre dans mon usercontrol des label, shape,
textbox,...etc
ou
2)Tout créer avec l'aide de fonctions API

Oui en général il vaut mieux tout redessiner soit mm.

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/

Flex wrote:

bonjour tout le monde,
voila, j'ai décidé de me lancer dans la création d'un ocx.
Il s'agira d'une version améliorée du controle frame.
J'ai réfléchi déja à différents options du genre:
modifier l'apparence,
incorporer des images,
définir les contours,
définir l'alignement du titre et plein d'autres choses

Pour ce qui concerne les contours, j'ai cherché du coté des API et
j''ai vu qu'il y en a pas mal:
CreateRoundRectRgn
RoundRect
...

Deux choses:
1) Est ce qu'il vaut mieux mettre dans mon usercontrol des label,
shape, textbox,...etc
ou
2)Tout créer avec l'aide de fonctions API

Dans le 2ème cas, quelle est la stratégie(et ou quelle fonction api) à
adopter si on veut pouvoir choisir le coin à arrondir.

j'attends vos réponses.
Merci

PS: existe t-il un site vb FR oui on peut developper en communauté