1 ------------------------------------------------------------------------------
3 -- Nom du fichier : Draw.adb --
5 -- Auteur(s) : SALAMIN Michel / Assistant HEV --
6 -- Ecole d'ingenieurs du canton de Vaud (EIVD) --
8 -- Date de creation : 20 avril 2000 --
10 -- But : Mettre a disposition les fonctions graphiques --
12 -- - gerer la couleur sous Spider --
13 -- - dessiner des cercles --
14 -- - dessiner des rectangles --
15 -- - changer la couleur d'un pixel --
17 -- Date de modif. : --
20 -- Modules appeles : --
21 -- Mat. particulier : Graphmin.dll --
25 ------------------------------------------------------------------------------
29 package body Spider
.Draw
is
33 procedure ADA_Get_Color_Pen(R
: out Integer;
37 pragma import(DLL
,ADA_Get_Color_Pen
,"ADA_getColorPen");
39 function Get_Color_Pen
return tColor
is
42 ADA_Get_Color_Pen(R
,G
,B
);
43 return tColor
'(R,G,B);
48 procedure ADA_Get_Color_Background(R : out Integer;
52 pragma import(DLL,ADA_Get_Color_Background,"ADA_getColorBackground");
54 function Get_Color_Background return tColor is
57 ADA_Get_Color_Background(R,G,B);
58 return tColor'(R
,G
,B
);
59 end Get_Color_Background
;
63 procedure ADA_Get_Color_Text(R
: out Integer;
67 pragma import(DLL
,ADA_Get_Color_Text
,"ADA_getColorText");
69 function Get_Color_Text
return tColor
is
72 ADA_Get_Color_Text(R
,G
,B
);
73 return tColor
'(R,G,B);
78 procedure ADA_Get_Width_Char(Width_Car : out Natural;
81 pragma import(DLL,ADA_Get_Width_Char,"ADA_getWidthChar");
83 function Get_Width_Char return Natural is
87 ADA_Get_Width_Char(Width_Car,Err);
98 procedure ADA_Get_Height_Char(HeightCar : out Natural;
101 pragma import(DLL,ADA_Get_Height_Char,"ADA_getHeightChar");
103 function Get_Height_Char return Natural is
107 ADA_Get_Height_Char(HeightCar,Err);
118 procedure ADA_Set_Color_Pen(R : in Integer;
122 pragma import(DLL,ADA_Set_Color_Pen,"ADA_setColorPen");
124 procedure Set_Color_Pen(Color : in tColor) is
126 ADA_Set_Color_Pen(Color.R,Color.G,Color.B);
131 procedure ADA_Set_Color_Background(R : in Integer;
135 pragma import(DLL,ADA_Set_Color_Background,"ADA_setColorBackground");
137 procedure Set_Color_Background(Color : in tColor) is
139 ADA_Set_Color_Background(Color.R,Color.G,Color.B);
140 end Set_Color_Background;
144 procedure ADA_Set_Color_Text(R : in Integer;
148 pragma import(DLL,ADA_Set_Color_Text,"ADA_setColorText");
150 procedure Set_Color_Text(Color : in tColor) is
152 ADA_Set_Color_Text(Color.G,Color.G,Color.B);
157 procedure ADA_Display_Text(Text : in String;
160 pragma import(DLL,ADA_Display_Text,"ADA_displayText");
162 procedure Display_Text(Text : in String) is
163 ADA_Text : String := Text & Character'Val(0);
166 ADA_Display_Text(ADA_Text,Err);
174 procedure ADA_Circle(Radius : in Natural;
178 pragma import(DLL,ADA_Circle,"ADA_circle");
180 procedure Circle(Radius : in Natural;
181 Filled : in tFill) is
182 ADA_filled : Natural;
191 ADA_Circle(Radius,ADA_Filled,Err);
200 procedure ADA_Box(Width : in Integer;
205 pragma import(DLL,ADA_Box,"ADA_box");
207 procedure Box(Width : in Integer;
209 Filled : in tFill) is
210 ADA_filled : Natural;
219 ADA_Box(Width,Height,ADA_Filled,Err);
228 procedure ADA_Put_Pixel(Err : out Natural);
230 pragma import(DLL,ADA_Put_Pixel,"ADA_putPixel");
232 procedure Put_Pixel is
243 procedure ADA_Get_Pixel(Couleur_R : out Natural;
244 Couleur_G : out Natural;
245 Couleur_B : out Natural;
248 pragma import(DLL,ADA_Get_Pixel,"ADA_getPixel");
250 function Get_Pixel return tColor is
256 ADA_Get_Pixel(Couleur_R,Couleur_G,Couleur_B,Err);
262 return tColor'(Couleur_R
,Couleur_G
,Couleur_B
);