home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / voxrom / textes / repwin08 / annexes / scythale / graph / bluegui_.pas next >
Pascal/Delphi Source File  |  1995-10-01  |  57KB  |  1,623 lines
  1. {
  2. ╓────────────────────────────────────────────────────────────────────────────╖
  3. ║                                                                            ║
  4. ╟─────────────────────────────────────┬─┬────────────────────────────────────╢
  5. ║   Supplied by: Scythale             │ │    Written by: Vector Sigma        ║
  6. ║    Cracked by: None                 │ │    Protection: None                ║
  7. ║   Packaged by: MoX                  │ │Graphics/Sound: GUI                 ║
  8. ║  Release Date: 08/01/95             │ │  Program Type:                     ║
  9. ║        Rating:                      │ │    # of Disks:                     ║
  10. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  11. ║                                                                            ║
  12. ║                                                                            ║
  13. ║                                                                            ║
  14. ║                                                                            ║
  15. ║                                                                            ║
  16. ║                                                                            ║
  17. ╟────────────────────────────────────────────────────────────────────────────╢
  18. ║                                                                            ║
  19. ╙────────────────────────────────────────────────────────────────────────────╜
  20.  draw_ratio_box et pct_done faites le 23/12/94
  21.  input,choose_file,exist,file_open le 23/12/94
  22.  title_cadre le 24/12/94
  23.  choice_box le 25/12/94
  24.  BGchoose_file le 08/01/95, corrigée le 24/02/95.
  25. }
  26. Unit BlueGui_;
  27. Interface
  28. CONST
  29.  VER_BGUI = 'BlueGui v1.1, SourceWare (C) 94-95 XTECH.';
  30.  
  31. var
  32.  couleur_light:byte;
  33.  couleur_ppale:byte;
  34.  
  35.  procedure palette(index,r,g,b:byte);
  36.  procedure noir_blanc;
  37.  procedure couleur;
  38.  function  light(color:byte):byte;{couleur legere}
  39.  function  Max(x,y:integer):integer;
  40.  function  Min(x,y:integer):integer;
  41.  function  get_middle_screen_x:integer;{renvoie le milieu en X}
  42.  function  get_middle_screen_Y:integer;{renvoie le milieu en Y}
  43.  procedure exicen(x,y:integer);{bouton de fermeture}
  44.  procedure rect_relief_inf(x1,y1,x2,y2:word;color:byte);{relief superieur}
  45.  procedure rect_relief_sup(x1,y1,x2,y2:word;color:byte);{relief inférieur}
  46.  procedure static_line(x1,y1,x2:word;color:byte);{ligne relief}
  47.  procedure cadre(x1,y1,x2,y2:word;color:byte);{cadre}
  48.  procedure plaque(x1,y1,x2,y2:word;color:byte);{plaque relief}
  49.  
  50.  procedure input_box(x1,y1,x2:word;color:byte;msg:string);{boite de saisie}
  51.  procedure text_input_box(x1,y1,x2:word;color:byte;message:string;color_msg:byte);
  52.  function  text_input(x1,y1,x2:word;color:byte;message:string):string;{fenetre d'edition avec titre}
  53.  function  input(x1,y1,x2:word;color:byte;mot:string):string;{boite de saisie, renvoie la chaine saisie}
  54.  
  55.  procedure draw_ratio_box(x1,y1,x2:word;color:byte);{boite de pourcentage}
  56.  procedure pct_done(pct:word);{pour boite de pourcentage, l'augmente}
  57.  
  58.  procedure combon(x1,y1:word;color:byte);
  59.  procedure combof(x1,y1:word;color:byte);
  60.  procedure affiche_file(x1,y1,x2,y2:word;color:byte;var file_name:string);{affiche les fichiers disponibles dans file_name}
  61.  function  exist(fic:string):boolean;{existence d'un fichier}
  62.  function  file_open(color:byte;init_string:string):string;{fenêtre pour choisir un fichier}
  63.  function  file_open_(color:byte;init_string:string):string;{fenêtre pour choisir un fichier}
  64.  
  65.  procedure a_win(x1,y1,x2,y2:word;color:byte;savewin:boolean;msg:string;special:boolean);{fenêtre effacable}
  66.  procedure Windc;{efface la fenetre}
  67.  
  68.  procedure static_win(x1,y1,x2,y2:word;color:byte;savewin:boolean);{fenetre message}
  69.  procedure StatC;{efface la fenetre}
  70.  
  71.  procedure draw_button(x1,y1,long,larg:word;color:byte;txt:string);{dessine un bouton}
  72.  procedure press_button(x1,y1,long,larg:word;color:byte;txt:string);{l'enfonce}
  73.  
  74.  procedure title_cadre(x1,y1,x2,y2:word;color:byte;title:string);{trace un cadre titré}
  75.  
  76.  function  choice_box(x1,y1:word;p:pointer;size:byte;color:byte):word;{boide de choix, entrer adr tableau, nb elem tableau}
  77.  
  78.  function  BGchoose_file(x1,y1,x2,y2:word;color:byte;var file_name:string):string;
  79.  function  BGfile_open(color:byte;init_string:string):string;
  80.  
  81.  procedure BG_login_box;{dessine une boite de saisie d'accès}
  82.  
  83.  procedure Ecrit_(x,y:word;mot:string;souligne:boolean); { ecriture améliorée }
  84.  procedure Cadre_title(x1,y1,x2,y2:word;color:byte;titre:string;t_c:byte); { cadre de sous plaque }
  85.  
  86.  
  87. Implementation
  88. uses graph,crt,dos;
  89. type
  90.   RGBRec = record
  91.     RedVal, GreenVal, BlueVal : Integer;
  92.      { Intensity values (values from 0 to 63) }
  93.     Name: String;
  94.     ColorNum: Integer;
  95.      { The VGA color palette number as mapped into 16 color palette }
  96.   end;
  97. const  Colors : array[0..MaxColors] of RGBRec = (
  98.    ( RedVal:0;GreenVal:0;BlueVal:0;Name:'Black';ColorNum: 0),
  99.    ( RedVal:0;GreenVal:0;BlueVal:40;Name:'Blue';ColorNum: 1),
  100.    ( RedVal:0;GreenVal:40;BlueVal:0;Name:'Green';ColorNum: 2),
  101.    ( RedVal:0;GreenVal:40;BlueVal:40;Name:'Cyan';ColorNum: 3),
  102.    ( RedVal:40;GreenVal:7;BlueVal:7;Name:'Red';ColorNum: 4),
  103.    ( RedVal:40;GreenVal:0;BlueVal:40;Name:'Magenta';ColorNum: 5),
  104.    ( RedVal:40;GreenVal:30; BlueVal:0;Name:'Brown';ColorNum: 20),
  105.    ( RedVal:49;GreenVal:49;BlueVal:49;Name:'Light Gray';ColorNum: 7),
  106.    ( RedVal:26;GreenVal:26;BlueVal:26;Name:'Dark Gray';ColorNum: 56),
  107.    ( RedVal:0;GreenVal:0;BlueVal:63;Name:'Light Blue';ColorNum: 57),
  108.    ( RedVal:9;GreenVal:63;BlueVal:9;Name:'Light Green';ColorNum: 58),
  109.    ( RedVal:0;GreenVal:63;BlueVal:63;Name:'Light Cyan';ColorNum: 59),
  110.    ( RedVal:63;GreenVal:10;BlueVal:10;Name:'Light Red';ColorNum: 60),
  111.    ( RedVal:44;GreenVal:0;BlueVal:63;Name:'Light Magenta';ColorNum: 61),
  112.    ( RedVal:63;GreenVal:63;BlueVal:18;Name:'Yellow';ColorNum: 62),
  113.    ( RedVal:63; GreenVal:63; BlueVal:63; Name: 'White'; ColorNum: 63)
  114.   );
  115.  
  116. Var
  117.    P1,P2,P3: POINTER;
  118.     mx1,my1:integer;
  119.     mx2,my2:integer;
  120.     mx3,my3:integer;
  121.  
  122.       Size_1,
  123.       size2: WORD;
  124.     ratioX1,
  125.     ratioX2,
  126.     ratioY1: word;
  127.   open_win1,
  128.   open_win3,
  129.    open_win2:boolean;
  130.    BG_save_color,
  131.    BG_save_BK : word;
  132. {
  133. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  134. ║        PROCEDURE ()                 │ │                           by XTech ║
  135. ║                                     │ │                           00/00/95 ║
  136. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  137. ║                                                                            ║
  138. ║ Use:                                                                       ║
  139. ║                                                                            ║
  140. ╙────────────────────────────────────────────────────────────────────────────╜
  141. }
  142. function light(color:byte):byte;
  143. begin
  144. if (color=8) then light:=color-1
  145.   else
  146.    light:=color+8;
  147. if (color=couleur_ppale) then
  148.  light:=couleur_light;
  149.  
  150. end;
  151. {
  152. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  153. ║        PROCEDURE ()                 │ │                           by XTech ║
  154. ║                                     │ │                           00/00/95 ║
  155. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  156. ║                                                                            ║
  157. ║ Use:                                                                       ║
  158. ║                                                                            ║
  159. ╙────────────────────────────────────────────────────────────────────────────╜
  160. }
  161. procedure palette(index,r,g,b:byte);assembler;
  162. asm
  163. mov dx,$3C8
  164. mov al,index
  165. out dx,al
  166. inc dx
  167. mov al,r
  168. out dx,al
  169. mov al,g
  170. out dx,al
  171. mov al,b
  172. out dx,al
  173. end;
  174.  
  175. {procedure set_palette;
  176. begin
  177.  
  178. end;}
  179. {
  180. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  181. ║        PROCEDURE ()                 │ │                           by XTech ║
  182. ║                                     │ │                           00/00/95 ║
  183. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  184. ║                                                                            ║
  185. ║ Use:                                                                       ║
  186. ║                                                                            ║
  187. ╙────────────────────────────────────────────────────────────────────────────╜
  188. }
  189. procedure noir_blanc;
  190. var i:byte;
  191. begin
  192.   for i:=1 to 7 do palette(i,63*(i+3) div 10,63*(i+3) div 10,63*(i+3) div 10);
  193.   palette(20,56,56,56);
  194. end;
  195. {
  196. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  197. ║        PROCEDURE ()                 │ │                           by XTech ║
  198. ║                                     │ │                           00/00/95 ║
  199. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  200. ║                                                                            ║
  201. ║ Use:                                                                       ║
  202. ║                                                                            ║
  203. ╙────────────────────────────────────────────────────────────────────────────╜
  204. }
  205. procedure couleur;
  206. var i:byte;
  207. begin
  208. { Restore original colors to the palette. The default colors might vary
  209.    depending upon the initial values used by your video system.}
  210.   for i := 0 to 15 do
  211.     with Colors[i] do
  212.       SetRGBPalette(ColorNum, RedVal, GreenVal, BlueVal);
  213. end;
  214. {
  215. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  216. ║        PROCEDURE _save_colors()     │ │                           by XTech ║
  217. ║                                     │ │                           15/04/95 ║
  218. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  219. ║                                                                            ║
  220. ║ Use:                                                                       ║
  221. ║                                                                            ║
  222. ╙────────────────────────────────────────────────────────────────────────────╜
  223. }
  224. procedure _save_colors;
  225. begin
  226.  BG_save_color:=getcolor;
  227.  BG_save_BK:=getbkcolor;
  228. end;
  229. {
  230. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  231. ║        PROCEDURE _restore_colors()  │ │                           by XTech ║
  232. ║                                     │ │                           15/04/95 ║
  233. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  234. ║                                                                            ║
  235. ║ Use:                                                                       ║
  236. ║                                                                            ║
  237. ╙────────────────────────────────────────────────────────────────────────────╜
  238. }
  239. procedure _restore_colors;
  240. begin
  241.  setcolor(BG_save_color);
  242.  setbkcolor(BG_save_BK);
  243. end;
  244. {
  245. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  246. ║        PROCEDURE ()                 │ │                           by XTech ║
  247. ║                                     │ │                           00/00/95 ║
  248. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  249. ║                                                                            ║
  250. ║ Use:                                                                       ║
  251. ║                                                                            ║
  252. ╙────────────────────────────────────────────────────────────────────────────╜
  253. }
  254. procedure exicen(x,y:integer);
  255. begin
  256.  setcolor(lightblue);
  257.  setfillstyle(solidfill,blue);
  258.  bar(x+1,y+1,x+14,y+14);
  259.  setcolor(black);
  260.  line(x+15,y+1,x+15,y+15);
  261.  line(x+1,y+15,x+15,y+15);
  262.  setcolor(lightblue);
  263.  line(x+1,y,x+14,y);
  264.  line(x,y+1,x,y+15);
  265.  setcolor(black);
  266.  line(x+3,y+3,x+13,y+3);
  267.  line(x+3,y+3,x+8,y+13);
  268.  line(x+8,y+13,x+13,y+3);
  269.  setcolor(lightblue);
  270.  line(x+8,y+13,x+13,y+3);
  271. end;
  272. {
  273. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  274. ║        PROCEDURE ()                 │ │                           by XTech ║
  275. ║                                     │ │                           00/00/95 ║
  276. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  277. ║                                                                            ║
  278. ║ Use:                                                                       ║
  279. ║                                                                            ║
  280. ╙────────────────────────────────────────────────────────────────────────────╜
  281. }
  282. procedure CADRE(x1,y1,x2,y2:word;color:byte);
  283. var i:integer;
  284. begin
  285.  SetLineStyle(SolidLn, 0, NormWidth);
  286.  setcolor(color);
  287.  for i:=0 to 4 do
  288.   begin
  289.    rectangle(x1+i,y1+i,x2-i,y2-i);
  290.   end;
  291.  setcolor(light(color));
  292.  rect_relief_sup(x1,y1,x2,y2,color);
  293. end;
  294. {
  295. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  296. ║        PROCEDURE exist()            │ │                           by XTech ║
  297. ║                                     │ │                           16/04/95 ║
  298. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  299. ║                                                                            ║
  300. ║ Use:                                                                       ║
  301. ║                                                                            ║
  302. ╙────────────────────────────────────────────────────────────────────────────╜
  303. }
  304. function exist(fic:string):boolean;
  305. var f:file of byte;
  306. begin
  307.  assign(f,fic);
  308.  {$I-}reset(f);{$I+}
  309.  if IOresult=0 then
  310.   begin
  311.    close(f);
  312.    exist:=true;
  313.   end
  314.  else
  315.   exist:=false;
  316. end;
  317. {
  318. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  319. ║        PROCEDURE get_middle_screen_x│ │                           by XTech ║
  320. ║                                     │ │                           16/04/95 ║
  321. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  322. ║                                                                            ║
  323. ║ Use: Renvoie le milieu de l'écran graphique sur X                          ║
  324. ║                                                                            ║
  325. ╙────────────────────────────────────────────────────────────────────────────╜
  326. }
  327. function get_middle_screen_x:integer;
  328. begin
  329.  get_middle_screen_x:=(GetMaxX div 2)
  330. end;
  331. {
  332. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  333. ║        PROCEDURE get_middle_screen_Y│ │                           by XTech ║
  334. ║                                     │ │                           16/04/95 ║
  335. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  336. ║                                                                            ║
  337. ║ Use: Renvoie le milieu de l'écran graphique sur Y                          ║
  338. ║                                                                            ║
  339. ╙────────────────────────────────────────────────────────────────────────────╜
  340. }
  341. function get_middle_screen_y:integer;
  342. begin
  343.  get_middle_screen_y:=(GetMaxY div 2)
  344. end;
  345.  
  346. {══════[ Ecrit en relief et souligné]═══════════════════════════════20/05/95═}
  347. procedure Ecrit_(x,y:word;mot:string;souligne:boolean);
  348. var xxx:integer;
  349.      mt:string;
  350.  j,i,cl:integer;
  351. begin
  352.  mt:=mot;
  353.  
  354.  if pos('~',mot)>0 then
  355.    delete(mot,pos('~',mot),1);
  356.  
  357.  cl:=getcolor;
  358.  setcolor(black);
  359.  outtextxy(x+1,y+1,mot);
  360.  if souligne then
  361.    line(x+1,y+2,x+textwidth(mot)+1,y+2);
  362.  setcolor(cl);
  363.  outtextxy(x,y,mot);
  364.  if souligne then
  365.    line(x,y+1,x+textwidth(mot),y+1);
  366.  if pos('~',mt)>0 then
  367.    begin
  368.      setcolor(lightgreen);
  369.      outtextxy(x+textwidth( copy(mot,1, pos('~',mt) -1) ),y,mot[pos('~',mt)]);
  370.      line(x+textwidth( copy(mot,1, pos('~',mt) -1) ),y+9,x+textwidth( copy(mot,1, pos('~',mt) ) ),y+9);
  371.    end;
  372.  setcolor(cl);
  373. end;
  374.  
  375. {══════[ Cadre de titre ]═══════════════════════════════════════════20/05/95═}
  376. procedure cadre_title(x1,y1,x2,y2:word;color:byte;titre:string;t_c:byte);
  377.  
  378. begin
  379.  setcolor(black);
  380.  line(x1+6-1,y1-1,x1-1,y1-1);
  381.  line(x1-1,y1-1,x1-1,y2+1);
  382.  line(x1-1,y2+1,x2+1,y2+1);
  383.  line(x2+1,y2+1,x2+1,y1-1);
  384.  line(x2+1,y1-1,x1+6-1+6+textwidth(titre),y1-1);
  385.  
  386.  setcolor(color);
  387.  line(x1+6,y1,x1,y1);
  388.  line(x1,y1,x1,y2+1);
  389.  line(x1,y2+2,x2+2,y2+2);
  390.  line(x2+2,y2+2,x2+2,y1);
  391.  line(x2,y1,x1+6+6+textwidth(titre),y1);
  392.  
  393.  setcolor(t_c);
  394.  ecrit_(x1+10,y1-textheight(titre) div 2,titre,false);
  395.  
  396. end;
  397.  
  398. {
  399. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  400. ║        PROCEDURE ()                 │ │                           by XTech ║
  401. ║                                     │ │                           00/00/95 ║
  402. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  403. ║                                                                            ║
  404. ║ Use:                                                                       ║
  405. ║                                                                            ║
  406. ╙────────────────────────────────────────────────────────────────────────────╜
  407. }
  408. function file_open(color:byte;init_string:string):string;
  409. var file_name,fic:string;
  410. begin
  411.  a_win(105,125,430,400,color,true,'-= Ouvrir =-',false);
  412.  SetTextStyle(DefaultFont, HorizDir, 1);
  413.  outtextXY(112,155,'Ouvrir');
  414.  file_name:=init_string;
  415.  affiche_file(112,181,424,394,color,file_name);
  416.  REPEAT
  417.  REPEAT
  418.   fic:=input(112,165,424,color,file_name);
  419.   if fic=#13 then file_name:=BGfile_open(color,file_name);
  420.  UNTIL ((pos('*',file_name)<=0)){and (file_name<>''));}
  421.  UNTIL (exist(file_name));
  422.  
  423.  file_open:=file_name;
  424.  windc;
  425. end;
  426. {
  427. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  428. ║        PROCEDURE ()                 │ │                           by XTech ║
  429. ║                                     │ │                           00/00/95 ║
  430. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  431. ║                                                                            ║
  432. ║ Use:                                                                       ║
  433. ║                                                                            ║
  434. ╙────────────────────────────────────────────────────────────────────────────╜
  435. }
  436. function file_open_(color:byte;init_string:string):string;
  437. var file_name,fic:string;
  438. begin
  439.  static_win(95,135,440,410,color,true);
  440.  title_cadre(104,151,431,401,blue,'Ouvrir');
  441.  file_name:=init_string;
  442.  affiche_file(112,181,424,394,color,file_name);
  443.  
  444.  REPEAT
  445.  REPEAT
  446.   fic:=input(112,165,424,color,file_name);
  447.   if fic=#13 then file_name:=BGfile_open(color,file_name)
  448.    else
  449.   begin
  450.    file_name:=fic;
  451.    affiche_file(112,181,424,394,color,file_name);
  452.   end;
  453.  UNTIL ((pos('*',fic)<=0)) ; {and (file_name<>''));}
  454.  UNTIL (exist(fic));
  455.  
  456.  file_open_:=fic;
  457.  statc;
  458. end;
  459. {
  460. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  461. ║        PROCEDURE ()                 │ │                           by XTech ║
  462. ║                                     │ │                           00/00/95 ║
  463. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  464. ║                                                                            ║
  465. ║ Use:                                                                       ║
  466. ║                                                                            ║
  467. ╙────────────────────────────────────────────────────────────────────────────╜
  468. }
  469. procedure static_line(x1,y1,x2:word;color:byte);
  470. begin
  471.  SetLineStyle(SolidLn, 0, NormWidth);
  472.  if (color=8) then setcolor(color-1)
  473.   else
  474.  setcolor(color+8);
  475.  line(x1,y1,x2,y1);
  476.  setcolor(black);
  477.  line(x1,y1+1,x2-1,y1+1);
  478. end;
  479. {
  480. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  481. ║        PROCEDURE ()                 │ │                           by XTech ║
  482. ║                                     │ │                           00/00/95 ║
  483. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  484. ║                                                                            ║
  485. ║ Use:                                                                       ║
  486. ║                                                                            ║
  487. ╙────────────────────────────────────────────────────────────────────────────╜
  488. }
  489. procedure static_win(x1,y1,x2,y2:word;color:byte;savewin:boolean);
  490. var i : integer;
  491. begin
  492.  if savewin then
  493.   begin
  494.    mx2:=x1;my2:=y1;
  495.    Size2 := ImageSize(x1,y1,x2,y2);
  496.    GetMem(P2, Size2);
  497.    GetImage(x1,y1,x2,y2,P2^);
  498.    open_win2:=true;
  499.   end;
  500.  SetLineStyle(SolidLn, 0, NormWidth);
  501.  setcolor(blue);
  502.  for i:=0 to 2 do
  503.   rectangle(x1+i,y1+i,x2-i,y2-i);
  504.  setfillstyle(solidfill,color);
  505.  setcolor(color);
  506.  bar(x1+3,y1+3,x2-3,y2-3);
  507.  {relief bord sup}
  508.  setcolor(lightblue);
  509.  line(x1,y1,x2,y1);
  510.  line(x1,y1,x1,y2);
  511.  {relief bord inf}
  512.  setcolor(black);
  513.  line(x1,y2,x2,y2);
  514.  line(x2,y1,x2,y2);
  515.  {relief interieur inf}
  516.  setcolor(lightblue);
  517.  line(x1+2,y2-2,x2-2,y2-2);
  518.  line(x2-2,y1+2,x2-2,y2-2);
  519.  {relief interieur sup}
  520.  setcolor(black);
  521.  line(x1+2,y1+2,x2-2,y1+2);
  522.  line(x1+2,y1+2,x1+2,y2-2);
  523. end;
  524. {
  525. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  526. ║        PROCEDURE ()                 │ │                           by XTech ║
  527. ║                                     │ │                           00/00/95 ║
  528. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  529. ║                                                                            ║
  530. ║ Use:                                                                       ║
  531. ║                                                                            ║
  532. ╙────────────────────────────────────────────────────────────────────────────╜
  533. }
  534. procedure StatC;
  535.  begin;
  536.    if open_win2 then
  537.     begin
  538.      PutImage(mx2,my2, P2^, NormalPut);
  539.      freemem(P2,size2);
  540.      open_win2:=false;
  541.     end;
  542.  end;
  543. {
  544. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  545. ║        PROCEDURE ()                 │ │                           by XTech ║
  546. ║                                     │ │                           00/00/95 ║
  547. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  548. ║                                                                            ║
  549. ║ Use:                                                                       ║
  550. ║                                                                            ║
  551. ╙────────────────────────────────────────────────────────────────────────────╜
  552. }
  553. procedure rect_relief_inf(x1,y1,x2,y2:word;color:byte);
  554. begin
  555.  setcolor(light(color));
  556.  line(x1+1,y2,x2,y2);
  557.  line(x2,y1+1,x2,y2);
  558. end;
  559. {
  560. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  561. ║        PROCEDURE ()                 │ │                           by XTech ║
  562. ║                                     │ │                           00/00/95 ║
  563. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  564. ║                                                                            ║
  565. ║ Use:                                                                       ║
  566. ║                                                                            ║
  567. ╙────────────────────────────────────────────────────────────────────────────╜
  568. }
  569. procedure rect_relief_sup(x1,y1,x2,y2:word;color:byte);
  570. begin
  571.  setcolor(light(color));
  572.  line(x1,y1,x2,y1);
  573.  line(x1,y1,x1,y2);
  574. end;
  575. {
  576. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  577. ║        PROCEDURE ()                 │ │                           by XTech ║
  578. ║                                     │ │                           00/00/95 ║
  579. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  580. ║                                                                            ║
  581. ║ Use:                                                                       ║
  582. ║                                                                            ║
  583. ╙────────────────────────────────────────────────────────────────────────────╜
  584. }
  585. procedure affiche_file(x1,y1,x2,y2:word;color:byte;var file_name:string);
  586. var
  587.  DirInfo : searchrec;
  588.    count : integer;
  589.      ord : integer;
  590. begin
  591.  SetLineStyle(SolidLn, 0, NormWidth);
  592.  setfillstyle(solidfill,black);
  593.  setcolor(black);
  594.  bar(x1,y1,x2,y2);
  595.  rect_relief_inf(x1,y1,x2,y2,color);
  596.  
  597.  setcolor(white);
  598.  FindFirst('*.*', Directory, DirInfo);
  599.  count:=0;
  600.  ord:=0;
  601.  while (DosError = 0) do
  602.  begin
  603.    if (((dirinfo.attr and directory)<>0)and (dirinfo.name<>'.')) then
  604.     begin
  605.      outtextXY(x1+2+ord,y1+5+count,DirInfo.Name+'\');
  606.      FindNext(DirInfo);
  607.      inc(count,textheight('F'));
  608.      if ((count+y1+5)>=(y2-4)) then
  609.       begin
  610.        inc(ord,textwidth('FICHIERS.MAX '));
  611.        if ((ord+x1+textwidth('FICHIERS.MAX'))>(x2)) then exit;
  612.        count:=0;
  613.       end;
  614.     end;
  615.    FindNext(DirInfo);
  616.  end;
  617.  FindFirst(file_name, Anyfile, DirInfo);
  618.  while DosError = 0 do
  619.  begin
  620.    outtextXY(x1+2+ord,y1+5+count,DirInfo.Name);
  621.    FindNext(DirInfo);
  622.    inc(count,textheight('F'));
  623.    if ((count+y1+5)>=(y2-4)) then
  624.     begin
  625.      inc(ord,textwidth('FICHIERS.MAX '));
  626.      if ((ord+x1+textwidth('FICHIERS.MAX'))>(x2)) then exit;
  627.      count:=0;
  628.     end;
  629.  end;
  630.  if ((ord=0)and(count=0)) then outtextXY(x1+(x2-x1) div 2-textwidth('No File Found') div 2,
  631.      y1+((y2-y1) div 2)-textheight('N') div 2,'No File Found');
  632.  
  633. end;
  634. {****************************************************************************}
  635. function Max(x,y:integer):integer;
  636. begin
  637.  if (x>y) then max:=x else max:=y;
  638. end;
  639. function Min(x,y:integer):integer;
  640. begin
  641.  if (x<y) then min:=x else min:=y;
  642. end;
  643. {****************************************************************************}
  644. {
  645. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  646. ║        PROCEDURE ()                 │ │                           by XTech ║
  647. ║                                     │ │                           00/00/95 ║
  648. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  649. ║                                                                            ║
  650. ║ Use:                                                                       ║
  651. ║                                                                            ║
  652. ╙────────────────────────────────────────────────────────────────────────────╜
  653. }
  654. function BGchoose_file(x1,y1,x2,y2:word;color:byte;var file_name:string):string;
  655. type
  656.  string12=string[12];
  657. var
  658.  DirInfo : searchrec;
  659.    count : integer;
  660.      ord : integer;
  661.      lig : integer;
  662.  fichiers: ARRAY[0..400] of ^string12;
  663.  Max_fich: word;
  664.  col_ref : integer;
  665.       pc : byte;
  666.  col_rel : integer;
  667.      key : char;
  668.        i : integer;
  669.   nb_col : integer;
  670. {procedure Interne}
  671. procedure bar_(pc:byte;pos:boolean);
  672. var  ofs : word;
  673. begin
  674.  ofs:=col_rel*textwidth('FICHIERS.MAX ');
  675.  if pos then SetFillStyle(solidFill, light(color))
  676.   else
  677.     SetFillStyle(solidFill, black);
  678.  
  679.  bar(x1+2+ofs,y1+4+pc*(textheight('I')),
  680.      x1+textwidth('FICHIERS.MAX')+ofs+4,y1+4+(pc+1)*(textheight('I')));
  681.  
  682.  if pos then
  683.   begin
  684.    setcolor(white);
  685.    outtextXY(x1+2+1+ofs,y1+5+pc*(textheight('I')),fichiers[pc+(col_ref+col_rel)*26]^);
  686.   end
  687.  else
  688.   begin
  689.    setcolor(white);
  690.    outtextXY(x1+2+ofs,y1+5+pc*(textheight('I')),fichiers[pc+(col_ref+col_rel)*26]^);
  691.   end;
  692. end;
  693. {Procedure Interne}
  694. procedure Maj(count:word);
  695. var ii:integer;
  696. begin
  697.  setcolor(black);
  698.  bar(x1,y1,x2,y2);
  699.  rect_relief_inf(x1,y1,x2,y2,color);
  700.  setcolor(white);
  701.  if count=1 then count:=0;
  702.  lig:=0;
  703.  ord:=0;
  704.  for ii:=count to Min(count+104,Max_fich) do
  705.  begin
  706.    outtextXY(x1+2+ord,y1+5+lig,fichiers[ii]^);
  707. {   FindNext(DirInfo);}
  708.    inc(lig,textheight('I'));
  709.    if ((lig+y1+5)>=(y2-4)) then
  710.     begin
  711.      inc(ord,textwidth('FICHIERS.MAX '));
  712.      if ((ord+x1+textwidth('FICHIERS.MAX'))>(x2)) then exit;
  713.      lig:=0;
  714.     end;
  715.  end;
  716. end;
  717.  
  718. begin
  719.  
  720.  for i:=0 to 400 do new(fichiers[i]);
  721.  SetTextStyle(DefaultFont, HorizDir, 1);
  722.  SetLineStyle(SolidLn, 0, NormWidth);
  723.  setfillstyle(solidfill,black);
  724.  setcolor(black);
  725.  bar(x1,y1,x2,y2);
  726.  rect_relief_inf(x1,y1,x2,y2,color);
  727.  setcolor(white);
  728.  
  729.  FindFirst('*.*', Directory, DirInfo);
  730.  Max_fich:=0;
  731.  while ((DosError = 0)and(max_fich<400)) do
  732.  begin
  733.    if (((dirinfo.attr and directory)<>0)and (dirinfo.name<>'.')) then
  734.     begin
  735.      fichiers[Max_fich]^:=DirInfo.Name+'\';
  736.      inc(Max_fich);
  737.     end;
  738.    FindNext(DirInfo);
  739.  end;
  740.  
  741.  FindFirst(file_name, Anyfile, DirInfo);
  742.  while ((DosError = 0)and(max_fich<400)) do
  743.  begin
  744.    if (dirinfo.attr and directory)=0 then
  745.     begin
  746.      fichiers[Max_fich]^:=DirInfo.Name;
  747.      inc(Max_fich);
  748.     end;
  749.    FindNext(DirInfo);
  750.  end;
  751.  dec(Max_fich);
  752.  maj(0); {init screen}
  753. {*}
  754.  pc:=0;
  755.  col_rel:=0;
  756.  col_ref:=0;
  757.  bar_(pc,true);
  758.  repeat
  759.   key:=readkey;
  760.   bar_(pc,false);
  761.  
  762.   if key=#27 then {ESCAPE}
  763.    begin
  764.     pc:=0;
  765.     key:=#13;
  766.    end
  767.   else
  768.   if key=#0 then
  769.    begin
  770.     key:=readkey;
  771.    CASE key of
  772.     #71 : begin
  773.            pc:=0; {home}
  774.            col_rel:=0;
  775.            col_ref:=0;
  776.            maj(col_ref);
  777.           end;
  778.     #72 : begin {up}
  779.            if pc=0 then
  780.             begin
  781.              if col_rel>0 then
  782.               begin
  783.                dec(col_rel);
  784.                pc:=25;
  785.               end
  786.              else
  787.             if (col_ref>0) then
  788.               begin
  789.                dec(col_ref);
  790.                maj(col_ref*25+1);
  791.                col_rel:=0;
  792.                pc:=25;
  793.               end;
  794.             end
  795.            else
  796.             dec(pc);
  797.            bar_(pc,true);
  798.           end;
  799.     #73 : begin  {pgup}
  800.            pc:=0;
  801.           end;
  802.     #75 : begin  {à gauche}
  803.            if (col_rel>0) then
  804.             begin
  805.              dec(col_rel);
  806.             end
  807.            else
  808.             if (col_ref>0) then
  809.             begin
  810.              dec(col_ref);
  811.              col_rel:=0;
  812.              maj((col_ref)*26);
  813.             end;
  814.           end;
  815.     #77 : begin  {à droite}
  816.            if ((col_ref+col_rel+1)*26+pc)>(max_fich) then
  817.             if ((col_ref+col_rel)*26+pc)<>(max_fich) then
  818.               begin
  819.                nb_col:=(max_fich div 26);
  820.                pc:=(max_fich mod 26);
  821.                col_rel:=min(max_fich div 26,2);
  822.                if (nb_col-2)>0 then
  823.                 col_ref:=nb_col-2
  824.                else
  825.                 col_ref:=0;
  826.                 maj((col_ref)*26);
  827.                 bar_(pc,true);
  828.               end;
  829.  
  830.            if (col_rel<2) then
  831.             begin
  832.              if ((col_ref+col_rel+1)*26+pc)<=(max_fich) then
  833.               inc(col_rel)
  834.             end
  835.            else
  836.             begin
  837.              if (((col_ref+1)+2)*25+pc)<max_fich then
  838.              begin
  839.               inc(col_ref);
  840.               col_rel:=2;
  841.               maj((col_ref)*26);
  842.              end;
  843.             end;
  844.           end;
  845.  
  846.     #79 : begin  {fin}
  847.            nb_col:=(max_fich div 26);
  848.            pc:=(max_fich mod 26);
  849.            col_rel:=min(max_fich div 26,2);
  850.  
  851.            if (nb_col-2)>0 then
  852.             col_ref:=nb_col-2
  853.            else
  854.              col_ref:=0;
  855.  
  856.            maj((col_ref)*26);
  857.            bar_(pc,true);
  858.           end;
  859.  
  860.     #80 : begin {down}
  861.            if pc=25 then
  862.             begin
  863.              if col_rel<2 then
  864.               begin
  865.                inc(col_rel);
  866.                pc:=0;
  867.               end
  868.              else
  869.               begin
  870.                inc(col_ref);
  871.                maj(col_ref*25+1);
  872.                col_rel:=2;
  873.                pc:=0;
  874.               end;
  875.             end
  876.            else
  877.             begin
  878.              if ((col_rel+col_ref)<>(max_fich div 26)) then
  879.               inc(pc)
  880.              else
  881.               if (pc<>(max_fich mod 26)) then inc(pc);
  882.             end;
  883.            bar_(pc,true);
  884.           end;
  885.     #81 : begin  {pgdn}
  886.            if (col_rel+col_ref)<(max_fich div 26) then
  887.             pc:=25
  888.            else
  889.             pc:=(max_fich mod 26);
  890.           end;
  891.   end;{CASE}
  892.     end;
  893.   bar_(pc,true);
  894.  
  895.  
  896.  until (key=#13);
  897.  if ((ord=0)and(count=0)) then outtextXY(x1+(x2-x1) div 2-textwidth('No File Found') div 2,
  898.      y1+((y2-y1) div 2)-textheight('N') div 2,'No File Found');
  899.  BGchoose_file:=fichiers[pc+(col_ref+col_rel)*26]^;
  900.  for i:=0 to 400 do dispose(fichiers[i]);
  901. end;
  902. {****************************************************************************}
  903. {
  904. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  905. ║        PROCEDURE ()                 │ │                           by XTech ║
  906. ║                                     │ │                           00/00/95 ║
  907. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  908. ║                                                                            ║
  909. ║ Use:                                                                       ║
  910. ║                                                                            ║
  911. ╙────────────────────────────────────────────────────────────────────────────╜
  912. }
  913. function BGfile_open(color:byte;init_string:string):string;
  914. var file_name,fic:string;
  915.     f:file;
  916.     attr:word;
  917. begin
  918.  {static_win(95,135,440,410,color,true);
  919.  SetTextStyle(DefaultFont, HorizDir, 1);
  920.  outtextXY(112,155,'Ouvrir');           }
  921.  file_name:=init_string;
  922.  
  923.  repeat
  924.   fic:=BGchoose_file(112,181,424,394,color,file_name);
  925.   if pos('\',fic)<>0 then delete(fic,pos('\',fic),1);
  926.   Assign(F,fic);
  927.   GetFAttr(F, Attr);
  928.   if (attr and directory)<>0 then
  929.    {$i-}chdir(fic);{$i+}
  930.  until (attr and directory)=0;
  931.  BGfile_open:=fic;
  932. { StatC;}
  933. end;
  934. {
  935. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  936. ║        PROCEDURE ()                 │ │                           by XTech ║
  937. ║                                     │ │                           00/00/95 ║
  938. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  939. ║                                                                            ║
  940. ║ Use:                                                                       ║
  941. ║                                                                            ║
  942. ╙────────────────────────────────────────────────────────────────────────────╜
  943. }
  944. procedure plaque(x1,y1,x2,y2:word;color:byte);
  945. var i:integer;
  946. begin
  947.  setfillstyle(solidfill,color);
  948.  SetLineStyle(SolidLn, 0, NormWidth);
  949.  bar(x1+1,y1+1,x2-1,y2-1);
  950.  rect_relief_sup(x1+1,y1+1,x2-1,y2-1,color);
  951.  setcolor(black);
  952.  rectangle(x1,y1,x2,y2);
  953. end;
  954. {
  955. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  956. ║        PROCEDURE ()                 │ │                           by XTech ║
  957. ║                                     │ │                           00/00/95 ║
  958. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  959. ║                                                                            ║
  960. ║ Use:                                                                       ║
  961. ║                                                                            ║
  962. ╙────────────────────────────────────────────────────────────────────────────╜
  963. }
  964. procedure draw_ratio_box(x1,y1,x2:word;color:byte);
  965. var i:integer;
  966. begin
  967.  ratioX1:=x1;
  968.  ratioX2:=x2;
  969.  ratioY1:=y1;
  970.  setfillstyle(solidfill,black);
  971.  SetLineStyle(SolidLn, 0, NormWidth);
  972.  setcolor(black);
  973.  bar(x1,y1,x2,y1+15);
  974.  if (color=8) then setcolor(color-1)
  975.   else
  976.  setcolor(color+8);
  977.  line(x1+1,y1+15,x2,y1+15);
  978.  line(x2,y1+15,x2,y1+1);
  979. end;
  980. {
  981. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  982. ║        PROCEDURE ()                 │ │                           by XTech ║
  983. ║                                     │ │                           00/00/95 ║
  984. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  985. ║                                                                            ║
  986. ║ Use:                                                                       ║
  987. ║                                                                            ║
  988. ╙────────────────────────────────────────────────────────────────────────────╜
  989. }
  990. procedure pct_done(pct:word);
  991. begin
  992.  if ((pct>0) and (pct<=100)) then
  993.  begin
  994.   setfillstyle(solidfill,white);
  995.   bar(ratioX1+3,ratioY1+2,ratioX1+(((ratioX2-2)-ratioX1)*pct)div 100,ratioY1+13);
  996.  end;
  997. end;
  998. {
  999. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1000. ║        PROCEDURE input_box()        │ │                           by XTech ║
  1001. ║                                     │ │                           00/00/95 ║
  1002. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1003. ║                                                                            ║
  1004. ║ Use: Affiche une boite de saisie inactive.                                 ║
  1005. ║                                                                            ║
  1006. ╙────────────────────────────────────────────────────────────────────────────╜
  1007. }
  1008. procedure input_box(x1,y1,x2:word;color:byte;msg:string);
  1009. begin
  1010.  _save_colors;
  1011.  setfillstyle(solidfill,black);
  1012.  SetLineStyle(SolidLn, 0, NormWidth);
  1013.  setcolor(black);
  1014.  bar(x1,y1,x2,y1+15);
  1015.  
  1016.  setcolor(light(color));
  1017.  line(x1+1,y1+15,x2,y1+15);
  1018.  line(x2,y1+15,x2,y1+1);
  1019.  
  1020.  setcolor(white);
  1021.  outtextXY(x1+2,y1+5,msg);
  1022.  _restore_colors;
  1023. end;
  1024. {
  1025. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1026. ║        PROCEDURE text_input_box()   │ │                           by XTech ║
  1027. ║                                     │ │                           00/00/95 ║
  1028. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1029. ║                                                                            ║
  1030. ║ Use: Affiche titre+boite de saisie inactive.                               ║
  1031. ║                                                                            ║
  1032. ╙────────────────────────────────────────────────────────────────────────────╜
  1033. }
  1034. procedure text_input_box(x1,y1,x2:word;color:byte;message:string;color_msg:byte);
  1035. begin
  1036.  SetTextStyle(DefaultFont, HorizDir, 1);
  1037.  setcolor(color_msg);
  1038.  outtextXY(x1,y1,message);
  1039.  input_box(x1+10+textwidth(message),y1-5,x2-3,color,'');
  1040. end;
  1041. {
  1042. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1043. ║        PROCEDURE text_input()       │ │                           by XTech ║
  1044. ║                                     │ │                           00/00/95 ║
  1045. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1046. ║                                                                            ║
  1047. ║ Use: affiche titre+boite de saisie active.                                 ║
  1048. ║                                                                            ║
  1049. ╙────────────────────────────────────────────────────────────────────────────╜
  1050. }
  1051. function text_input(x1,y1,x2:word;color:byte;message:string):string;
  1052. begin
  1053.  SetTextStyle(DefaultFont, HorizDir, 1);
  1054.  setcolor(White);
  1055.  outtextXY(x1,y1,message);
  1056.  text_input:=input(x1+10+textwidth(message),y1-5,x2-3,color,'');
  1057. end;
  1058. {
  1059. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1060. ║        PROCEDURE Input()            │ │                           by XTech ║
  1061. ║                                     │ │                           00/00/95 ║
  1062. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1063. ║                                                                            ║
  1064. ║ Use: Lit un STRING dans une boite de saisie.                               ║
  1065. ║                                                                            ║
  1066. ╙────────────────────────────────────────────────────────────────────────────╜
  1067. }
  1068. function input(x1,y1,x2:word;color:byte;mot:string):string;
  1069. var key:char;
  1070.     bs,oldstr:string;
  1071.     PC:byte;
  1072. {Procedure Interne}
  1073. procedure clear_pc;
  1074. begin
  1075.  setcolor(black);
  1076.  outtextXY(x1+2+textwidth(copy(mot,1,pc)),y1+7,'_');
  1077. end;
  1078. {Procedure Interne}
  1079. procedure clear_box;
  1080. begin
  1081.  bar(x1+2,y1+2,x2-2,y1+13);
  1082. end;
  1083. {Début}
  1084. begin
  1085.  _save_colors;
  1086.  setfillstyle(solidfill,black);
  1087.  SetLineStyle(SolidLn, 0, NormWidth);
  1088.  setcolor(black);
  1089.  bar(x1,y1,x2,y1+15);
  1090.  
  1091.  if (color=8) then setcolor(color-1)
  1092.   else
  1093.  setcolor(color+8);{relief inf}
  1094.  line(x1+1,y1+15,x2,y1+15);
  1095.  line(x2,y1+15,x2,y1+1);
  1096.  
  1097.  SetTextStyle(DefaultFont, HorizDir, 1);
  1098.  setcolor(White+blink);
  1099.  oldstr:=mot;
  1100.  pc:=0{length(mot)};
  1101.  
  1102.  repeat
  1103.   setcolor(white);
  1104.   outtextXY(x1+2,y1+5,mot);
  1105.   setcolor(white);
  1106.   outtextXY(x1+2+textwidth(copy(mot,1,pc)),y1+7,'_');
  1107.   key:=readkey;
  1108.   clear_pc;
  1109.  
  1110.   if key=#27 then {ESCAPE}
  1111.    begin
  1112.     mot:='';
  1113.     key:=#13;
  1114.    end
  1115.   else
  1116.   if key=#8 then {efface un caractere à gauche du curseur}
  1117.    begin
  1118.     clear_box;
  1119.     delete(mot,pc,1);
  1120.     dec(pc);
  1121.    end
  1122.   else
  1123.   if key=#9 then {TAB}
  1124.    begin
  1125.     mot:=#13;
  1126.     key:=#13;
  1127.    end
  1128.   else
  1129.    if key=#0 then
  1130.    begin
  1131.     key:=readkey;
  1132.    CASE key of
  1133.     #71 : pc:=0; {home}
  1134.     #72 : begin
  1135.            clear_box;
  1136.            if mot<>'' then oldstr:=mot;
  1137.            mot:='';
  1138.            pc:=0;
  1139.           end;
  1140.     #75 :  begin{Fg}
  1141.             setcolor(white);
  1142.             if (pc>0) then
  1143.              begin
  1144.               dec(pc);
  1145.               outtextXY(x1+2+textwidth(copy(mot,1,pc)),y1+7,'_');
  1146.              end;
  1147.            end;
  1148.     #77 : begin{Fd}
  1149.            setcolor(white);
  1150.            if (pc<length(mot)) then
  1151.             begin
  1152.              inc(pc);
  1153.              outtextXY(x1+2+textwidth(copy(mot,1,pc)),y1+7,'_');
  1154.             end;
  1155.           end;
  1156.     #79 : pc:=length(mot);{fin}
  1157.  
  1158.     #80 : begin {down}
  1159.            clear_box;
  1160.            mot:=oldstr;
  1161.            pc:=length(mot);
  1162.           end;
  1163.     #83 : begin{suppr}
  1164.            clear_box;
  1165.            delete(mot,pc+1,1);
  1166.           end;
  1167.    end;{CASE}
  1168.     end
  1169.   else
  1170.    if (((ord(key)>32) and (ord(key)<127))and ((x1+2+textwidth(mot))<(x2-15))) then
  1171.     begin
  1172.      if (pc=length(mot)) then
  1173.       begin
  1174.        mot:=mot+key;
  1175.        inc(pc);
  1176.       end
  1177.      else
  1178.       begin
  1179.        insert(key,mot,pc+1);
  1180.        inc(pc);
  1181.        clear_box;
  1182.       end;
  1183.     end;
  1184.  until (key=#13);
  1185.  input:=mot;
  1186.  _restore_colors;
  1187. end;
  1188. {
  1189. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1190. ║        PROCEDURE ()                 │ │                           by XTech ║
  1191. ║                                     │ │                           00/00/95 ║
  1192. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1193. ║                                                                            ║
  1194. ║ Use:                                                                       ║
  1195. ║                                                                            ║
  1196. ╙────────────────────────────────────────────────────────────────────────────╜
  1197. }
  1198. procedure a_win(x1,y1,x2,y2:word;color:byte;savewin:boolean;msg:string;special:boolean);
  1199. var i : integer;
  1200.     FillInfo: FillSettingsType;
  1201.     mx,my:integer;
  1202. begin
  1203.   if savewin then
  1204.   begin
  1205.    mx1:=x1;my1:=y1-20;
  1206.    mx:=x2+5;my:=y2+5;
  1207.    Size_1 := ImageSize(mx1,my1,mx,my);
  1208.    GetMem(P1, Size_1);
  1209.    GetImage(mx1,my1,mx,my,P1^);
  1210.    open_win1:=true;
  1211.   end;
  1212.  GetFillSettings(FillInfo);    {save fill style and color}
  1213.  SetLineStyle(SolidLn, 0, NormWidth);
  1214.  if not(special) then
  1215.  begin
  1216.   setcolor(blue);
  1217.   for i:=0 to 2 do
  1218.    begin
  1219.     rectangle(x1+i,y1+i,x2-i,y2-i);
  1220.    end;
  1221.   setcolor(lightblue);
  1222.   rect_relief_sup(x1,y1,x2,y2,blue);
  1223.  end
  1224.   else
  1225.  begin
  1226.   SetFillStyle(solidFill,black);  {  New style}
  1227.   bar(x1,y1,x2,y2);
  1228.   SetFillStyle(slashFill, yellow);  {  New style}
  1229.   setcolor(blue);
  1230.   rectangle(x1,y1,x2,y2);
  1231.   floodfill(x1+1,y1+1,blue);
  1232.   setcolor(lightblue);
  1233.   rect_relief_sup(x1,y1,x2,y2,black);
  1234.  end;
  1235.  plaque(x1+3,y1+3,x2-3,y1+20+3,color);
  1236.  exicen(x1+6,y1+6);
  1237.  plaque(x1+3,y1+20+3+1,x2-3,y2-3,color);
  1238.  setcolor(black);
  1239.  line(x1,y2,x2,y2);
  1240.  line(x2,y1,x2,y2);
  1241.  setcolor(white);                {texte message}
  1242.  settextstyle(TripleXFont,horizdir,1);
  1243.  outtextxy(x1+3+(((x2-x1)div 2)-(textwidth(msg)div 2)),y1+2,msg);
  1244.  with FillInfo do
  1245.   SetFillStyle(Pattern, Color);   { Restore old fill style }
  1246. end;
  1247. {
  1248. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1249. ║        PROCEDURE ()                 │ │                           by XTech ║
  1250. ║                                     │ │                           00/00/95 ║
  1251. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1252. ║                                                                            ║
  1253. ║ Use:                                                                       ║
  1254. ║                                                                            ║
  1255. ╙────────────────────────────────────────────────────────────────────────────╜
  1256. }
  1257. procedure Windc;
  1258.  begin;
  1259.    if open_win1 then
  1260.     begin
  1261.      PutImage(mx1,my1, P1^, NormalPut);
  1262.      freemem(P1,size_1);
  1263.      open_win1:=false;
  1264.     end;
  1265.  end;
  1266. {
  1267. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1268. ║        PROCEDURE press_button()     │ │                           by XTech ║
  1269. ║                                     │ │                           00/00/95 ║
  1270. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1271. ║                                                                            ║
  1272. ║ Use: Enfonce un bouton.                                                    ║
  1273. ║                                                                            ║
  1274. ╙────────────────────────────────────────────────────────────────────────────╜
  1275. }
  1276. procedure press_button(x1,y1,long,larg:word;color:byte;txt:string);
  1277. var x,y:integer;
  1278.      mt:string;
  1279. begin
  1280.  _save_colors;
  1281.  mt:=txt;
  1282.  if pos('~',txt)>0 then
  1283.    delete(txt,pos('~',txt),1);
  1284.  SetTextStyle(DefaultFont, HorizDir, 1);
  1285.  SetFillStyle(solidfill,color);
  1286.  SetLineStyle(SolidLn, 0, NormWidth);
  1287.  bar(x1+2,y1+2,x1+long-2,y1+larg-2);
  1288.  setcolor(color);
  1289.  line(x1,y1,x1+long,y1);
  1290.  line(x1,y1,x1,y1+larg);
  1291.  setcolor(light(color));
  1292.  line(x1+1,y1+larg,x1+long,y1+larg);
  1293.  line(x1+long,y1+1,x1+long,y1+larg);
  1294.  setcolor(white);
  1295.  x:=x1+2+(((long)div 2)-(textwidth(txt)div 2))+1;
  1296.  y:=y1+(((larg)div 2)-(textheight('I')div 2))+1;
  1297.  outtextxy(x,y,txt);
  1298.  if pos('~',mt)>0 then
  1299.    begin
  1300.      setcolor(lightgreen);
  1301.      outtextxy(x+textwidth( copy(txt,1, pos('~',mt) -1) ),y,txt[pos('~',mt)]);
  1302.      line(x+textwidth( copy(txt,1, pos('~',mt) -1) ),y+9,x+textwidth( copy(txt,1, pos('~',mt) ) ),y+9);
  1303.    end;
  1304.  _restore_colors;
  1305. end;
  1306. {
  1307. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1308. ║        PROCEDURE draw_button()      │ │                           by XTech ║
  1309. ║                                     │ │                           00/00/95 ║
  1310. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1311. ║                                                                            ║
  1312. ║ Use: Dessine un bouton.                                                    ║
  1313. ║                                                                            ║
  1314. ╙────────────────────────────────────────────────────────────────────────────╜
  1315. }
  1316. procedure draw_button(x1,y1,long,larg:word;color:byte;txt:string);
  1317. var mt:string;
  1318.    x,y:integer;
  1319. begin
  1320.  _save_colors;
  1321.  mt:=txt;
  1322.  if pos('~',txt)>0 then
  1323.    delete(txt,pos('~',txt),1);
  1324.  
  1325.  setfillstyle(solidfill,color);
  1326.  SetLineStyle(SolidLn, 0, NormWidth);
  1327.  SetTextStyle(DefaultFont, HorizDir, 1);
  1328.  bar(x1,y1,x1+long,y1+larg);
  1329.  setcolor(black);
  1330.  rectangle(x1-1,y1-1,x1+long+1,y1+larg+1);
  1331.  {relief du bouton}
  1332.  setcolor(light(color));
  1333.  line(x1,y1,x1+long,y1);
  1334.  line(x1,y1,x1,y1+larg);
  1335. { setcolor(darkgray);
  1336.  line(x1+1,y2,x2,y2);
  1337.  line(x2,y1+1,x2,y2);
  1338.  {}
  1339.  setcolor(white);
  1340.  x:=x1+2+(((long)div 2)-(textwidth(txt)div 2));
  1341.  y:=y1+(((larg)div 2)-(textheight(txt)div 2));
  1342.  outtextxy(x,y,txt);
  1343.  if pos('~',mt)>0 then
  1344.    begin
  1345.      setcolor(lightgreen);
  1346.      outtextxy(x+textwidth( copy(txt,1, pos('~',mt) -1) ),y,txt[pos('~',mt)]);
  1347.      line(x+textwidth( copy(txt,1, pos('~',mt) -1) ),y+9,x+textwidth( copy(txt,1, pos('~',mt) ) ),y+9);
  1348.    end;
  1349.  _restore_colors;
  1350. end;
  1351. {
  1352. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1353. ║        PROCEDURE ()                 │ │                           by XTech ║
  1354. ║                                     │ │                           00/00/95 ║
  1355. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1356. ║                                                                            ║
  1357. ║ Use:                                                                       ║
  1358. ║                                                                            ║
  1359. ╙────────────────────────────────────────────────────────────────────────────╜
  1360. }
  1361. procedure title_cadre(x1,y1,x2,y2:word;color:byte;title:string);
  1362. begin
  1363.  SetLineStyle(SolidLn, 0, NormWidth);
  1364.  SetLineStyle(SolidLn, 0, NormWidth);
  1365.  SetTextStyle(DefaultFont, HorizDir, 1);
  1366.  setcolor(black);
  1367.  line(x1+8,y1,x1,y1);
  1368.  line(x1,y1,x1,y2);
  1369.  line(x1,y2,x2,y2);
  1370.  line(x2,y2,x2,y1);
  1371.  line(x2,y1,x1+(textwidth(title)+12)+2,y1);
  1372.  if (color=8) then setcolor(color-1)
  1373.   else
  1374.  setcolor(color+8);
  1375.  line(x1+9,y1+1,x1+1,y1+1);{partie sup}
  1376.  line(x1+1,y1+1,x1+1,y2-1);
  1377.  line(x2-1,y1+1,x1+(textwidth(title)+12)+2+1,y1+1);
  1378.  line(x1+1,y2+1,x2,y2+1); {partie inf}
  1379.  line(x2+1,y2+1,x2+1,y1+1);
  1380.  setcolor(darkgray);
  1381.  outtextXY(x1+12+1,y1-3+1,title);
  1382.  setcolor(white);
  1383.  outtextXY(x1+12,y1-3,title);
  1384. end;
  1385. {
  1386. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1387. ║        PROCEDURE ()                 │ │                           by XTech ║
  1388. ║                                     │ │                           00/00/95 ║
  1389. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1390. ║                                                                            ║
  1391. ║ Use:                                                                       ║
  1392. ║                                                                            ║
  1393. ╙────────────────────────────────────────────────────────────────────────────╜
  1394. }
  1395. function choice_box(x1,y1:word;p:pointer;size:byte;color:byte):word;
  1396. var x2,y2:word;
  1397.     pc   :byte;
  1398.     i    :byte;
  1399.     key  :char;
  1400.     sizei:integer;
  1401.     liste : array[0..100] of ^string;
  1402.     p3   : pointer;
  1403. {Procedure Interne}
  1404. procedure bar_(pc:byte;pos:boolean);
  1405. begin
  1406.  if pos then SetFillStyle(solidFill, light(color))
  1407.   else
  1408.     SetFillStyle(solidFill, color);
  1409.  bar(x1+2,y1+1+pc*(textheight('I')+2),x2-2,y1+1+(pc+1)*(textheight('I')+2));
  1410.  if pos then
  1411.   begin
  1412.    setcolor(white);
  1413.    line(x1+2,y1+1+pc*(textheight('I')+2),x2-2,y1+1+pc*(textheight('I')+2));
  1414.    setcolor(black);
  1415.    line(x1+2,y1+1+(pc+1)*(textheight('I')+2),x2-2,y1+1+(pc+1)*(textheight('I')+2));
  1416.    setcolor(white);
  1417.    outtextXY(x1+2+1,y1+2+pc*(textheight('I')+2)+1,liste[pc]^);
  1418.   end
  1419.  else
  1420.   begin
  1421.    setcolor(white);
  1422.    outtextXY(x1+2,y1+2+pc*(textheight('I')+2),liste[pc]^);
  1423.   end;
  1424.  
  1425. end;
  1426. begin
  1427.  SetLineStyle(SolidLn, 0, NormWidth);
  1428.  SetFillStyle(solidFill, black);
  1429.  SetTextStyle(DefaultFont,horizdir,1);
  1430.  x2:=x1+textwidth('GGGGGGGGGGGGGGGG');
  1431.  y2:=y1+(textheight('I')+4)*(size-1)+4;
  1432.    {sauve le cadre}
  1433.    Sizei := ImageSize(x1-2,y1-2,x2+2,y2+10+2);
  1434.    GetMem(P3, Sizei);
  1435.    GetImage(x1-2,y1-2,x2+2,y2+10+2,P3^);
  1436.    {}
  1437.  bar(x1,y1,x2,y2);
  1438.  
  1439.  setcolor(color);
  1440.  rectangle(x1-1,y1-1,x2+1,y2+1);
  1441.  rectangle(x1,y1,x2,y2);
  1442.  setcolor(black);
  1443.  rectangle(x1-2,y1-2,x2+2,y2+2);
  1444.  rect_relief_sup(x1-2,y1-2,x2+2,y2+2,color);
  1445.  
  1446.  SetFillStyle(solidFill, color);
  1447.  bar(x1+1,y1+1,x2-1,y2-1);
  1448.  pc:=0;
  1449.  setcolor(white);
  1450.  for i:=0 to size do new(liste[i]);
  1451.  for i:=0 to size do
  1452.   liste[i]:=ptr(seg(p^),ofs(p^)+256*i);
  1453.  
  1454.  for i:=0 to size do outtextXY(x1+2,y1+2+i*(textheight('I')+2),liste[i]^);
  1455.  bar_(pc,true);
  1456.  repeat
  1457.   key:=readkey;
  1458.   bar_(pc,false);
  1459.  
  1460.   if key=#27 then {ESCAPE}
  1461.    begin
  1462.     pc:=size+1;
  1463.     key:=#13;
  1464.    end
  1465.   else
  1466.   if key=#0 then
  1467.    begin
  1468.     key:=readkey;
  1469.    CASE key of
  1470.     #71 : pc:=0; {home}
  1471.     #72 : begin {up}
  1472.            if pc=0 then pc:=size
  1473.            else
  1474.             dec(pc);
  1475.            bar_(pc,true);
  1476.           end;
  1477.     #79 : begin
  1478.            pc:=size;{fin}
  1479.            bar_(pc,true);
  1480.           end;
  1481.     #80 : begin {down}
  1482.            inc(pc);
  1483.            if pc>size then pc:=0;
  1484.            bar_(pc,true);
  1485.           end;
  1486.   end;{CASE}
  1487.     end;
  1488.   bar_(pc,true);
  1489.  
  1490.  
  1491.  until (key=#13);
  1492. {for i:=0 to size do
  1493.  dispose(liste[i]);}
  1494.      PutImage(x1-2,y1-2, P3^, NormalPut);
  1495.      freemem(P3,sizei);
  1496.  choice_box:=pc;
  1497. end;
  1498. {══════[ Combo box off ]════════════════════════════════════════════21/05/95═}
  1499. procedure combof(x1,y1:word;color:byte);
  1500. var
  1501.         a,b : byte;
  1502.     Losange : array[1..4] of PointType;
  1503. begin
  1504.  a:=12;
  1505.  
  1506.  Losange[1].x:=x1-(a div 2)+2;
  1507.  Losange[1].y:=y1;
  1508.  
  1509.  Losange[2].x:=x1;
  1510.  Losange[2].y:=y1-(a div 2)+2;
  1511.  
  1512.  Losange[3].x:=x1+(a div 2)-2;
  1513.  Losange[3].y:=y1;
  1514.  
  1515.  Losange[4].x:=x1;
  1516.  Losange[4].y:=y1+(a div 2)-2;
  1517.  
  1518.  Setcolor(couleur_ppale);
  1519.  SetFillStyle(SolidFill,couleur_ppale);
  1520.  FillPoly(SizeOf(Losange) div SizeOf(PointType), Losange);
  1521.  
  1522.  setcolor(black);
  1523.  line(x1+a div 2,y1,x1,y1+a div 2);
  1524.  line((x1+a div 2)+1,y1,x1+1,y1+a div 2);
  1525.  line(x1,y1+a div 2,x1-a div 2,y1);
  1526.  
  1527.  setcolor(light(couleur_ppale));
  1528.  line(x1-a div 2,y1,x1,y1-a div 2);
  1529.  line((x1-a div 2)-1,y1,x1-1,y1-a div 2);
  1530.  line(x1,y1-a div 2,x1+a div 2,y1);
  1531.  
  1532. end;
  1533.  
  1534. {══════[ Combo box on ]═════════════════════════════════════════════21/05/95═}
  1535. procedure combon(x1,y1:word;color:byte);
  1536. var
  1537.         a,b : byte;
  1538.     Losange : array[1..4] of PointType;
  1539. begin
  1540.  a:=12;
  1541.  
  1542.  Losange[1].x:=x1-(a div 2)+2+1;
  1543.  Losange[1].y:=y1;
  1544.  
  1545.  Losange[2].x:=x1;
  1546.  Losange[2].y:=y1-(a div 2)+2+1;
  1547.  
  1548.  Losange[3].x:=x1+(a div 2)-2-1;
  1549.  Losange[3].y:=y1;
  1550.  
  1551.  Losange[4].x:=x1;
  1552.  Losange[4].y:=y1+(a div 2)-2-1;
  1553.  
  1554.  Setcolor(couleur_ppale);
  1555.  SetFillStyle(SolidFill,white);
  1556.  FillPoly(SizeOf(Losange) div SizeOf(PointType), Losange);
  1557.  
  1558. { relief interne
  1559.  setcolor(black);
  1560.  line(Losange[1].x-1-2,Losange[1].y,Losange[2].x,Losange[1].y-1-2);
  1561.  line(Losange[1].x-1-2,Losange[1].y,Losange[4].x,Losange[4].y+1+2);}
  1562.  
  1563.  setcolor(black);
  1564.  line(x1+a div 2,y1,x1,y1+a div 2);
  1565.  line((x1+a div 2)+1,y1,x1+1,y1+a div 2);
  1566.  line(x1,y1+a div 2,x1-a div 2,y1);
  1567.  
  1568.  setcolor(light(couleur_ppale));
  1569.  line(x1-(a div 2),y1,x1,y1-(a div 2));
  1570.  line(x1-(a div 2)-1,y1,x1-1,y1-(a div 2));
  1571.  line(x1,y1-(a div 2),x1+(a div 2),y1);
  1572.  
  1573. end;
  1574.  
  1575. {
  1576. ╓─────────────────────────────────────┬─┬────────────────────────────────────╖
  1577. ║        PROCEDURE BG_login_box()     │ │                           by XTech ║
  1578. ║                                     │ │                           15/04/95 ║
  1579. ╟─────────────────────────────────────┴─┴────────────────────────────────────╢
  1580. ║                                                                            ║
  1581. ║ Use:                                                                       ║
  1582. ║                                                                            ║
  1583. ╙────────────────────────────────────────────────────────────────────────────╜
  1584. }
  1585. procedure BG_login_box;
  1586. var x1,x2,y1,y2:integer;
  1587.     t1,t2:integer;
  1588. begin
  1589.  _save_colors;
  1590.  x1:=Get_Middle_Screen_X-120;
  1591.  x2:=x1+240;
  1592.  y1:=Get_Middle_Screen_Y-80;
  1593.  y2:=y1+160;
  1594.  static_win(x1,y1,x2,y2,blue,false);
  1595.  
  1596.  {mox(x1+1+5,y1+61,4,white);
  1597.  mox(x1+5,y1+60,4,black);}
  1598.  setcolor(white);
  1599.  SetTextStyle(1, HorizDir, 8);
  1600.  outtextXY(x1+80,y1-10,'X');
  1601.  SetTextStyle(10, HorizDir, 4);
  1602.  outtextXY(x1+130,y1,'NET');
  1603.  SetTextStyle(SmallFont, HorizDir, 4);
  1604.  outtextXY(x1+130,y1+60,'Tachy Security');
  1605.  
  1606.  setcolor(white);
  1607.  settextstyle(defaultfont,horizdir,1);
  1608.  t1:=90;
  1609.  t2:=t1+30;
  1610.  outtextxy(x1+10,y1+t1,'User ID:');
  1611.  Input_Box(x1+10,y1+t1+10,x2-10,blue,'');
  1612.  outtextxy(x1+10,y1+t2,'User Code:');
  1613.  Input_Box(x1+10,y1+t2+10,x2-10,blue,'');
  1614.  _restore_colors;
  1615. end;
  1616.  
  1617.  
  1618. BEGIN
  1619.  OPEN_WIN1:=FALSE;
  1620.  OPEN_WIN2:=FALSE;
  1621.  OPEN_WIN3:=FALSE;
  1622.  Writeln(Ver_BGUI);
  1623. END.