home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TGTP60.ZIP / INTROPAK.EXE / TSTPICK2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-05  |  3.3 KB  |  115 lines
  1.  
  2. {$M 20000,0,655360}
  3.        {-- Defaults }
  4. {$A-}  {-- A- byte alignment }
  5. {$B-}  {-- B- short circuit boolean evaluation }
  6. {$D+}  {-- D- No debug info }
  7. {$E-}  {-- E- No emulation }
  8. {$F-}  {-- F- Far calls only when necessary }
  9. {$I-}  {-- I- I/O error checking done internally }
  10. {$L+}  {-- L- No local symbols }
  11. {$N-}  {-- N- Software reals }
  12. {$R-}  {-- R- Range checking off }
  13. {$S-}  {-- S- Stack overflow off }
  14. {$V-}  {-- V- No strict type checking }
  15.  
  16. uses virtmem,
  17.      errorlog,
  18.      teglfont,
  19.      teglmain,
  20.      tegledit,
  21.      tgraph,
  22.      teglintr,
  23.      teglmenu,
  24.      teglpick,
  25.      teglunit,
  26.      fastgrph;
  27.  
  28. var pickeditem : string;
  29.     pickedms   : msclickptr;
  30.     pickedfs   : imagestkptr;
  31.  
  32.  
  33. {$F+}
  34. Function ExitOption(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  35. {$F+}
  36.    BEGIN
  37.       Abortexit(pickeditem);
  38.       exitoption := 1;
  39.    END;
  40.  
  41. {$F+}
  42. function droppicklist(fs:ImageStkPtr; Userkey:word; Var DataArea):Word;
  43. {$F-}
  44.    var picklist : optionmptr absolute DataArea;
  45.    begin
  46.       dropoptionmenu(picklist);
  47.       droppicklist := 0;
  48.    END;
  49.  
  50. {$F+}
  51. Function dropitems(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  52. {$F+}
  53.    var picklist : optionmptr;
  54.    begin
  55.       getuserdataarea(fs,222,picklist);
  56.       detachpicklist(picklist);
  57.       deletePickItem(picklist,random(picklist^.numofentries)+1);
  58.       deletePickItem(picklist,random(picklist^.numofentries)+1);
  59.       deletePickItem(picklist,random(picklist^.numofentries)+1);
  60.       deletePickItem(picklist,random(picklist^.numofentries)+1);
  61.       attachpicklist(picklist,random(picklist^.numofentries)+1);
  62.  
  63.       beep(500,4,50);
  64.       dropitems := 1;
  65.    end;
  66.  
  67. {$F+}
  68. Function Additems(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  69. {$F+}
  70.    var picklist : optionmptr;
  71.    begin
  72.       getuserdataarea(fs,222,picklist);
  73.       detachpicklist(picklist);
  74.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item one on list',Additems,pickeditem);
  75.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item two on list',dropitems,pickeditem);
  76.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item three on list',Additems,pickeditem);
  77.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item four on list',dropitems,pickeditem);
  78.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item five on list',Additems,pickeditem);
  79.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item six on list',dropitems,pickeditem);
  80.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item seven on list',additems,pickeditem);
  81.       attachpicklist(picklist,random(picklist^.numofentries)+1);
  82.  
  83.       beep(500,4,50);
  84.       Additems := 1;
  85.    end;
  86.  
  87. procedure testpicklist;
  88.    var x,y,x1,y1 : word;
  89.        picklist  : optionmptr;
  90.    begin
  91.       x  := 100;
  92.       y  := 100;
  93.       x1 := x+200;
  94.       y1 := y+200;
  95.  
  96.       pushimage(x,y,x1,y1);
  97.       shadowbox(x,y,x1,y1);
  98.  
  99.       picklist := createpicklist(@font14);
  100.       DefinePickItem(picklist,'item one on list',Additems,pickeditem);
  101.       DefinePickItem(picklist,'item two on list',dropitems,pickeditem);
  102.  
  103.       setuserdataarea(stackptr,222,picklist,droppicklist);
  104.       definepicklistarea(stackptr,10,10,3,5,picklist);
  105.    end;
  106.  
  107. begin
  108.    EasyTegl;
  109.    EasyOut;
  110.  
  111.    testpicklist;
  112.  
  113.    TEGLSupervisor;
  114. end.
  115.