Fonctions de l'unité Crt pour Delphi XE2

1 pièce(s) jointe(s)

Bonjour !

J'ai longtemps cherché une unité Crt pour Delphi XE2 : je ne l'ai jamais trouvée. Apparemment ça n'intéresse plus personne, ce que je peux comprendre. :)

Mais c'est quand même dommage, non ?

Citation:

Pourquoi ne l'écris-tu pas toi-même ?

Eh bien justement j'y pense mais en attendant je me suis amusé, à partir de morceaux de code pris çà et là (tous basés sur l'unité Windows), je me suis fabriqué une unité offrant les fonctions basiques de l'unité Crt : effacer l'écran, choisir la couleur des caractères, placer le curseur à tel endroit. J'ai eu la bonne surprise de voir tous les morceaux se compiler et fonctionner parfaitement, non seulement avec XE2, mais aussi avec FreePascal et Delphi 6 !

Je vous présente donc le code que j'ai écrit ou plutôt collé, et je propose le sujet suivant : une unité Crt compatible avec les dernières versions de Delphi. :)

Unité Console de Rudy Velthuis

En continuant mes recherches, je suis tombé sur l'unité Console de Rudy Velthuis, qui reprend toutes les fonctions de la Crt. Je l'ai testée avec XE2 : ça marche ! :)

L'auteur précise qu'il a testé l'unité avec Delphi 5 et Delphi 2006.

J'en conclus qu'elle doit être compatible avec toutes les versions intermédiaires, et peut-être aussi avec FreePascal. :)

P.-S. Non, pas avec FreePascal.

1 pièce(s) jointe(s)

J'ai retravaillé mon unité : j'y ai ajouté une procédure qui permet de cacher le curseur.

Code:

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
unit miniCrt;
 
{ delphi.developpez.com/faq/?page=applisconsole
  logiterre.org/langages_de_programmation/pascal/faq-delphi-pascal.html
  www.delphipraxis.net/705144-post2.html }
 
interface
 
procedure Title(const s: string);
procedure Color(const caractere, fond: byte);
procedure ClrScr;
procedure GotoXY(const x, y: integer);
procedure CursorOff;
procedure CursorOn;
 
{$I Couleurs.inc}
 
implementation
 
uses SysUtils, Windows;
 
procedure Title(const s: string);
begin
  SetConsoleTitle(Pchar(s));
end;
 
procedure Color(const caractere, fond: byte);
begin
  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE), caractere + (fond * 16));
end;
 
procedure ClrScr;
var
  pos: TCoord;
  h: THandle;
  info: TConsoleScreenBufferInfo;
  nbr: LongWord;
  nbr_ecrits: LongWord;
begin
  pos.x := 0;
  pos.y := 0;
  h := GetStdHandle(STD_OUTPUT_HANDLE);
  GetConsoleScreenBufferInfo(h, info);
  nbr := info.dwSize.x * info.dwSize.y;
  FillConsoleOutputCharacter(h, #32, nbr, pos, nbr_ecrits);
  FillConsoleOutputAttribute(h, info.wAttributes, nbr,  pos, nbr_ecrits);
  SetConsoleCursorPosition(h, pos);
end;
 
procedure GotoXY(const x, y: integer);
var
  pos: TCoord;
begin
  pos.x := x - 1;
  pos.y := y - 1;
  SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), pos);
end;
 
procedure CursorOff;
var
  cci : TConsoleCursorInfo;
begin
  GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), cci);
  cci.bVisible := FALSE;
  SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), cci);
end;
 
procedure CursorOn;
var
  cci : TConsoleCursorInfo;
begin
  GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), cci);
  cci.bVisible := TRUE;
  SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), cci);
end;
 
end.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
const
  NOIR = 0;
  BLEU_FONCE = 1;
  VERT_FONCE = 2;
  CYAN_FONCE = 3;
  ROUGE_FONCE = 4;
  MAGENTA_FONCE = 5;
  MARRON = 6;
  GRIS_PALE = 7;
  GRIS_FONCE = 8;
  BLEU_PALE = 9;
  VERT_PALE = 10;
  CYAN_PALE = 11;
  ROUGE_PALE = 12;
  MAGENTA_PALE = 13;
  JAUNE = 14;
  BLANC = 15;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
program test_miniCrt;
 
{$APPTYPE CONSOLE}
 
uses
  miniCrt;
 
{$R Icone}
 
begin
  Title('Test miniCrt');
  Color(BLANC, BLEU_FONCE);
  ClrScr;
 
  CursorOff;
  GotoXY(2, 2);
  Write('Curseur invisible. Appuyez sur une touche...');
  ReadLn;
 
  CursorOn;
  GotoXY(2, 4);
  Write('Curseur visible. Appuyez sur une touche...');
  ReadLn;
end.