Discussion :

[ChPr]

Bonjour à toutes et à tous,

Dans une "Form", je place une "ScrollBox" dans laquelle je place une image "TImage"

Même avec une image qui mesure 10000 x 10000 pixels², lorsque je déplace le curseur de la ScrollBox, le déplacement de l'image est fluide --> pas de problème.

Maintenant, sur la gauche de l'image, j'ajoute des graduations avec des "TextRect". Pas de problème.

Mais si je déplace mon image vers la gauche (barre de scroll vers la droite), mes graduations disparaissent.

Pour pallier ce problème, je déplace les textRect de la quantité dont s'est déplacée la ScrollBox.

Si je déplace mon image vers la gauche, mes TextRect restent bien collés à la gauche de l'image --> super !

Mais si je re-déplace l'image vers la droite, tous mes TextRect qui avaient été ajoutés reviennent avec l'image dans laquelle ces TextRect ont été ajoutés à chaque déplacement. Barbouiilage de l'image --> pas super !

Il faut donc que ce que j'affiche soit l'image originale à laquelle je n'ajoute qu'une seule fois les TextRect.

Pour ce faire, j'utilise un Bitmap transitoire dans lequel je dessine ma carte et, c'est seulement au moment où je déplace la ScrollBox que j'assigne au TImage mon bitmap transitoire auquel j'ajoute enfin mes TextRect : ça marche très bien.

Problème, le déplacement de l'image avec le Scrolling devient très saccadé, je suppose que cela vient du temps mis par la fonction Assign.

N'y aurait-il pas une autre manière de faire afin que le déplacement reste fluide ?

Cordialement.

Pierre.

[Lung]

Et avec une image à fond transparent, avec juste les graduations, placée par-dessus la grosse image dans la ScrollBox ?

[ChPr]

Et avec une image à fond transparent, avec juste les graduations, placée par-dessus la grosse image dans la ScrollBox ?

L'idée est bonne, mais je n'arrive pas à faire une image transparente .

Si j'écris :

Code :

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

1
2
3
4
5
6
7
8
9
10
  Image1.Transparent:= True;
  with Image1.Picture.Bitmap do
  begin
    Width:= 1000;
    Height:= 1000;
    Canvas.Brush.Color:= $00FFFFFF;
    Canvas.Brush.Style:= bsClear; // ou bsSolid : ce n'est que le fond de mon rectangle qui change
    Canvas.Pen.Color:= clYellow;
    Canvas.Rectangle(Rect(0, 0, 100, 20));
  end;

Je vois mon rectangle, mais un fond noir de 1000 x 1000 pixels² recouvre l'image qui est en dessous.

Si je supprime :

Code :

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

1
2
    Width:= 1000;
    Height:= 1000;

Je ne vois plus rien du tout de Image1.

Qu'est-ce que j'ai encore raté ?

Cordialement.

Pierre.

[Lung]

Si j'ai bien compris ton besoin, j'ai bricolé un test vite fait (en delphi):
ImageG est le TImage de graduation placé à gauche, par-dessus la grosse image, avec Transparent := True;

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
var
   i: Integer;
begin
   ImageG.Picture.Bitmap.Width := ImageG.Width;
   ImageG.Picture.Bitmap.Height := ImageG.Height;
   ImageG.Picture.Bitmap.Canvas.Brush.Color := clBlack;
//   ImageG.Picture.Bitmap.Canvas.Brush.Style := bsSolid;
   ImageG.Picture.Bitmap.Canvas.FillRect(ImageG.BoundsRect);
   ImageG.Picture.Bitmap.Canvas.Pen.Color := clBlue;
   for i:=1 to (ImageG.Height div 10) do
   begin
      ImageG.Picture.Bitmap.Canvas.MoveTo(0, i * 10);
      ImageG.Picture.Bitmap.Canvas.LineTo(ImageG.Width, i * 10);
   end;

Et moi, ça s'affiche bien.

[ChPr]

Si j'ai bien compris ton besoin, j'ai bricolé un test vite fait (en delphi):
ImageG est le TImage de graduation placé à gauche, par-dessus la grosse image, avec Transparent := True;

...
Et moi, ça s'affiche bien.

Je te remercie pour cet exemple, mais chez moi, avec Lazarus 2.0.6, ça ne fonctionne pas : il n'y a pas de transparence.

Il me semble que, il y a longtemps, quand j'ai migré de Delphi vers Lazarus, j’avais déjà rencontré ce type de problème.

Pour l'instant, j'ai résolu mon problème d'une manière différente :

Je crée autant de petites imagettes (TImage) que j'ai de graduations à afficher puis, je les place là où il faut. Je n'ai pas la même fluidité que si j'utilisais des bitmap incorporés à la carte, mais c'est très acceptable (essai avec une image de 20000 x 20000 pixels²).

Cordialement.

Pierre.

[Jipété]

Je te remercie pour cet exemple, mais chez moi, avec Lazarus 2.0.6, ça ne fonctionne pas : il n'y a pas de transparence.

Et pourquoi chez moi, avec un vieux Linux 32 bits et un Laz 1.4 / FPC 2.6 j'ai de la transparence ?

Regarde le coin blanc en haut à gauche, placé sous l'image du dégradé gris aux bords colorés :



Je ne passe pas le code, c'est un brouillon abominable, même moi plusieurs années plus tard je ne m'y retrouve pas...

Faut que je te cherche trouve autre chose…

EDIT : bon, j'ai retrouvé, mais ça utilise scanline, les pointeurs, rgbquad et tout ce genre de choses qui font peur.
Peut-être que tu pourrais regarder les RGBA controls ? Car pour avoir de la transparence, 32 bits obligatoire !

Si ça t'intéresse, je peux te passer les fichiers (il y en a 2 : l'unité de la fiche, et une librairie graphique, et ça vient de chez EFG)



NE PAS TENIR COMPTE du rendu tout moche des couleurs du dégradé, c'est lié à la compression gif ! On ne peut pas tout avoir, du gif animé et des millions de couleurs, bah...

[BeanzMaster]

Salut , pourquoi ne pas dessiner ta graduation sur le canvas de ta scrollbox directement ou en dehors de ta scrollbox, et tu synchronises les déplacements ?

[ChPr]

... Si ça t'intéresse, je peux te passer les fichiers (il y en a 2 : l'unité de la fiche, et une librairie graphique, et ça vient de chez EFG) ...

Merci Jipété pour cette proposition, mais pour l'instant, je vais rester sur ma méthode qui fonctionne bien sans avoir à faire appel à la transparence.

Cordialement.

Pierre.

[ChPr]

Salut , pourquoi ne pas dessiner ta graduation sur le canvas de ta scrollbox directement ou en dehors de ta scrollbox, et tu synchronises les déplacements ?

Je viens d'appliquer ce que tu me dis : je ne vois pas mes graduations. Je n'ai pas dû tout comprendre.

Ce que fais :

NOTA : les propriétés "Align" du ScrollBox et du TImage sont à "alClient"

Je dessine les graduations sur le canvas de ma scrollBox, puis sur le canvas du Timage qui est sur le ScrollBox, je dessine ma carte. J'ai mis la transparence du TImage à true.

Maintenant, je place la propriété "Align" de ma TImage à "alNone" pour déplacer cette dernière un peu sur la droite pour laisser une partie visible du scrollBox sur la gauche. Dans cette partie laissée libre du ScrollBox, je vois les graduations mais elles s'arrêtent la où le TImage commence.

Cordialement.

Pierre.

[Guesset]

Bonjour,

Dans la même logique que la solution de BeanzMaster, il est possible de travailler sur le canvas du TImage.

Attention, le Canvas qui nous intéresse ici est celui accessible sous l'événement onPaint du TImage. Le TImage.Canvas n'est pas le même selon qu'il est accédé hors onPaint (équivalent dans ce cas à TImage.Image.Picture.Bitmap.Canvas) ou dans le onPaint (équivalent dans ce cas au Canvas d'un TPaint qui serait placé au-dessus du TImage).

C'est parfait pour mettre des informations, règles, quadrillages sans altérer l'image.

Salutations

[Jipété]

Bonsoir,

C'est parfait pour mettre des informations, règles, quadrillages sans altérer l'image.

Je m'immisce dans la discussion car je n'ai pas compris : ça fonctionne comme si c'était un calque superposé à l'image ? Y aurait-il moyen d'avoir un tout petit projet d'exemple ?

[Guesset]

Bonjour Jipété,

... ça fonctionne comme si c'était un calque superposé à l'image ? Y-aurait moyen d'avoir un tout petit projet d'exemple ?

Oui ça fonctionne comme un calque (mais pas pérenne, les données doivent être recrées à chaque affichage).

Petit exemple :

_Attraction_.7z

Les planètes/soleils qui bougent et palpitent (indiqués par les flèches rouges ajoutées) sont ainsi gérés dans le Canvas du TImage vu sous OnPaint.

C'est très pratique même si un même nom cache des objets différents selon les circonstances

Salut

[Jipété]

Ho, grand merci à toi !

Les gens sous Linux rajouteront ça au tout début de l'unité, après implementation :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
uses
  BaseUnix, // timespec
  Linux; // clock_gettime
 
function GetTickCount64: QWord;
var
  tp: timespec;
begin
  clock_gettime(CLOCK_MONOTONIC_RAW, @tp);
  Result := (Int64(tp.tv_sec) * 1000) + (tp.tv_nsec div 1000000);  // 1 ms
end;

Avec ça, ça compile et ça s'exécute sur ma vieille machine (Linux 32 bits, FPC 2.6.4 Laz 1.4) sans problème.

Plus qu'à étudier le code…

[Guesset]

Bonjour Jipété,

J'ai beaucoup de défauts. Dans les plus avouables : j'utilise Windows, je ne travaille qu'en 64 bits et j'utilise la syntaxe Intel pour l'assembleur .

... Les gens sous Linux rajouteront ça au tout début de l'unité, après implementation :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
uses
  BaseUnix, // timespec
  Linux; // clock_gettime
 
function GetTickCount64: QWord;
var
  tp: timespec;
begin
  clock_gettime(CLOCK_MONOTONIC_RAW, @tp);
  Result := (Int64(tp.tv_sec) * 1000) + (tp.tv_nsec div 1000000);  // 1 ms
end;

…

Salut

[ChPr]

J'ai essayé ton appli sous Windows 10 et sous Ubuntu 20.04 : ça fonctionne sans problème. C'est hypnotique, on s'en ferait un fond d'écran .

Pour autant, j'ai essayé dans mon appli : ça ne fonctionne pas. Ce que j'ai fait :

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
procedure TCreeCarte.ScrollBoxPaint(Sender: TObject);
begin
  if (ScrollBox.HorzScrollBar.Position <> Xprec) or (ScrollBox.VertScrollBar.Position <> Yprec) then
  begin
//    Graduation(CarteAff, ZoomAff);
    Bouge:= True;
  end;
end;
 
procedure TCreeCarte.ImgCartePaint(Sender: TObject);
begin
  if Bouge then
    ImgCarte.Picture.Bitmap.Canvas.Rectangle(10+ScrollBox.HorzScrollBar.Position, 100, 50+ScrollBox.HorzScrollBar.Position, 150);
  Bouge:= False;
end;

Mon image ne se renouvelle que si je déplace le scrolling d'où la première procédure "ScrollBoxPaint". Elle met "Bouge" à True. et ma deuxième procédure "ImgCartePaint" ne se déclenche et ne remplit sa fonction que si "Bouge" est à True : ça dessine mon rectangle ... mais n'efface pas les précédemment tracés. D'où une grande quantité de rectangles qui se dessinent les uns après les autres sans jamais s'effacer.

Qu'ai-je raté ?

Cordialement.

Pierre.

[ChPr]

Bon, je pense que j'ai vu ce que j'avais raté : je ne dois pas dessiner mon rectangle dans :

ImgCarte.Picture.Bitmap.Canvas.Rectangle();

mais dans :

ImgCarte.Canvas.Rectangle();

Bon, je vais essayer de remodeler mon programme à cette lumière.

Cordialement.

Pierre.

[Guesset]

Bonjour Pierre,

... je ne dois pas dessiner mon rectangle dans : ImgCarte.Picture.Bitmap.Canvas.Rectangle(); mais dans : ImgCarte.Canvas.Rectangle();

Si ton rectangle doit être dessiné au-dessus (et non dans) ImgCarte, c'est effectivement ce qui doit être écrit dans le gestionnaire de l'événement OnPaint.

Si quelque chose doit évoluer en surimpression indépendamment d'un quelconque rafraichissement de l'image (par exemple un temps qui s'incrémente), il faut prévoir des ImgCarte.Refresh ou Repaint qui vont déclencher les événement OnPaint nécessaires (mais pas suffisant car il faut réafficher l'image à l'écran avant).

Salut

[ChPr]

Bon, en fait, ça ne se passe pas bien dans le cas de mon application .

Avec ta méthode, j'ai réussi à faire fonctionner cet affichage de graduations dans des conditions que je n'arrive pas à expliquer, pérenniser. De toute évidence, même avec une image de 20000 x 20000 pixels² carré ça garde toute sa fluidité alors qu'avec ma méthode j'en perd un peu .

Mais les conditions dans lesquelles j'ai obtenu ce résultat ne sont pas exploitables :

Voici ma procédure "Paint" qui est déclenchée par le scrolling:

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
procedure TCreeCarte.ImgCartePaint(Sender: TObject);
var
  X, Y: Integer;
  RctTxt: TRect;
begin
  X:= ScrollBox.HorzScrollBar.Position;
  Y:= ScrollBox.VertScrollBar.Position;
//  if (X <> Xprec) or (Y <> Yprec) then
  begin
//    ImgCarte.Picture.Bitmap.Canvas.Line(0, 0, 1, 1);
    Xprec:= X;
    Yprec:= Y;
    case ZoomAff of
  15: DistGrad:= 100;
  13: DistGrad:= 50;
  11: DistGrad:= 20;
  9: DistGrad:= 5;
    end;
    DistGrad:= DistGrad/kAff;
    with ImgCarte.Canvas do
    begin
      Pen.Style:= psSolid;
      Pen.Mode:= pmCopy;
      Pen.Color:= clBlue;
    end;
    GradLo:= DistGrad*CarteAff.LonMin;
    if GradLo < 0 then
       GradLo:= Trunc(GradLo)
     else
       GradLo:= Trunc(GradLo)+1;
    GradLo:= GradLo/DistGrad; // Première graduations des longitudes
    PosGradLo:= (GradLo-CarteAff.LonMin)*FeLon; // Première position des graduations des longitudes
    with ImgCarte.Canvas do
    begin
      Pen.Color:= clBlue;
      Font.Color:= clBlue;
      repeat
         RctTxt:= Rect(Round(PosGradLo-20), 0+Y, Round(PosGradLo+20), 16+Y);
         Line(Round(PosGradLo), 0, Round(PosGradLo), Height);
         Rectangle(RctTxt);
         TextRect(RctTxt, 0, 0, Format('%.2f°', [GradLo]), TS);
         PosGradLo:= PosGradLo+1/DistGrad*FeLon;
         GradLo:= GradLo+1/DistGrad;
       until GradLo > CarteAff.LonMax;
    end;
      GradLa:= DistGrad*CarteAff.LatMax;
      if GradLa > 0 then
         GradLa:= Trunc(GradLa)
       else
         GradLa:= Trunc(GradLa)+1;
      GradLa:= GradLa/DistGrad; // Première des graduations des latitudes
      PosGradLa:= (CarteAff.LatMax-GradLa)*FeLat; // Première position des graduations des latitudes
      with ImgCarte.Canvas do
      begin
        Pen.Color:= clBlue;
        Font.Color:= clBlue;
        repeat
           RctTxt:= Rect(0+X, Round(PosGradLa-8), 40+X, Round(PosGradLa+8));
           Line(0, Round(PosGradLa), Width, Round(PosGradLa));
           Rectangle(RctTxt);
           TextRect(RctTxt, 0, 0, Format('%.2f°', [GradLa]), TS);
           PosGradLa:= PosGradLa+1/DistGrad*FeLat;
           GradLa:= GradLa-1/DistGrad;
        until GradLa < CarteAff.LatMin;
      end;
  end;
end;

Pour faire en sorte que ça fonctionne, je suis obligé de faire un appel à n'importe quel tracé (ligne, rectangle, ...) à ImgCarte.Picture.Bitmap.Canvas. sinon, bien que la procédure se déroule normalement, mes graduations se déplacent et se superposent au fur et à mesure du scrolling.

Ensuite, si j'active cette ligne if (X <> Xprec) or (Y <> Yprec) then, bien que je passe toujours normalement dans ma procédure, aucune graduation ne s'affiche.

Maintenant, je désactive la ligne if (X <> Xprec) or (Y <> Yprec) then et j'active cette ligne ImgCarte.Picture.Bitmap.Canvas. alors, à l'affichage de l'image, un tout petit fragment de celle-ci s'affiche. Je déplace la fenêtre un peu hors de l'écran et toute mon image s'affiche avec les graduations qui cette fois restent en place : super ! Mais alors, plus moyen de fermer la fenêtre : mon programme est bloqué sur cette image.

Tout ceci est vraiment incompréhensible et totalement inexploitable.

Si vous avez des idées sur ce qui ne va pas ...

Cordialement.

Pierre.

[Guesset]

Bonjour,

Ce que tu cites ressemble beaucoup à un manque de refresh.
Il y a beaucoup de choses dans ImgCartePaint mais je ne pense pas que ce soit le problème. Il y a cependant des suites de lignes étranges, par exemple :

Code Pascal :

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

1
2
3
4
5
6
GradLo:= DistGrad*CarteAff.LonMin;
if GradLo < 0 then
   GradLo:= Trunc(GradLo)
else
   GradLo:= Trunc(GradLo)+1;
GradLo:= GradLo/DistGrad;

Pourquoi ne pas écrire :

Code Pascal :

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

GradLo   := Trunc(CarteAff.LonMin) + Ord(CarteAff.LonMin >= 0)/DistGrad; // en supposant kAff > 0

Par ailleurs, il est possible que 1/Disgrad soit plus utile que Disgrad.

Je ne vois pas l'intérêt de calculer dans ImgCartePaint des valeurs qui viennent d'ailleurs. Exemple : DistGrad est une variable globale qui dépend de ZoomAff et kAff, deux autres variables globales, pourquoi n'est elle pas calculée quand l'une de ces deux valeurs change ?

Propositions de modifications a minima (qui ne règle pas le problème de fond ).

Code Pascal :

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
47
procedure TCreeCarte.ImgCartePaint(Sender: TObject);
var
   RctTxt : TRect;
   X, Y, iPos : Integer;
begin
  X := ScrollBox.HorzScrollBar.Position;
  Y := ScrollBox.VertScrollBar.Position;
//  if (X = Xprec) and (Y = Yprec) then Exit;
//    ImgCarte.Picture.Bitmap.Canvas.Line(0, 0, 1, 1);
   case ZoomAff of                               // A mettre ailleurs
      15: DistGrad:= 100;                        // ''
      13: DistGrad:=  50;                        // ''
      11: DistGrad:=  20;                        // ''
       9: DistGrad:=   5;                        // ''
   end;                                          // ''
   DistGrad := DistGrad/kAff;                    // ''
   GradLo   := Trunc(CarteAff.LonMin) + Ord(CarteAff.LonMin >= 0)/DistGrad;
   PosGradLo:= (GradLo-CarteAff.LonMin)*FeLon; // Première position des graduations des longitudes
   with ImgCarte.Canvas do begin
      Pen.Style := psSolid;
      Pen.Mode  := pmCopy;
      Pen.Color := clBlue;
      Font.Color:= clBlue;
      repeat
         iPos   := Round(PosGradLo);
         RctTxt := Rect(iPos - 20, 0 + Y, iPos + 20, 16 + Y);
         Line(iPos, 0, iPos, Height);
         Rectangle(RctTxt);
         TextRect (RctTxt, 0, 0, Format('%.2f°', [GradLo]), TS);
         PosGradLo+= 1 / DistGrad*FeLon;
         GradLo   += 1 / DistGrad;
      until GradLo > CarteAff.LonMax;
      GradLa    := Trunc(CarteAff.LatMax) + Ord(CarteAff.LatMax <= 0)/DistGrad;
      PosGradLa := (CarteAff.LatMax-GradLa)*FeLat; // Première position des graduations des latitudes
      repeat
         iPos   := Round(PosGradLa);
         RctTxt := Rect(0 + X, iPos - 8, 40 + X, iPos + 8);
         Line(0, iPos, Width, iPos);
         Rectangle(RctTxt);
         TextRect(RctTxt, 0, 0, Format('%.2f°', [GradLa]), TS);
         PosGradLa += 1 / DistGrad * FeLat;
         GradLa    -= 1 / DistGrad;
      until GradLa < CarteAff.LatMin;
   end;
   Xprec := X;
   Yprec := Y;
end;

Avec le code complet ce serait plus facile. Par exemple j'ai des doutes sur le type de plusieurs variables.

Salut

[ChPr]

... Ce que tu cites ressemble beaucoup à un manque de refresh. ...

J'en avais placé un en fin du Paint, mais c'était pire. Bon, je suppose qu'il était mal placé.

... Pourquoi ne pas écrire :

Code Pascal :

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

GradLo   := Trunc(CarteAff.LonMin) + Ord(CarteAff.LonMin >= 0)/DistGrad; // en supposant kAff > 0

...

Pour que ce soit exact, il faut écrire :

Code Pascal :

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

GradLo   := (Trunc(DistGrad*CarteAff.LonMin) + Ord(CarteAff.LonMin >= 0))/DistGrad; // en supposant kAff > 0

Tu souhaites avoir tout le code de cette fiche ? Si c'est pour voir ce qui est dedans, pas de problème, si c'est pour la faire fonctionner, il faudrait que je la sépare du reste du programme pour en faire un programme autonome.

Cordialement.

Pierre