home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Pascal / Snippets / MovieScroll / MovieScroll.p < prev    next >
Encoding:
Text File  |  1995-11-26  |  6.0 KB  |  199 lines  |  [TEXT/PJMM]
  1. {• --------------------------------------------------------------- •//}
  2. {• A public domain demo of "movie" type scrolling,    courtesy of        •//}
  3. {• Kenneth A. Long (kenlong@netcom.com).                            •//}
  4. {• An itty bitty bytes™ production, for the benefit of anyone        •//}
  5. {• who can use it.                                                    •//}
  6. {• This is basically just "Bullseye" with some things dumped and    •//}
  7. {• two routines added, and a resource file to back the additions.    •//}
  8.  
  9. {• If you want the text drawn over black, like in the movies,         •//}
  10. {• then some other "girations" are necessary.  This just shows     •//}
  11. {• the scrolling, with style.                                        •//}
  12.  
  13. {• Enjoy!                                                            •//}
  14.  
  15. {• --------------------------------------------------------------- •//}
  16.  
  17. {Revised by Ingemar Ragnemalm:}
  18. {- Took out event handling - the modal dialog is just enough for the demo}
  19. {- Converted to Pascal}
  20. {- Timed the scrolling with TickCount, so it won't get ridiculously slow}
  21. {or, for that matter, fast.}
  22. {Slight revision nov-95:}
  23. {- Universal Interfaces}
  24. {- PPC project}
  25.  
  26. program MovieScroll;
  27.  
  28. {$IFC UNDEFINED THINK_PASCAL}
  29.     uses
  30.         Types, Quickdraw, Dialogs, Windows, Menus, Fonts, Events,{}
  31.         ToolUtils, TextEdit, Resources;
  32. {$ELSEC}
  33. {$SETC GENERATINGPOWERPC := false}
  34. {$ENDC}
  35.  
  36.     var
  37.         textHand: TEHandle;
  38.         appleMenu, fileMenu: MenuHandle;
  39.         shell_window: WindowPtr;
  40.  
  41.     const
  42.         aboutID = 128;
  43.  
  44.         appleID = 1;
  45.         fileID = 2;
  46.         quitItem = 1;
  47.  
  48. {In case you don't use Universal Interfaces with Think P, here's the renamed routines:}
  49. {$IFC UNDEFINED THINK_PASCAL}
  50. {$ELSEC}
  51.     type
  52.         DialogRef = DialogPtr;
  53.     procedure GetDialogItem (theDialog: DialogRef; itemNo: INTEGER; var itemType: INTEGER; var item: Handle; var box: Rect);
  54.     inline
  55.         $A98D;
  56.     procedure SetDialogItem (theDialog: DialogRef; itemNo: INTEGER; itemType: INTEGER; item: Handle; {CONST}
  57.                                     var box: Rect);
  58.     inline
  59.         $A98E;
  60.     function TEStyleNew ({CONST}
  61.                                     var destRect: Rect; {CONST}
  62.                                     var viewRect: Rect): TEHandle;
  63.     inline
  64.         $A83E;
  65.     procedure TEStyleInsert (text: univ Ptr; length: LONGINT; hST: StScrpHandle; hTE: TEHandle);
  66.     inline
  67.         $3F3C, $0007, $A83D;
  68.     function GetResourceSizeOnDisk (theResource: Handle): LONGINT;
  69.     inline
  70.         $A9A5;
  71.     procedure TESetAlignment (just: INTEGER; hTE: TEHandle);
  72.     inline
  73.         $A9DF;
  74. {$ENDC}
  75.  
  76.     procedure InitMacintosh;
  77.     begin
  78. {$IFC UNDEFINED THINK_PASCAL}
  79.         InitGraf(@qd.thePort);
  80.         InitFonts;
  81.         InitWindows;
  82.         InitMenus;
  83.         TEInit;
  84.         InitDialogs(nil);
  85.         MaxApplZone;
  86. {$ENDC}
  87.         FlushEvents(everyEvent, 0);
  88.         InitCursor;
  89.     end;
  90.  
  91.     procedure OutlineDefault (myDialog: WindowPtr; itemNo: Integer);
  92.         var
  93.             x: Integer;
  94.             rectangle: Rect;
  95.             theHandle: Handle;
  96.     begin
  97.         GetDialogItem(DialogPtr(myDialog), itemNo, x, theHandle, rectangle);
  98.         PenSize(3, 3);
  99.         InsetRect(rectangle, -4, -4);
  100.         FrameRoundRect(rectangle, 16, 16);
  101.         PenSize(1, 1);
  102.     end;
  103.  
  104.     const
  105.         SCREEN = 2;                    {• Text window useritem.}
  106.         SHOWTIME = 3;
  107.  
  108.         USERITEM = 7;                {• Used to outline default button.}
  109.         textID = 128;                {• rsrc ID# for text used.}
  110.         styleID = 128;                {• rsrc ID# for styl used.}
  111.         kTicksPerStep = 2;            {Number of ticks per step}
  112.     var
  113.         saveWPtr: GrafPtr;            {• Holds previous grafPtr.}
  114.         aboutPtr: DialogPtr;        {• Pointer to dialog.}
  115.         theItem: Integer;            {• Item selected by user.}
  116.         mLoc: Point;                {• Mouse location.}
  117.         rectangle: Rect;
  118.         x: Integer;
  119.         theHandle: Handle;
  120.         txtRect: Rect;                {• Used to hold viewRect.}
  121.         saveTxtHdl: TEHandle;        {• Text handle.}
  122.         finished: Boolean;            {• Pushed 'The End' button yet?}
  123.         styleHdl: StScrpHandle;
  124.         err: OSErr;
  125.  
  126.         thisTime, lastTime: Longint;
  127. {$IFC GENERATINGPOWERPC }
  128.         drawProc: ProcPtr;
  129. {$ENDC}
  130.  
  131. begin
  132.     InitMacintosh;
  133.  
  134.     GetPort(saveWPtr);                {• Save the old port.}
  135.     saveTxtHdl := textHand;            {• Save the old text hdl.}
  136.  
  137.     {• Get dialog box pointer.}
  138.     aboutPtr := GetNewDialog(aboutID, nil, WindowPtr(-1));
  139.  
  140.     {• This next makes the static text field font monaco 9.}
  141.     SetPort(GrafPtr(aboutPtr));    {• Output to dialog.}
  142.     TextSize(9);                    {• Set text size.}
  143.     TextFont(monaco);                {• Set text font.}
  144.  
  145.     {• Get text window rect.}
  146.     GetDialogItem(DialogPtr(aboutPtr), SCREEN, x, theHandle, txtRect);
  147.     InsetRect(txtRect, 5, 1);        {• Leave margins for text.}
  148.  
  149.     {• Create styled TERecord.}
  150.     textHand := TEStyleNew(txtRect, txtRect);
  151.  
  152.     {• Read the TEXT resource.}
  153.     theHandle := GetResource('TEXT', textID);
  154.     HLock(theHandle);                    {• Lock handle.}
  155.  
  156.     {• Get the style handle.}
  157.     styleHdl := StScrpHandle(Get1Resource('styl', styleID));
  158.     TEStyleInsert(theHandle^, GetResourceSizeOnDisk(theHandle), styleHdl, textHand);    {• move text into text record.}
  159.     TESetAlignment(1, textHand);
  160.     HUnlock(theHandle);                    {• Unlock handle.}
  161.  
  162.     ShowWindow(aboutPtr);                {• Show dialog box now.}
  163.     TEUpdate(txtRect, textHand);        {• Draw text in viewRect.}
  164.     InsetRect(txtRect, -5, -1);        {• Leave margins for text.}
  165.     FrameRect(txtRect);                {• Draw frame around text.}
  166.     OutlineDefault(aboutPtr, USERITEM);
  167.     GetDialogItem(DialogPtr(aboutPtr), USERITEM, x, theHandle, rectangle);    {• outline default button.}
  168. {$IFC GENERATINGPOWERPC}
  169.     drawProc := NewRoutineDescriptor(@OutlineDefault, uppUserItemProcInfo, GetCurrentISA);
  170.     SetDialogItem(aboutPtr, USERITEM, x, Handle(drawProc), rectangle);    {• redraw if erased*/}
  171. {$ELSEC}
  172.     SetDialogItem(aboutPtr, USERITEM, x, Handle(@OutlineDefault), rectangle);    {• redraw if erased*/}
  173. {$ENDC}
  174.  
  175.     finished := false;                {• Reset flag.}
  176.     repeat                             {• Repeat until finished.}
  177.         ModalDialog(nil, theItem);    {• Show dialog/get result.}
  178.         case theItem of             {• Control hit.}
  179.             OK: 
  180.                 finished := true;    {• "The End" button hit / close.}
  181.             SHOWTIME: 
  182.                 begin
  183.                     thisTime := TickCount div kTicksPerStep;
  184.                     repeat
  185.                         lastTime := TickCount div kTicksPerStep;
  186.                     {• scroll up a pixel}
  187.                         TEScroll(0, thisTime - TickCount div kTicksPerStep, textHand);
  188.                         thisTime := lastTime;
  189.                     until Button;
  190.                 end;
  191.             otherwise
  192.         end;                            {• End of  case.}
  193.     until finished;            {• End of  mainloop.}
  194.  
  195.     TEDispose(textHand);            {• Reclaim heap space.}
  196.     textHand := saveTxtHdl;            {• Restore global textHand.}
  197.     DisposeDialog(aboutPtr);            {• Get rid of dialog box.}
  198.     SetPort(saveWPtr);                {• Restore the old port.}
  199. end.