Menu.pas

Un article de Wikipedia.

(Différences entre les versions)
Version actuelle (22 mars 2008 à 10:19) (modifier) (défaire)
 
Ligne 1 : Ligne 1 :
 +
[[Génération de menus]]
<code pascal n>
<code pascal n>
// librairie de creation de menus
// librairie de creation de menus

Version actuelle

Génération de menus

  1. // librairie de creation de menus
  2. //
  3. // methodes
  4. // initmenu(var m:menu)
  5. // titlemenu(var m:menu;t:string)
  6. // addmenuitem(var m:menu;e:string)
  7. // selectmenu(m:menu):integer
  8. // sizemenu(var m:menu):integer
  9. //
  10. // definitions a inclure
  11. // {$i PalmAPI2.pas}
  12. const maxmenu = 10;
  13. type
  14. plistitem = ^listitem;
  15. listitem = record
  16. etiquette : string;
  17. next : plistitem;
  18. end;
  19. menu = record
  20. title : string;
  21. next : plistitem;
  22. end;
  23. //var m : menu;
  24. function sizemenu(var m:menu):integer;
  25. var tm:plistitem;
  26. count:integer;
  27. begin
  28. if m.next = nil then
  29. sizemenu := 0
  30. else
  31. begin
  32. tm := m.next;
  33. count:=1;
  34. while tm^.next <> nil do
  35. begin
  36. count:=count+1;
  37. tm := tm^.next;
  38. end;
  39. sizemenu := count;
  40. end;
  41. end;
  42. procedure initmenu(var m:menu);
  43. begin
  44. m.title := '';
  45. m.next := nil;
  46. end;
  47. procedure titlemenu(var m:menu;t:string);
  48. begin
  49. m.title := t;
  50. end;
  51. procedure addmenuitem(var m:menu;e:string);
  52. var tm:plistitem;
  53. begin
  54. if m.next = nil then
  55. begin
  56. new(m.next);
  57. with m.next^ do
  58. begin
  59. etiquette := e;
  60. next := nil;
  61. end;
  62. end
  63. else
  64. begin
  65. tm:=m.next;
  66. while tm^.next <> nil do
  67. tm := tm^.next;
  68. new(tm^.next);
  69. with tm^.next^ do
  70. begin
  71. etiquette := e;
  72. next := nil;
  73. end;
  74. end;
  75. end;
  76. function selectmenu(m:menu):integer;
  77. var tm:plistitem;
  78. page,count,n,maxpages,sel,selecteditem:integer;
  79. selection:set of 1..20;
  80. navigation:set of 'A'..'z';
  81. s:string;
  82. quit:boolean;
  83. maxmenuitems:integer;
  84. function itemnumber(n,max:integer):integer;
  85. begin
  86. itemnumber:=((n-1) mod max)+1;
  87. end;
  88. begin
  89. //bug dans la multiplication de constante
  90. maxmenuitems:=maxmenu;
  91. page:=0;
  92. quit:=false;
  93. selecteditem:=0;
  94. maxpages:=(sizemenu(m)-1) div maxmenuitems;
  95. repeat
  96. clrscr;
  97. count:=1;
  98. selection:=[];
  99. navigation:=['q','Q'];
  100. writeln;
  101. writeln(' ':5,m.title);
  102. write(' ':5);
  103. for n:=1 to length(m.title) do
  104. begin
  105. write('-');
  106. end;
  107. writeln;
  108. writeln;
  109. if m.next <> nil then
  110. begin
  111. tm:=m.next;
  112. while tm^.next <> nil do
  113. begin
  114. if (count > maxmenuitems*page) and (count <= maxmenuitems*(page+1)) then
  115. begin
  116. writeln(itemnumber(count,maxmenuitems):3,'. ',tm^.etiquette);
  117. selection:=selection+[itemnumber(count,maxmenuitems)];
  118. end;
  119. tm:=tm^.next;
  120. count:=count+1;
  121. end;
  122. if (count > maxmenuitems*page) and (count <= maxmenuitems*(page+1)) then
  123. begin
  124. writeln(itemnumber(count,maxmenuitems):3,'. ',tm^.etiquette);
  125. selection:=selection+[itemnumber(count,maxmenuitems)];
  126. end;
  127. end;
  128. writeln;
  129. if page > 0 then
  130. begin
  131. writeln('p':3,'. Precedent');
  132. navigation:=navigation+['p','P'];
  133. end;
  134. if page < maxpages then
  135. begin
  136. writeln('s':3,'. Suivant');
  137. navigation:=navigation+['s','S'];
  138. end;
  139. writeln('q':3,'. Quitter');
  140. writeln;
  141. write(' ':5,'Selection : ');
  142. read(s);
  143. if 'p' in navigation then
  144. if (s = 'p') or (s = 'P') then
  145. page:=page-1;
  146. if 's' in navigation then
  147. if (s = 's') or (s = 'S') then
  148. page:=page+1;
  149. if (s = 'q') or (s = 'Q') then
  150. quit:=true;
  151. sel:=StrAtoI(s);
  152. if sel in selection then
  153. begin
  154. selecteditem:=sel+maxmenuitems*page;
  155. quit:=true;
  156. end;
  157. until quit = true;
  158. selectmenu:=selecteditem;
  159. end;