Sujet Précédent Sujet Suivant

Limiter affichage label

Résolu
gabs77 Messages postés 379 Date d'inscription mardi 6 décembre 2005 Statut Membre Dernière intervention 8 octobre 2008 - 4 oct. 2006 à 18:10
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 - 7 oct. 2006 à 11:42
bonjour, je cherche a faire un algorithme ki va limiter le nombre de caractere a l affichage d un label

voici un exemple:
"ceci est test pour voir que cela fonctionne comme je le désire"
je voudrais ke par exemple sa me donne a l affichage une limite de 20 caracteres par ligne
et si au 20eme caractere de la ligne on coupe un mot et bien il faut prendre le mot en entier et le mettre a la ligne comme l'exemple si dessous:

"ceci est test pour
voir que cela
fonctionne comme je
le désire"

donc voici ce que j'ai commencé a faire
ph:=edit1.text;
while i<length(ph) do
   begin
   nb:=pos(' ',ph);
   if nb=0 then
      co:=copy(ph,0,nb)
   else
      co:=co+#13+copy(ph,0,nb);
   delete(ph,1,nb);
   end;
label1.caption:=co+#13+ph;

pour le moment ce script me permet de décomposer chaque mot en sautant une ligne après chaque mot.malheureusement je ne parviens pas a dire si la ligne existante plus nouveau mot font moins 20 caractères alors ajouter sinon aller a la ligne

19 réponses

Réponse 1 / 19
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
5 oct. 2006 à 01:57
Voici le code corrigé

































procedure

TfrmMain
.
Button5Click
(
Sender
:
TObject
);





Const

MaxLen
=


20
;





Var

TSL     
:
TStringList
;

   
I       
:
Integer
;

   
TmpStr
,

   
FinalStr
:



String

;





begin






 
FinalStr
:=
EmptyStr
;

 
TSL
:=

TStringList
.
Create
;

 

With

TSL

do




Try


 











   
CommaText
:=






'inconstitutionnalité inconditionnellement'










;

   
I
:=


0
;

   

Repeat






     
TmpStr
:=
TSL
[
I
];

     


If

Length
(
TmpStr
)


<>


20



Then






     



While



(
I 
<


(
Count
-


1
))



and



(
Length
(
TmpStr
+
#32
+
TSL
[
I
+


1
])


<=
MaxLen
)



Do






       



Begin






         
Inc
(
I
);

         
TmpStr
:=
TmpStr
+
#32
+
TSL
[
I
];

       


End

;

     
FinalStr
:=
FinalStr
+
TmpStr
+
#13
;

     
Inc
(
I
);

   

Until

I
>
Count
-


1
;

 

Finally






   
Free
;

 

End

;

 
Label1
.
Caption
:=
FinalStr
;





end

;





 






@+
Cirec





3
Réponse 2 / 19
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
5 oct. 2006 à 02:01
il est temps que je me couche

cette ligne : If Length(TmpStr)<>20Then

est totalement inutile


 
@+
Cirec

3
Réponse 3 / 19
cs_Jean_Jean Messages postés 615 Date d'inscription dimanche 13 août 2006 Statut Membre Dernière intervention 13 décembre 2018 3
4 oct. 2006 à 19:08
Tu ne fais aucun test de limite, c'est normal!
si tes lignes ne comprennent que des mots, c'est facile!Sinon,il te faut te repérer par rapport à un index de car ds la ligne
Un mot est encadré par des espaces ou caractères de ponctuation, tu détermine leur position et le tour est joué:

if dM > 0 and ph[i] = car séparateur
  alors dM := Pos(ph[i],ph) // index déb mot
  sinon if fM >0 alors
                        fM := Pos(ph[i],ph) // index fin mot
                        On a 1 mot; Mot := Copy(ph,dM,fM)
Si on a un Mot et que fM > limite alors on met le mot entier à la ligne
sinon Raz de dM et fM, actualisation d'autres index ...
Bon, c'est du rapide
Bon Code[javascript:Insert_Emoticon('/imgs2/smile.gif'); ]
Jean_jean
0
Réponse 4 / 19
cs_Jean_Jean Messages postés 615 Date d'inscription dimanche 13 août 2006 Statut Membre Dernière intervention 13 décembre 2018 3
4 oct. 2006 à 19:10
[javascript:Insert_Emoticon('/imgs2/smile_dissapprove.gif');

]Erreur : il faut lire Copy(ph,dM,FM-dM)
Excuse
@+
jean_jean
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 19
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
4 oct. 2006 à 22:41
Salut,

Essaye voir comme ça :
procedure TfrmMain.Button1Click(Sender: TObject);

Const MaxLen = 20;

Var TSL      : TStringList;

   
I        : Integer;

   
TmpStr,

   
FinalStr :String;

begin

 
FinalStr : = EmptyStr;

 
TSL :=
TStringList.Create;

  With TSL doTry

   
CommaText : ='ceci est un test pour voir que cela
fonctionne comme je le désire';

   
I := 0;

    Repeat

     
TmpStr := TSL[I];

     
While (I  <(Count-1))and(Length(TmpStr + #32 + TSL[I +1])< MaxLen)Do

       
Begin

         
Inc(I);

         
TmpStr : = TmpStr + #32 + TSL[I];

       
End;

     
FinalStr := FinalStr + TmpStr + #13;

     
Inc(I);

    Until I > = Count -1;

  Finally

   
Free;

  End;

 
Label1.Caption := FinalStr;

end ;

 
@+
Cirec

<hr size ="2" />
0
Réponse 6 / 19
cs_Jean_Jean Messages postés 615 Date d'inscription dimanche 13 août 2006 Statut Membre Dernière intervention 13 décembre 2018 3
5 oct. 2006 à 00:34
[javascript:Insert_Emoticon('/imgs2/smile.gif');

]Bravo Cirec!
il me plaît bien ton code!Optimisé, rapide et tout et tout...C'est bien ces listes...
bon, mais c'est à gabs77 de dire![javascript:Insert_Emoticon('/imgs2/smile_approve.gif'); ]
Jean_jean
0
Réponse 7 / 19
japee Messages postés 1727 Date d'inscription vendredi 27 décembre 2002 Statut Modérateur Dernière intervention 6 novembre 2021 8
5 oct. 2006 à 01:22
Hello (j'ai vu de la lumière).

Décidément, Cirec, on est souvent sur les mêmes coups...
Moi, j'avais trouvé ce code qui, après divers tests, a l'air de tenir la route :

function Decoupe(S: string): string;
const
  LIMIT = 20;
var
  Tmp: string;
  i: Integer;
begin
  Result := '';
  if (Pos(' ', S) > LIMIT + 1) or (Pos(' ', S) = 0) then
    Exit;
  Tmp := '';
  repeat
    Tmp := Copy(S, 1, LIMIT);
    for i := LIMIT downto 1 do
    begin
      if (Tmp[i] = ' ') or (Pos(' ', Tmp) = 0) then
      begin
        Tmp := TrimRight(Copy(Tmp, 1, i)) + #13#10;
        Result := Result + Tmp;
        Delete(S, 1, i + Integer(Pos(' ', Tmp) = 0));
        Break;
      end;
    end;
  until (Length(S) < 20) or (Length(S) = 0);
  Result := Result + S;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := Decoupe(ComboBox1.Text);
end;


Ton code semble caler sur une suite de mots de 20 lettres, par exemple :

"inconstitutionnalité inconditionnellement"

Mais j'ai pas le temps d'approfondir, la fatigue me gagne...

Bonne nuit...

japee
0
Réponse 8 / 19
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
5 oct. 2006 à 01:37
"Décidément, Cirec, on est souvent sur les mêmes coups..."
lol : si c'est pas le cas ça y ressemble étrangement

"Ton code semble caler sur une suite de mots de 20 lettres"

possible j'ai pas eu l'idée de tester sur des mots de 20 lettres ...
d'un autre côté on utilise pas souvent des mots de 20 lettres

j'ai pas testé mais la correction devrait être :

While(I  <(Count-1))and(Length(TmpStr + #32 + TSL[I +1])= < MaxLen) Do

 
@+
Cirec

<hr size ="2" />
0
Réponse 9 / 19
Utilisateur anonyme
5 oct. 2006 à 01:50
Ben dis donc Monsieur Japee : ca faisait longtemps. Bien content de te revoir ;).
0
Réponse 10 / 19
japee Messages postés 1727 Date d'inscription vendredi 27 décembre 2002 Statut Modérateur Dernière intervention 6 novembre 2021 8
5 oct. 2006 à 09:25
C'est vrai que les mots de 20 lettres ou plus sont plutôt rares, heureusement.

J'ai relevé une erreur dans mon code, pas gênante dans le contexte, mais sinon...

Bref, il faut écrire (à l'avant dernière ligne) :

until (Length(S) < LIMIT) or (Length(S) = 0);

Bonne prog'

japee
0
Réponse 11 / 19
gabs77 Messages postés 379 Date d'inscription mardi 6 décembre 2005 Statut Membre Dernière intervention 8 octobre 2008
5 oct. 2006 à 10:30
super, je te remercie Cirec !
ça marche nickel !


il y a des notions que je connais tres peu et donc je ne sais pas trop comment utiliser comme les try ... finally ou encore les repeat ... until donc voila je vais essayer de me mettre a utiliser ces scripts.
 sinon il y a un truc que je connais pas c'est la classe TStringList
je viens de le decouvrir avec ton script
 enfin bref ! ça marche, ça résoud mon problème, c'est l'essentiel
après j'ai juste à comprendre la totalité du script et à le maitriser


encore merci et peut être à une prochaine cirec
0
Réponse 12 / 19
japee Messages postés 1727 Date d'inscription vendredi 27 décembre 2002 Statut Modérateur Dernière intervention 6 novembre 2021 8
5 oct. 2006 à 12:34
Correction de mon code précédent :

function StringWantReturns(const S: string): string;

const

  LIMIT = 20;

var

  TmpStr, TmpBloc, TmpResult: string;

  i: Integer;

  Monobloc: Boolean;

begin

  Result := '';

  TmpStr := S;

  TmpResult := '';

  repeat

    TmpBloc := Copy(TmpStr, 1, LIMIT);

    for i := LIMIT downto 1 do

    begin

      Monobloc :Pos(' ', TmpBloc) 0;

      if (TmpBloc[i] = ' ') or Monobloc then

      begin

        TmpBloc := Copy(TmpBloc, 1, i - Byte(not Monobloc)) + #13#10;

        TmpResult := TmpResult + TmpBloc;

        if Monobloc

        and ((Length(TmpStr) > LIMIT) and (TmpStr[i + 1] <> ' ')) then

          Exit;

        Delete(TmpStr, 1, i + Byte(Monobloc));

        Break;

      end;

    end;

  until (Length(TmpStr) < LIMIT) or (Length(TmpStr) = 0);

  Result := TmpResult + TmpStr;

end;


Je n'y reviendrai pas, l'intérêt de ma méthode me paraît limité (et visiblement peu didactique).
0
Réponse 13 / 19
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
5 oct. 2006 à 13:41
Content de l'apprendre, merci.

pour les blocs Try ... Finally ... End; et Repeat ... Until; ainsi que TStringList
tu devrais trouver suffisement de documentations et d'exemples dans l'aide de Delphi.

En ce qui concerne les TStringList, l'utilisation que j'en fait dans mon code n'est pas une utilisation courante, en principe on s'ent sert pour charger un fichier ... des Strings et autres mais on ne pense pas toujours à la propriété CommaText (Lecture et Ecriture) qui permet de séparer les mots très simplement.

Mais je te propose de jeter un oeil sur le code de Japee.
En effet, si j'ai bien compris, tu es encore débutant et dans ce cas tu ne devrais pas te priver d'examiner son code, qui certe utilise une méthode de base mais que tu devrais connaitre puisque tout ce qu'il utilise te servira tôt où tard

@ Japee : j'ai trouvé un petit "bug"  avec le résutat de ta fonction
si tu mets au pluriel inconstitutionnalité
ton code ne revoie plus rien (chaine vide) 

@+
Cirec

0
Réponse 14 / 19
cs_Jean_Jean Messages postés 615 Date d'inscription dimanche 13 août 2006 Statut Membre Dernière intervention 13 décembre 2018 3
5 oct. 2006 à 14:27
[javascript:Insert_Emoticon('/imgs2/smile_wink.gif');

] Personnellement, j'utilisai une solution proche de celle de japee plus lisible pour un débutant.
[javascript:Insert_Emoticon('/imgs2/smile.gif'); ] Mais le code de Cirec est très intéressant et je bien à vous!
redécouvre les possibilités énormes de ces stringlist! ça vaut le coup de s'y pencher, même pour un débutant come je me considère toujours!
Bien à vous
Jean_Jean
0
Réponse 15 / 19
japee Messages postés 1727 Date d'inscription vendredi 27 décembre 2002 Statut Modérateur Dernière intervention 6 novembre 2021 8
5 oct. 2006 à 16:44
J'aime bien finalement ta solution, Cirec, surtout l'utilisation de TStrings.CommaText.

Ma solution est plus besogneuse et a fini par me prendre la tête, car oui, il y a un bug si on met le premier mot de 20 lettres au pluriel. GRRR...

Je pense par ailleurs qu'il n'y a pas vraiment d'intérêt à filtrer les
mots dépassant la limite de longueur, et comme ça complique gravement
le code, pourquoi s'emm... avec ça ?

Donc je laisse tomber.


Hé oui, Jean_Jean, éternel débutant, j'en connais un autre...

Et y'a des jours, je me demande si j'ai pas commencé la semaine dernière.


Ceci dit, je suis parti sur l'idée du CommaText, et sans tricher (c'est
à dire sans regarder de trop près le code à Cirec), j'ai trouvé cette
approche, avec deux StringList.Je la poste juste pour info, elle
n'apporte rien de plus :

function StringWantReturns(const S: string): string;

const

  LIMIT = 20;

var

  SL, SLResult: TStringList;

  Index: Integer;

  Tmp: string;

begin

  SL := TStringList.Create;

  with SL do

  try

    CommaText := S;

    SLResult := TStringList.Create;

    try

      Index := 0;

      repeat

        Tmp := '';

        while (Length(Tmp) < LIMIT + 1) and (Index < SL.Count) do

        begin

          Tmp := Tmp + Strings[Index] + ' ';

          Inc(Index);

        end;

        SLResult.Add(Tmp);

      until SL.Count <= Index;

      Result := SLResult.Text;

    finally

      SLResult.Free;

    end;

  finally

    Free;

  end;

end;


procedure TForm1.Button1Click(Sender: TObject);

begin

  Label1.Caption := StringWantReturns(ComboBox1.Text);

end;


J'avais dit que j'y reviendrais plus, ptdr...


Bonne prog'


japee
0
Réponse 16 / 19
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
5 oct. 2006 à 18:04
@ Japee j'ai testé ton code et je confirme il fonctionne
approuvé avec : StringWantReturns('inconstitutionnalités inconditionnellement anticonstitutionnellement');

Sinon j'ai apporté de petites modifications a mon code dans un soucis de réutilisabilité

Il permet en plus de choisir la taille des lignes de sorties qui est 80 caractères par défaut:

Function LineToBlock(Const Source :String;Const MaxLen : integer = 80): String ;

Var TSL      : TStringList;

   
I        : Integer;

   
TmpStr,

   
FinalStr :String;

begin

 
FinalStr : = EmptyStr;

 
TSL :=
TStringList.Create;

  With TSL doTry

   
CommaText : = Source;

   
I := 0;

    Repeat

     
TmpStr := TSL[I];

     
While (I  <(Count-1))and(Length(TmpStr + #32 + TSL[I +1])< = MaxLen)Do

       
Begin

         
Inc(I);

         
TmpStr := TmpStr + #32 + TSL[I];

       
End ;

     
FinalStr : = FinalStr + TmpStr + #13;

     
Inc(I);

    Until I > Count -1;

  Finally

   
Free;

  End;

 
Result := FinalStr;

end ;

// utilisation
Caption : = LineToBlock('ici votre texte où variable string') // donne un résultat de 80 caractères / lignes (defaut)

Caption := LineToBlock('ici votre texte où variable string', 20) // donne un résultat de 20 caractères / lignes
 
@+
Cirec

<hr size ="2" />
0
Réponse 17 / 19
cs_Delphiprog Messages postés 4297 Date d'inscription samedi 19 janvier 2002 Statut Membre Dernière intervention 9 janvier 2013 32
6 oct. 2006 à 23:24
J'ai rien compris à l'énoncé du problème ou alors personne n'a pensé à mettre la propriété WordWrap d'un TLabel à vrai ?

May Delphi be with you !
<hr color="#008000" />
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.
0
Réponse 18 / 19
cs_Delphiprog Messages postés 4297 Date d'inscription samedi 19 janvier 2002 Statut Membre Dernière intervention 9 janvier 2013 32
6 oct. 2006 à 23:27
Il y a aussi la fonction WrapText déclarée dans SysUtils (bien utile pour formater des messages quand on ne connait pas leur longueur à la conception).

May Delphi be with you !
<hr color="#008000" />
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.
0
Réponse 19 / 19
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
7 oct. 2006 à 11:42
WordWrap ne produit pas l'effet souhaité, il découpe le
texte en fonction du Width du TLabel et non du nombre de caractère souhaité


Par contre merci pour WrapText, que je ne connaissais pas

mais ça prouve au moins qu'on ne se laisse pas abattre si on a pas de solution
à portée de main


Et du reste je suis assez content de ma fonction qui par une
approche différente et avec moins de code produit pratiquement le même résultat.


Il est claire que WrapText est plus aboutit et offre plus de
flexibilité, choix des caractères à insérer  et définition des caractères de séparation, ce
qui augmente considérablement ses possibilités.


Mais le plus intéressant, dans mon code, (à mon avis) c’est l’utilisation
de CommaText pour récupérer les mots d’un texte individuellement.





 






@+
Cirec





0

Discussions similaires

Créer un Label avec un programme
InfoGeo -
InfoGeo -

10 réponses
PYTHON TKINTER utilisation de labels
bichon3001 -
MeierLink -

3 réponses
affichage de caractere dans une grille
anzelus -
anzelus -

2 réponses
Changer le texte d'un label
Fildomen -
Fildomen -

2 réponses
webview2 pb d affichage en exportent le projet
FRED92G -
FRED92G -

11 réponses
Rejoignez-nous