home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 502b.lha / PCQ_v1.2 / PCQ_Examples / examples.LZH / Examples / IDCMP.p < prev    next >
Encoding:
Text File  |  1990-07-17  |  3.0 KB  |  109 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.  
  9. {$I "Include:Exec/Ports.i"}
  10. {$I "Include:Intuition/Intuition.i"}
  11.  
  12. var
  13.     W : WindowPtr;
  14.     IM : IntuiMessagePtr;
  15.     Quit : Boolean;
  16.  
  17. Function OpenNewWindow : Boolean;
  18. var
  19.    nw : NewWindow;
  20. begin
  21.     with nw do begin
  22.     LeftEdge := 50;
  23.     TopEdge  := 50;
  24.     Width    := 200;
  25.     Height   := 100;
  26.     DetailPen:= -1;
  27.     BlockPen := -1;
  28.     IDCMPFlags := NEWSIZE_f + MOUSEBUTTONS_f + MENUPICK_f +
  29.             CLOSEWINDOW_f + DISKINSERTED_f +
  30.             DISKREMOVED_f + ACTIVEWINDOW_f + INACTIVEWINDOW_f +
  31.             VANILLAKEY_f;
  32.     Flags    := WINDOWSIZING + WINDOWDRAG + WINDOWDEPTH +
  33.             WINDOWCLOSE;
  34.     FirstGadget := Nil;
  35.     CheckMark := Nil;
  36.     Title     := "IDCMP Test Window";
  37.     Screen    := Nil;
  38.     BitMap      := Nil;
  39.     MinWidth  := 40;
  40.     MinHeight := 20;
  41.         MaxWidth  := -1;
  42.     MaxHeight := -1;
  43.     WType      := WBENCHSCREEN_f;
  44.     end;
  45.     W := OpenWindow(Adr(nw));
  46.     OpenNewWindow := W <> Nil;
  47. end;
  48.  
  49. begin
  50.     if OpenNewWindow then begin
  51.     repeat
  52.         IM := IntuiMessagePtr(WaitPort(W^.UserPort));
  53.         IM := IntuiMessagePtr(GetMsg(W^.UserPort));
  54.         Writeln;
  55.         with IM^ do begin
  56.         case Class of
  57.           SIZEVERIFY_f    : Writeln('Size Verify');
  58.           NEWSIZE_f    : Writeln('New Window Size');
  59.           REFRESHWINDOW_f: Writeln('Refresh Window');
  60.           MOUSEBUTTONS_f: Writeln('Mouse Button');
  61.           MOUSEMOVE_f    : Writeln('Mouse Move');
  62.           GADGETDOWN_f    : Writeln('Gadget Down');
  63.           GADGETUP_f    : Writeln('Gadget Up');
  64.           REQSET_f    : Writeln('Request Set');
  65.           MENUPICK_f    : Writeln('Menu Pick');
  66.           CLOSEWINDOW_f    : Writeln('Close Window');
  67.           RAWKEY_f    : Writeln('Raw Key');
  68.           REQVERIFY_f    : Writeln('Request Verify');
  69.           REQCLEAR_f    : Writeln('Requests Cleared');
  70.           MENUVERIFY_f    : Writeln('Menu Verify');
  71.           NEWPREFS_f    : Writeln('New Preferences');
  72.           DISKINSERTED_f: Writeln('Disk Inserted');
  73.           DISKREMOVED_f    : Writeln('Disk Removed');
  74.           WBENCHMESSAGE_f: Writeln('WorkBench Message');
  75.           ACTIVEWINDOW_f: Writeln('Window Activated');
  76.           INACTIVEWINDOW_f: Writeln('Window Deactivated');
  77.           DELTAMOVE_f    : Writeln('Delta Move');
  78.           VANILLAKEY_f    : Writeln('Vanilla Key');
  79.           INTUITICKS_f    : Writeln('IntuiTicks');
  80.         end;
  81.         case Class of
  82.           MOUSEBUTTONS_f: if Code = SELECTUP then
  83.                       Writeln('Left Button Released')
  84.                   else
  85.                       Writeln('Left Button Pressed');
  86.           MENUPICK_f    : Writeln('Menu Choice: ', Code);
  87.           RAWKEY_f    : Writeln('Raw Key Code: ', Code);
  88.           VANILLAKEY_f    : begin
  89.                       Write('Key Pressed: ');
  90.                       if (Code > 32) and (Code < 127) then
  91.                       Write(Chr(Code),',');
  92.                       Writeln('Chr(', Code, ')');
  93.                   end;
  94.         else
  95.             Writeln('Code: ', Code);
  96.         end;
  97.         Writeln('Qualifier: ', Qualifier);
  98.         Writeln('Mouse Position: (', MouseX, ',', MouseY, ')');
  99.         Writeln('Seconds: ', Seconds);
  100.         Writeln('Micros:  ', Micros);
  101.         Quit := Class = CLOSEWINDOW_f;
  102.         end;
  103.         ReplyMsg(MessagePtr(IM));
  104.     until Quit;
  105.     CloseWindow(W);
  106.     end else
  107.     Writeln('Could not open the window');
  108. end.
  109.