Discussion :

[Roland Chastain]

Bonjour !

Je vous propose une adaptation pour FreePascal du programme BGIDEMO (tiré des exemples de Turbo Pascal). Ce programme fait le tour des possibilités de l'unité Graph.

Comme vous pourrez vous en rendre compte, les performances de l'unité Graph de FreePascal ne sont pas excellentes, mais il y a quand même de quoi faire pas mal de petites choses, et on peut saluer le travail de l'auteur.

J'en demande pardon à mes confrères linuxiens : c'est une version Windows exclusivement. Peut-être quelqu'un fera-t-il une version Linux ?

Le programme a été compilé avec FreePascal 2.6.2, sous Windows 8.

[batyann811]

Après quelques adaptations voilà une version qui marche sous windows et linux. Petite limitation : il n'existe qu'une police de caractères.

[Roland Chastain]

Après quelques adaptations voilà une version qui marche sous windows et linux. Petite limitation : il n'existe qu'une police de caractères.

Merci, batyann811, je vais regarder ton code avec intérêt.

Voici à présent le programme ARTY, provenant également des exemples de Turbo Pascal.

P.-S. Je viens d'essayer ton programme. Les performances sont incomparables, je veux dire bien meilleures ! Je vais adopter cette unité ptcGraph, que je ne connaissais pas.

[Roland Chastain]

L'unité ptcGraph permet d'utiliser des couleurs 16-bit. J'ai voulu savoir comment sont codées les couleurs 16-bit. D'après ce que j'ai lu ici et là, il y a plusieurs normes. Voici apparemment celle qui est suivie dans ce cas : 5 bits pour le rouge, 6 pour le vert, 5 pour le bleu.

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
program PtcGraph_001;
{$MODE DELPHI}
{$IFDEF WINDOWS}
{$APPTYPE GUI}
{$ENDIF}
 
uses
  PtcGraph, PtcCrt, SysUtils;
 
function StringToWord(const s: string): word;
var
  i: integer;
begin
  result := 0;
  for i := 0 to 15 do
    if s[16 - i] > '0' then
      result := result or (1 shl i);
end;
 
var
  d, m: smallInt;
  c: word;
 
begin
  d := 10;    // 640 x 480
  m := $0111; // 65536 couleurs
 
  InitGraph(d, m, '');
 
  {
  SetColor($FFFF);
  OutTextXY(10, 10, IntToStr(GetMaxX + 1) + 'x' + IntToStr(GetMaxY + 1) + 'x' + IntToStr(GetMaxColor + 1));
  }
 
  c := StringToWord('11111' + '000000' + '00000');
  SetFillStyle(SolidFill, c);
  Bar(100, 100, 240, 380);
 
  c := StringToWord('00000' + '111111' + '00000');
  SetFillStyle(SolidFill, c);
  Bar(250, 100, 390, 380);
 
  c := StringToWord('00000' + '000000' + '11111');
  SetFillStyle(SolidFill, c);
  Bar(400, 100, 540, 380);
 
  ReadKey;
  CloseGraph;
end.

Autrement dit, l'intensité du rouge et du bleu varie de 0 à 31, celle du vert de 0 à 63.

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
program PtcGraph_004;
{$MODE DELPHI}
{$IFDEF WINDOWS}
{$APPTYPE GUI}
{$ENDIF}
 
uses
  PtcGraph, PtcCrt;
 
function RGBToWord(r, g, b: byte): word;
begin
  if r > 31 then r := 31;
  if g > 63 then g := 63;
  if b > 31 then b := 31;
  result := (r shl 11) or (g shl 5) or b;
end;
 
var
  d, m: smallInt;
  c: word;
  i: byte;
 
begin
  d := 10;    // 640 x 480
  m := $0111; // 65536 couleurs
 
  InitGraph(d, m, '');
 
  for i := 0 to 31 do
  begin
    c := RGBToWord(i, 0, 0);
    SetFillStyle(SolidFill, c);
    Bar(016, i * (448 div 32) + 16, 208, (i + 1) * (448 div 32) + 16);
  end;
 
  for i := 0 to 63 do
  begin
    c := RGBToWord(0, i, 0);
    SetFillStyle(SolidFill, c);
    Bar(224, i * (448 div 64) + 16, 416, (i + 1) * (448 div 64) + 16);
  end;
 
  for i := 0 to 31 do
    begin
    c := RGBToWord(0, 0, i);
    SetFillStyle(SolidFill, c);
    Bar(432, i * (448 div 32) + 16, 624, (i + 1) * (448 div 32) + 16);
  end;
 
  ReadKey;
  CloseGraph;
end.

Pas évident à manipuler ! Le mieux serait peut-être de faire une fonction qui convertirait un nombre 32-bit (ce qui permettrait d'utiliser les valeurs usuelles). Qu'en pensez-vous ?

[Roland Chastain]

Voici une adaptation des lignes ondoyantes d'Alcatîz.

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
 
program Ondoyant;
{$IFDEF WINDOWS}
{$APPTYPE GUI}
{$ENDIF}
 
(* Programme original :
   http://alcatiz.developpez.com/tutoriel/owl/?page=pg_gdi *)
 
uses
  PtcGraph, PtcCrt;
 
const
  indiceMax    = 100;
  vitesse      = 100;
  dx1: integer =   4;
  dy1: integer =  10;
  dx2: integer =   3;
  dy2: integer =   9;
 
type
  tLigne = record
    x1, y1, x2, y2: integer;
    couleur: word;
  end;
  tTabLignes = array[0..indiceMax]of tLigne;
 
var
  tabLignes: tTabLignes;
  indiceGeneral: integer;
  effacer: boolean;
 
function Initialise: boolean;
var
  d, m: smallint;
  i: integer;
begin
  d := d16bit;
  m := m800x600;
  InitGraph(d, m, '');
  result := (GraphResult = grOk);
  if result then
  begin
    for i := 0 to indiceMax do
      tabLignes[i].x1 := -1;
    indiceGeneral := 0;
    effacer := false;
  end;
end;
 
procedure NouvelleLigne(var coord, intervalle : integer; coordMax : integer; var couleur : word);
var
  total : integer;
  signe : integer;
begin
  total := coord + intervalle;
  if (total < 0) or (total > coordMax) then
  begin
    if intervalle >= 0 then
      signe := -1
    else
      signe := 1;
    intervalle := signe * (3 + Random(12));
    couleur := Random(65535) + 1;
  end else
    coord := total;
end;
 
procedure DessinLigne(i: integer);
begin
  with tabLignes[i] do
  begin
    SetColor(couleur);
    Line(x1, y1, x2, y2);
  end;
end;
 
procedure Redessine;
var
  i: integer;
  ancienIndice: integer;
begin
  for i := 1 to 10 do
  begin
    ancienIndice := indiceGeneral;
    if indiceGeneral = indiceMax - 1 then
    begin
      indiceGeneral := 0;
      effacer := True;
    end else
      Inc(indiceGeneral);
    if effacer then
    begin
      tabLignes[indiceGeneral].couleur := 0;
      DessinLigne(indiceGeneral);
    end;
    tabLignes[indiceGeneral] := tabLignes[ancienIndice];
    with tabLignes[indiceGeneral] do
    begin
      NouvelleLigne(x1, dx1, GetMaxX, couleur);
      NouvelleLigne(y1, dy1, GetMaxY, couleur);
      NouvelleLigne(x2, dx2, GetMaxX, couleur);
      NouvelleLigne(y2, dy2, GetMaxY, couleur);
    end;
    DessinLigne(indiceGeneral);
  end;
end;
 
begin
  Randomize;
  if Initialise then
  begin
    repeat
      Redessine;
      Delay(vitesse);
    until KeyPressed;
    CloseGraph;
  end;
end.

En pièce jointe, le même programme, mais utilisant l'unité Graph. Avec cette dernière j'avais trouvé le moyen de modifier le titre de la fenêtre et aussi l'icône de la fenêtre. Apparemment, ce n'est pas possible avec PtcGraph, ou du moins je ne vois pas comment faire. Je suppose que c'est la rançon de la compilation multi-plateforme.

Autre pièce jointe, le même programme utilisant l'unité Wingraph. La principale différence entre les trois versions est le nombre de couleurs supportées.

[Roland Chastain]

En regardant des exemples que j'avais oubliés, je m'aperçois que l'unité WinGraph a un mode "plein écran". En l'occurrence, ce serait dommage de ne pas l'utiliser. Voici donc une nouvelle version des lignes ondoyantes.

P.-S. Ajouté la détection des mouvements de la souris, pour pouvoir utiliser le programme comme écran de veille. Le programme s'arrête si la souris est déplacée ou si un bouton est pressé.

[Alcatîz]

Décidément, cette unité WinGraph est pleine de possibilités !
Il va falloir que je la regarde de plus près.

[Paul TOTH]

ahah, ça me rappelle le bon vieux temps sous TP

par contre sur mon PC la détection est trop sensible, quand je double clic sur l'application elle se termine directement, je dois passer par la touche ENTREE pour la lancée sans qu'elle se ferme instantanément.

[Roland Chastain]

Décidément, cette unité WinGraph est pleine de possibilités !

En effet, l'auteur ne s'est pas contenté de restituer les fonctions de l'unité Graph : il a poussé les choses un peu plus loin. Et l'unité est aussi utilisable avec Delphi !

par contre sur mon PC la détection est trop sensible, quand je double clic sur l'application elle se termine directement, je dois passer par la touche ENTREE pour la lancée sans qu'elle se ferme instantanément.

Merci pour le retour, Paul. Oui, il faudra que je retravaille cela.

P.-S. Voilà, j'ai corrigé le défaut signalé par Paul (voir plus haut la nouvelle pièce jointe).

Code :

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

until KeyPressed or (Abs(GetMouseX - x) > 20) or (Abs(GetMouseY - Y) > 20) or (GetMouseButtons <> 0);

[Alcatîz]

En regardant de plus près l'unité WinGraph, je vois que la procédure SetWriteMode permet de définir une opération logique pour le dessin, à l'instar de la fonction BGI SetROP2. Voilà de quoi effacer une ligne ondoyante en la redessinant avec une opération XOR, ce qui permet au programme d'avoir n'importe quelle couleur de fond.

[Roland Chastain]

En regardant de plus près l'unité WinGraph, je vois que la procédure SetWriteMode permet de définir une opération logique pour le dessin, à l'instar de la fonction BGI SetROP2. Voilà de quoi effacer une ligne ondoyante en la redessinant avec une opération XOR, ce qui permet au programme d'avoir n'importe quelle couleur de fond.

Merci pour le tuyau ! Je ne connaissais pas cette procédure. Effectivement, maintenant ça fonctionne quelle que soit la couleur de fond.