MeasureString, MeasureCharacterRanges ... Precision ?Résolu

Question

Voila je galère depuis 2 jours pour masquer un mot contenu dans le texte d'un label.
En fouillant sur le net, j'ai trouvé que measurestring n'était pas prècis et qu'il fallait mieux utiliser measurecharacterrange. Soit ! Mais rien n'y fait.

Je vous sollicite et vous propose d'essayer ce programme et peut-être de me conseiller. Merci.

Public Class Form1

    Dim ma_font As New Font("Arial", 14, FontStyle.Regular, GraphicsUnit.Point)
    Dim mot_a_masquer As String

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Dim marge As Integer = 20
        Dim phrase As String = "Essai pour masquer un mot par un label en comptant sur votre aide pour résoudre mon problème"

        Me.WindowState = FormWindowState.Maximized

        'button_cde pour masquer le mot choisi dans la listbox
        Dim button_masquer_mot As New Button
        Me.Controls.Add(button_masquer_mot)
        button_masquer_mot.AutoSize = True
        button_masquer_mot.Text = "Masquer"
        button_masquer_mot.Location = New Point(marge, marge)
        AddHandler button_masquer_mot.MouseClick, AddressOf button_masquer_mot_MouseClick

        'button_cde pour effacer les masques
        Dim button_effacer_masque As New Button
        Me.Controls.Add(button_effacer_masque)
        button_effacer_masque.AutoSize = True
        button_effacer_masque.Text = "Effacer"
        button_effacer_masque.Location = New Point(marge, _
                                                button_masquer_mot.Location.Y + button_masquer_mot.Height + marge)
        AddHandler button_effacer_masque.MouseClick, AddressOf button_effacer_masque_MouseClick

        'listbox_mot contenant les mots de la phrase
        Dim array_mot_du_label As String()
        array_mot_du_label = Split(phrase, " ")
        Dim listbox_mot As New ListBox
        Me.Controls.Add(listbox_mot)
        listbox_mot.Name = "listbox_mot"
        listbox_mot.Location = New Point(button_masquer_mot.Location.X + button_masquer_mot.Width + marge, _
                                         marge)
        For index = 0 To array_mot_du_label.Length - 1
            listbox_mot.Items.Add(array_mot_du_label(index))
        Next index
        AddHandler listbox_mot.SelectedIndexChanged, AddressOf listbox_mot_SelectedIndexChanged

        'Item sélectionné par défaut
        listbox_mot.SelectedIndex = 0
        mot_a_masquer = listbox_mot.SelectedItem

        'label_texte affichant la phrase
        Dim label_texte As New Label
        Me.Controls.Add(label_texte)
        label_texte.Name = "label_texte"
        label_texte.AutoSize = True
        label_texte.Font = ma_font
        label_texte.Text = phrase
        label_texte.Location = New Point(marge, _
                                         listbox_mot.Location.Y + listbox_mot.Height + marge)

    End Sub

    Private Sub listbox_mot_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs)

        Dim listbox_mot As ListBox = CType(Me.Controls("listbox_mot"), ListBox)
        mot_a_masquer = listbox_mot.SelectedItem

    End Sub

    Private Sub button_masquer_mot_MouseClick(ByVal sender As System.Object, ByVal e As System.EventArgs)

        Dim Size_F_mot_a_masquer As SizeF

        'Dimensions du mot à masquer
        Size_F_mot_a_masquer = fct_dimension_mot_a_masquer(mot_a_masquer)

        'Localisation du mot à masquer dans le label
        Dim label_texte As Label = CType(Me.Controls("label_texte"), Label)

        Dim mon_graphique As Graphics = Me.CreateGraphics

        Dim position_X_mot_a_masquer As Integer = label_texte.Text.IndexOf(mot_a_masquer)

        Dim ma_characterrange As CharacterRange() = {New CharacterRange(position_X_mot_a_masquer, _
                                                                        mot_a_masquer.Length - 1)}

        Dim ma_stringformat As New StringFormat
        ma_stringformat = StringFormat.GenericTypographic
        ma_stringformat.FormatFlags = StringFormatFlags.MeasureTrailingSpaces

        ma_stringformat.SetMeasurableCharacterRanges(ma_characterrange)

        Dim mon_rectangle_layout As RectangleF
        mon_rectangle_layout.X = label_texte.Location.X
        mon_rectangle_layout.Y = label_texte.Location.Y
        mon_rectangle_layout.Width = label_texte.Width
        mon_rectangle_layout.Height = label_texte.Height

        Dim ma_measurecharacterranges(0) As Region

        ma_measurecharacterranges = mon_graphique.MeasureCharacterRanges(label_texte.Text, _
                                                                         ma_font, _
                                                                         mon_rectangle_layout, _
                                                                         ma_stringformat)

        Me.Text = ma_measurecharacterranges(0).GetBounds(mon_graphique).X & " " & _
                  ma_measurecharacterranges(0).GetBounds(mon_graphique).Y & " " & _
                  ma_measurecharacterranges(0).GetBounds(mon_graphique).Width & " " & _
                  ma_measurecharacterranges(0).GetBounds(mon_graphique).Height

        Dim label_place_du_blanc As New Label
        Me.Controls.Add(label_place_du_blanc)
        label_place_du_blanc.Name = "label_place_du_blanc"
        label_place_du_blanc.AutoSize = False
        label_place_du_blanc.Text = vbNullString
        label_place_du_blanc.BackColor = Color.Aquamarine

        'label_place_du_blanc.Size = New Size(CInt(ma_measurecharacterranges(0).GetBounds(mon_graphique).Width), _
        '                                     CInt(ma_measurecharacterranges(0).GetBounds(mon_graphique).Height))

        label_place_du_blanc.Size = Size_F_mot_a_masquer.ToSize

        label_place_du_blanc.Location = New Point(CInt(ma_measurecharacterranges(0).GetBounds(mon_graphique).X), _
                                                  CInt(ma_measurecharacterranges(0).GetBounds(mon_graphique).Y))

        label_place_du_blanc.BringToFront()

        mon_graphique.Dispose()


    End Sub

    Private Sub button_effacer_masque_MouseClick(ByVal sender As System.Object, ByVal e As System.EventArgs)

        Dim mon_controle As Control

        For index = Me.Controls.Count - 1 To 0 Step -1
            mon_controle = Me.Controls(index)
            If mon_controle.Name.Contains("label_place_du_blanc") Then
                mon_controle.Dispose()
            End If
        Next

    End Sub

    Private Function fct_dimension_mot_a_masquer(ByVal mot_a_masquer As String) As SizeF

        Dim mon_graphique As Graphics = Me.CreateGraphics
        fct_dimension_mot_a_masquer = mon_graphique.MeasureString(mot_a_masquer, ma_font)
        mon_graphique.Dispose()

    End Function

End Class

Renfield · Accepted Answer

Au final, là, pour le test, j'ai préféré un DrawRectangle.

pour placer un rectangle masquant le mot, te faudra utiliser plutôt un FillRectangle...

Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

Renfield · Answer

Le code est maladroit...
trop de variables globales, alors qu tu pourrais stocker un private Listbox et un private Label pour t'éviter d'avoir a y faire reference par leur nom...

pourquoi ce  -1 pour la définition du range de caracteres ?

je bosse en C#, je suis en train de nettoyer le code.

Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

Renfield · Answer

Tu ne peux apparemment pas utiliser les méthodes de mesure de texte sur ton Label...

j'ai fait le test, en écrivant moi même la phrase, elle dépasse de la taille du Label : 
.Net joue a écrire le texte du label avec une version modifiée de la Font...

Au final, le plus simple est de dessiner soi même le Label :
public partial class Form1 : Form {
        private ListBox LstMots;
        private Label LblPhrase;

        public Form1() {
            string phrase = "Essai pour masquer un mot par un label en comptant sur votre aide pour résoudre mon problème";
            
            SuspendLayout();
            WindowState = FormWindowState.Maximized;

            //button_cde pour masquer le mot choisi dans la listbox
            Button b = new Button();
            b.Visible = true;
            b.AutoSize = true;
            b.Text = "Masquer";
            b.Location = new Point(20, 20);
            b.Click += BtnMasquerMot_Click;
            Controls.Add(b);

            //button_cde pour effacer les masques
            b = new Button();
            b.Visible = true;
            b.AutoSize = true;
            b.Text = "Effacer";
            b.Location = new Point(20, 20 + b.Height);
            b.Click += BtnEffacerMasque_Click;
            Controls.Add(b);

            //listbox_mot contenant les mots de la phrase
            string[] words = phrase.Split(new Char[] { ' ' });
            LstMots = new ListBox();
            LstMots.Visible = true;
            LstMots.Location = new Point(40 + b.Width, 20);
            LstMots.Items.AddRange(words);
            Controls.Add(LstMots);
            LstMots.SelectedIndexChanged += new EventHandler(LstMots_SelectedIndexChanged);

            //label_texte affichant la phrase
            LblPhrase = new Label();
            LblPhrase.Visible = true;
            LblPhrase.BackColor = Color.Transparent;
            LblPhrase.Font = new Font("Arial", 14);
            LblPhrase.Text = phrase;
            LblPhrase.Location = new Point(20, LstMots.Top + LstMots.Height + 20);
            using (Graphics g = LblPhrase.CreateGraphics()) {
                SizeF S = g.MeasureString(LblPhrase.Text, LblPhrase.Font);
                LblPhrase.Height = (int)S.Height+1;
                LblPhrase.Width = (int)S.Width+1;
            }
            LblPhrase.Paint += new PaintEventHandler(LblPhrase_Paint);
            Controls.Add(LblPhrase);

            ResumeLayout(true);
        }

        void LstMots_SelectedIndexChanged(object sender, EventArgs e) {
            LblPhrase.Refresh();
        }

        void LblPhrase_Paint(object sender, PaintEventArgs e) {
            SolidBrush b = new SolidBrush(Color.FromKnownColor(KnownColor.Control));
            e.Graphics.FillRectangle(b, new Rectangle(0, 0, LblPhrase.Width, LblPhrase.Height));
            Pen p = new Pen(Color.Black);
            e.Graphics.DrawString(LblPhrase.Text, LblPhrase.Font, new SolidBrush(Color.Black), 0, 0, null); 

            if (LstMots.SelectedItem == null)
                return;
            String Mot = LstMots.SelectedItem.ToString();

            int nPos = LblPhrase.Text.IndexOf(Mot);
            CharacterRange[] CharRanges = { new CharacterRange(nPos, Mot.Length) };

            StringFormat StrFormat = new StringFormat(StringFormatFlags.FitBlackBox | StringFormatFlags.NoClip | StringFormatFlags.LineLimit);
            StrFormat.SetMeasurableCharacterRanges(CharRanges);

            SizeF S = e.Graphics.MeasureString(LblPhrase.Text, LblPhrase.Font);
            Region[] Rgn = e.Graphics.MeasureCharacterRanges(LblPhrase.Text,
                                                             LblPhrase.Font,
                                                             new RectangleF(new PointF(0, 0), S),
                                                             StrFormat);
            RectangleF bounds = Rgn[0].GetBounds(e.Graphics);
            Text = bounds.X + " " + bounds.Y + " " + bounds.Width + " " + bounds.Height;

            e.Graphics.DrawRectangle(p, bounds.X, bounds.Y, bounds.Width, bounds.Height);
        }

        private void BtnMasquerMot_Click(object sender, System.EventArgs e) {
            LblPhrase.Refresh();
        }

        private void BtnEffacerMasque_Click(object sender, System.EventArgs e) {
            LstMots.SelectedItem = null;
            LblPhrase.Refresh();
        }
    }



Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

Renfield · Answer

ou la version traduite automatiquement par :
tools.codes-sources.com/DotNetCodeConverter.aspx
Public Class Form1
  Dim LstMots As ListBox
  Dim LblPhrase As Label

  Public Sub New()
    Dim phrase As String = "Essai pour masquer un mot par un label en comptant sur votre aide pour résoudre mon problème"

    SuspendLayout()
    WindowState = FormWindowState.Maximized

    'button_cde pour masquer le mot choisi dans la listbox
    Dim b As New Button()
    b.Visible = True
    b.AutoSize = True
    b.Text = "Masquer"
    b.Location = New Point(20, 20)
    b.Click += BtnMasquerMot_Click
    Controls.Add(b)

    'button_cde pour effacer les masques
    b = New Button()
    b.Visible = True
    b.AutoSize = True
    b.Text = "Effacer"
    b.Location = New Point(20, 20 + b.Height)
    b.Click += BtnEffacerMasque_Click
    Controls.Add(b)

    'listbox_mot contenant les mots de la phrase
    Dim words As String() = phrase.Split(New Char() {" "C})
    LstMots = New ListBox()
    LstMots.Visible = True
    LstMots.Location = New Point(40 + b.Width, 20)
    LstMots.Items.AddRange(words)
    Controls.Add(LstMots)
    AddHandler LstMots.SelectedIndexChanged, AddressOf LstMots_SelectedIndexChanged

   'label_texte affichant la phrase
    LblPhrase = New Label()
    LblPhrase.Visible = True
    LblPhrase.BackColor = Color.Transparent
    LblPhrase.Font = New Font("Arial", 14)
    LblPhrase.Text = phrase
    LblPhrase.Location = New Point(20, LstMots.Top + LstMots.Height + 20)
   Using g As Graphics = LblPhrase.CreateGraphics()
      Dim S As SizeF = g.MeasureString(LblPhrase.Text, LblPhrase.Font)
      LblPhrase.Height = DirectCast(S.Height, Integer) + 1
      LblPhrase.Width = DirectCast(S.Width, Integer) + 1
    End Using
    AddHandler LblPhrase.Paint, AddressOf LblPhrase_Paint
    Controls.Add(LblPhrase)

    ResumeLayout(True)
  End Sub

  Sub LstMots_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs)
    LblPhrase.Refresh()
  End Sub

 Sub LblPhrase_Paint(ByVal sender As Object, ByVal e As PaintEventArgs)
   Dim b As New SolidBrush(Color.FromKnownColor(KnownColor.Control))
    e.Graphics.FillRectangle(b, New Rectangle(0, 0, LblPhrase.Width, LblPhrase.Height))
    Dim p As New Pen(Color.Black)
    e.Graphics.DrawString(LblPhrase.Text, LblPhrase.Font, New SolidBrush(Color.Black), 0, 0, Nothing)
 
   If LstMots.SelectedItem Is Nothing Then
      Return
    End If

    Dim Mot As String = LstMots.SelectedItem.ToString()
    Dim nPos As Integer = LblPhrase.Text.IndexOf(Mot)
    Dim CharRanges As CharacterRange() = {New CharacterRange(nPos, Mot.Length)}

    Dim StrFormat As New StringFormat(StringFormatFlags.FitBlackBox Or StringFormatFlags.NoClip Or StringFormatFlags.LineLimit)
    StrFormat.SetMeasurableCharacterRanges(CharRanges)

    Dim S As SizeF = e.Graphics.MeasureString(LblPhrase.Text, LblPhrase.Font)
    Dim Rgn As Region() = e.Graphics.MeasureCharacterRanges(LblPhrase.Text, LblPhrase.Font, New RectangleF(New PointF(0, 0), S), StrFormat)
    Dim bounds As RectangleF = Rgn(0).GetBounds(e.Graphics)
    Text = bounds.X + " " + bounds.Y + " " + bounds.Width + " " + bounds.Height

    e.Graphics.DrawRectangle(p, bounds.X, bounds.Y, bounds.Width, bounds.Height)
  End Sub

  Private Sub BtnMasquerMot_Click(ByVal sender As Object, ByVal e As System.EventArgs)
    LblPhrase.Refresh()
  End Sub

  Private Sub BtnEffacerMasque_Click(ByVal sender As Object, ByVal e As System.EventArgs)
    LstMots.SelectedItem = Nothing
    LblPhrase.Refresh()
  End Sub
End Class


Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

Fabasia · Answer

Merci, je regarde ton code ce soir et reponds ... Je dois sortir ! Ko kun ma kap  (merci "très" beaucoup en thai, où je reside)

Fabasia · Answer

Un grand merci ... 

Je retiens surtout :

- l'utilisation astucieuse de Paint pour effectuer la mesure en tenant compte de "... .Net joue a écrire le texte du label avec une version modifiée de la Font ..." 
  
- LblPhrase.Refresh qui relance automatiquement Paint


J'ai dû remplacer :

- BtnMasquerMot.Click += BtnMasquerMot_Click() par AddHandler b.Click, AddressOf BtnMasquerMot_Click

- LblPhrase.Height DirectCast(S.Height, Integer) + 1 par LblPhrase.Height CInt(S.Height) + 1

qui posaient pb (VB2008 Express)

Fabasia · Answer

En renrant un peu plus dans le code, le sub LblPhrase_Paint, je me suis demandé l'intérêt de :

- e.Graphics.FillRectangle(b, New Rectangle(0, 0, LblPhrase.Width, LblPhrase.Height))

- e.Graphics.DrawString(LblPhrase.Text, LblPhrase.Font, New SolidBrush(Color.Black), 0, 0, Nothing)

Je l'ai modifié de la sorte :

Sub LblPhrase_Paint(ByVal sender As Object, ByVal e As PaintEventArgs)

        If LstMots.SelectedItem Is Nothing Then Return

        'Dim b As New SolidBrush(Color.FromKnownColor(KnownColor.Control))

        'e.Graphics.FillRectangle(b, New Rectangle(0, 0, LblPhrase.Width, LblPhrase.Height))

        Dim p As New Pen(Color.Black)

        'e.Graphics.DrawString(LblPhrase.Text, _
        '                      LblPhrase.Font, _
        '                      New SolidBrush(Color.Black), _
        '                      0, _
        '                      0, _
        '                      Nothing)

        'If LstMots.SelectedItem Is Nothing Then
        'Return
        'End If

        Dim Mot As String = LstMots.SelectedItem.ToString()
        Dim nPos As Integer = LblPhrase.Text.IndexOf(Mot)
        Dim CharRanges As CharacterRange() = {New CharacterRange(nPos, Mot.Length)}

        Dim StrFormat As New StringFormat(StringFormatFlags.FitBlackBox _
                                          Or StringFormatFlags.NoClip _
                                          Or StringFormatFlags.LineLimit)

        StrFormat.SetMeasurableCharacterRanges(CharRanges)

        Dim S As SizeF = e.Graphics.MeasureString(LblPhrase.Text, LblPhrase.Font)

        Dim Rgn As Region() = e.Graphics.MeasureCharacterRanges(LblPhrase.Text, _
                                                                LblPhrase.Font, _
                                                                New RectangleF(New PointF(0, 0), S), _
                                                                StrFormat)

        Dim bounds As RectangleF = Rgn(0).GetBounds(e.Graphics)

        Me.Text = bounds.X.ToString + " " + bounds.Y.ToString + " " + bounds.Width.ToString + " " + bounds.Height.ToString

        e.Graphics.DrawRectangle(p, bounds.X, bounds.Y, bounds.Width, bounds.Height)

    End Sub


et puis je vais peut-être faire une mofif dans la sub New()

Using g As Graphics = LblPhrase.CreateGraphics()
            Dim S As SizeF = g.MeasureString(LblPhrase.Text, LblPhrase.Font)
            'LblPhrase.Height = DirectCast(S.Height, Integer) + 1
            'LblPhrase.Width = DirectCast(S.Width, Integer) + 1
            LblPhrase.Height = CInt(S.Height) + 1
            LblPhrase.Width = CInt(S.Width) + 1
        End Using

        'LblPhrase.AutoSize = True


Je continue ... Peu importe, merci de m'avoir tiré le l'impasse !

Renfield · Answer

pour les changements que tu a fait concernant le AddHandler, c'est du a la conversion automatisée...

je code en C#


CInt, c'est pas du .NET !!!!!

c'est d'u VB6

bien penser à virer

Microsoft.VisualBasic

de tes references de projets.

je redessine moi même le label complètement, pour maitriser le truc, surtout parce que .Net ecris pas au bord (0) ; il ajoute un marge, et dessine plus petit, bien que je spécifie une police d'une taille donnée.

Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

Fabasia · Answer

Ok je vais virer les Cint, Cstr, Csng, ... J'avais été au plus vite malgré le fait que je positionne Option Explicit On, Option Strict On.

Je retiens ta remarque "... .Net ecris pas au bord (0) ; il ajoute un marge, et dessine plus petit, bien que je spécifie une police d'une taille donnée ..." Je pense que je vais devoir faire qq modif.

D'autre part, si tu as un peu de temps, j'ai mis de coté qq pb pour continuer d'avancer, mais j'aimerais changer :

1/ J'inhibe l'appel de sub pendant l'initialisation de variables, form, ... en faisant un RemoveHandler puis quand les init sont faites je autorise en faisant un AddHandler. Cela me semble pas très stable d'agir sur la table des Handlers. Par exemple :

Sinon, Form8.ListView_themes.Items(index_theme).Checked = True me lance la sub de la form8 Public Sub ListView_themes_ItemChecked(ByVal sender As Object, ByVal e As System.Windows.Forms.ItemCheckedEventArgs) Handles ListView_themes.ItemChecked



  Private Sub debuter_analyse()

        'Inhibition des sub pour eviter leurs appels lors des  form8.ListView.Items(x).Checked = True/false
        
        RemoveHandler Form8.ListView_themes.ItemChecked, AddressOf Form8.ListView_themes_ItemChecked
.....
 'Remplissage de ListView_themes
        For index_theme = 0 To array_theme.Length - 1
            Form8.ListView_themes.Items.Add(array_theme(index_theme))
            Form8.ListView_themes.Items(index_theme).Checked = True
        Next
....

 'Activation des sub form8.ListView.ItemChecked
                AddHandler Form8.ListView_themes.ItemChecked, AddressOf Form8.ListView_themes_ItemChecked
           End Sub     

 

2/ En passant en .Net j'ai pu me passer de tous les dll sauf RemoveMenu et GetSystemMenu pour interdire le déplacement de la fenêtre en cliquant/deplacant dans la barre de titre de la fenêtre. Un autre solution ? Est-il souhaitable de se passer des dll ?

RemoveMenu(GetSystemMenu(Me.Handle, 0), &HF010&, &H0&)

3/ Comment éviter la réduction d'une fenêtre en double-cliquant sur sa barre de titre ?

Renfield · Answer

Subclasses
override le WndProc, guettant WM_NCLBUTTONDOWN, entre autres

Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

Fabasia · Answer

J'ai pas tout compris "Subclasses 
override le WndProc, guettant WM_NCLBUTTONDOWN"... mais je sais où regarder maintenant. Merci

PS : Je suis entrain de refondre mon appli en virant (enfin !) la référence Microsoft.VisualBasic, et CInt est accepté en .Net

Renfield · Answer

je ne code pas en VB.Net, mais en C#

il te suffit de définir un WndProc perso pour ta Form, ce qui te permettra de regarder passer les messages de Windows.
Ainsi, tu pourras modifier le comportement de ta fenêtre.

Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

MeasureString, MeasureCharacterRanges ... Precision ?

12 réponses

Votre réponse

Discussions similaires