home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / PascalPCQ / Examples / IDCMP.p < prev    next >
Text File  |  1991-06-08  |  7KB  |  252 lines
  1. Program IDCMP;
  2.  
  3. {
  4.     This program demonstrates the sort of information you can
  5. expect from Intuition.  All it does is open a window with a bunch
  6. of IDCMP flags set, then describes them as they come in.
  7.  
  8.     It also creates some simple gadgets so you can experiment with
  9. them as well.  Note that virtually all the work in this program is
  10. in defining the typed constants that represent the window and the
  11. gadgets.  Also note that I could have included the gadgets automatically
  12. in the window by setting the FirstGadget field in the NewWindow
  13. structure, but I wanted to show the AddGadget/RefreshGadget use.
  14.  
  15.     The colors used in the borders and other stuff is designed to
  16. look right under 2.0, which means it will look bizarre under 1.3.
  17. }
  18.  
  19. {$I "Include:Exec/Ports.i"}
  20. {$I "Include:Intuition/Intuition.i"}
  21.  
  22. var
  23.     W : WindowPtr;
  24.     IM : IntuiMessagePtr;
  25.     Quit : Boolean;
  26.     S : StringInfoPtr;
  27.     P : PropInfoPtr;
  28.  
  29. Const
  30.     IText1  : IntuiText = (1,0,JAM2,20,5,Nil,"Gadget",Nil);
  31.  
  32.     Pairs1  : Array [1..3,1..2] of Short = (    (  0,19),
  33.                         (  0, 0),
  34.                         ( 99, 0));
  35.  
  36.     Pairs2  : Array [1..3,1..2] of Short = (    ( 99, 1),
  37.                         ( 99,19),
  38.                         (  1,19));
  39.  
  40.     Pairs3  : Array [1..3,1..2] of Short = (( -1, 20),
  41.                         ( -1, -1),
  42.                         (100, -1));
  43.  
  44.     Pairs4  : Array [1..3,1..2] of Short = ((100, -1),
  45.                         (100, 20),
  46.                         ( -1, 20));
  47.  
  48.     { Normal shadow borders }
  49.  
  50.     Border2 : Border = (0,0,1,0,JAM2,3,@Pairs2,Nil);
  51.     Border1 : Border = (0,0,2,0,JAM2,3,@Pairs1,@Border2);
  52.  
  53.     { Reversed, selected borders }
  54.  
  55.     Border4 : Border = (0,0,2,0,JAM2,3,@Pairs2,Nil);
  56.     Border3 : Border = (0,0,1,0,JAM2,3,@Pairs1,@Border4);
  57.  
  58.     Gadget1 : Gadget = (Nil, 10, 20, 100, 20,
  59.             GADGHIMAGE,
  60.             RELVERIFY + GADGIMMEDIATE + TOGGLESELECT,
  61.             BOOLGADGET,
  62.             @Border1,
  63.             @Border3,
  64.             @IText1,
  65.             0,
  66.             Nil,
  67.             0,
  68.             Nil);
  69.  
  70.     StrBorder4 : Border = (-5,-5,1,0,JAM2,3,@Pairs4,Nil);
  71.     StrBorder3 : Border = (-5,-5,2,0,JAM2,3,@Pairs3,@StrBorder4);
  72.     StrBorder2 : Border = (-5,-5,2,0,JAM2,3,@Pairs2,@StrBorder3);
  73.     StrBorder1 : Border = (-5,-5,1,0,JAM2,3,@Pairs1,@StrBorder2);
  74.  
  75.     StringInfo1 : StringInfo = (
  76.             "Initial\0              ",
  77.             "\0                     ",
  78.             0,
  79.             20,
  80.             0,
  81.             0,
  82.             0,
  83.             0,
  84.             0,
  85.             0,
  86.             Nil,
  87.             0,
  88.             Nil);
  89.  
  90.     Gadget2 : Gadget = (Nil, 15, 55, 90, 10,
  91.             GADGHNONE,
  92.             RELVERIFY + GADGIMMEDIATE,
  93.             STRGADGET,
  94.             @StrBorder1,
  95.             Nil,
  96.             Nil,
  97.             0,
  98.             @StringInfo1,
  99.             1,
  100.             Nil);
  101.  
  102.  
  103.     PropInfo1 : PropInfo = (AUTOKNOB + FREEHORIZ,
  104.             0,0, { Pot values }
  105.             $FFFF div 5,
  106.             0,
  107.             0,0,
  108.             0,0,
  109.             0,0);
  110.  
  111.     PropBorder1 : Border = (-1,-1,1,0,JAM2,3,@Pairs1,Nil);
  112.  
  113.     Gadget3 : Gadget = (Nil, 10, 78, 100, 14,
  114.             GADGHNONE,
  115.             RELVERIFY + GADGIMMEDIATE,
  116.             PROPGADGET,
  117.             @PropBorder1,
  118.             Nil,
  119.             Nil,
  120.             0,
  121.             @PropInfo1,
  122.             2,
  123.             Nil);
  124.  
  125.     MyWindow : NewWindow = (50,30,400,150,-1,-1,
  126.             NEWSIZE_f + MOUSEBUTTONS_f + MENUPICK_f +
  127.             CLOSEWINDOW_f + DISKINSERTED_f +
  128.             DISKREMOVED_f + ACTIVEWINDOW_f +
  129.             INACTIVEWINDOW_f + VANILLAKEY_f +
  130.             GADGETUP_f + GADGETDOWN_f,
  131.             WINDOWSIZING + WINDOWDRAG + WINDOWDEPTH +
  132.             WINDOWCLOSE,
  133.             Nil, { Could add all gadgets automatically here }
  134.             Nil,
  135.             "IDCMP Test Window",
  136.             Nil,
  137.             Nil,
  138.             138,
  139.             100,
  140.             -1,-1,
  141.             WBENCHSCREEN_f);
  142.  
  143. Function OpenNewWindow : Boolean;
  144. begin
  145.     W := OpenWindow(@MyWindow);
  146.     OpenNewWindow := W <> Nil;
  147. end;
  148.  
  149. begin
  150.     if OpenNewWindow then begin
  151.  
  152.     { Set the string gadget size to the font size }
  153.  
  154.     Gadget2.Height := W^.IFont^.tf_YSize;
  155.  
  156.     { Actually add the gadgets }
  157.  
  158.     if AddGadget(W, @Gadget1, -1) = 0 then;
  159.     if AddGadget(W, @Gadget2, -1) = 0 then;
  160.     if AddGadget(W, @Gadget3, -1) = 0 then;
  161.  
  162.     { Display them }
  163.  
  164.     RefreshGadgets(W^.FirstGadget, W, Nil);
  165.  
  166.     { Receive messages, and report on them }
  167.  
  168.     repeat
  169.         IM := IntuiMessagePtr(WaitPort(W^.UserPort));
  170.         IM := IntuiMessagePtr(GetMsg(W^.UserPort));
  171.         Writeln;
  172.         with IM^ do begin
  173.         case Class of
  174.           SIZEVERIFY_f    : Writeln('Size Verify');
  175.           NEWSIZE_f    : Writeln('New Window Size');
  176.           REFRESHWINDOW_f: Writeln('Refresh Window');
  177.           MOUSEBUTTONS_f: Writeln('Mouse Button');
  178.           MOUSEMOVE_f    : Writeln('Mouse Move');
  179.           GADGETDOWN_f    : Writeln('Gadget Down');
  180.           GADGETUP_f    : Writeln('Gadget Up');
  181.           REQSET_f    : Writeln('Request Set');
  182.           MENUPICK_f    : Writeln('Menu Pick');
  183.           CLOSEWINDOW_f    : Writeln('Close Window');
  184.           RAWKEY_f    : Writeln('Raw Key');
  185.           REQVERIFY_f    : Writeln('Request Verify');
  186.           REQCLEAR_f    : Writeln('Requests Cleared');
  187.           MENUVERIFY_f    : Writeln('Menu Verify');
  188.           NEWPREFS_f    : Writeln('New Preferences');
  189.           DISKINSERTED_f: Writeln('Disk Inserted');
  190.           DISKREMOVED_f    : Writeln('Disk Removed');
  191.           WBENCHMESSAGE_f: Writeln('WorkBench Message');
  192.           ACTIVEWINDOW_f: Writeln('Window Activated');
  193.           INACTIVEWINDOW_f: Writeln('Window Deactivated');
  194.           DELTAMOVE_f    : Writeln('Delta Move');
  195.           VANILLAKEY_f    : Writeln('Vanilla Key');
  196.           INTUITICKS_f    : Writeln('IntuiTicks');
  197.         end;
  198.         case Class of
  199.           MOUSEBUTTONS_f: if Code = SELECTUP then
  200.                       Writeln('Left Button Released')
  201.                   else
  202.                       Writeln('Left Button Pressed');
  203.           MENUPICK_f    : Writeln('Menu Choice: ', Code);
  204.           RAWKEY_f    : Writeln('Raw Key Code: ', Code);
  205.           VANILLAKEY_f    : begin
  206.                       Write('Key Pressed: ');
  207.                       if (Code > 32) and (Code < 127) then
  208.                       Write(Chr(Code),',');
  209.                       Writeln('Chr(', Code, ')');
  210.                   end;
  211.         else
  212.             Writeln('Code: ', Code);
  213.         end;
  214.         Writeln('Qualifier: ', Qualifier);
  215.         Writeln('Mouse Position: (', MouseX, ',', MouseY, ')');
  216.         Writeln('Seconds: ', Seconds);
  217.         Writeln('Micros:  ', Micros);
  218.  
  219.     { For gadgets, give more information }
  220.  
  221.         if (Class = GADGETUP_f) or (Class = GADGETDOWN_f) then begin
  222.             case GadgetPtr(IAddress)^.GadgetID of
  223.               0 : if (GadgetPtr(IAddress)^.Flags and SELECTED) <> 0
  224.                 then begin
  225.                   Writeln('Gadget is selected');
  226.                   OffGadget(@Gadget2,W,Nil);
  227.                   OffGadget(@Gadget3,W,Nil);
  228.               end else begin
  229.                   Writeln('Gadget is not selected');
  230.                   OnGadget(@Gadget2,W,Nil);
  231.                   OnGadget(@Gadget3,W,Nil);
  232.               end;
  233.               1 : begin
  234.                   S := GadgetPtr(IAddress)^.SpecialInfo;
  235.                   Writeln('String Buffer "', S^.Buffer, '"');
  236.               end;
  237.               2 : begin
  238.                   P := GadgetPtr(IAddress)^.SpecialInfo;
  239.                   Writeln('Selected part: ',
  240.                 (P^.HorizPot and $FFFF) / 655.35:3:0, '%');
  241.               end;
  242.             end;
  243.         end;
  244.         Quit := Class = CLOSEWINDOW_f;
  245.         end;
  246.         ReplyMsg(MessagePtr(IM));
  247.     until Quit;
  248.     CloseWindow(W);
  249.     end else
  250.     Writeln('Could not open the window');
  251. end.
  252.