PD ROM 1/PD ROM Volume I - Macintosh Software from BMUG (1988).iso/Programming/Programming Tools/Pascal Demos from Apple/sfgetfile examp/SFSAMPLE.TEXT

Text File | 1985-05-13 | 17.9 KB | 596 lines | [TEXT/ttxt]

{$X-}   {Turn off stack expansion. This is a Lisa concept, not needed on Mac}
{$U-}   {Turn off the Lisa Libraries. This is required by the WorkShop}
{$R-}   {Turn off range checking}

Program SFDialogSample;

{--   Jeffery J. Bradford,  Macintosh Technical Support, April 1985    }

{--  This is a sample program that shows how to write a dialog box with }
{--- a scrollable window. It is similar to SF Get & Put File, but I have}
{--  left out a lot of things like being able to select items and stuff }
{--  you can probably write if you're considering doing something like  }
{--  this. Also the getting the names of files is not included. Look at }
{--  the File Sys example for how to do this.                           }



USES
    {$U Obj/Memtypes  } MemTypes,
    {$U Obj/QuickDraw } QuickDraw,
    {$U Obj/OSIntf    } OSIntf,
    {$U Obj/ToolIntf  } ToolIntf,
    {$U Obj/PackIntf  } PackIntf;

CONST
{menu stuff}
    AppleMenu = 256;
    FileMenu  = 257;
    EditMenu  = 258;
    SFMenu    = 259;

{window IDs}
    WindResID = 256;       {resource for background window}
    DlogResID = 256;       {resource for the dialog}
    CntlResID = 256;       {resource for the scroll bar}

TYPE
{this is useful stuff you might need sometime}

    WordStuff = Packed Record
       Case Integer of
         0: (Word: Integer);
         1: (SByte1,SByte0: SignedByte);
         2: (b15,b14,b13,b12,b11,b10,b9,b8,b7,b6,b5,b4,b3,b2,b1,b0: Boolean)
       End;

    CharStuff = Packed Record
         chr3,chr2,chr1,chr0: char;
       End;

    LMwordPtr = ^Integer;          {pointer to low memory address}
    LMLongPtr = ^LongInt;          {pointer to low memory address - long}



VAR
{global program stuff}
    Finished:      Boolean;    {used to terminate the program}
    ClockCursor:   CursHandle; {handle to the waiting watch cursor}

{Screen stuff}
    DragArea:   Rect;          {holds the area where window can be dragged in}
    GrowArea:   Rect;          {holds the area to which a window's size can change}
    Screen:     Rect;          {holds the screen dimensions}

{graphics stuff}
    Circle:     Rect;          {holds the coordinates for the circle}

{Window & Dialog pointer stuff}
    GrafWindow:   WindowPtr;   {pointer to the window}

{-----------------------------------------------------------------------------
                     end of global variable definition
-----------------------------------------------------------------------------}

PROCEDURE DrawBoxInerds;
{this routine draws a line to show scrolling, it could be file names}
Begin
  PenSize(10,10);
  MoveTo(0,0);
  LineTo(125,300);
  PenSize(1,1);         {restore the pensize}
End;

{-----------------------------------------------------------------------------}

PROCEDURE DrawGrayLine(theDialog: DialogPtr; ItemNo: integer);
{this is the UserItem procedure that draws the gray divider line}
Var
   ItemType: integer;
   theItem:  Handle;
   itsRect:  Rect;
Begin
  GetDItem(theDialog, ItemNo, ItemType, theItem, itsRect);
  FillRect(itsRect, ltGray);
End;

{-----------------------------------------------------------------------------}

PROCEDURE Scroll_It(SBar: ControlHandle);
Var OldOrig:   integer;
    NewOrig:   integer;
    delta:     integer;
    theBox:    Rect;
    UpDateRgn: RgnHandle;
    TempClip:  RgnHandle;

Begin
{get some new region space}
  UpDateRgn := NewRgn;                 {Rgn for use in updateing}
  TempClip  := NewRgn;                 {Rgn for use in restoring the clip}

{calculate the amount scrolled}
  OldOrig := GetCRefCon(SBar);             {get the current origin & save it}
  NewOrig := GetCtlValue(SBar);            {get what the new origin should be}
  delta := OldOrig - NewOrig;              {get V diff. between old & new origin}

{get the area to scroll}
  SetRect(theBox, 12, 11, 125, 125);       {get the box rect = item rect}
  InSetRect(theBox, 1,1);                  {make scroll box smaller by one pixel}

{do the scrolling}
  ScrollRect(theBox, 0, delta, UpDateRgn);  {move pixels up by Vert. diff.}

{clip to the update region, & set to new origin}
  GetClip(TempClip);
  SetOrigin(0,NewOrig);                          {move the origin for drawing}
  OffSetRect(UpDateRgn^^.rgnBBox, 0, NewOrig);   {move the clip}
  ClipRect(UpDateRgn^^.rgnBBox);

{draw whatever is in the box}
  DrawBoxInerds;

{restore the clip, origin & remember the new origin for next scroll}
  SetOrigin(0,0);
  SetClip(TempClip);
  SetCRefCon(SBar, NewOrig);

{throw away unneeded things}
  DisposeRgn(tempClip);
  DisposeRgn(UpDateRgn);
End;

{-----------------------------------------------------------------------------}

PROCEDURE ItemScroll(ScrollBarHdl:ControlHandle; CntlLoc: integer);
{this routine is used to scroll an item at a time}
Var inc: integer;
Begin
  If CntlLoc = inUpButton then inc := -5
  else
  If CntlLoc = inDownButton then inc := +5;

  SetCtlValue(ScrollBarHdl, GetCtlValue(ScrollBarHdl) + inc);
  Scroll_It(ScrollBarHdl);
End;

{-----------------------------------------------------------------------------}

PROCEDURE PageSroll(ScrollBarHdl:ControlHandle; CntlLoc: integer);
{this routine is used to scroll a page at a time}
Var inc: integer;
Begin
  If CntlLoc = inPageUp then inc := GetCtlMin(ScrollBarHdl)
  else
  If CntlLoc = inPageDown then inc := GetCtlMax(ScrollBarHdl);

  SetCtlValue(ScrollBarHdl, inc);
  Scroll_It(ScrollBarHdl);
End;

{-----------------------------------------------------------------------------}

PROCEDURE Scroller(theDialog: DialogPtr);
Var
   BoxScrollBar: ControlHandle;
   mouseLoc:     Point;
   ControlLoc:   integer;
   dummy:        integer;

Begin
{get the mouse location- its local to the current Grafport}
  SetPort(theDialog);
  GetMouse(mouseLoc);

{find the control part}
  ControlLoc := FindControl(mouseLoc, theDialog, BoxScrollBar);
  If ControlLoc <> 0 then
    Case ControlLoc of

      inUpButtom:   dummy:=TrackControl(BoxScrollBar, mouseLoc, @ItemScroll);
      inDownButton: dummy:=TrackControl(BoxScrollBar, mouseLoc, @ItemScroll);
      inPageUp:     PageSroll(BoxScrollBar, ControlLoc);
      inPageDown:   PageSroll(BoxScrollBar, ControlLoc);
      inThumb:      If TrackControl(BoxScrollBar, mouseLoc, Nil) <> 0 then
                    Scroll_It(BoxScrollBar);
    End
    else sysbeep(3);

End;

{-----------------------------------------------------------------------------}

PROCEDURE BoxContents(theDialog: DialogPtr; ItemNo: integer);
{this procedure draws the box rect and the diagonal line that scrolls}
Var
   ItemType: integer;
   ItemHdl:  Handle;
   ItemRect: Rect;
   LongHdl:  LongInt;
   TempClip: RgnHandle;

Begin
{first get the Box size}
  GetDItem(theDialog, ItemNo, ItemType, ItemHdl, ItemRect);

{set the clip for drawing}
  TempClip := NewRgn;
  GetClip(TempClip);
  ClipRect(ItemRect);

{do the drawing}
  FrameRect(ItemRect);
  DrawBoxInerds;

{restore the clip & clean up}
  SetClip(TempClip);
  DisposeRgn(tempClip);

End;

{-----------------------------------------------------------------------------}

PROCEDURE DialogWithWindow;
{this procedure works just (almost) like the standard SFGetFile}
{it does not have the disk checking, etc. that SFGet does}
Var
   SFFileDlg: DialogPtr;
   ItemHit:    integer;
   ItemType:   integer;
   ItemHdl:    Handle;
   ItemRect:   Rect;
   BoxScrollBar:  ControlHandle;

Begin
{create the dialog}
  SFFileDlg := GetNewDialog(DlogResID, Nil, Pointer(-1));
  SetPort(SFFileDlg);   {so things work before we go into modal dialog}

{set the scroll bar and put it in dialog window; same location as UserItem #7}
  BoxScrollBar := GetNewControl(CntlResID, SFFileDlg);
  SetCtlMin(BoxScrollBar, 0);
  SetCtlMax(BoxScrollBar, 300 - 114);            {114=len of box}

{Set scrollbar refCon = origin = to zero initially,don't have to use globals}
  SetCRefCon(BoxScrollBar, 0);

{set the gray line userItem}
  GetDItem(SFFileDlg, 6, ItemType, ItemHdl, ItemRect);
  ItemHdl := Handle(ORD(@DrawGrayLine));       {convert procedure name to handle}
  SetDItem(SFFileDlg, 6, ItemType, ItemHdl, ItemRect);

{set the diagonal line drawing proc for the Box UserItem}
  GetDItem(SFFileDlg, 4, ItemType, ItemHdl, ItemRect);
  ItemHdl := Handle(ORD(@BoxContents));     {convert procedure name to handle}
  SetDItem(SFFileDlg, 4, ItemType, ItemHdl, ItemRect);

{everything has been setup, show the dialog window}
  ShowWindow(SFFileDlg);

{now start processing some user inputs}
  Repeat
    ModalDialog(Nil, ItemHit);
    Case ItemHit of
      1: begin end;                             {open}
      2: begin end;                             {cancel}
      3: begin end;                             {flower}
      4: begin end; {SFClick to detect click}   {window}
      5: Scroller(SFFileDlg);                   {scrollBar}
    End;
  Until ItemHit = Cancel;

  DisposeControl(BoxScrollBar);
  DisposDialog(SFFileDlg);
End;

{-----------------------------------------------------------------------------}

PROCEDURE DisplayCircle;
{This procedure is used to draw a circle in a window. Simple}
Begin
  FrameOval(Circle);
End;

{-----------------------------------------------------------------------------}

PROCEDURE ReSizeWindow(theWindow:WindowPtr; MouseLoc: Point);

 Var NewSize: LongInt;
     Width:   Integer;
     Height:  Integer;

 Begin
   NewSize := GrowWindow(theWindow,      { grow this window}
                         MouseLoc,       { mouse location  }
                         GrowArea);      { limits of growth - global var}
   If NewSize <> 0 then
   begin
     Height :=  HiWord(NewSize);         {high word of..}
     Width  :=  LoWord(NewSize);         {low word of...}

     If Height< 16 then Height := 16; {don't let the window close on itself}
     If Width < 16 then Width  := 16;

{now set the new size}
     SizeWindow(theWindow,   {resize this Window}
                    Width,   {set the width}
                   Height,   {set the height}
                    TRUE);   {set the update flag}

     InValRect(theWindow^.PortRect); {just inval everything, its a simple draw}

   end; {if size of window was changed}
 End;

{-----------------------------------------------------------------------------}

PROCEDURE ProcessMenu_in(CodeWord:longint);
Var
  Menu_No:    integer;        {menu number that was selected}
  Item_No:    integer;        {item in menu that was selected}
  NameHolder: Str255;         {name holder for desk accessory or font}
  DNA:        integer;        {OpenDA will never return 0, so don't care}

Begin
  If CodeWord <> 0 then {go ahead and process the command}
  begin
    Menu_No := HiWord(CodeWord);   {get the Hi word of...}
    Item_no := LoWord(CodeWord);   {get the Lo word of...}

    Case Menu_No of

     AppleMenu: Begin
                  GetItem(GetMHandle(AppleMenu), Item_No, NameHolder);
                  DNA := OpenDeskAcc(NameHolder);
                End;

      FileMenu: Begin
                  Case Item_No of
                    1: Finished := True;          {quit}
                  End;
                End;

      EditMenu: Begin
                  If Not SystemEdit(Item_no - 1) {if not for a desk accessory}
                  then
                    Case Item_No of
                      1: begin end;               {undo}
                    { 2:                           line divider}
                      3: begin end;               {cut}
                      4: begin end;               {copy}
                      5: begin end;               {paste}
                      6: begin end;               {clear}
                    End;
                End;

       SFMenu: If Item_no = 1 then DialogWithWindow;

    End;{case of Menu_No}

    HiliteMenu(0);               {unhilite after processing menu}
  end; {the If codeword <> 0}
End; {of ProcessMenu_in procedure}


{-------------------------------------------------------------------}
{----- These are procedures called from the main event loop  -------}

PROCEDURE DealwthMouseDowns(Event:EventRecord);
Var Location: integer;
    WindowPointedTo: WindowPtr;
    MouseLoc:Point;
    WindoLoc:integer;
Begin
  MouseLoc := Event.Where;
  WindoLoc := FindWindow(MouseLoc, WindowPointedTo);
  Case WindoLoc of

     inMenuBar: ProcessMenu_in(MenuSelect(MouseLoc));

     inSysWindow: SystemClick(Event,WindowPointedTo);

     inContent: If WindowPointedTo <> FrontWindow
                then SelectWindow(WindowPointedTo)
                else begin {do something} end;

     inGrow:    If WindowPointedTo <> FrontWindow
                then SelectWindow(WindowPointedTo)
                else ReSizeWindow(WindowPointedTo,MouseLoc);

     inDrag   :DragWindow(WindowPointedTo,MouseLoc,DragArea);

     inGoAway :If TrackGoAway(WindowPointedTo,MouseLoc)
               then DisposeWindow(WindowPointedTo); {since W mgr allocated space}

  End{ of case};
End;

{-----------------------------------------------------------------------------}

PROCEDURE DealwthKeyDowns(Event:EventRecord);
Var CharCode:char;
Begin
   CharCode:= CharStuff(Event.message).Chr0; {get low byte w/no processing}

  If BitAnd(Event.modifier,CmdKey) = CmdKey
   then
     begin  {key board command - probably a menu command}
       ProcessMenu_in(MenuKey(CharCode));
     end
   else
     begin
       {regular keyboard entry}
     end;
End;

{-----------------------------------------------------------------------------}

PROCEDURE DealwthActivates(Event: EventRecord);
Var TargetWindow:WindowPtr;
Begin
   TargetWindow := WindowPtr(Event.message);
   DrawGrowIcon(TargetWindow);

   If Odd(Event.modifiers) {then the window is becoming active}
   then
     begin
       SetPort(TargetWindow);
       {and activate whatever else you need}
       {the scroll bars}
       {hilite selected text}
     end
   else
     begin
       {deactivate whatever you need}
       {deactivate the scroll bars}
       {UNhilite selected text}
     end;
End;

{-----------------------------------------------------------------------------}

PROCEDURE DealwthUpdates(Event:EventRecord);
Var UpDateWindow,
          TempPort: WindowPtr;
Begin
   UpDateWindow := WindowPtr(Event.message);
   GetPort(TempPort);                {Save the current port}

   SetPort    (UpDateWindow);      {set the port to one in Evt.msg}
   BeginUpDate(UpDateWindow);
     EraseRect(UpDateWindow^.VisRgn^^.rgnBBox);
     DisplayCircle;
     DrawGrowIcon(UpDateWindow);
   EndUpDate  (UpDateWindow);

   SetPort    (TempPort);             {restore to the previous port}
End;

{-----------------------------------------------------------------------------}

PROCEDURE MainEventLoop;
Var Event:EventRecord;
    ProcessIt: Boolean;
Begin
  Repeat
    SystemTask;             {so you can support Desk Accessories}

    ProcessIt := GetNextEvent(EveryEvent,Event);
    If ProcessIt{is true} then {we'll ProcessIt}
          Case Event.what of

            mouseDown  : DealwthMouseDowns(Event);
            KeyDown    : DealwthKeyDowns  (Event);
            ActivateEvt: DealwthActivates (Event);
            UpDateEvt  : DealwthUpdates   (Event);

          End;{of Case}
  Until Finished; {terminate the program}
End;

{-----------------------------------------------------------------------------}

PROCEDURE InitThings;
Begin
  InitGraf(@thePort);          {create a grafport for the screen}

  MoreMasters;                 {extra pointer blocks at the bottom of the heap}
  MoreMasters;                 {this is 5 X 64 master pointers}
  MoreMasters;
  MoreMasters;
  MoreMasters;

{get the cursors we use and lock them down - no clutter}
  ClockCursor := GetCursor(watchCursor);
  HLock(Handle(ClockCursor));

{show the watch while we wait for inits & setups to finish}
  SetCursor(ClockCursor^^);

{init everything in case the app is the Startup App}
  InitFonts;                     {startup the fonts manager}
  InitWindows;                   {startup the window manager}
  InitMenus;                     {startup the menu manager}
  TEInit;                        {startup the text edit manager}
  InitDialogs(Nil);              {startup the dialog manager}

  Finished := False;             {set program terminator to false}
  FlushEvents(everyEvent,0);     {clear events from previous program}
End;

{-----------------------------------------------------------------------------}

PROCEDURE SetupLimits;
Begin
  Screen := ScreenBits.Bounds;   {set the size of the screen}
  SetRect(DragArea,Screen.left+4,Screen.top+24,Screen.right-4,Screen.bottom-4);
  SetRect(GrowArea,Screen.left,Screen.top+24,Screen.right,Screen.bottom);
End;

{-----------------------------------------------------------------------------}

PROCEDURE SetupMenus;
Var
  MenuTopic: MenuHandle;
Begin
  MenuTopic := GetMenu(AppleMenu);  {get the apple desk accessories menu}
  AddResMenu(MenuTopic,'DRVR');     {adds all names into item list}
  InsertMenu(MenuTopic,0);          {put in list held by menu manager}

  MenuTopic := GetMenu(FileMenu);   {always need this for Quiting}
  InsertMenu(MenuTopic,0);

  MenuTopic := GetMenu(EditMenu);   {always need for editing Desk Accessories}
  InsertMenu(MenuTopic,0);

  MenuTopic := GetMenu(SFMenu);     {this is for showing SF sample dialog}
  InsertMenu(MenuTopic,0);

  DrawMenuBar;           {all done so show the menu bar}
End;

{-----------------------------------------------------------------------------}

PROCEDURE SetupWindows;
Begin
  GrafWindow := GetNewWindow(WindResID, Nil, Pointer(-1));
End;

{-----------------------------------------------------------------------------}

PROCEDURE SetupGraphics;
{used just to show something on the screen}
Begin
  SetRect(Circle, 50,50,100,100);
End;

{-----------------------------------------------------------------------------}

PROCEDURE SetUpThings;
Begin
  SetupWindows;         {do first so its low in heap}
  SetupMenus;
  SetupLimits;
  SetupGraphics;

  InitCursor;           {ready, set, go, show the Arrow cursor}
End;

{-----------------------------------------------------------------------------}

PROCEDURE CloseThings;
Begin
{close files, if you changed sys resources, UNchange them here be carefull}
{about changing sys things, remember the Switcher could be around}
End;

{-----------------------------------------------------------------------------}

BEGIN
  InitThings;
  SetUpThings;
  MainEventLoop;
  CloseThings;
END.