Imprimer du texte verticalement

element1488 Messages postés 7 Date d'inscription vendredi 13 février 2004 Statut Membre Dernière intervention 18 décembre 2005 - 6 juil. 2005 à 22:00
element1488 Messages postés 7 Date d'inscription vendredi 13 février 2004 Statut Membre Dernière intervention 18 décembre 2005 - 7 juil. 2005 à 15:13
Bonjour,
j'ai besoin d'imprimer un texte verticalement au bord d'un formulaire et je ne trouve aucune propriété de l'objet printer qui le permet.
Est-ce que quelqu'un connait un truc pour y arriver.

Merci

Jean

2 réponses

Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 34
6 juil. 2005 à 22:56
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function CreateFont Lib "gdi32.dll" Alias "CreateFontA"
(ByVal nheight As Long, ByVal nWidth As Long, ByVal nEscapement As
Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal
fdwItalic As Long, ByVal fdwUnderline As Long, ByVal fdwStrikeOut As
Long, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal
fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal
fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long,
ByVal nNumerator As Long, ByVal nDenominator As Long) As Long



Private Const LOGPIXELSY = 90

Private Const ANSI_CHARSET = 0

Private Const CLIP_LH_ANGLES = 16

Private Const OUT_TT_PRECIS = 4

Private Const PROOF_QUALITY = 2

Private Const DEFAULT_PITCH = 0

Private Const FF_DONTCARE = 0



Private Enum FontWeight

FW_DONTCARE = 0

FW_THIN = 100

FW_EXTRALIGHT = 200

FW_ULTRALIGHT = 200

FW_LIGHT = 300

FW_NORMAL = 400

FW_REGULAR = 400

FW_MEDIUM = 500

FW_SEMIBOLD = 600

FW_DEMIBOLD = 600

FW_BOLD = 700

FW_EXTRABOLD = 800

FW_ULTRABOLD = 800

FW_HEAVY = 900

FW_BLACK = 900

End Enum



Private Sub Command1_Click()

Call DrawRotatedText("Bordure du formulaire", 500, 250, 90)

Call DrawRotatedText("Bordure du formulaire", 20, 100, 270)

End Sub



Private Sub DrawRotatedText(ByVal txt As String, ByVal X As Single, ByVal Y As Single, ByVal Angle As Single)

Dim newfont As Long

Dim oldfont As Long

Dim nEscapement As Long

Dim nheight As Long

nEscapement = Angle * 10

nheight = -MulDiv(Me.FontSize, GetDeviceCaps(Me.hdc, LOGPIXELSY), 72)

newfont = CreateFont(nheight, 0, nEscapement, 0,
FW_NORMAL, 0, 0, 0, ANSI_CHARSET, OUT_TT_PRECIS, CLIP_LH_ANGLES,
PROOF_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, Me.FontName)

oldfont = SelectObject(Me.hdc, newfont)

Me.CurrentX = X

Me.CurrentY = Y

Me.Print txt

newfont = SelectObject(Me.hdc, oldfont)

DeleteObject newfont

End Sub


Daniel
0
element1488 Messages postés 7 Date d'inscription vendredi 13 février 2004 Statut Membre Dernière intervention 18 décembre 2005
7 juil. 2005 à 15:13
Un gros Merci!!

Jean
0