Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Ecrire vertical sur form ???

6 réponses
Avatar
X
Bonjour,

Je fais des graphique directement sur une form au pixel, et j'aurais
besoin d'écrire en vertical, en fait, pas les lettre l'une au dessus de
l'autre, non, mais disons une date horizontale qui pivoterait de -90°, y
a-t-il une propriété sur la form qui permette ça avec "Form1.Print ladate"
???

Merci.
--
ECRIRE
http://irolog.free.fr/ecrire/index.htm

LOGICIELS
http://irolog.free.fr

SITE
http://irolog.free.fr/joe/index.htm

FAQ VB
http://faq.vb.free.fr

PRINCIPE D'UTILISATION DES NEWSGROUPS MICROSOFT
http://support.microsoft.com/directory/worldwide/fr/newsgroup/regles.htm
********************************************************

6 réponses

Avatar
Jacques93
Bonjour X,
X a écrit :
Bonjour,

Je fais des graphique directement sur une form au pixel, et j'aurais
besoin d'écrire en vertical, en fait, pas les lettre l'une au dessus de
l'autre, non, mais disons une date horizontale qui pivoterait de -90°, y
a-t-il une propriété sur la form qui permette ça avec "Form1.Print ladate"
???



Essaie :

Option Explicit

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

Private Const LF_FACESIZE = 32

Private Const FW_DONTCARE = 0
Private Const FW_THIN = 100
Private Const FW_EXTRALIGHT = 200
Private Const FW_LIGHT = 300
Private Const FW_NORMAL = 400
Private Const FW_MEDIUM = 500
Private Const FW_SEMIBOLD = 600
Private Const FW_BOLD = 700
Private Const FW_EXTRABOLD = 800
Private Const FW_HEAVY = 900

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 As String * 32
End Type

Private Declare Function CreateFontIndirect Lib "gdi32" _
Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
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) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Private Sub Command1_Click()
DrawText Me, "Je m'appelle", 40, 40, 2700
DrawText Me, "Le Troll :-)", 40, 160, 900
End Sub

Private Sub DrawText(Pict As Object, Txt As String,_
X As Long, Y As Long, Angle As Long)
Dim hFont As Long, OldHdc As Long
Dim lf As LOGFONT, lResult As Long

Pict.ScaleMode = vbPixels
With lf
.lfHeight = 20
.lfWidth = 10
.lfEscapement = Angle
.lfWeight = FW_NORMAL
.lfItalic = 0
.lfUnderline = 0
.lfStrikeOut = 0
.lfOutPrecision = 2
.lfClipPrecision = 1
.lfQuality = 0
.lfPitchAndFamily = 0
.lfCharSet = 0
.lfFaceName = "Arial" & Chr$(0)
End With
hFont = CreateFontIndirect(lf)
OldHdc = SelectObject(Pict.hdc, hFont)

lResult = TextOut(Pict.hdc, X, Y, Txt, Len(Txt))
lResult = SelectObject(Pict.hdc, OldHdc)
lResult = DeleteObject(hFont)
End Sub


Tu peux faire varier l'angle de 0 à 3600, ça fonctionne sur les feuilles
et les PictureBox (il faut la propriété hDc).

Pour les anglophones :

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/fontext_4rw4.asp

--
Cordialement,

Jacques.
Avatar
X
Merci :o)


"Jacques93" a écrit dans le message de news:

| Bonjour X,
| X a écrit :
| > Bonjour,
| >
| > Je fais des graphique directement sur une form au pixel, et j'aurais
| > besoin d'écrire en vertical, en fait, pas les lettre l'une au dessus de
| > l'autre, non, mais disons une date horizontale qui pivoterait de -90°, y
| > a-t-il une propriété sur la form qui permette ça avec "Form1.Print
ladate"
| > ???
|
| Essaie :
|
| Option Explicit
|
| Private Type RECT
| Left As Long
| Top As Long
| Right As Long
| Bottom As Long
| End Type
|
| Private Const LF_FACESIZE = 32
|
| Private Const FW_DONTCARE = 0
| Private Const FW_THIN = 100
| Private Const FW_EXTRALIGHT = 200
| Private Const FW_LIGHT = 300
| Private Const FW_NORMAL = 400
| Private Const FW_MEDIUM = 500
| Private Const FW_SEMIBOLD = 600
| Private Const FW_BOLD = 700
| Private Const FW_EXTRABOLD = 800
| Private Const FW_HEAVY = 900
|
| 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 As String * 32
| End Type
|
| Private Declare Function CreateFontIndirect Lib "gdi32" _
| Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
| Private Declare Function SelectObject Lib "gdi32" _
| (ByVal hdc As Long, ByVal hObject As Long) As Long
| 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) As Long
| Private Declare Function DeleteObject Lib "gdi32" _
| (ByVal hObject As Long) As Long
|
| Private Sub Command1_Click()
| DrawText Me, "Je m'appelle", 40, 40, 2700
| DrawText Me, "Le Troll :-)", 40, 160, 900
| End Sub
|
| Private Sub DrawText(Pict As Object, Txt As String,_
| X As Long, Y As Long, Angle As Long)
| Dim hFont As Long, OldHdc As Long
| Dim lf As LOGFONT, lResult As Long
|
| Pict.ScaleMode = vbPixels
| With lf
| .lfHeight = 20
| .lfWidth = 10
| .lfEscapement = Angle
| .lfWeight = FW_NORMAL
| .lfItalic = 0
| .lfUnderline = 0
| .lfStrikeOut = 0
| .lfOutPrecision = 2
| .lfClipPrecision = 1
| .lfQuality = 0
| .lfPitchAndFamily = 0
| .lfCharSet = 0
| .lfFaceName = "Arial" & Chr$(0)
| End With
| hFont = CreateFontIndirect(lf)
| OldHdc = SelectObject(Pict.hdc, hFont)
|
| lResult = TextOut(Pict.hdc, X, Y, Txt, Len(Txt))
| lResult = SelectObject(Pict.hdc, OldHdc)
| lResult = DeleteObject(hFont)
| End Sub
|
|
| Tu peux faire varier l'angle de 0 à 3600, ça fonctionne sur les feuilles
| et les PictureBox (il faut la propriété hDc).
|
| Pour les anglophones :
|
|
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/fontext_4rw4.asp
|
| --
| Cordialement,
|
| Jacques.
Avatar
TouTi
Bonsoir Jacques

Est-il possible de récupérer le texte pour le placer dans un contrôle
transparent???. J'ai des tracés sur la form qui ne peuvent pas être effacés.

--
Guy-TouTen
Avatar
TouTi
j'ai pas arrivé à changé la couleur du texte

--
Guy-TouTi


Bonsoir Jacques

Est-il possible de récupérer le texte pour le placer dans un contrôle
transparent???. J'ai des tracés sur la form qui ne peuvent pas être
effacés.



Avatar
Jacques93
Bonsoir Touti,
TouTi a écrit :
j'ai pas arrivé à changé la couleur du texte




Me.ForeColor = vbBlue
DrawText Me, "Je m'appelle", 40, 40, 2700
Me.ForeColor = vbRed
DrawText Me, "Touti", 40, 160, 900


--
Cordialement,

Jacques.
Avatar
TouTi
> Me.ForeColor = vbBlue
DrawText Me, "Je m'appelle", 40, 40, 2700
Me.ForeColor = vbRed
DrawText Me, "Touti", 40, 160, 900
Cordialement,
Jacques.



En fait j'y arrivais avec l'api SetTextColor, mais je n'arrivais pas à
l'effacer en utilisant le backcolor de la form (le texte était en noir)

J'ai trouvé du code pour écrire dans une image (dont le fond est
transparent) mais il fonctionne sous Access. J'ai essayé de le transposer en
VB mais sans success http://www.mvps.org/accessfr/apis/api0050.htm

Merci Jacques
Très amicalement

--
Guy-TouTi