home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Snippets / CollectPictColors 1.0 / CollectPictColors.p < prev    next >
Encoding:
Text File  |  1995-10-09  |  6.1 KB  |  229 lines  |  [TEXT/PJMM]
  1. (****************************************************************************)
  2. (*                                                                                *)
  3. (*    Application:    CollectPictColors                                            *)
  4. (*                                                                                *)
  5. (*    Description:    This application uses the Picture Utilities package        *)
  6. (*                    and Jon Zap's KnowsPict application to demonstrate    *)
  7. (*                    two methods of collecting colors used by Pict            *)
  8. (*                    resources.  In this program, you'll see different        *)
  9. (*                    results for each method.  With the Pict Util package,    *)
  10. (*                    the routine, GetPictInfo, returns a colortable with    *)
  11. (*                    the number of colors requested, but only the colors    *)
  12. (*                    used in the picture or it's pixmap(s) image data are    *)
  13. (*                    stored in the requested colors.  As for the                *)
  14. (*                    remaining requested colors not used by the picture    *)
  15. (*                    but stored in the picture's pixmap(s) colortable,        *)
  16. (*                    they are set to black.  In Jon's application this        *)
  17. (*                    doesn't occur.  All the colors used by the picture,        *)
  18. (*                    including those stored in the picture's pixmap(s)        *)
  19. (*                    colortable are returned.  To use Jon's routines,        *)
  20. (*                    simply call CollectColors with the appropriate            *)
  21. (*                    parameters.                                                *)
  22. (*                                                                                *)
  23. (*    Files:            CollectPictColors.π                                        *)
  24. (*                    CollectPictColors.c                                        *)
  25. (*                    CollectPictColors.π.rsrc                                *)
  26. (*                    CLUTBuilder.c    (written by Jon Zap)                        *)
  27. (*                                                                                *)
  28. (*    Programmer:        Edgar Lee                                                *)
  29. (*    Organization:    Apple Computer, Inc.                                        *)
  30. (*    Department:        Developer Technical Support, DTS                    *)
  31. (*    Date Created:    02-20-92                                                    *)
  32. (*                                                                                *)
  33. (*    Converted to Pascal 1995                                                *)
  34. (*    Language:        Pascal (Think Pascal version 4.0.2 /                    *)
  35. (*                                Metrowerks Pascal CW6)                    *)
  36. (*                                                                                *)
  37. (**********************************************)
  38.  
  39.  
  40. {Converted to Pascal 1995 by… bah, what do you care?}
  41.  
  42.  
  43. program CollectPictColors;
  44.  
  45.     uses
  46.         Palettes, 
  47. {$IFC UNDEFINED THINK_PASCAL}
  48.         Types, QuickDraw, Memory, Events, Menus, Windows, TextEdit, Dialogs,{}
  49.         Fonts, Resources, ToolUtils, PictUtils, 
  50. {$ELSEC}
  51.         PictUtil, 
  52. {$ENDC}
  53.         CLUTBuilder;
  54.  
  55. (* Constant Declarations *)
  56.  
  57.     const
  58.         kWWidth = 470;
  59.         kWHeight = 330;
  60.  
  61.     procedure InitMac;
  62.     begin
  63. {$IFC UNDEFINED THINK_PASCAL}
  64.         MaxApplZone;
  65.  
  66.         InitGraf(@qd.thePort);
  67.         InitFonts;
  68.         InitWindows;
  69.         InitMenus;
  70.         TEInit;
  71.         InitDialogs(nil);
  72. {$ENDC}
  73.         InitCursor;
  74.         FlushEvents(0, everyEvent);
  75.     end; {InitMac}
  76.  
  77.     procedure CreateWindow;
  78.         var
  79.             theRect: Rect;
  80.             window: WindowPtr;
  81.             wLeft, wTop: Integer;
  82.     begin
  83. {$IFC UNDEFINED THINK_PASCAL}
  84.         wLeft := (qd.screenBits.bounds.right - qd.screenBits.bounds.left - kWWidth) div 2;
  85.         wTop := (qd.screenBits.bounds.bottom - qd.screenBits.bounds.top - kWHeight) div 2;
  86. {$ELSEC}
  87.         wLeft := (screenBits.bounds.right - screenBits.bounds.left - kWWidth) div 2;
  88.         wTop := (screenBits.bounds.bottom - screenBits.bounds.top - kWHeight) div 2;
  89. {$ELSEC}
  90.         SetRect(theRect, wLeft, wTop, wLeft + kWWidth, wTop + kWHeight);
  91.         window := NewCWindow(nil, theRect, 'Collect Pict Colors', true, documentProc, WindowPtr(-1), true, 0);
  92.         SetPort(window);
  93.  
  94.         TextFont(geneva);
  95.         TextSize(9);
  96.         TextMode(srcCopy);
  97.     end; {CreateWindow}
  98.  
  99.     procedure DrawColors (ctable: CTabHandle; offset: Integer; theString: Str255);
  100.         var
  101.             i: Integer;
  102.             col, row: Integer;
  103.             theRect: Rect;
  104.     begin
  105.         ForeColor(whiteColor);
  106.         BackColor(blackColor);
  107.  
  108.         MoveTo(offset, 20);
  109.         DrawString(theString);
  110.  
  111.         if (ctable <> nil) then
  112.             begin
  113.                 for i := 0 to 255 do
  114.                     begin
  115.                         col := offset + ((i mod 8) * 16);
  116.                         row := 30 + ((i div 8) * 9);
  117.  
  118.                         SetRect(theRect, col, row, col + 10, row + 3);
  119.                         RGBForeColor(ctable^^.ctTable[i].rgb);
  120.                         PaintRect(theRect);
  121.  
  122.                         ForeColor(whiteColor);
  123.                         InsetRect(theRect, -2, -2);
  124.                         FrameRect(theRect);
  125.                     end;
  126.             end
  127.         else
  128.             begin
  129.                 MoveTo(12, offset);
  130.                 DrawString('-Sorry could not load PICT resource.');
  131.             end;
  132.     end;
  133.  
  134.     procedure DrawPictureColors;
  135.         var
  136.             theRect: Rect;
  137.             pict: PicHandle;
  138.             ctable: CTabHandle;
  139.             depth: Integer;
  140.             directFlag: Boolean;
  141.             thePictInfo: PictInfo;
  142.     begin
  143.  
  144.     (* Load the pict resource. *)
  145.         pict := GetPicture(128);
  146.  
  147.     (* Make sure it's not purgeable. *)
  148.         HNoPurge(Handle(pict));
  149.  
  150.     (* Set a black background. *)
  151.         SetRect(theRect, 0, 0, kWWidth, kWHeight);
  152.         ForeColor(blackColor);
  153.         PaintRect(theRect);
  154.  
  155.     (* See what CollectColors returns. *)
  156.         ctable := CollectColors(pict, depth, directFlag);
  157.         DrawColors(ctable, 20, 'COLLECTCOLORS Colortable');
  158.  
  159.     (* Draw the picture. *)
  160.         theRect := pict^^.picFrame;
  161.         OffsetRect(theRect, -theRect.left + 160, -theRect.top + 70);
  162.         DrawPicture(pict, theRect);
  163.  
  164.     (* Frame the picture. *)
  165.         InsetRect(theRect, -2, -2);
  166.         FrameRect(theRect);
  167.  
  168.     (* Now see what GetPictInfo returns. *)
  169.         if noErr = GetPictInfo(pict, thePictInfo, returnColorTable, 256, medianMethod, 0) then
  170.             ;
  171.         DrawColors(thePictInfo.theColorTable, theRect.right + 15, 'GETPICTINFO Colortable');
  172.  
  173.     (* Release the resource. *)
  174.         ReleaseResource(Handle(pict));
  175.  
  176.     (* Release the colortable. *)
  177.         DisposeCTable(ctable);
  178.     end; {DrawPictureColors}
  179.  
  180.     procedure DoEventLoop;
  181.         var
  182.             event: EventRecord;
  183.             window: WindowPtr;
  184.             clickArea: Integer;
  185.             screenRect: Rect;
  186.     begin
  187.         while true do
  188.             begin
  189.                 if (WaitNextEvent(everyEvent, event, 0, nil)) then
  190.                     begin
  191.                         if (event.what = mouseDown) then
  192.                             begin
  193.                                 clickArea := FindWindow(event.where, window);
  194.                                 if (clickArea = inDrag) then
  195.                                     begin
  196.                                         screenRect := GetGrayRgn^^.rgnBBox;
  197.                                         DragWindow(window, event.where, screenRect);
  198.                                     end
  199.                                 else if (clickArea = inContent) then
  200.                                     begin
  201.                                         if (window <> FrontWindow) then
  202.                                             SelectWindow(window);
  203.                                     end
  204.                                 else if (clickArea = inGoAway) then
  205.                                     if (TrackGoAway(window, event.where)) then
  206.                                         exit(DoEventLoop);
  207.                             end
  208.                         else if (event.what = updateEvt) then
  209.                             begin
  210.                                 window := WindowPtr(event.message);
  211.                                 SetPort(window);
  212.  
  213.                                 BeginUpdate(window);
  214.                                 DrawPictureColors;
  215.                                 EndUpdate(window);
  216.                             end;
  217.                     end;
  218.             end;
  219.     end; {DoEventLoop}
  220.  
  221.  {main program}
  222.  
  223. begin
  224.     InitMac;
  225.  
  226.     CreateWindow;
  227.  
  228.     DoEventLoop;
  229. end.