[D7] TimageView-Scale sur du texte

Question

Bonjour, 

J'ai un tImageView (tImageView32 de graphics32 pour être précis, mais je ne pense pas que ça change la solution) sur lequel sont déposés des calques (TPositionedLayer).
Certain calques sont des images, d'autres du texte et d'autres, un dessin fait au pen

J'utilise scale pour zoomer, et si sur les image, le comportement est géré automatiquement, pas sur du texte ni sur les dessins.
Je suis obligé de changer la police dans le redessinement:
...Buffer.Font.Size := Round(monTexte.police.Size*ImgView.Scale);

Je ne trouve pas ca très propre, c'est saccadé (par paliers) et pas régulier (des fois gras, des fois non...).

Y a t-il un moyen de définir la taille du pixel ou une unité graphique pour du texte ?

(pour info, je suis partit de l'exemple: ImgView_Layers_Ex de graphics32)

Merci d'avance.

WhiteHippo · Answer

Bonjour
"Des fois gras" Cela est normal pour les fêtes de fin d'année. 

Cordialement. 

<hr />
L'imbécile prétentieux est celui qui se croit plus intelligent que ceux qui sont aussi bêtes que lui.

cs_nitrique · Answer

Oui, pour celui qui pense que l'ortographe est la science des imbéciles, hi.

Et dans ton assiette, il n'y a rien d'autre qui puisse m'aggrandir mon pixel ?

;-)

WhiteHippo · Answer

Dans mon assiette, je risque de ne pas trouver grand chose... cependant je regarde ton problème mais c'était juste pour te faire patienter. 

Cordialement. 

<hr />
L'imbécile prétentieux est celui qui se croit plus intelligent que ceux qui sont aussi bêtes que lui.

cs_nitrique · Answer

En tous cas, ça m'a permis de me tirer une balle dans le pied, car j'ai fait autant de fautes que de phrases.
Aller, pour soulager ma conscience, je corrige:
* pensent
* agrandir
Ouf. ;-)

Si tu as besoin d'un bout de code ou autre chose, n'hésites pas... 
Mais j'ai peur de t'induire en erreur car il est assez lourd, et j'ai la facheuse tendance à tout concentrer.
Bah, le voici épuré, regarde le de loin:

procedure TfrmEtat.ImgViewClick(Sender: TObject);
var
  L: TPositionedLayer;
  B: TBitmapLayer;
begin
...
          L := TPositionedLayer.Create(ImgView.Layers);
          L.Location := FloatRect(W,H,W+maLongueur,H+maHauteur);
          L.Scaled := True;
          L.MouseEvents := True;
          L.Tag := lTabElements;
          L.OnMouseDown := LayerMouseDown;
          L.OnPaint := dessineTexte;
          Selection := L;

...
end;

procedure TfrmEtat.dessineTexte(Sender: TObject; Buffer: TBitmap32);
begin
  if Sender is TPositionedLayer then
    with TPositionedLayer(Sender).GetAdjustedLocation do begin
      Buffer.Font := maFont;
      Buffer.Font.Size := maFont.Size
      Buffer.Textout(Floor(Left),Ceil(Top),"Bonjour");
    end;
end;

Ca va ?

WhiteHippo · Answer

Alors, voyons si cela solutionne ton problème :
  Remplace tous tes TPositionedLayer par des TBitmapLayer (A utiliser de préférence, et si besoin un transtypage par ici ou par là.)
  A la création des tes layers ne pas oublier la propriété Scaled qui doit être à TRUE
  L'utilisation de RenderText devrait alors se passer correctement.
  

Cordialement. 

<hr />
L'imbécile prétentieux est celui qui se croit plus intelligent que ceux qui sont aussi bêtes que lui.

cs_nitrique · Answer

Non, ça ne marche pas... Le texte reste figé dans tous les cas.
Quand on réduit, il dépasse de la zone et quand on agrandit, il ne suit pas.

En fait, avant, dans le dessineTexte, je faisait:
Buffer.Font.Size := maFont.Size*ImgView.scale
Pour que la taille suive (ce qui me faisait mon foie gras, hi).

Chose que j'ai enlevé en utilisant ta méthode... C'est logique, nan ?

WhiteHippo · Answer

Ici cela fonctionne. 

Bon voici un bout de code que j'ai utilisé pour tester ton problème : 

procedure TForm1.Timer1Timer(Sender: TObject); // Timer de 100 millisecondes
var
  i : integer ;
begin
  for i:= 0 to iv32.Layers.Count-1 do
  begin
    If ( TBitmapLayer(iv32.Layers[i]).Tag=0 ) then
    begin
      // DrawBitmap est ma routine de dessin dedans il y a un renderText !!
      //   procedure DrawBitmap(B: TBitmap32; MyColor32 : TColor32 ); 
      //   begin
      //     // ... dessin ici
      //     B.RenderText(0,0,'TEST',255,Color32(255,255,255,255));
      //   end ;

      DrawBitmap(TBitmapLayer(iv32.Layers[i]).Bitmap, MyColor32) ;
      TBitmapLayer(iv32.Layers[i]).Scaled := TRUE ; 
    end ;
  end ;
  // ici j'effectue un zoom en dynamique
  iv32.Scale := iv32.Scale + (Random(2))/100 ;
  iv32.Refresh;
end;

Cordialement. 

<hr />
L'imbécile prétentieux est celui qui se croit plus intelligent que ceux qui sont aussi bêtes que lui.

cs_nitrique · Answer

Mince, rien à faire.

En fait, c'est ça qui dérange:
      Buffer.Font := maPolice;
      Buffer.Font.Size := maPolice.Size;
Sans ça, il simule exactement ce que je faisait avant, a savoir:
      Buffer.Font.Size := Round(maPolice.Size*imgview.scale);

Ca ne m'arrange guère, car si adopter ce comportement ne me dérange qu'à moitié, ce n'est pas une solution pour mes dessins:
                  Buffer.MoveTo(ceil(gauche+k),Round(Top));
                  Buffer.LineToAS(ceil(gauche+k),hautTexte-4);

Dessine un carré, tu verras.

WhiteHippo · Answer

La différence, c'est que toi tu utilises le buffer et moi directe;ent le TBitmap32.
Réessayes avec mon code donné plus haut et ceci :

procedure DrawBitmap(B: TBitmap32; MyColor32 : TColor32 ); 
begin
  B.Font.Name := 'Arial' ;
  B.Font.Size := 32 ;
  B.RenderText(0,0,'TEST',255,Color32(255,255,255,255));
end ;

Cordialement. 

<hr />
L'imbécile prétentieux est celui qui se croit plus intelligent que ceux qui sont aussi bêtes que lui.

cs_nitrique · Answer

Aie, 

j'ai des erreur avec ton code...
En fait, je t'avais dit que j'ai épuré... J'ai besoin de récuperer le X, le Y et le tag du TBitmapLayer.
Or, le TBitmap32 ne possède pas ces propriétés.
J'ai donc fait: 
TBitmapLayer(B).Tag
TBitmapLayer(B).GetAdjustedLocation

Mais j'ai des erreurs mémoire. :-(

Voici ma fonction d'origine:
procedure TfrmEtat.dessineTexte(Sender: TObject; Buffer: TBitmap32);
var // Dessine un texte
  id: Integer;
  texte: String;
begin
  if Sender is TBitmapLayer  then
    with TBitmapLayer(Sender).GetAdjustedLocation do begin
      id := TBitmapLayer(Sender).Tag-1;
      texte := tabElts[id].texte;
      Buffer.Font := tabElts[id].police;
      Buffer.Font.Size := Round(tabElts[id].police.Size*ImgView.Scale); //
      Buffer.Textout(Floor(Left),Ceil(Top),texte);
      with TBitmapLayer(Sender).Location do begin// Repositionner les ancres
        TBitmapLayer(Sender).Location := FloatRect(Left,Top,Left+(tabElts[id].lMin),Top+(tabElts[id].police.Size*2));
        tabElts[id].haut := Top;
        tabElts[id].gauche := Left;
      end;
    end;
end;

En fait, je garde dans un tableau les positions et paramètres des calques...
De plus, je travaillait déjà sur le Bitmap, vu que ma variable Buffer est un TBitmap32... 
Seulement, elle est en deuxième position... J'était donc bon, nan ?

WhiteHippo · Answer

Non je crois pas que ce soit avec mon code Je t'ai juste fourni un bout de code qui fonctionne, il faut adapter pour le tien... Les erreurs mémoire viennent du fait que tu transtypes en TBitmapLayer le TBitmap32 qui n'est pas un de ses descendant !!! Le tag n'existe pas, et le X et Y non plus au niveau du TBitmap32 !!! Une solution pour le tag, tu passes TBitmapLayer au lieu du TBitmap32 et dans ta procédure tu utilises B.Bitmap au lieu de B pour le bitmap et B.Tag pour le Tag D'après ton dode je dirais : procedure TfrmEtat.dessineTexte(Sender: TObject~~; Buffer: TBitmapLayer~~); var // Dessine un texte id: Integer; texte: String; begin if Sender is TBitmapLayer then with TBitmapLayer(Sender).GetAdjustedLocation do begin id := TBitmapLayer(Sender).Tag-1; texte := tabElts[id].texte; TBitmapLayer(Sender).Bitmap .Font : = tabElts[id].police; // On change pas la taille de la police le scale doit le faire tout seul TBitmapLayer(Sender).Bitmap.Font.Size := tabElts[id].police.Size ; // On employe RenderText et non TextOut !!!! TBitmapLayer(Sender).Bitmap.RenderText(Floor(Left),Ceil(Top),texte,255,Color32(255,255,255,255)); with TBitmapLayer(Sender).Location do begin// Repositionner les ancres TBitmapLayer(Sender).Location : = FloatRect(Left,Top,Left+(tabElts[id].lMin),Top+(tabElts[id].police.Size*2)); tabElts[id].haut := Top; tabElts[id].gauche := Left; end; end; // Penser à rafraichir ici le TImageView TBitmapLayer(Sender).Scaled := TRUE ; ImageView32.Refresh ; end; Cordialement.

L'imbécile prétentieux est celui qui se croit plus intelligent que ceux qui sont aussi bêtes que lui.

cs_nitrique · Answer

Hummm, ca n'écrit pas...

Il passe une fois dans la fonction lors de la création, mais plus ensuite.
Ce qui me parait normal en même temps, vu qu'il n'est plus attaché au onPaint.

Je ne vais tout de même pas le mettre dans un timer.
Ni dans le onPaint, il va s'appeler tout seul vu qu'il y a un refresh.

Je fait comme ça:
        B := TBitmapLayer.Create(ImgView.Layers);
        B.Location := FloatRect(rec.Left,rec.Top,rec.Right,rec.Bottom);
        B.Scaled := True;
        B.MouseEvents := True;
        B.Tag := i+1;
        B.OnMouseDown := LayerMouseDown;
        dessineTexte(B);
        //B.OnPaint := dessineTexte;
        Selection := B;

Comment fait-tu, toi ?

Désolé avec tous ces petits pépins, je me sent bête, mais ce truc m'a déjà tellement vidé.

cs_nitrique · Answer

Hummm, ca n'écrit pas...

Il passe une fois dans la fonction lors de la création, mais plus ensuite.
Ce qui me parait normal en même temps, vu qu'il n'est plus attaché au onPaint.

Je ne vais tout de même pas le mettre dans un timer.
Ni dans le onPaint, il va s'appeler tout seul vu qu'il y a un refresh.

Je fait comme ça:
        B := TBitmapLayer.Create(ImgView.Layers);
        B.Location := FloatRect(rec.Left,rec.Top,rec.Right,rec.Bottom);
        B.Scaled := True;
        B.MouseEvents := True;
        B.Tag := i+1;
        B.OnMouseDown := LayerMouseDown;
        dessineTexte(B);
        //B.OnPaint := dessineTexte;
        Selection := B;

Comment fais-tu, toi ?

Désolé avec tous ces petits pépins, je me sent bête, mais ce truc m'a déjà tellement vidé.

cs_nitrique · Answer

Je suis partit de l'exemple ImgView_Layers_Ex de graphics32, 
et dans la procédure de redessinement, il n'y a pas de refresh.

Est-tu sur qu'il en faut un ?

WhiteHippo · Answer

Je crois que l'on était pas sur la même longueur d'onde ( désolé, mon exemple n'utilisait directement le OnPaint ) . Donc si la méthode donnée plus haut est celle appelée par le OnPaint alors tu laisses : B.OnPaint := dessineTexte; et DessineTexte devient : procedure TfrmEtat.dessineTexte(Sender: TObject; Buffer: TBitmap32 ); var // Dessine un texte id: Integer; texte: String; begin if Sender is TBitmapLayer then with TBitmapLayer(Sender).GetAdjustedLocation do begin id : = TBitmapLayer(Sender).Tag-1; texte := tabElts[id].texte; TBitmapLayer(Sender).Bitmap .Font : = tabElts[id].police; // On ne change pas la taille de la police le scale doit le faire tout seul TBitmapLayer(Sender).Bitmap.Font.Size := tabElts[id].police.Size ; // On employe RenderText et non TextOut !!!! TBitmapLayer(Sender).Bitmap.RenderText(Floor(Left),Ceil(Top),texte,255,Color32(255,255,255,255)); with TBitmapLayer(Sender).Location do begin// Repositionner les ancres TBitmapLayer(Sender).Location : = FloatRect(Left,Top,Left+(tabElts[id].lMin),Top+(tabElts[id].police.Size*2)); tabElts[id].haut := Top; tabElts[id].gauche := Left; end; end; // Penser à rafraichir ici le TImageView TBitmapLayer(Sender).Scaled := TRUE ; ~~ImageView32.Refresh ;~~ end; Cordialement.

L'imbécile prétentieux est celui qui se croit plus intelligent que ceux qui sont aussi bêtes que lui.

cs_nitrique · Answer

Ca me parrait plus adapté.


Seulement, mon texte n'apparait pas. :-(

C'est pourtant bon:
procedure TfrmEtat.dessineTexte(Sender: TObject; Buffer: TBitmap32);
var // Dessine un texte
  id: Integer;
  texte: String;
begin
  if Sender is TBitmapLayer  then
    with TBitmapLayer(Sender).GetAdjustedLocation do begin
      id := TBitmapLayer(Sender).Tag-1;
      texte := tabElts[id].texte;
      TBitmapLayer(Sender).Bitmap.Font := tabElts[id].police;
      TBitmapLayer(Sender).Bitmap.Font.Size := Round(tabElts[id].police.Size); // *ImgView.Scale
      TBitmapLayer(Sender).Bitmap.RenderText(Floor(Left),Ceil(Top),texte,255,clBlack32);
      with TBitmapLayer(Sender).Location do begin// Repositionner les ancres
        //TBitmapLayer(Sender).Location := FloatRect(Left,Top,Left+(tabElts[id].lMin),Top+(tabElts[id].police.Size*2));
        tabElts[id].haut := Top;
        tabElts[id].gauche := Left;
      end; // }
      TBitmapLayer(Sender).Scaled := TRUE;
    end;
end;

Il y passe bien régulièrement, j'ai vérifié.

WhiteHippo · Answer

Il est soit effacé par un autre layer, soit écrit en dehors de la zone du layer.
Essayes  TBitmapLayer(Sender).Bitmap.RenderText(0,0,texte,255,clBlack32);
et supprimes tous les autres appel à des routines de dessin, pour qu'il n'y ait plus que celle du texte.

N.B. Tu peux toujours m'envoyer ton source ( contact moi au préalable en MP )

Cordialement. 

<hr />L'imbécile prétentieux est celui qui se croit plus intelligent que ceux qui sont aussi bêtes que lui.

cs_nitrique · Answer

Ces manips ne changent rien...

Je t'ai envoyé un MP.

WhiteHippo · Answer

Bonjour nitrique, voilà je pense une solution adaptée à ton cas :

procedure TfrmEtat.dessineTexte(Sender: TObject; Buffer: TBitmap32);
var // Dessine un texte
  id: Integer;
  texte: String;
  W,H:Integer ;
begin
  if ( Sender is TBitmapLayer ) then
    with TBitmapLayer(Sender) do
    begin

      id := Tag-1;
      texte := tabElts[id].texte;
      Bitmap.Font := tabElts[id].police;
      Bitmap.Font.Size := Round(tabElts[id].police.Size);
      H := Bitmap.TextHeight(texte) ;
      W := Bitmap.TextWidth(texte) ;
      Bitmap.Font.Height := H ;
      Bitmap.SetSize(W+1,H+1) ;
      Bitmap.DrawMode := dmBlend ; 
      Bitmap.RenderText(0,0,Texte,255,color32(255,0,0,255));

      with Location do
      begin// Repositionner les ancres
        Location := FloatRect(Left,Top,Left+W,Top+H);
        tabElts[id].haut := Top;
        tabElts[id].gauche := Left;
      end; // }
      Scaled := TRUE;
    end;
end;

Avec ceci tu devrais voir ton texte et le zoom actif.  

N.B. Ce n'est qu'un début, il reste des points sur lesquels il faudra se pencher ( Comment réduire l'effet de crénelage des textes ? Que se passe-t-il lors du redimensionnement de la fiche ? Pourquoi faut-il un clic sur le imgview pour faire apparaitre le texte ? Pourquoi lors du changement de la taille de la police d'un texte cela prend tant de temps, etc...) , mais là va falloir réfléchir un peu  

Cordialement. 

<hr />
L'imbécile prétentieux est celui qui se croit plus intelligent que ceux qui sont aussi bêtes que lui.

cs_nitrique · Answer

Extra, je te remercie...

Cependant, il y a un effet indésiré.
Quand je crée le TBitmapLayer, il est bien présent et séléctionné, seulement, il est vide.
Il faut que je clique à coté ou que je le fasse bouger pour que le texte apparaisse.
Il passe pourtant bien dans la fonction lors de la création...

Est ce également le cas chez toi ?

WhiteHippo · Answer

C'est 1 des "problèmes" que je t'indiquait lors de mon précédent message :
  " Pourquoi faut-il un clic sur le imgview pour faire apparaitre le texte ? "
Je n'est pas le temps, pour l'instant, de regarder en profondeur pourquoi. A première vue je dirais qu'il faut chercher du côté de la sélection des layers et du TRubberbandLayer.

Cordialement. 

<hr />
L'imbécile prétentieux est celui qui se croit plus intelligent que ceux qui sont aussi bêtes que lui.

cs_nitrique · Answer

Bon, rien à faire, je penssait à une autre méthode:

Lors de la création, on le sauvegarde (comme un flux ?) dans la BDD, et ensuite, on le traite comme une image (qu'on recrée lors de chaque modif).

Qu'en penses tu... C'est faisable ?

[D7] TimageView->Scale sur du texte

22 réponses

Votre réponse

Discussions similaires