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...

[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.