home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / DBL Pascal Library / DefProcs / PopUp / PopUpTest.p < prev    next >
Encoding:
Text File  |  1992-06-05  |  6.1 KB  |  197 lines  |  [TEXT/PJMM]
  1. program PopUpTest;
  2.  
  3.     const
  4.         dialogID = 128;
  5.  
  6.         firstMenu = 2;        {item numbers}
  7.         secondMenu = 3;
  8.         hideSecond = 4;
  9.         disableControl = 5;
  10.         disableMenu = 6;
  11.         resetMenu = 7;
  12.         speedLabel = 8;
  13.         speedTE = 9;
  14.         speedMenu = 10;
  15.         ctlTitleMenu = 11;
  16.         altCTitle = 12;
  17.         invisibleMenu = 13;
  18.         frameItem = 14;
  19.         emptyMenu = 15;
  20.         reportItem = 16;
  21.  
  22.     var
  23.         theDialog: DialogPtr;
  24.         itemHit: Integer;
  25.         i: Integer;
  26.         theEvent: EventRecord;
  27.         pt: Point;
  28.         theMenu: MenuHandle;
  29.  
  30.     function GetControlHandle (item: Integer): ControlHandle;
  31.         var
  32.             kind: Integer;
  33.             h: Handle;
  34.             r: Rect;
  35.     begin
  36.         GetDItem(theDialog, item, kind, h, r);
  37.         if BAND(kind, $FC) = ctrlItem then
  38.             GetControlHandle := ControlHandle(h)
  39.         else
  40.             GetControlHandle := nil;
  41.     end;
  42.  
  43.     function FilterProc (dlg: DialogPtr; var evt: EventRecord; var itemHit: Integer): Boolean;
  44.     begin
  45.         FilterProc := False;
  46.         theEvent := evt;
  47.     end;
  48.  
  49.     procedure DrawFrame (theWindow: WindowPtr; itemNo: Integer);
  50.         var
  51.             itemType: Integer;
  52.             itemHandle: Handle;
  53.             itemRect: Rect;
  54.     begin
  55.         PenNormal;
  56.         GetDItem(theWindow, itemNo, itemType, itemHandle, itemRect);
  57.         FrameRect(itemRect);
  58.     end;
  59.  
  60.     procedure SetUserItem (theWindow: WindowPtr; itemNo: Integer; theProc: ProcPtr);
  61.         var
  62.             itemType: Integer;
  63.             itemHandle: Handle;
  64.             itemRect: Rect;
  65.     begin
  66.         GetDItem(theWindow, itemNo, itemType, itemHandle, itemRect);
  67.         SetDItem(theWindow, itemNo, itemType, Handle(theProc), itemRect);
  68.     end;
  69.  
  70.     procedure ReportControl (theDialog: DialogPtr; item: Integer);
  71.         var
  72.             aString: Str255;
  73.             value: Integer;
  74.             hiByte: Integer;
  75.             mString: Str255;
  76.             loByte: Integer;
  77.             iString: Str255;
  78.             itemKind: Integer;
  79.             itemHandle: Handle;
  80.             itemRect: Rect;
  81.             itemRgn: RgnHandle;
  82.     begin
  83.         NumToString(item, aString);
  84.         value := GetCtlValue(GetControlHandle(item));
  85.         hiByte := BSR(value, 8);
  86.         loByte := BAND(value, $FF);
  87.         NumToString(hiByte, mString);
  88.         NumToString(loByte, iString);
  89.         ParamText(aString, mString, iString, '');
  90.         GetDItem(theDialog, reportItem, itemKind, itemHandle, itemRect);
  91.         itemRgn := NewRgn;
  92.         RectRgn(itemRgn, itemRect);
  93.         UpdtDialog(theDialog, itemRgn);
  94.         DisposeRgn(itemRgn);
  95.     end;
  96.  
  97.     procedure RecursiveGetMenu (menuH: MenuHandle);
  98.         var
  99.             i: Integer;
  100.             cmd, mark: Char;
  101.     begin
  102.         if menuH <> nil then
  103.             begin
  104.                 InsertMenu(menuH, -1);
  105.                 for i := 1 to CountMItems(menuH) do
  106.                     begin
  107.                         GetItemMark(menuH, i, mark);
  108.                         GetItemCmd(menuH, i, cmd);
  109.                         if cmd = CHR($1B) then
  110.                             RecursiveGetMenu(GetMenu(ORD(mark)));
  111.                     end;
  112.             end;
  113.     end;
  114.  
  115.     type
  116.         popupPrivateData = record
  117.                 mHandle: MenuHandle;
  118.                 mID: Integer;
  119.             end;
  120.         popupPrivateDataPtr = ^popupPrivateData;
  121.         popupPrivateDataHdl = ^popupPrivateDataPtr;
  122.  
  123.     function GetDPopUpMenuID (item: Integer): Integer;
  124.     begin
  125.         GetDPopUpMenuID := popupPrivateDataHdl(GetControlHandle(item)^^.contrlData)^^.mID;
  126.     end;
  127.  
  128.     procedure GetDPopUpMenu (item: Integer);
  129.         var
  130.             menuID: Integer;
  131.             menuH: MenuHandle;
  132.     begin
  133.         menuID := GetDPopUpMenuID(item);
  134.         menuH := GetMenu(menuID);
  135.         RecursiveGetMenu(menuH);
  136.     end;
  137.  
  138.     function NewDPopUpMenu (item: Integer; title: Str255): MenuHandle;
  139.         var
  140.             menuID: Integer;
  141.             menuH: MenuHandle;
  142.     begin
  143.         menuID := GetDPopUpMenuID(item);
  144.         menuH := NewMenu(menuID, title);
  145.         if menuH <> nil then
  146.             InsertMenu(menuH, -1);
  147.         NewDPopUpMenu := menuH;
  148.     end;
  149.  
  150.  
  151. begin
  152.     theDialog := GetNewDialog(dialogID, nil, POINTER(-1));
  153.     SetPort(theDialog);
  154.     GetDPopUpMenu(firstMenu);
  155.     GetDPopUpMenu(secondMenu);
  156. {$IFC True}
  157.     theMenu := NewDPopUpMenu(speedMenu, '');
  158.     AppendMenu(theMenu, '123');
  159.     AppendMenu(theMenu, '456');
  160. {$ELSEC}
  161.     GetDPopUpMenu(speedMenu);
  162. {$ENDC}
  163.     GetDPopUpMenu(ctlTitleMenu);
  164.     GetDPopUpMenu(invisibleMenu);
  165.     GetDPopUpMenu(emptyMenu);
  166.     SetUserItem(theDialog, frameItem, @DrawFrame);
  167.     TextFont(geneva);    {Try different fonts and sizes to see how useWFont variant works…}
  168.     TextSize(9);
  169.     ShowWindow(theDialog);
  170.     for i := 1 to 3 do    {Have to do this to synchronize TE items to the window font!}
  171.         if EventAvail(everyEvent, theEvent) then
  172.             ;
  173.     with DialogPeek(theDialog)^.textH^^ do
  174.         begin
  175.             txFont := theDialog^.txFont;
  176.             txSize := theDialog^.txSize;
  177.         end;
  178.     InitCursor;
  179.     repeat
  180.         ModalDialog(@FilterProc, itemHit);
  181.  
  182.         case itemHit of
  183.             firstMenu, secondMenu, speedMenu, ctlTitleMenu, emptyMenu: 
  184.                 ReportControl(theDialog, itemHit);
  185.  
  186.             frameItem: 
  187.                 begin
  188.                     pt := theEvent.where;
  189.                     GlobalToLocal(pt);
  190.                     MoveControl(GetControlHandle(invisibleMenu), pt.h, pt.v);
  191.                     i := TrackControl(GetControlHandle(invisibleMenu), pt, POINTER(-1));
  192.                     ReportControl(theDialog, invisibleMenu);
  193.                 end;
  194.  
  195.             hideSecond: 
  196.                 begin
  197.                     SetCtlValue(Get