Discussion :

[looker11]

Bonjour,
Je voudrais avoir des informations sur la fonction DrawText de l'api Window.
Je travaille sur une base access, et j'ai besoin de savoir qu'elle sera la hauteur d'un label.
Il y un exemple de la fonction dans le tutoriel http://cafeine.developpez.com/access...utoextensible/ mais j'arrive pas avoir le résultat que je désire.
Je détermine une largeur maximum de 1500 twips que je convertis en pixel pour un string qui contient "les diamètres intérieurs et extérieurs de la portée de buse seront utilisés" mais lors de l'affichage du label,j'obtiens le résultat suit :

Et je voudrais savoir comment afficher tout le texte dans le label

Code Vba :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim label As label
Set label = CreateControl("Vue", acLabel, acDetail, , , cControle.X, cControle.Y + 10)
label.Caption = ChrW(&H25CF) & "    " & cIntitule
label.Width = 1500
label.Height = GetTextWidthMultiline(cIntitule, 1500 / TwipsPerPixelY) * TwipsPerPixelY

[ClaudeLELOUP]

Bonjour,

1° Je suppose que ce que tu décris, c'est dans un formulaire que cela se passe.
Sinon, tu aurais utilisé les propriétés auto extensible et auto réductible.
Correct ?

2° Pourquoi veux-tu créer le contrôle à la volée ?
Peux-tu le fixer arbitrairement et par le code, ajuster ses dimensions en fonction de ce qu'il contient au moment de l'affichage ?

Si la réponse est oui aux deux questions, je peux te proposer une solution qui s'inspire de l'idée de cafeine.

[looker11]

Merci de me réponde,
Cela se passe dans un formulaire, et je peux fixer par le code les dimensions du label en fonction de ce qu'il contient.
Cela suit la discussion http://www.developpez.net/forums/d14...gestion-fiche/, je suis entrains de voir pour modéliser les données comme dans l'image suivante :

Je dois connaitre la hauteur du label car si on dit que le contrôle est le commentaire1, je connais son x et y, mais si je veux placer correctement le commentaire 2, je dois connaitre la hauteur du commentaire1 pour pas que le commentaire2 chevauche le commentaire1 car la largueur de la zone des commentaires est connue.

[ClaudeLELOUP]

Bonjour,

L’idée de ce qui suit s'est largement inspirée du tutoriel de cafeine que tu renseignais plus haut : http://cafeine.developpez.com/access...utoextensible/

Je propose une fonction qui renvoie la hauteur en twips pour qu’une zone de texte affiche la totalité de son texte.

Cela permet d’adapter de manière dynamique la taille d’une zone de texte et pallier ainsi l’absence d’une propriété « Auto extensible » et « Auto réductible » dans un formulaire.

Voici ce qu’il faut mettre en œuvre

1° Ajouter la bibliothèque Microsoft DAO x.x ObjectLibrary




2° Dans un module standard, insérez ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 Option Compare Database
Option Explicit
 
Public Function AjusterZdt(NomZdt As String) As Long
  On Error GoTo GestionErreurs
  Dim frm As Form
  Dim ctlEtiquette As Control
 
  'figer l'écran
  Application.Echo False
  'Créer un formulaire martyr
  Set frm = CreateForm
  'Créer une étiquette dans sa section Détail.
  Set ctlEtiquette = CreateControl(frm.Name, acLabel)
  With ctlEtiquette
    .Name = "lblTexteCible"
    .Caption = "Cette étiquette doit contenir" & vbCrLf & "un retour chariot "
    .SizeToFit 'pour ajuster sa taille
    .FontName = Forms(CodeContextObject.Name)(NomZdt).FontName
    .FontSize = Forms(CodeContextObject.Name)(NomZdt).FontSize
    .FontBold = Forms(CodeContextObject.Name)(NomZdt).FontBold
    .FontItalic = Forms(CodeContextObject.Name)(NomZdt).FontItalic
    .FontWeight = Forms(CodeContextObject.Name)(NomZdt).FontWeight
    'On fixe la largeur et on copie le texte de la zdt dans l'étiquette
    .Width = Forms(CodeContextObject.Name)(NomZdt).Width
    .Caption = Forms(CodeContextObject.Name)(NomZdt)
    .SizeToFit
    'On récupère la hauteur
    AjusterZdt = .Height
  End With
  'Supprimer le formumaire martyr
  DoCmd.Close acForm, frm.Name, acSaveNo
  'Rétablir l'écran
  Application.Echo True
  Exit Function
GestionErreurs:
  Select Case Err.Number
    Case 2176
      MsgBox "Votre texte est trop long, il contient plus de 2040 caractères", vbCritical
      AjusterZdt = 500
      'Fermer le formulaire martyr
      DoCmd.Close acForm, frm.Name, acSaveNo
    Case Else
      MsgBox Err.Number & " " & Err.Description
  End Select
End Function

La syntaxe de l’appel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Form_Current()
  Me.LeNomDeLaZoneDeTexte.Height = AjusterZdt("LeNomDeLaZoneDeTexte")
End Sub

Restrictions
Le texte doit comporter au maximum 2040 caractères, sinon



Et bien sûr, la section qui contient la zone de texte doit être suffisamment grande, sinon





Pour en revenir à ton cas, dans la BdD en exemple, j’ai placé sur le formulaire deux zones de texte txtCommentaire1 et txtCommentaires2.

Dans l’événement Sur activation, on adapte la hauteur utile pour txtCommentaire1 et on déplace txtCommentaire2 pour le situer juste en dessous.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 Option Compare Database
Option Explicit
 
Private Sub Form_Current()
  On Error GoTo GestionErreurs
  'Ajuster la hauteur du commentaire1
  If Not IsNull(Me.txtCommentaire1) Then
      Me.txtCommentaire1.Height = AjusterZdt("txtCommentaire1")
    Else
      Me.txtCommentaire1.Height = 0
  End If
  'Positionner le commentaire2
  Me.txtCommentaire2.Top = Me.txtCommentaire1.Top + Me.txtCommentaire1.Height + 50
  'Ajuster la hauteur du commentaire2
  If Not IsNull(Me.txtCommentaire2) Then
      Me.txtCommentaire2.Height = AjusterZdt("txtCommentaire2")
    Else
      Me.txtCommentaire2.Height = 0
  End If
  Exit Sub
GestionErreurs:
  Select Case Err.Number
    Case 2100 ' pas assez de place
      MsgBox "L'espace manque pour afficher la zone de texte !", vbCritical
      Me.txtCommentaire1.Height = 500
      Me.txtCommentaire2.Height = 500
     'Positionner le commentaire2
      Me.txtCommentaire2.Top = Me.txtCommentaire1.Top + Me.txtCommentaire1.Height + 50
 
    Case Else
      MsgBox Err.Number & " " & Err.Description
  End Select
End Sub

On obtient ceci :



Ceci te convient-il ?


Plus de détails sur le processus dans cet article : http://claudeleloup.developpez.com/t...te-extensible/

La BdD de test est ici : http://claudeleloup.developpez.com/t...Extensible.mdb