home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / util / reqtools-2.2b.lha / ReqTools-2.2b / Glue / HSPascal.2 / hs_glue2.lha / DemoReq.p < prev    next >
Encoding:
Text File  |  1992-06-28  |  14.7 KB  |  434 lines
  1. program demo;
  2.  
  3. Uses Exec,reqtools,Init,Intuition,utility,AmigaDos;
  4.  
  5. const     DISKINSERTED=$00008000;
  6.  
  7. var        filereq: prtFileRequester;
  8.         fontreq: prtFontRequester;
  9.         inforeq: prtReqInfo;
  10.         scrnreq: prtScreenModeRequester;
  11.         filterhook, font_filterhook: tHook;
  12.         ret2,buffer2: String;
  13.         buffer: Pointer;
  14.         filename: String;
  15.         files: String;
  16.         ptr,longnum: Pointer;
  17.         ret: LongInt;
  18.         color: LongInt;
  19.         name: String;
  20.         mytag: preqtaglist;
  21.         values: argarray;
  22.         ff: tFileInfoBlock;
  23.         tt: pTextAttr;
  24.             
  25. function filterfunc(Hook: tHook; filereq: prtFileRequester; fib: tFileInfoBlock): BOOL;
  26. var naam:String;
  27. begin
  28. {    naam:=Char(@fib^.fib_FileName);}
  29. {    writeln(naam);}
  30.     filterfunc:=TRUE;
  31. end;
  32.  
  33. function font_filterfunc(Hook: tHook; fontreq: prtFontRequester; textatt: pTextAttr): BOOL;
  34. begin
  35. {    writeln(textatt^.ta_Name^);}
  36.     font_filterfunc:=TRUE;
  37. end;
  38.  
  39. begin
  40.     ReqToolsBase:=pReqToolsBase(OpenLibrary(REQTOOLSNAME,REQTOOLSVERSION));
  41.     if(ReqToolsBase=NIL) then 
  42.         begin
  43.             writeln('You need reqtools.library V38 or higher!');
  44.             writeln;
  45.             writeln('Please install it in your Libs: directory.');
  46.             exit;
  47.         end;
  48.     writeln('reqtools Demo');
  49.     writeln;
  50.     writeln('¯¯¯¯¯¯¯¯¯¯¯¯¯');
  51.     writeln('This program demonstrates what ''reqtools.library'' ');
  52.     writeln('has to offer.');
  53.  
  54.     Delay (60);
  55.     ret:=rtEZRequestA('''reqtools.library'' offers several' + chr(10) + 'different types of requesters:',
  56.                      'Let''s see them', NIL, NIL, NIL);
  57.  
  58.     ret:=rtEZRequestA('NUMBER 1:' + chr(10) + 'The larch',
  59.                      'Be serious!', NIL, NIL, NIL);
  60.  
  61.     ret:=rtEZRequestA('NUMBER 1:' + chr(10) + 'String requester' + chr(10) + 'function: rtGetString'+'('+')',
  62.                      'Show me', NIL, NIL, NIL);
  63.  
  64.     buffer:=CstrConstPtr('Type in anything');
  65.     ret:=rtGetStringA (buffer, 127, 'Enter anything:', NIL, NIL);
  66.     values[0]:=LongInt(buffer);
  67.     if (ret=0) then 
  68.         ret:=rtEZRequestA('You entered nothing','I''m sorry', NIL, NIL, NIL)
  69.     else
  70.         ret:=rtEZRequestA('You entered this string:' + #10 + '%s','So I did', NIL, @values[0], NIL);
  71.         
  72.     buffer:=CstrConstPtr('It is possible to have several responses');
  73.     new(mytag);
  74.     mytag^[0].ti_Tag:=RTGS_GadFmt;
  75.     mytag^[0].ti_Data:=LongInt(CstrConstPtr(' OK | New 2.0 feature | Cancel '));
  76.     mytag^[1].ti_Tag:=TAG_END;
  77.  
  78.     ret:=rtGetStringA (buffer, 127, '* New for ReqTools 2.0 *',
  79.                 NIL , mytag);
  80.  
  81.     ret:=rtEZRequestA ('NUMBER 2:' + chr(10) + 'Number requester' + chr(10) + 'function: rtGetLong' + '(' + ')',
  82.                      'Show me', NIL, NIL, NIL);
  83.  
  84.     mytag^[0].ti_Tag:=RTGL_ShowDefault;
  85.     mytag^[0].ti_Data:=LongInt(FALSE);
  86.     mytag^[1].ti_Tag:=TAG_END;
  87.     
  88.     ret:=rtGetLongA (@longnum, 'Enter a number:', NIL, mytag);
  89.  
  90.     values[0]:=LongInt(longnum);
  91.  
  92.     if(ret=0) then 
  93.         ret:=rtEZRequestA('You entered nothing','I''m sorry', NIL, NIL, NIL)
  94.     else
  95.         ret:=rtEZRequestA('The number You entered was: ' + chr(10) + '%ld' ,
  96.                      'So it was', NIL, @values[0], NIL);
  97.  
  98.     mytag^[0].ti_Tag:=RTGL_ShowDefault;
  99.     mytag^[0].ti_Data:=LongInt(FALSE);
  100.     mytag^[1].ti_Tag:=RTGL_GadFmt;
  101.     mytag^[1].ti_Data:=LongInt(CstrConstPtr('Ok|V38 feature|Cancel'));
  102.     mytag^[2].ti_Tag:=TAG_END;
  103.  
  104.     ret:=rtGetLongA (@longnum, '* New for ReqTools 2.0 *', NIL, mytag);
  105.  
  106.     ret:=rtEZRequestA ('NUMBER 3:' + chr(10) + 'Notification requester, the requester' + chr(10) +
  107.                      'you''ve been using all the time!' + chr(10) + 'function: rtEZRequestA'+'('+')',
  108.                      'Show me more', NIL, NIL, NIL);
  109.  
  110.     ret:=rtEZRequestA ('Simplest usage: some body text and' + chr(10) + 'a single centered gadget.',
  111.                      'Got it', NIL, NIL, NIL);
  112.  
  113.     ret:=rtEZRequestA ('You can also use two gadgets to' + chr(10) +
  114.                                 'ask the user something.' + chr(10) +
  115.                                 'Do you understand?', 'Of course|Not really',
  116.                                 NIL, NIL, NIL);
  117.     while ret=0 do
  118.     begin
  119.         ret:=rtEZRequestA ('You are not one of the brightest are you?' + chr(10) +
  120.                          'We''ll try again...','Ok', NIL, NIL, NIL);
  121.         ret:=rtEZRequestA ('You can also use two gadgets to' + chr(10) +
  122.                                 'ask the user something.' + chr(10) +
  123.                                 'Do you understand?', 'Of course|Not really',
  124.                                 NIL, NIL, NIL)
  125.     end;
  126.  
  127.     ret:=rtEZRequestA ('Great, we''ll continue then.', 'Fine', NIL, NIL, NIL);
  128.  
  129.     ret:=rtEZRequestA ('You can also put up a requester with' + chr(10) +
  130.                                 'three choices.' + chr(10) +
  131.                                 'How do you like the demo so far ?',
  132.                                 'Great|So so|Rubbish', NIL, NIL, NIL);
  133.     case ret of
  134.         0:    ret:=rtEZRequestA ('Too bad, I really hoped you' + chr(10) + 
  135.                                     'would like it better.',
  136.                              'So what', NIL, NIL, NIL);
  137.         1:
  138.             ret:=rtEZRequestA ('I''m glad you like it so much.','Fine', NIL, NIL, NIL);
  139.         2:
  140.             ret:=rtEZRequestA ('Maybe if you run the demo again' + chr(10) +
  141.                              'you''ll REALLY like it.',
  142.                              'Perhaps', NIL, NIL, NIL);
  143.         end;
  144.         
  145.     mytag^[0].ti_Tag:=RTEZ_DefaultResponse;
  146.     mytag^[0].ti_Data:=4;
  147.     mytag^[1].ti_Tag:=TAG_END;
  148.  
  149.     ret :=rtEZRequestA ('The number of responses is not limited to three' + chr(10) +
  150.                                   'as you can see.  The gadgets are labeled with' + chr(10) +    
  151.                                   'the "Return" code from rtEZRequestA().' + chr(10) +
  152.                                   'Pressing "Return" will choose 4, note that' + chr(10) +
  153.                                   '4''s button text is printed in boldface.',
  154.                                   '1|2|3|4|5|0', NIL, NIL,
  155.                                   mytag);
  156.     
  157.     values[0]:=LongInt(ret);
  158.     
  159.     ret:=rtEZRequestA ('You picked ' + '%ld', 'How true', NIL, @values[0], NIL);
  160.  
  161.     mytag^[0].ti_Tag:=RT_Underscore;
  162.     mytag^[0].ti_Data:=LongInt('_');
  163.     mytag^[1].ti_Tag:=TAG_END;
  164.  
  165.     ret:=rtEZRequestA ('New for Release 2.0 of ReqTools (V38) is' + chr(10) +
  166.                           'the possibility to define characters in the' + chr(10) +
  167.                           'buttons as keyboard shortcuts.' + chr(10) + 
  168.                           'As you can see these characters are underlined.' + chr(10) +
  169.                           'Note that pressing shift while still holding' + chr(10) + 
  170.                           'down the key will cancel the shortcut.',
  171.                           '_Great|_Fantastic|_Swell|Oh _Boy',
  172.                           NIL, NIL, mytag);
  173.  
  174.     values[0]:=5;
  175.     values[1]:=LongInt(CstrConstPtr('five'));
  176.     
  177.     ret:=rtEZRequestA ('You may also use C-style formatting codes in the body text.' + chr(10) +
  178.         'Like this:' + chr(10) + chr(10) + 
  179.         'The number %%ld is written %%s. will give:' + chr(10) + chr(10) +
  180.         'The number %ld is written %s.' + chr(10) + chr(10)+
  181.         'if you also pass ''5'' and ''five'' to rtEZRequestA'+'('+')'+'.',
  182.         '_Proceed', NIL, @values[0], mytag);    
  183.     
  184.         mytag^[0].ti_Tag:=RT_IDCMPFlags;
  185.         mytag^[0].ti_Data:=DISKINSERTED;
  186.         mytag^[1].ti_Tag:=RT_Underscore;
  187.         mytag^[1].ti_Data:=LongInt('_');
  188.         mytag^[2].ti_Tag:=TAG_END;
  189.  
  190.         ret:=rtEZRequestA ('It is also possible to pass extra IDCMP flags' + chr(10) +
  191.                                'that will satisfy rtEZRequestA'+'('+')'+'. This requester' + chr(10) +
  192.                                'has had DISKINSERTED passed to it.' + chr(10) +
  193.                                '('+'Try inserting a disk'+')'+'.',
  194.                                '_Continue', NIL, NIL, mytag);
  195.  
  196.     if ((ret=DISKINSERTED)) then
  197.         ret:=rtEZRequestA ('You inserted a disk.', 'I did', NIL, NIL, NIL)
  198.     else
  199.         ret:=rtEZRequestA ('You used the ''Continue'' gadget' + chr(10) + 
  200.                          'to satisfy the requester.', 'I did', NIL, NIL, NIL);
  201.  
  202.     mytag^[0].ti_Tag:=RT_ReqPos;
  203.     mytag^[0].ti_Data:=LongInt(REQPOS_TOPLEFTSCR);
  204.     mytag^[1].ti_Tag:=RT_Underscore;
  205.     mytag^[1].ti_Data:=LongInt('_');
  206.     mytag^[2].ti_Tag:=TAG_END;
  207.  
  208.     ret:=rtEZRequestA ('Finally, it is possible to specify the position' + chr(10) +
  209.                           'of the requester.' + chr(10) +
  210.                           'E.g. at the top left of the screen, like this.' + chr(10) +
  211.                           'This works for all requesters, not just rtEZRequestA'+'('+')'+'!',
  212.                           '_Amazing', NIL, NIL, mytag);
  213.  
  214.     mytag^[0].ti_Tag:=RT_ReqPos;
  215.     mytag^[0].ti_Data:=LongInt(REQPOS_CENTERSCR);
  216.     mytag^[1].ti_Tag:=TAG_END;
  217.  
  218.     ret:=rtEZRequestA ('Alternatively, you can center the' + chr(10) +
  219.                           'requester on the screen.' + chr(10) +
  220.                           'Check out ''reqtools.doc'' for all the possibilities.',
  221.                           'I''ll do that', NIL, NIL,
  222.                           mytag);
  223.  
  224.     mytag^[0].ti_Tag:=RT_Underscore;
  225.     mytag^[0].ti_Data:=LongInt('_');
  226.     mytag^[1].ti_Tag:=TAG_END;
  227.  
  228.     ret:=rtEZRequestA ('NUMBER 4:' + chr(10) + 'File requester' + chr(10) +
  229.                           'function: rtFileRequest'+'('+')',
  230.                           '_Demonstrate', NIL, NIL, mytag);
  231.  
  232.     filereq:=Pointer(rtAllocRequestA (RT_FILEREQ, NIL));
  233.     
  234.     if (filereq<>NIL) then
  235.     begin
  236. {        filterhook.h_Entry^ := LongInt(filterfunc(filterhook,filereq,ff));
  237.         mytag^[0].ti_Tag:=RTFI_FilterFunc;
  238.         mytag^[0].ti_Data:=LongInt(@filterhook);
  239.         mytag^[1].ti_Tag:=TAG_END;
  240. }        
  241.         filename := '';
  242.         ret:=rtFileRequestA (filereq, @filename, 'Pick a file', NIL);
  243.         if(ret<>0) then
  244.             begin
  245.                 values[0]:=LongInt(@filename);
  246.                 values[1]:=LongInt(@filereq^.Dir^);
  247.                 ret:=rtEZRequestA ('You picked the file:' + #10 +
  248.                 '%s' + #10 + 'in directory:' + #10 + '%s','Right', NIL, @values[0], NIL)
  249.             end
  250.         else
  251.             ret:=rtEZRequestA ('You didn''t pick a file.', 'No', NIL, NIL, NIL);
  252.  
  253.         ret:=rtFreeRequest(filereq)
  254.     end
  255.     else
  256.         ret:=rtEZRequestA ('Out of memory!', 'Oh boy!', NIL, NIL, NIL);
  257.  
  258.     ret:=rtEZRequestA ('The file requester can be used' + chr(10) +
  259.                           'as a directory requester as well.',
  260.                           'Let''s _see that', NIL, NIL, mytag);
  261.  
  262.     filereq := Pointer(rtAllocRequestA (RT_FILEREQ, NIL));
  263.     if (filereq<>NIL) then
  264.         begin
  265.             mytag^[0].ti_Tag:=RTFI_Flags;
  266.             mytag^[0].ti_Data:=FREQF_NOFILES;
  267.             mytag^[1].ti_Tag:=TAG_END;
  268.  
  269.             ret:=rtFileRequestA (filereq, @filename, 'Pick a directory',mytag);
  270.             values[0]:=LongInt(@filereq^.Dir^);
  271.             if(ret=1) then
  272.                 ret:=rtEZRequestA ('You picked the directory:' + chr(10) + '%s',
  273.                              'Right', NIL, @values[0], NIL)
  274.             else
  275.                 ret:=rtEZRequestA ('You didn''t pick a directory.', 'No', NIL, NIL, NIL);
  276.  
  277.             ret:=rtEZRequestA ('You can also change the Height of the requester', 'Wow', NIL, NIL, NIL);
  278.  
  279.             mytag^[0].ti_Tag:=RTFI_Flags;
  280.             mytag^[0].ti_Data:=FREQF_NOFILES;
  281.             mytag^[1].ti_Tag:=RTFI_Height;
  282.             mytag^[1].ti_Data:=LongInt(250);
  283.             mytag^[2].ti_Tag:=TAG_END;
  284.  
  285.             ret:=rtFileRequestA (filereq, @filename, 'Pick a directory',mytag);
  286.             values[0]:=LongInt(@filereq^.Dir^);
  287.             if(ret=1) then
  288.                 ret:=rtEZRequestA ('You picked the directory:' + chr(10) + '%s',
  289.                              'Right', NIL, @values[0], NIL)
  290.             else
  291.                 ret:=rtEZRequestA ('You didn''t pick a directory.', 'No', NIL, NIL, NIL);
  292.  
  293.             ret:=rtEZRequestA ('You can also change the OK_GADGET', 'Great', NIL, NIL, NIL);
  294.  
  295.             mytag^[0].ti_Tag:=RTFI_Flags;
  296.             mytag^[0].ti_Data:=FREQF_NOFILES;
  297.             mytag^[1].ti_Tag:=RTFI_OkText;
  298.             mytag^[1].ti_Data:=LongInt(CstrConstPtr('_Remove'));
  299.             mytag^[2].ti_Tag:=RT_UnderScore;
  300.             mytag^[2].ti_Data:=LongInt('_');
  301.             mytag^[3].ti_Tag:=TAG_END;
  302.  
  303.             ret:=rtFileRequestA (filereq, @filename, 'Remove a directory',mytag);
  304.             values[0]:=LongInt(@filereq^.Dir^);
  305.             if(ret=1) then
  306.                 ret:=rtEZRequestA ('You picked the directory:' + chr(10) + '%s',
  307.                              'Right', NIL, @values[0], NIL)
  308.             else
  309.                 ret:=rtEZRequestA ('You didn''t pick a directory.', 'No', NIL, NIL, NIL);
  310.  
  311.             ret:=rtFreeRequest(filereq);
  312.             filereq := Pointer(rtAllocRequestA (RT_FILEREQ, NIL));            
  313.             ret:=rtEZRequestA ('You can also use it as a Disk-requester', 'Perfect', NIL, NIL, NIL);
  314.  
  315.             mytag^[0].ti_Tag:=RTFI_VolumeRequest;
  316.             mytag^[0].ti_Data:=VREQF_ALLDISKS|VREQF_NOASSIGNS;
  317.             mytag^[1].ti_Tag:=RTFI_OkText;
  318.             mytag^[1].ti_Data:=LongInt(CstrConstPtr('Un_Mount'));
  319.             mytag^[2].ti_Tag:=RT_UnderScore;
  320.             mytag^[2].ti_Data:=LongInt('_');
  321.             mytag^[3].ti_Tag:=TAG_END;
  322.  
  323.             ret:=rtFileRequestA (filereq, @filename, 'Unmount a device',mytag);
  324.             values[0]:=LongInt(@filereq^.Dir^);
  325.             if(ret=1) then
  326.                 ret:=rtEZRequestA ('You picked the device:' + chr(10) + '%s',
  327.                              'Right', NIL, @values[0], NIL)
  328.             else
  329.                 ret:=rtEZRequestA ('You didn''t pick a device.', 'No', NIL, NIL, NIL);
  330.         ret:=rtFreeRequest (filereq)
  331.         end
  332.     else
  333.         ret:=rtEZRequestA ('Out of memory!', 'Oh boy!', NIL, NIL, NIL);
  334.  
  335.     ret:=rtEZRequestA ('NUMBER 5:' + chr(10) + 'Font requester' + chr(10) +
  336.                           'function: rtFontRequest'+'('+')',
  337.                           'Show', NIL, NIL, NIL);
  338.  
  339.     fontreq := Pointer(rtAllocRequestA (RT_FONTREQ, NIL));
  340.     if (fontreq<>NIL) then
  341.     begin
  342.         fontreq^.Flags := FREQF_STYLE|FREQF_COLORFONTS;
  343. {        font_filterhook.h_Entry^ := LongInt(font_filterfunc(font_filterhook,fontreq,tt));
  344.         mytag^[0].ti_Tag:=RTFO_FilterFunc;
  345.         mytag^[0].ti_Data:=LongInt(@font_filterhook);
  346.         mytag^[1].ti_Tag:=TAG_END;
  347. }        
  348.         ret:=rtFontRequestA (fontreq, 'Pick a font', NIL);
  349.         if(ret<>0) then
  350.         begin
  351.             values[0]:=LongInt(fontreq^.Attr.ta_Name);
  352.             values[1]:=LongInt(fontreq^.Attr.ta_YSize);
  353.             ret:=rtEZRequestA ('You picked the font:' + #10 +
  354.                     '%s' + #10 + 'with size:' + #10 +
  355.                     '%ld','Right', NIL, @values[0], NIL)
  356.         end
  357.         else
  358.             ret:=rtEZRequestA ('You didn''t pick a font','I know', NIL, NIL, NIL);
  359.         ret:=rtFreeRequest (fontreq);
  360.     end
  361.     else         ret:=rtEZRequestA ('Out of memory!', 'Oh boy!', NIL, NIL, NIL);
  362.  
  363.     inforeq := Pointer(rtAllocRequestA (RT_REQINFO, NIL));
  364.     if (inforeq<>NIL) then
  365.     begin
  366.         inforeq^.Flags := EZREQF_CENTERTEXT;
  367.         ret:=rtEZRequestA ('With rtAllocRequestA'+' ('+' RT_REQINFO '+', NIL )'+ #10 +
  368.                            'you can center the text in the requester', 'Got it', inforeq, NIL, NIL);
  369.         ret:=rtFreeRequest (inforeq);
  370.     end
  371.     else         ret:=rtEZRequestA ('Out of memory!', 'Oh boy!', NIL, NIL, NIL);
  372.  
  373.     ret:=rtEZRequestA ('NUMBER 6:' + chr(10) + 'ScreenMode requester' + chr(10) +
  374.                           'function: rtScreenModeRequestA'+'('+')',
  375.                           'Proceed', NIL, NIL, NIL);
  376.  
  377.     scrnreq := Pointer(rtAllocRequestA (RT_SCREENMODEREQ, NIL));
  378.     if (scrnreq<>NIL) then
  379.     begin
  380.         mytag^[0].ti_Tag:=RTSC_Flags;
  381.         mytag^[0].ti_Data:=SCREQF_DEPTHGAD|SCREQF_SIZEGADS|SCREQF_AUTOSCROLLGAD|SCREQF_OVERSCANGAD;
  382.         mytag^[1].ti_Tag:=RT_UnderScore;
  383.         mytag^[1].ti_Data:=LongInt('_');
  384.         mytag^[2].ti_Tag:=TAG_END;
  385.  
  386.         ret:=rtScreenModeRequestA ( scrnreq, 'Pick a screenmode', mytag);
  387.         values[0]:=LongInt(scrnreq^.DisplayID);
  388.         values[1]:=LongInt(scrnreq^.DisplayWidth);
  389.         values[2]:=LongInt(scrnreq^.DisplayHeight);
  390.         values[3]:=LongInt(scrnreq^.DisplayDepth);
  391.         values[4]:=LongInt(scrnreq^.OverscanType);
  392.         if (Boolean(scrnreq^.AutoScroll)) then
  393.             values[5]:=LongInt(CstrConstPtr('On'))
  394.         else values[5]:=LongInt(CstrConstPtr('Off'));
  395.  
  396.         if(ret=1) then
  397.             ret:=rtEZRequestA ('You picked this mode:' + #10 +
  398.                                      'ModeID   : 0x%lx' + #10 +
  399.                                      'Size     : %ld x %ld' + #10 +
  400.                                      'Depth    : %ld' + #10 +
  401.                                      'Overscan : %ld' + #10 +
  402.                                      'AutoScroll %s' , 'Right', NIL, @values[0], NIL)
  403.         else
  404.             ret:=rtEZRequestA ('You didn''t pick a screen mode.', 'Sorry', NIL, NIL, NIL);
  405.         ret:=rtFreeRequest (scrnreq);
  406.     end
  407.     else
  408.         ret:=rtEZRequestA ('Out of memory!', 'Oh boy!', NIL, NIL, NIL);
  409.  
  410.     mytag^[0].ti_Tag:=RT_Underscore;
  411.     mytag^[0].ti_Data:=LongInt('_');
  412.     mytag^[1].ti_Tag:=TAG_END;
  413.  
  414.     ret:=rtEZRequestA ('NUMBER 7:' + chr(10) + 'Palette requester' + chr(10) +
  415.                           'function: rtPaletteRequest'+'('+')',
  416.                           '_Proceed', NIL, NIL, mytag);
  417.  
  418.     color := rtPaletteRequestA ('Change palette', NIL, NIL);
  419.     if (color = -1) then
  420.         ret:=rtEZRequestA ('You canceled.' + chr(10) + 'No nice colors to be picked ?',
  421.                          'Nah', NIL, NIL, NIL)
  422.     else
  423.         ret:=rtEZRequestA ('You picked color number ' + '%ld.', 'Sure did',
  424.                          NIL, @color, NIL);
  425.  
  426.     CloseLibrary (pLibrary(ReqToolsBase));
  427.     writeln;
  428.     writeln ('Finished, hope you enjoyed the demo');
  429.     writeln;
  430.  
  431.     exit;
  432.  
  433. end.
  434.