Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Développement Développement Visual Basic Ecrire le long d'une ligne

Ecrire le long d'une ligne

15 réponses
Avatar
Patrice Henrio
Quelqu'un a-t'il déjà codé le problème suivant :
J'ai une ligne à l'écran définie pas des segments de droites (suffisamment
rapprochés pour donner l'illusion d'une courbe).
Je veux écrire un texte qui suive une partie de cette courbe.
Cerise sur le gâteau, je souhaite pouvoir sélectionner ce texte et le
déplacer le long de la courbe.
Si quelqu'un a une idée pas trop lourde ?

Pour l'instant je me suis contenté de réécrire le texte en mode dessin et
considéré ce dessin comme une courbe puis je l'ai intégré au dessin de la
courbe de départ.
Avantage : tous les calculs préliminaires se font dans Excel, ensuite je
charge les résultats (texte + courbe) dans un fichier de points. Ca je sais
faire.
Inconvénient : mon texte est figé à un endroit de la courbe et n'est donc
pas dynamique.

Peut-être faudrait-il que je développe un ocx ?
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Patrice Henrio
Je viens d'essayer. Cela correspond à ce que m'a proposé Jean-Marc (en
passant par une classe pour ce qui te concerne). Malheureusement cela ne
fait pas avancer le schmilblick, car le vrai problème n'est pas d'écrire
suivant un angle défini mais de trouver quelle angle il faut attribuer à
chaque lettre. A priori ça parait simple mais à l'usage cela est bien
compliqué, au point que je n'ai pas d'algorithme satisfaisant à me mettre
sous la dent.. Je dois m'y remettre la semaine prochaine.

"<pasdespam> @wanadoo.fr>" <"<pasdespam> a écrit dans le message de news:
4301b17b$0$919$
Patrice Henrio a écrit :
Est-ce que l'angle est le même pour chaque lettre (écriture du mot en une
fois) ou dépend de chaque lettre ?
Peut-on voir de quoi il retourne ?
Merci.




Bonjour,

En fait la methode de la classe prend en argument un string donc tu peux
gérer ton mot en n caractères à toi de voir, ci-joint un exemple
d'utilisation de la classe.
NB: prendre garde à mettre scalemode à pixel pour picture1.
Désolé c'est pas trop commenté mais tu devrais t'en sortir.
Si tu as des questions n'hésites pas.

A+

Christophe



'****************
'form1, picture1 (picturebox), command1 (command button
'****************

Private mdc As metricDC


Private Sub Command1_Click()
Dim Io As Long
Dim dX As Double
Dim i&
Dim x As Double
Dim y As Double


mdc.zoomReel -5, -5, 5, 5

mdc.linereal -10, 0, mdc.Espacereelright, 0, RGB(0, 0, 0)
mdc.linereal 0, -10, 0, mdc.Espacereeltop, RGB(0, 0, 0)

mdc.writetext "0rigine (0,0)", 0.2, -0.7, 0.7, 0, 0, True
dX = mdc.DefiniPasReal

x = mdc.Espacereelleft

Do While x < mdc.Espacereelright
y = Sin(x)
mdc.DessinePointFonction x, y, RGB(0, 255, 0)
y = Tan(x)
mdc.DessinePointFonction x, y, RGB(255, 0, 0)
x = x + dX
Loop

mdc.Cercle 0, 0, 1, RGB(0, 0, 255)

End Sub

Private Sub Form_Load()


Set mdc = New metricDC
mdc.Init Picture1


End Sub

Private Sub Form_Unload(Cancel As Integer)
Set mdc = Nothing

End Sub
'**************************************


Option Explicit


'---------------------------------------------------------------------------------------
' Module : metricDC
' DateTime : 17/11/02 17:51
' Author : VERGON Christophe
' Purpose : Gestion des pictureBox en mode metrique
' How to use PictureBox in Metric Mode with API
'call init sub to start
'---------------------------------------------------------------------------------------
Const PS_SOLID& = 0
Const PS_DOT& = 2
Const PS_DASH& = 1
Const PS_DASHDOT& = 3
Const PS_DASHDOTDOT& = 4
Const MM_HIMETRIC& = 3

Const FIXED_PITCH = 1
Const TA_NOUPDATECP = 0
Const TA_UPDATECP = 1
Const TA_LEFT = 0
Const TA_RIGHT = 2
Const TA_CENTER = 6
Const TA_TOP = 0
Const TA_BOTTOM = 8
Const TA_BASELINE = 24
Const LF_FACESIZE = 32

Private Const SYSTEM_FONT& = 13
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type




Private Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type


Private Type Size
cx As Long
cy As Long
End Type
Private m_hwnd As Long

Private Declare Function CreateFontIndirect& Lib "gdi32" Alias
"CreateFontIndirectA" (lpLogFont As LOGFONT)
Private Declare Function GetTextFace& Lib "gdi32" Alias "GetTextFaceA"
(ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String)
Private Declare Function GetTextMetrics& Lib "gdi32" Alias
"GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC)
Private Declare Function GetTextExtentPoint32& Lib "gdi32" Alias
"GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal
cbString As Long, lpSize As Size)
Private Declare Function TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hdc
As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal
nCount As Long)
Private Declare Function SetTextAlign& Lib "gdi32" (ByVal hdc As Long,
ByVal wFlags As Long)
Private Declare Function DrawText& Lib "user32" Alias "DrawTextA" (ByVal
hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As Rect,
ByVal wFormat As Long)
Private Type POINTAPI
x As Long
y As Long
End Type

Private Type POINTGEO
x As Double
y As Double
End Type

Private Type RECTGEO
Left As Double
Top As Double
Right As Double
Bottom As Double
End Type

Private Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type


'**********************************


Private mMousepointer As Integer
'** Function Declarations:
Private Declare Function CreateSolidBrush& Lib "gdi32" (ByVal crColor As
Long)
Private Declare Function CreatePen& Lib "gdi32" (ByVal nPenStyle As Long,
ByVal nWidth As Long, ByVal crColor As Long)
Private Declare Function LineTo& Lib "gdi32" (ByVal hdc As Long, ByVal x
As Long, ByVal y As Long)
Private Declare Function MoveToEx& Lib "gdi32" (ByVal hdc As Long, ByVal x
As Long, ByVal y As Long, lpPoint As POINTAPI)
Private Declare Function Polyline& Lib "gdi32" (ByVal hdc As Long, lpPoint
As POINTAPI, ByVal nCount As Long)
Private Declare Function PolylineTo& Lib "gdi32" (ByVal hdc As Long, lppt
As POINTAPI, ByVal cCount As Long)
Private Declare Function Polygon& Lib "gdi32" (ByVal hdc As Long, lpPoint
As POINTAPI, ByVal nCount As Long)
Private Declare Function DPtoLP& Lib "gdi32" (ByVal hdc As Long, lpPoint
As POINTAPI, ByVal nCount As Long)
Private Declare Function LPtoDP& Lib "gdi32" (ByVal hdc As Long, lpPoint
As POINTAPI, ByVal nCount As Long)
Private Declare Function SetMapMode& Lib "gdi32" (ByVal hdc As Long, ByVal
nMapMode As Long)
Private Declare Function SetViewportOrgEx& Lib "gdi32" (ByVal hdc As Long,
ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
Private Declare Function SetWindowOrgEx& Lib "gdi32" (ByVal hdc As Long,
ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
Private Declare Function RestoreDC& Lib "gdi32" (ByVal hdc As Long, ByVal
nSavedDC As Long)
Private Declare Function GetClientRect& Lib "user32" (ByVal hwnd As Long,
lpRect As Rect)
Private Declare Function GetStockObject& Lib "gdi32" (ByVal nIndex As
Long)
Private Declare Function SelectObject& Lib "gdi32" (ByVal hdc As Long,
ByVal hObject As Long)
Private Declare Function SaveDC& Lib "gdi32" (ByVal hdc As Long)
Private Declare Function Rectangle& Lib "gdi32" (ByVal hdc As Long, ByVal
x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
Private Declare Function GetObjectAPI& Lib "gdi32" Alias "GetObjectA"
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any)
Private Declare Function SetPixelV& Lib "gdi32" (ByVal hdc As Long, ByVal
x As Long, ByVal y As Long, ByVal crColor As Long)
Private Declare Function Ellipse& Lib "gdi32" (ByVal hdc As Long, ByVal x1
As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long)
Private Declare Function CreateRectRgn& Lib "gdi32" (ByVal x1 As Long,
ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long)
Private Declare Function SelectClipRgn& Lib "gdi32" (ByVal hdc As Long,
ByVal hRgn As Long)
Private Declare Function SetROP2& Lib "gdi32" (ByVal hdc As Long, ByVal
nDrawMode As Long)
Private Declare Function GetROP2& Lib "gdi32" (ByVal hdc As Long)






Private Const R2_COPYPEN& = 13
Private mrectdessin As Rect
Private mypoint As POINTAPI
Private MyGeoPoint As POINTGEO
Private mespacereel As RECTGEO
Private mDimensionEspaceLogique
Private mYlog As Long
Private mXlog As Long
Private mYlogique As Long
Private mXlogique As Long
Private mX As Double
Private mY As Double
Private mXph As Long
Private mYph As Long
Private mxT As Double
Private myT As Double
Private mEchelle As Double
Private mViewOrgX As Long
Private mviewOrgY As Long
Private mWinOrgX As Long
Private mWinOrgY As Long
Private m_savedDC&
Private mrectText As Rect
Private mespaceText As RECTGEO
Private MaxlogPoint() As POINTAPI
Private lpPoint() As POINTAPI
Private mlpgeo() As POINTGEO
Private dummy&


Private mPicture As PictureBox





Public Sub Init(Picture1 As PictureBox)
Dim pt As POINTAPI

Set mPicture = Picture1

mPicture.ScaleMode = 3



espaceclient

mViewOrgX = 0&
mviewOrgY = mrectdessin.Bottom - mrectdessin.Top
mWinOrgX = 0
mWinOrgY = 0
mxT = 0
myT = 0
mEchelle = 1 / 1000
InitEspace
zoomReel 0, 0, 1000, 1000
End Sub
Public Function InitEspace()
Dim pt As POINTAPI
setmetrique
ReDim MaxlogPoint(0)
MaxlogPoint(0).x = mrectdessin.Right
MaxlogPoint(0).y = mrectdessin.Top
dummy& = DPtoLP(mPicture.hdc, MaxlogPoint(0), 1)
pt.x = 0: pt.y = 0
mYlogique = MaxlogPoint(0).y
mXlogique = MaxlogPoint(0).x
mDimensionEspaceLogique = DistanceAPI(pt, MaxlogPoint(0))

MyGeoPoint = LtoR(MaxlogPoint(0))
mespacereel.Right = MyGeoPoint.x
mespacereel.Top = MyGeoPoint.y
MyGeoPoint = LtoR(pt)
mespacereel.Bottom = MyGeoPoint.x
mespacereel.Left = MyGeoPoint.y

exitmetrique

End Function

Public Sub setmetrique()


m_savedDC& = SaveDC&(mPicture.hdc)

dummy& = SetMapMode&(mPicture.hdc, MM_HIMETRIC)
dummy& = SetViewportOrgEx&(mPicture.hdc, mViewOrgX, mviewOrgY,
mypoint)
dummy& = SetWindowOrgEx&(mPicture.hdc, mWinOrgX, mWinOrgY,
mypoint)
End Sub
Public Sub exitmetrique()
m_savedDC& = RestoreDC(mPicture.hdc, m_savedDC&)
End Sub
Public Sub PeriphReel(x As Single, y As Single)
setmetrique
ReDim lpPoint(0)
ReDim mlpgeo(0)
lpPoint(0).x = CLng(x)
lpPoint(0).y = CLng(y)
dummy& = DPtoLP(mPicture.hdc, lpPoint(0), 1)
mlpgeo(0) = LtoR(lpPoint(0))
mX = mlpgeo(0).x
mY = mlpgeo(0).y
'retour dc à vb
exitmetrique
End Sub
Public Sub ReelPeriph(x As Double, y As Double)
setmetrique
ReDim mlpgeo(0)
mlpgeo(0).x = x
mlpgeo(0).y = y
ReDim lpPoint(0)
lpPoint(0) = RtoL(mlpgeo(0))
dummy& = LPtoDP(mPicture.hdc, lpPoint(0), 1)
mXph = lpPoint(0).x
mYph = lpPoint(0).y
exitmetrique
End Sub
Public Sub ReelLogiq(x As Double, y As Double)
setmetrique
ReDim mlpgeo(0)
mlpgeo(0).x = x
mlpgeo(0).y = y
ReDim lpPoint(0)
lpPoint(0) = RtoL(mlpgeo(0))
mXlog = lpPoint(0).x
mYlog = lpPoint(0).y
exitmetrique
End Sub
Public Sub LogiqToReel(x As Long, y As Long)
setmetrique
ReDim lpPoint(0)
ReDim mlpgeo(0)
lpPoint(0).x = x
lpPoint(0).y = y
mlpgeo(0) = LtoR(lpPoint(0))
mX = mlpgeo(0).x
mY = mlpgeo(0).y
exitmetrique
End Sub
Public Sub espaceclient()
Dim dummy&
Dim pt As POINTAPI
Dim p As POINTGEO

dummy& = GetClientRect&(mPicture.hwnd, mrectdessin)
mviewOrgY = mrectdessin.Bottom - mrectdessin.Top
setmetrique
ReDim MaxlogPoint(0)
MaxlogPoint(0).x = mrectdessin.Right
MaxlogPoint(0).y = mrectdessin.Top
dummy& = DPtoLP(mPicture.hdc, MaxlogPoint(0), 1)


pt.x = 0: pt.y = 0
mYlogique = MaxlogPoint(0).y
mXlogique = MaxlogPoint(0).x
mDimensionEspaceLogique = DistanceAPI(pt, MaxlogPoint(0))

p = LtoR(pt)
mespacereel.Left = p.x
mespacereel.Bottom = p.y

p = LtoR(MaxlogPoint(0))
mespacereel.Right = p.x
mespacereel.Top = p.y

exitmetrique

End Sub



Private Function RtoL(p As POINTGEO) As POINTAPI
Dim x As Long, y As Long
Dim x1 As Double, y1 As Double



x1 = ((p.x - mxT) * 10 ^ 5 * mEchelle)
y1 = ((p.y - myT) * 10 ^ 5 * mEchelle)
On Error Resume Next
Err.Clear
x = CLng(x1)
If Err.Number = 6 Then
x = -32765
Err.Clear
End If
y = CLng(y1)
If Err.Number = 6 Then
y = -32765
Err.Clear
End If
On Error GoTo 0


If p.x < mxT Then
RtoL.x = -32765
x = -32765
End If
If p.y < myT Then
RtoL.y = -32765
y = -32765
End If

If x > 32765 Then
RtoL.x = 32765
Else
RtoL.x = x
End If

If y > 32765 Then
RtoL.y = 32765
Else
RtoL.y = y
End If

'RtoL.x = x
'RtoL.y = y
End Function
Private Function LtoR(p As POINTAPI) As POINTGEO
If mEchelle = 0 Then Exit Function
LtoR.x = p.x / (mEchelle * 10 ^ 5) + mxT
LtoR.y = p.y / (mEchelle * 10 ^ 5) + myT

End Function
Public Sub zoomPh(x1 As Single, y1 As Single, x2 As Single, y2 As Single)
espaceclient

setmetrique
ReDim lpPoint(1)
ReDim mlpgeo(1)
lpPoint(1).x = CLng(x2)
lpPoint(1).y = CLng(y2)
lpPoint(0).x = CLng(x1)
lpPoint(0).y = CLng(y1)

dummy& = DPtoLP(mPicture.hdc, lpPoint(0), 2)
mlpgeo(0) = LtoR(lpPoint(0))
mlpgeo(1) = LtoR(lpPoint(1))

If mlpgeo(0).x < mlpgeo(1).x Then
mespacereel.Left = mlpgeo(0).x
mespacereel.Right = mlpgeo(1).x
Else
mespacereel.Left = mlpgeo(1).x
mespacereel.Right = mlpgeo(0).x
End If

If mlpgeo(0).y < mlpgeo(1).y Then
mespacereel.Bottom = mlpgeo(0).y
mespacereel.Top = mlpgeo(1).y
Else
mespacereel.Bottom = mlpgeo(1).y
mespacereel.Top = mlpgeo(0).y
End If

mEchelle = mDimensionEspaceLogique / (DistanceGEO(mlpgeo(0),
mlpgeo(1)) * 10 ^ 5)

mxT = mespacereel.Left
myT = mespacereel.Bottom

lpPoint(1).x = mrectdessin.Right
lpPoint(1).y = mrectdessin.Top
dummy& = DPtoLP(mPicture.hdc, lpPoint(0), 2)
mlpgeo(1) = LtoR(lpPoint(1))
mespacereel.Right = mlpgeo(1).x
mespacereel.Top = mlpgeo(1).y
exitmetrique
End Sub
Public Sub Offset(x1 As Single, y1 As Single, x2 As Single, y2 As Single)
espaceclient
setmetrique
ReDim lpPoint(1)
ReDim mlpgeo(1)
lpPoint(1).x = CLng(x2)
lpPoint(1).y = CLng(y2)
lpPoint(0).x = CLng(x1)
lpPoint(0).y = CLng(y1)

dummy& = DPtoLP(mPicture.hdc, lpPoint(0), 2)
mlpgeo(0) = LtoR(lpPoint(0))
mlpgeo(1) = LtoR(lpPoint(1))
mespacereel.Bottom = mespacereel.Bottom + (mlpgeo(0).y - mlpgeo(1).y)
mespacereel.Left = mespacereel.Left + (mlpgeo(0).x - mlpgeo(1).x)
mespacereel.Right = mespacereel.Right + (mlpgeo(0).x - mlpgeo(1).x)
mespacereel.Top = mespacereel.Top + (mlpgeo(0).y - mlpgeo(1).y)
mxT = mespacereel.Left
myT = mespacereel.Bottom
exitmetrique
End Sub

Public Sub OffsetReal(x1 As Double, y1 As Double, x2 As Double, y2 As
Double)



mespacereel.Bottom = mespacereel.Bottom + (y1 - y2)
mespacereel.Left = mespacereel.Left + (x1 - x2)
mespacereel.Right = mespacereel.Right + (x1 - x2)
mespacereel.Top = mespacereel.Top + (y1 - y2)
mxT = mespacereel.Left
myT = mespacereel.Bottom

End Sub
Public Sub zoomReel(x1 As Double, y1 As Double, x2 As Double, y2 As
Double)

If x1 = 0 And x2 = 0 And y1 = 0 And y2 = 0 Then Exit Sub
If (x2 - x1) > (y2 - y1) Then

zoomXReel x1, y1, x2, y2
Exit Sub

Else
zoomYReel x1, y1, x2, y2
Exit Sub
End If

espaceclient
setmetrique
ReDim lpPoint(1)
ReDim mlpgeo(1)
mlpgeo(0).x = mespacereel.Left
mlpgeo(1).x = mespacereel.Right
mlpgeo(0).y = mespacereel.Bottom
mlpgeo(1).y = mespacereel.Top
lpPoint(0) = RtoL(mlpgeo(0))
lpPoint(1) = RtoL(mlpgeo(1))

ReDim mlpgeo(1)
mlpgeo(0).x = x1
mlpgeo(1).x = x2
mlpgeo(0).y = y1
mlpgeo(1).y = y2
mxT = x1
myT = y1
mEchelle = DimensionEspaceLogique / (DistanceGEO(mlpgeo(0), mlpgeo(1)) *
10 ^ 5)
mlpgeo(0) = LtoR(lpPoint(0))
mlpgeo(1) = LtoR(lpPoint(1))

mespacereel.Left = mlpgeo(0).x
mespacereel.Right = mlpgeo(1).x
mespacereel.Bottom = mlpgeo(0).y
mespacereel.Top = mlpgeo(1).y
exitmetrique
End Sub



Public Sub linereal(x1 As Double, y1 As Double, x2 As Double, y2 As
Double, couleur As Long, Optional Mode As Long = 13)
Dim p1 As POINTGEO
Dim p2 As POINTGEO
Dim ap1 As POINTAPI
Dim ap2 As POINTAPI
Dim OldPen&
Dim UsePen&
Dim dummy&
Dim oldmode&

p1.x = x1
p1.y = y1
p2.x = x2
p2.y = y2
setmetrique

oldmode = SetROP2(mPicture.hdc, Mode)

UsePen& = CreatePen(PS_SOLID, 1, couleur)
OldPen& = SelectObject(mPicture.hdc, UsePen&)
ap1 = RtoL(p1)
ap2 = RtoL(p2)

'Debug.Print "Xd " & Str(ap1.x) & " Yd " & Str(ap1.Y)
dummy& = MoveToEx&(mPicture.hdc, ap1.x, ap1.y, ap1)
dummy& = LineTo(mPicture.hdc, ap2.x, ap2.y)

'Debug.Print "Xf " & Str(ap2.x) & " Yf " & Str(ap2.Y)

dummy& = SelectObject(mPicture.hdc, OldPen&)
dummy& = DeleteObject(UsePen&)
dummy& = SetROP2(mPicture.hdc, oldmode)
exitmetrique

End Sub

Public Sub linepheriph(x1 As Single, y1 As Single, x2 As Single, y2 As
Single, couleur As Long, Optional Mode As Long = 13)
Dim ap(1) As POINTAPI
Dim OldPen&
Dim UsePen&
Dim dummy&
Dim oldmode&

ap(0).x = CLng(x1)
ap(0).y = CLng(y1)
ap(1).x = CLng(x2)
ap(1).y = CLng(y2)

setmetrique

oldmode = SetROP2(mPicture.hdc, Mode)

UsePen& = CreatePen(PS_SOLID, 1, couleur)
OldPen& = SelectObject(mPicture.hdc, UsePen&)

dummy& = DPtoLP(mPicture.hdc, ap(0), 2)

'Debug.Print "Xd " & Str(ap1.x) & " Yd " & Str(ap1.Y)
dummy& = MoveToEx&(mPicture.hdc, ap(0).x, ap(0).y, ap(0))
dummy& = LineTo(mPicture.hdc, ap(1).x, ap(1).y)

'Debug.Print "Xf " & Str(ap2.x) & " Yf " & Str(ap2.Y)

dummy& = SelectObject(mPicture.hdc, OldPen&)
dummy& = DeleteObject(UsePen&)
dummy& = SetROP2(mPicture.hdc, oldmode)
exitmetrique

End Sub



'---------------------------------------------------------------------------------------
' Procedure : DefiniCompteur
' DateTime : 18/09/03 11:49
' Author : VERGON Christophe
' Purpose : valeur min des x=0 calcul valeur max
'---------------------------------------------------------------------------------------
'
Public Function DefiniCompteur() As Long
Dim p1 As POINTGEO
Dim p As POINTAPI

p1.x = mespacereel.Right
p1.y = mespacereel.Bottom
p = RtoL(p1)
DefiniCompteur = p.x

End Function

'---------------------------------------------------------------------------------------
' Procedure : DefiniPasReal
' DateTime : 18/09/03 11:50
' Author : VERGON Christophe
' Purpose : Valeur de l'increment en x en fonction du zoom
'---------------------------------------------------------------------------------------
'
Public Function DefiniPasReal() As Double
Dim p1 As POINTGEO
Dim p2 As POINTGEO
Dim pa1 As POINTAPI
Dim pa2 As POINTAPI
setmetrique
pa1.x = 0
pa2.x = 1
p1 = LtoR(pa1)
p2 = LtoR(pa2)
DefiniPasReal = p2.x - p1.x
exitmetrique
End Function
Public Function PixelScreen() As Double
Dim p1 As POINTGEO
Dim p2 As POINTGEO
Dim pa(1) As POINTAPI

Dim dummy&

setmetrique

pa(0).x = 0
pa(0).y = 0
pa(1).x = 1
pa(1).y = 0

dummy& = DPtoLP(mPicture.hdc, pa(0), 2)
p1 = LtoR(pa(0))
p2 = LtoR(pa(1))
PixelScreen = p2.x - p1.x
exitmetrique

End Function


'---------------------------------------------------------------------------------------
' Procedure : DessinePointFonction
' DateTime : 18/09/03 11:50
' Author : VERGON Christophe
' Purpose : dessine le point réel P dans le DC avec la couleur Color
'---------------------------------------------------------------------------------------
'
Public Sub DessinePointFonction(x As Double, y As Double, Color As Long)
Dim p1 As POINTAPI
Dim p As POINTGEO

p.x = x
p.y = y
p1 = RtoL(p)
setmetrique
dummy& = SetPixelV(mPicture.hdc, p1.x, p1.y, Color)
exitmetrique
End Sub
Private Function DistanceGEO(p1 As POINTGEO, p2 As POINTGEO) As Double
Dim x, y As Double

x = p2.x - p1.x
y = p2.y - p1.y
DistanceGEO = Sqr(x * x + y * y)
End Function

Private Function DistanceAPI(p1 As POINTAPI, p2 As POINTAPI) As Double
Dim x, y As Double

x = p2.x - p1.x
y = p2.y - p1.y
DistanceAPI = Sqr(x * x + y * y)

End Function

Private Function PinRealRegion(p As POINTGEO, rgn As RECTGEO) As Boolean
Dim t As Double
If rgn.Left > rgn.Right Then
t = rgn.Left
rgn.Left = rgn.Right
rgn.Right = t
End If

If rgn.Bottom > rgn.Top Then
t = rgn.Bottom
rgn.Bottom = rgn.Top
rgn.Top = t
End If

If p.x < rgn.Left Then
PinRealRegion = False
Exit Function
Else
If p.x > rgn.Right Then
PinRealRegion = False
Exit Function
Else
If p.y < rgn.Bottom Then
PinRealRegion = False
Exit Function
Else
If p.y > rgn.Top Then
PinRealRegion = False
Exit Function
Else

PinRealRegion = True

End If
End If
End If

End If

End Function
Public Sub Refresh()
mPicture.Refresh
End Sub

Public Function writetext(MyText As String, x As Double, y As Double,
taille As Double, align As Long, angle As Double, affiche As Boolean)
Dim lf As LOGFONT
Dim oldfont&
Dim alignorigin&
Dim newfont&

Dim di&
Dim pointattache As POINTAPI
Dim pointlog As POINTAPI
Dim p As POINTGEO
Dim SI As Size

setmetrique
p.x = x
p.y = y
pointattache = RtoL(p)
p.x = x + taille
p.y = y + taille
pointlog = RtoL(p)

'Police logique courante par selection police systeme
oldfont& = SelectObject(mPicture.hdc, GetStockObject(0))
di& = GetObjectAPI(oldfont&, Len(lf), lf)

'rétablit la police de départ
di& = SelectObject(mPicture.hdc, oldfont&)

'stocke l'alignement d'origine
Select Case align
Case 0
alignorigin& = SetTextAlign(mPicture.hdc, TA_LEFT Or TA_BOTTOM Or
TA_UPDATECP)
Case 1
alignorigin& = SetTextAlign(mPicture.hdc, TA_RIGHT Or TA_BOTTOM Or
TA_UPDATECP)
Case 2
alignorigin& = SetTextAlign(mPicture.hdc, TA_CENTER Or TA_BOTTOM Or
TA_UPDATECP)
End Select

lf.lfHeight = pointlog.y - pointattache.y
lf.lfEscapement = -1 * Round(angle * 10, 0)
newfont& = CreateFontIndirect(lf)
oldfont& = SelectObject(mPicture.hdc, newfont&)
di& = GetTextExtentPoint32(mPicture.hdc, MyText, Len(MyText), SI)
mrectText.Bottom = pointattache.y
mrectText.Top = mrectText.Bottom + SI.cy
mrectText.Left = pointattache.x - SI.cx / 2
mrectText.Right = mrectText.Left + SI.cx
ConvertEspaceText
If affiche Then
di& = MoveToEx&(mPicture.hdc, pointattache.x, pointattache.y, pointlog)
di& = TextOut(mPicture.hdc, 0, 0, MyText, Len(MyText))
End If
di& = SelectObject(mPicture.hdc, oldfont&)

DeleteObject (newfont&)

exitmetrique
End Function
Public Property Get Espacereeltop() As Double
Espacereeltop = mespacereel.Top
End Property
Private Sub ConvertEspaceText()
Dim p As POINTGEO
Dim PL As POINTAPI

'doit etre appelé par une foncvtion ayant effectué setmetrique

PL.x = mrectText.Left
PL.y = mrectText.Bottom
p = LtoR(PL)
mespaceText.Left = p.x
mespaceText.Bottom = p.y

PL.x = mrectText.Right
PL.y = mrectText.Top
p = LtoR(PL)
mespaceText.Right = p.x
mespaceText.Top = p.y

End Sub
Public Property Get Espacereelleft() As Double
Espacereelleft = mespacereel.Left
End Property
Public Property Get Espacereelright() As Double
Espacereelright = mespacereel.Right
End Property
Public Property Get Espacereelbottom() As Double
Espacereelbottom = mespacereel.Bottom
End Property

Public Property Get echelle() As Double
echelle = mEchelle
End Property

Public Property Get xT() As Double
xT = mxT
End Property

Public Property Get yT() As Double
yT = myT
End Property
Public Property Get DimensionEspaceLogique() As Long
DimensionEspaceLogique = mDimensionEspaceLogique
End Property

Public Property Let DimensionEspaceLogique(ByVal vNewValue As Long)
mDimensionEspaceLogique = vNewValue 'DimensionEspaceLogique
End Property




Public Property Get Xencours() As Double
Xencours = mX
End Property
Public Property Get Yencours() As Double
Yencours = mY
End Property
Public Property Get XencoursPh() As Long
XencoursPh = mXph
End Property
Public Property Get yencoursph() As Double
yencoursph = mYph
End Property
Public Property Get XencoursLog() As Double
XencoursLog = mXlog
End Property
Public Property Get YencoursLog() As Double
YencoursLog = mYlog
End Property

Private Sub Class_Terminate()

Set mPicture = Nothing
End Sub



Public Property Get hdc() As Long

hdc = mPicture.hdc

End Property



Public Property Get Mousepointer() As Integer

Mousepointer = mPicture.Mousepointer

End Property

Public Property Let Mousepointer(ByVal Mousepointer As Integer)

mPicture.Mousepointer = Mousepointer

End Property
Public Function DefiniValPixel(AxeX As Boolean) As Double

setmetrique
ReDim lpPoint(2)
ReDim mlpgeo(2)
lpPoint(0).x = 0
lpPoint(0).y = 0
lpPoint(1).x = 1
lpPoint(1).y = 0
lpPoint(2).x = 0
lpPoint(2).y = 1
dummy& = DPtoLP(mPicture.hdc, lpPoint(0), 3)
mlpgeo(0) = LtoR(lpPoint(0))
mlpgeo(1) = LtoR(lpPoint(1))
mlpgeo(2) = LtoR(lpPoint(2))

exitmetrique
If AxeX Then
DefiniValPixel = Sqr((mlpgeo(1).x - mlpgeo(0).x) ^ 2 + (mlpgeo(1).y -
mlpgeo(0).y) ^ 2)
Else
DefiniValPixel = Sqr((mlpgeo(2).x - mlpgeo(0).x) ^ 2 + (mlpgeo(2).y -
mlpgeo(0).y) ^ 2)
End If

End Function

Public Property Get hwnd() As Long

hwnd = mPicture.hwnd

End Property
Public Sub zoomYReel(x1 As Double, y1 As Double, x2 As Double, y2 As
Double)
espaceclient
setmetrique
ReDim lpPoint(1)
ReDim mlpgeo(1)
mlpgeo(0).x = mespacereel.Left
mlpgeo(1).x = mespacereel.Right
mlpgeo(0).y = mespacereel.Bottom
mlpgeo(1).y = mespacereel.Top
lpPoint(0) = RtoL(mlpgeo(0))
lpPoint(1) = RtoL(mlpgeo(1))

ReDim mlpgeo(1)
mlpgeo(0).x = x1
mlpgeo(1).x = x2
mlpgeo(0).y = y1
mlpgeo(1).y = y2
mxT = x1
myT = y1
mEchelle = mYlogique / ((mlpgeo(1).y - mlpgeo(0).y) * 10 ^ 5)
mlpgeo(0) = LtoR(lpPoint(0))
mlpgeo(1) = LtoR(lpPoint(1))

mespacereel.Left = mlpgeo(0).x
mespacereel.Right = mlpgeo(1).x
mespacereel.Bottom = mlpgeo(0).y
mespacereel.Top = mlpgeo(1).y
exitmetrique
End Sub
Public Sub zoomXReel(x1 As Double, y1 As Double, x2 As Double, y2 As
Double)
espaceclient
setmetrique
ReDim lpPoint(1)
ReDim mlpgeo(1)
mlpgeo(0).x = mespacereel.Left
mlpgeo(1).x = mespacereel.Right
mlpgeo(0).y = mespacereel.Bottom
mlpgeo(1).y = mespacereel.Top
lpPoint(0) = RtoL(mlpgeo(0))
lpPoint(1) = RtoL(mlpgeo(1))

ReDim mlpgeo(1)
mlpgeo(0).x = x1
mlpgeo(1).x = x2
mlpgeo(0).y = y1
mlpgeo(1).y = y2
mxT = x1
myT = y1
mEchelle = mXlogique / ((mlpgeo(1).x - mlpgeo(0).x) * 10 ^ 5)
mlpgeo(0) = LtoR(lpPoint(0))
mlpgeo(1) = LtoR(lpPoint(1))

mespacereel.Left = mlpgeo(0).x
mespacereel.Right = mlpgeo(1).x
mespacereel.Bottom = mlpgeo(0).y
mespacereel.Top = mlpgeo(1).y
exitmetrique
End Sub

Public Sub Cercle(x1 As Double, y1 As Double, rayon As Double, couleur As
Long)
Dim p1 As POINTGEO
Dim p2 As POINTGEO
Dim ap1 As POINTAPI
Dim ap2 As POINTAPI
Dim OldPen&, UsePen&
Dim dummy&
Dim r As RECTGEO

r.Bottom = mespacereel.Bottom
r.Left = mespacereel.Left
r.Right = mespacereel.Right
r.Top = mespacereel.Top

p1.x = x1
p1.y = y1

If PinRealRegion(p1, r) Then

If (r.Right - r.Left) < rayon Or (r.Top - r.Bottom) < rayon Then
Exit Sub
End If

Else
Exit Sub
End If

p1.x = x1 - rayon
p2.x = x1 + rayon
p1.y = y1 - rayon
p2.y = y1 + rayon



setmetrique

UsePen& = CreatePen(PS_SOLID, 1, couleur)
OldPen& = SelectObject(mPicture.hdc, UsePen&)
ap1 = RtoL(p1)
ap2 = RtoL(p2)

dummy& = Ellipse(mPicture.hdc, ap1.x, ap1.y, ap2.x, ap2.y)

dummy& = SelectObject(mPicture.hdc, OldPen&)
dummy& = DeleteObject(UsePen&)
exitmetrique
End Sub
Public Sub pointreal(x As Double, y As Double, couleur As Long)
Dim p1 As POINTGEO
Dim ap1 As POINTAPI
Dim ap2 As POINTAPI
Dim OldPen&, UsePen&
Dim dummy&

p1.x = x
p1.y = y
setmetrique
UsePen& = CreatePen(PS_SOLID, 1, couleur)
OldPen& = SelectObject(mPicture.hdc, UsePen&)
ap1 = RtoL(p1)
dummy& = MoveToEx&(mPicture.hdc, ap1.x, ap1.y, ap2)
dummy& = LineTo(mPicture.hdc, ap1.x + 100, ap1.y)
dummy& = MoveToEx&(mPicture.hdc, ap1.x, ap1.y, ap2)
dummy& = LineTo(mPicture.hdc, ap1.x - 100, ap1.y)
dummy& = MoveToEx&(mPicture.hdc, ap1.x, ap1.y, ap2)
dummy& = LineTo(mPicture.hdc, ap1.x, ap1.y + 100)
dummy& = MoveToEx&(mPicture.hdc, ap1.x, ap1.y, ap2)
dummy& = LineTo(mPicture.hdc, ap1.x, ap1.y - 100)
dummy& = SelectObject(mPicture.hdc, OldPen&)
dummy& = DeleteObject(UsePen&)
exitmetrique

End Sub
Public Sub CadreReal(x1 As Double, y1 As Double, x2 As Double, y2 As
Double, couleur As Long)
Dim p1 As POINTGEO
Dim p2 As POINTGEO
Dim ap1 As POINTAPI
Dim ap2 As POINTAPI
Dim ap As POINTAPI
Dim OldPen&, UsePen&
Dim dummy&

p1.x = x1
p1.y = y1
p2.x = x2
p2.y = y2
setmetrique

UsePen& = CreatePen(PS_SOLID, 1, couleur)
OldPen& = SelectObject(mPicture.hdc, UsePen&)
ap1 = RtoL(p1)
ap2 = RtoL(p2)
dummy& = MoveToEx&(mPicture.hdc, ap1.x, ap1.y, ap)
dummy& = LineTo(mPicture.hdc, ap2.x, ap1.y)
dummy& = LineTo(mPicture.hdc, ap2.x, ap2.y)
dummy& = LineTo(mPicture.hdc, ap1.x, ap2.y)
dummy& = LineTo(mPicture.hdc, ap1.x, ap1.y)
dummy& = SelectObject(mPicture.hdc, OldPen&)
dummy& = DeleteObject(UsePen&)
exitmetrique

End Sub
Public Sub DessineCadreSelect(x1 As Double, y1 As Double)
Dim p1 As POINTGEO
Dim ap1 As POINTAPI
Dim ap As POINTAPI
Dim OldPen&, UsePen&
Dim dummy&

p1.x = x1
p1.y = y1

setmetrique

UsePen& = CreatePen(PS_SOLID, 1, RGB(0, 0, 255))
OldPen& = SelectObject(mPicture.hdc, UsePen&)
ap1 = RtoL(p1)

dummy& = MoveToEx&(mPicture.hdc, ap1.x - 100, ap1.y - 100, ap)
dummy& = LineTo(mPicture.hdc, ap1.x - 100, ap1.y + 100)
dummy& = LineTo(mPicture.hdc, ap1.x + 100, ap1.y + 100)
dummy& = LineTo(mPicture.hdc, ap1.x + 100, ap1.y - 100)
dummy& = LineTo(mPicture.hdc, ap1.x - 100, ap1.y - 100)
dummy& = SelectObject(mPicture.hdc, OldPen&)
dummy& = DeleteObject(UsePen&)
exitmetrique

End Sub
Public Property Get Lastbottomtext() As Variant
Lastbottomtext = mespaceText.Bottom
End Property
Public Property Get Lastlefttext() As Variant
Lastlefttext = mespaceText.Left
End Property
Public Property Get Lasttoptext() As Variant
Lasttoptext = mespaceText.Top
End Property
Public Property Get Lastrighttext() As Variant
Lastrighttext = mespaceText.Right
End Property

Public Sub rectanglereal(x1 As Double, y1 As Double, x2 As Double, y2 As
Double, couleur As Long)
Dim p1 As POINTGEO
Dim p2 As POINTGEO
Dim ap1 As POINTAPI
Dim ap2 As POINTAPI
Dim lpPoint(3) As POINTAPI
Dim OldPen&, UsePen&
Dim oldbrush&, usebrush&
Dim dummy&

p1.x = x1
p1.y = y1
p2.x = x2
p2.y = y2
setmetrique
UsePen& = CreatePen(PS_SOLID, 1, couleur)
OldPen& = SelectObject(mPicture.hdc, UsePen&)
usebrush& = CreateSolidBrush(couleur)
oldbrush = SelectObject(mPicture.hdc, usebrush&)
ap1 = RtoL(p1)
ap2 = RtoL(p2)
lpPoint(0).x = ap1.x
lpPoint(0).y = ap1.y
lpPoint(1).x = ap2.x
lpPoint(1).y = ap1.y
lpPoint(2).x = ap2.x
lpPoint(2).y = ap2.y
lpPoint(3).x = ap1.x
lpPoint(3).y = ap2.y
dummy& = Polygon(mPicture.hdc, lpPoint(0), 4) 'Rectangle(mpicture.hdc,
ap1.x, ap1.y, ap2.x, ap2.y)
UsePen& = SelectObject(mPicture.hdc, OldPen&)
dummy& = DeleteObject(UsePen&)
usebrush& = SelectObject(mPicture.hdc, oldbrush)
dummy& = DeleteObject(usebrush)
exitmetrique
End Sub

Public Function CLS()
mPicture.CLS
End Function


Avatar
Patrice Henrio a écrit :
Je viens d'essayer. Cela correspond à ce que m'a proposé Jean-Marc (en
passant par une classe pour ce qui te concerne). Malheureusement cela ne
fait pas avancer le schmilblick, car le vrai problème n'est pas d'écrire
suivant un angle défini mais de trouver quelle angle il faut attribuer à
chaque lettre. A priori ça parait simple mais à l'usage cela est bien
compliqué, au point que je n'ai pas d'algorithme satisfaisant à me mettre
sous la dent.. Je dois m'y remettre la semaine prochaine.



Re,

Tu connais f(x) , tu connais f(x+dx) et dx (methode DefiniPasReal).
donc le vecteur directeur de la droite [X,Y], [x+dx,f(x+dx)] te donne
l'angle!

Ci-dessous la modification de l'exemple précédent (command1_click)
pour ecrire Sinus le long de la courbe sinus

A+

Christophe


Private Sub Command1_Click()
Dim Io As Long
Dim dX As Double
Dim i&
Dim x As Double
Dim y As Double
Dim a$
Dim Xo As Double
Dim Yo As Double
Dim angle As Double
Dim pi As Double

pi = 3.14116

a$ = "sinus"

mdc.zoomReel -7, -7, 7, 7

mdc.linereal -10, 0, mdc.Espacereelright, 0, RGB(0, 0, 0)
mdc.linereal 0, -10, 0, mdc.Espacereeltop, RGB(0, 0, 0)

mdc.writetext "0rigine (0,0)", 0.2, -0.7, 0.7, 0, 0, True
dX = mdc.DefiniPasReal

x = mdc.Espacereelleft

i& = 45
Do While x < mdc.Espacereelright
y = Sin(x)

mdc.DessinePointFonction x, y, RGB(0, 255, 0)


If i& Mod 400 = 0 Then

Xo = x + dX
Yo = Sin(Xo)


angle = Atn((Yo - y) / (Xo - x)) * (180 / pi)


Select Case (i& 400) Mod 10
Case 0
a$ = "s"
Case 1
a$ = "i"
Case 2
a$ = "n"
Case 3
a$ = "u"
Case 4
a$ = "s"
Case Else
a$ = " "

End Select
mdc.writetext a$, Xo, Yo, 0.5, 1, angle, True

End If

x = x + dX
i& = i& + 1
Loop

mdc.Cercle 0, 0, 1, RGB(0, 0, 255)

End Sub
Avatar
Patrice Henrio
Tu remarqueras sur le dessin que l'espacement entre le "s" et le "i" ainsi
q'entre le "u" et le "s" dans l'écriture 2 et 3 n'est pas régulier. C'est
cela que je veux améliorer. Sinon ton résultat est meilleur que ce que nous
avions réussi jusque là.
Il faudrait que je vois ce que cela donne avec une courbe définie par une
suite de points.
Je dois m'y mettre prochainement quand je serai en vacances la semaine
prochaine.

En tous cas merci de ton apport à ce problème.

"<pasdespam> @wanadoo.fr>" <"<pasdespam> a écrit dans le message de news:
43022c06$0$22276$
Patrice Henrio a écrit :
Je viens d'essayer. Cela correspond à ce que m'a proposé Jean-Marc (en
passant par une classe pour ce qui te concerne). Malheureusement cela ne
fait pas avancer le schmilblick, car le vrai problème n'est pas d'écrire
suivant un angle défini mais de trouver quelle angle il faut attribuer à
chaque lettre. A priori ça parait simple mais à l'usage cela est bien
compliqué, au point que je n'ai pas d'algorithme satisfaisant à me mettre
sous la dent.. Je dois m'y remettre la semaine prochaine.



Re,

Tu connais f(x) , tu connais f(x+dx) et dx (methode DefiniPasReal).
donc le vecteur directeur de la droite [X,Y], [x+dx,f(x+dx)] te donne
l'angle!

Ci-dessous la modification de l'exemple précédent (command1_click)
pour ecrire Sinus le long de la courbe sinus

A+

Christophe


Private Sub Command1_Click()
Dim Io As Long
Dim dX As Double
Dim i&
Dim x As Double
Dim y As Double
Dim a$
Dim Xo As Double
Dim Yo As Double
Dim angle As Double
Dim pi As Double

pi = 3.14116

a$ = "sinus"

mdc.zoomReel -7, -7, 7, 7

mdc.linereal -10, 0, mdc.Espacereelright, 0, RGB(0, 0, 0)
mdc.linereal 0, -10, 0, mdc.Espacereeltop, RGB(0, 0, 0)

mdc.writetext "0rigine (0,0)", 0.2, -0.7, 0.7, 0, 0, True
dX = mdc.DefiniPasReal

x = mdc.Espacereelleft

i& = 45
Do While x < mdc.Espacereelright
y = Sin(x)

mdc.DessinePointFonction x, y, RGB(0, 255, 0)


If i& Mod 400 = 0 Then

Xo = x + dX
Yo = Sin(Xo)


angle = Atn((Yo - y) / (Xo - x)) * (180 / pi)


Select Case (i& 400) Mod 10
Case 0
a$ = "s"
Case 1
a$ = "i"
Case 2
a$ = "n"
Case 3
a$ = "u"
Case 4
a$ = "s"
Case Else
a$ = " "

End Select
mdc.writetext a$, Xo, Yo, 0.5, 1, angle, True

End If

x = x + dX
i& = i& + 1
Loop

mdc.Cercle 0, 0, 1, RGB(0, 0, 255)

End Sub








Avatar
Patrice Henrio a écrit :

Tu remarqueras sur le dessin que l'espacement entre le "s" et le "i" ainsi
q'entre le "u" et le "s" dans l'écriture 2 et 3 n'est pas régulier. C'est
cela que je veux améliorer. Sinon ton résultat est meilleur que ce que nous
avions réussi jusque là.
Il faudrait que je vois ce que cela donne avec une courbe définie par une
suite de points.
Je dois m'y mettre prochainement quand je serai en vacances la semaine
prochaine.

En tous cas merci de ton apport à ce problème.



De rien,content que ça puisse t'aider, j'ai pas mal appris ici, alors
ça fait plaisir de rendre la pareille! c'est mieux que de passer son
temps à raconter des conneries si tu vois ce que je veux dire ([HS]).

Pour l'espacement il faut tenir compte de la police (proportionnelle ou
non ) ici j'utilise getstockobject(0) donc police système.

Ensuite je t'ai bricolé un truc vite fait.

TU remarqueras que la methode writetext
initialise les propriété LastBottomText, lastLeftText etc ...
Tu peux donc définir la position précédente du texte et ainsi en
fonction de la courbe (degré de pente de la pente du texte rapprocher ou
ecarter le texte.
Note que tu peux utiliser writetext avec le paramètre afficheúlse pour
prévoir l'espace texte occupé avant d'afficher(initialisation de
lastbottomtext et consort).(donc taille du I du U etc ... toujours dans
le système réel.

> Il faudrait que je vois ce que cela donne avec une courbe définie
par une
> suite de points.

!! Une courbe d'un point de vue Informatique est toujours une suite de
points (methode DéfiniPasReal et voir la signature de Jean-Marc
(sourire)) c'est l'objet même de metricDC : discréditer l'espace 2D réel
dans un pictureBox et avoir en permanence la conversion réel , unité
logique(api écran + imprimante), unité périphérique (position du curseur
ou autre éléments en unité de périphérique).


A+

Christophe
Avatar
Patrice Henrio
OK.
Merci je te tiens au courant à mon retour vers le 10 septembre.
"<pasdespam> @wanadoo.fr>" <"<pasdespam> a écrit dans le message de news:
430253e6$0$926$
Patrice Henrio a écrit :

Tu remarqueras sur le dessin que l'espacement entre le "s" et le "i"
ainsi q'entre le "u" et le "s" dans l'écriture 2 et 3 n'est pas régulier.
C'est cela que je veux améliorer. Sinon ton résultat est meilleur que ce
que nous avions réussi jusque là.
Il faudrait que je vois ce que cela donne avec une courbe définie par une
suite de points.
Je dois m'y mettre prochainement quand je serai en vacances la semaine
prochaine.

En tous cas merci de ton apport à ce problème.



De rien,content que ça puisse t'aider, j'ai pas mal appris ici, alors ça
fait plaisir de rendre la pareille! c'est mieux que de passer son temps à
raconter des conneries si tu vois ce que je veux dire ([HS]).

Pour l'espacement il faut tenir compte de la police (proportionnelle ou
non ) ici j'utilise getstockobject(0) donc police système.

Ensuite je t'ai bricolé un truc vite fait.

TU remarqueras que la methode writetext
initialise les propriété LastBottomText, lastLeftText etc ...
Tu peux donc définir la position précédente du texte et ainsi en fonction
de la courbe (degré de pente de la pente du texte rapprocher ou ecarter le
texte.
Note que tu peux utiliser writetext avec le paramètre afficheúlse pour
prévoir l'espace texte occupé avant d'afficher(initialisation de
lastbottomtext et consort).(donc taille du I du U etc ... toujours dans le
système réel.

> Il faudrait que je vois ce que cela donne avec une courbe définie par
une
> suite de points.

!! Une courbe d'un point de vue Informatique est toujours une suite de
points (methode DéfiniPasReal et voir la signature de Jean-Marc (sourire))
c'est l'objet même de metricDC : discréditer l'espace 2D réel dans un
pictureBox et avoir en permanence la conversion réel , unité logique(api
écran + imprimante), unité périphérique (position du curseur ou autre
éléments en unité de périphérique).


A+

Christophe




1 2