home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progpas / tegl6b.arj / INTROPAK.EXE / lha / TSTPICK1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-10  |  3KB  |  118 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.  
  30. {$F+}
  31. Function ExitOption(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  32. {$F+}
  33.    BEGIN
  34.       Abortexit(pickeditem);
  35.       exitoption := 1;
  36.    END;
  37.  
  38. {$F+}
  39. function droppicklist(fs:ImageStkPtr; Userkey:word; Var DataArea):Word;
  40. {$F-}
  41.    var picklist : optionmptr absolute DataArea;
  42.    begin
  43.       dropoptionmenu(picklist);
  44.       droppicklist := 0;
  45.    END;
  46.  
  47. {$F+}
  48. Function Gotitem(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  49. {$F+}
  50.    begin
  51.       beep(500,4,50);
  52.       gotitem := 1;
  53.    end;
  54.  
  55. procedure createtestpicklist;
  56.    var x,y,x1,y1     : word;
  57.        ax,ay,ax1,ay1 : word;
  58.        picklist      : optionmptr;
  59.        ifs         : imagestkptr;
  60.        margins         : word;
  61.        maxwidth      : word;
  62.    begin
  63.       x  := 100;
  64.       y  := 100;
  65.       x1 := x+200;
  66.       y1 := y+200;
  67.       margins  := 2;
  68.       maxwidth := 150;
  69.  
  70.       pushimage(x,y,x1,y1);
  71.       shadowbox(x,y,x1,y1);
  72.  
  73.       {---------------------------------------------------------------------}
  74.       {  Create an edit event to allow the user to edit the selected item   }
  75.       {---------------------------------------------------------------------}
  76.       ax  := 10+2+margins;    {<-- pick list adds 2 pixel before the text}
  77.       ay  := 10+2;
  78.       ax1 := ax+MaxWidth;
  79.       ay1 := ay+14;        {<-- Font height}
  80.  
  81.       setkeyboardmouse(false);
  82.       ifs := stackptr;
  83.       DefineStrEditEvent(ifs,ax,ay,ax1,ay1,40,blue,@font14,true,
  84.               pickeditem,Allchars,StrRedisplay,StrRedisplay,nilunitproc);
  85.       AddMouseClickMask(getlastmsptr(ifs),@Maskcursor,2,6);
  86.  
  87.  
  88.       {---------------------------------------------------------------------}
  89.       {  Create drop down pick list event                    }
  90.       {---------------------------------------------------------------------}
  91.       picklist := createpicklist(@font14);
  92.       setpicklistmargin(picklist,margins);
  93.       setpicklistwidth(picklist,maxwidth);
  94.       DefinePickItem(picklist,'item one on list',gotitem,pickeditem);
  95.       DefinePickItem(picklist,'item two on list',gotitem,pickeditem);
  96.       DefinePickItem(picklist,'item three on list',gotitem,pickeditem);
  97.  
  98.       definepicklistarea(ifs,10,10,3,1,picklist);
  99.  
  100.       {---------------------------------------------------------------------}
  101.       {  define a user data area for the picklist with an arbitrary        }
  102.       {  key of 222.                                }
  103.       {---------------------------------------------------------------------}
  104.       setuserdataarea(ifs,222,picklist,droppicklist);
  105.  
  106. {     pushimage(400,100,500,300);
  107.       shadowbox(400,100,500,300); }
  108.    end;
  109.  
  110. begin
  111.    EasyTegl;
  112.    EasyOut;
  113.  
  114.    createtestpicklist;
  115.  
  116.    TEGLSupervisor;
  117. end.
  118.