TweetFollow Us on Twitter

Window Defs
Volume Number:2
Issue Number:10
Column Tag:Pascal Procedures

Window Definition Routines

By Darryl Lovato, TML Systems, Inc., MacTutor Contributing Editor

In my first article describing definition routines, I stated that the best way to create a Definition Routine was to develop the routine as a procedure or function in your code, and when it is finished, make it into its respective resource (MDEF, WDEF, CDEF, LDEF). This finished resource can then be installed into your application and used just as you would a standard Definition Routine. There seems to be some confusion about this.

Creating the routine within your program requires that you do some hacking that isn't very nice, and slightly buggy, but it usually works. The reason you would want to create the routine as part of your code is because it's much faster to compile a definition procedure as part of your code as opposed to compiling the procedure into a resource, installing it, and then running the program that uses it.

As my first article explained, there are several ways to create the Definition Routine as part of your program. The way I choose to include the Definition Routine is shown below:

.....
var {our menu handle}
 myMenuHdl : MenuHandle;
.....
{this is the proc that will become a resource}
procedure TheMenuProc(.....);
begin
.....
end;
.....
 {first, we need to get a menu handle!}
myMenuHdl := GetNewMenu(.....);
 {second, we create a new handle that will be the  handle to our routine. 
}
myMenuHdl^^.menuProc := NewHandle(0);
 {third, we make the handle point to a pointer to  our routine. This, 
in effect makes a handle to our  routine (which is what we went through 
all this  for!).  We can do this because the routine is in the 
 first code segment that is always locked.}
myMenuHdl^^.menuProc^ := Ptr(@TheMenuProc);

Mike Shulster's approach to creating a definition routine is a bit different, but works just as well. He makes a 6 byte resource, MDEF, WDEF, etc. All the resource contains is a JMP XXXXXXXX instruction. After he gets the handle to the routine, he patches the contents of the resource so that it will to jump back to his code!!! This method is shown below.

.....
var {our menu handle}
 myMenuHdl : MenuHandle;
.....
{this is the proc that will become a resource}
procedure TheMenuProc(.....);
begin
.....
end;
.....
 {first, we need to get a menu handle.  This will  read the 6 byte "defintion" 
resource and place a handle to it in the menu record}
myMenuHdl := GetNewMenu(.....);
 {Now we need to patch the resource's  JMP         XXXXXXXX instruction 
so that it will jump to our Definition Routine.  This is done by making 
a blind pointer}

 {get a ptr to the resource data}
MyPtr := Pointer(myMenuHdl^^.menuProc^);
  {skip JMP instruction but not address}
MyPtr := Pointer(Ord4(myPtr) + 2);
 {and stuff the address of the menu proc in the    XXXXXXXX portion of 
the resource}
MyPtr^ := Ord4(@TheMenuProc);
 {the resource data now consists of a jump back to       the applications 
code that implements the  definition routine.}

These methods should only be used during development!

Normally, a fairly large program consists of more than one code segment, therefore you can never be sure if the procedure is going to be part of segment one (which is locked). You could Hlock the code segment the code is a part of, but this would result in heap fragmentation which is a BIG NO NO!

How do you compile the Definition Procedure into a resource? TML Pascal allows you to do this very easily. When I wrote this, mid-August, the only other compiler that I know of that had this capability was Lisa Pascal.

A TML Pascal shell is shown below for a program that is to be compiled into a resource. Note: it must be compiled with the create desk accessory option checked.

program TheDefProcProgram;

{$C type id [attribute] [name]}
{$H ''}

{----------------------- RESOURCE STARTS HERE --}
procedure TheDefProc(.....);
  const
  type
  var
begin
end;
{------------------------- RESOURCE ENDS HERE --}

begin {no main program allowed}
end.

The type, is the resource type, id is the resource id, the name and attribute fields are optional and are used to set the resources name and attributes. Always remember to compile your tested Definition Routines into a resource when they are finished! The $H '' tells the compiler that the desk accessory header should not be linked to the Definition Routine. [The $C directive tells the compiler to create a code resource out of the first procedure. -Ed]

There are a number of GREAT things that can be done with definition routines. By the way, have any of you seen dBase Mac? The PopUps used in dBase Mac are custom Control Definitions, which we cover next month!

Introduction to Wdef Routines

This month we are covering Window Definition Routines. What is a window definition routine? It is a procedure that defines a particular type of window. The routine controls the way windows are drawn, the regions of the window, the highlighting, how they are grown, etc. In general, Window Definition routines define windows' appearance and behavior. The standard type of Macintosh window has been pre-defined for you and is stored in the system file. You may however want to define your own type of window. The windows in Microsoft's Flight Simulator are good examples of non-standard windows.

The window definition procedure I decided to use for an example doesn't create a non-standard window but it shows exactly how the standard menu definition works! The standard definition routine was written in 68000 Assembler, by Andy Hertzfeld (my hero), but ours will be written entirely in TML Pascal. There isn't any noticeable speed difference between the standard Menu Def and our imitation.

The pascal definition and general outline for a Window Definition function follows:

function MyWindowDef(varCode : Integer;
 theWindow : WindowPtr;
 message : Integer;
 param : LongInt) : LongInt;
type
  RectPtr = ^Rect;
var
  aRectPtr : RectPtr;
procedure DoDraw(aWindow : WindowPtr; param : LongInt);
  begin
  ... {draw window - check param to draw go-away or frame}
  end
function DoHit(aWindow : WindowPtr; param : LongInt) : LongInt;
  begin
  ... {check to see if the point is in window, return region}
  end;
procedure DoCalcRgn(aWindow : WindowPtr);
  begin
  ... { calculate the windows structure and content rgns}
  end;
procedure DoInit(aWindow : WindowPtr);
  begin
  ... { allocate any additional storage needed for window}
  end;
procedure DoDispose(aWindow : WindowPtr);
  begin
  ... { dispose of what you created in DoInit}
  end;
procedure DoGrow(aWindow : WindowPtr; aRect : Rect);
  begin
  ... {draw the grow- outline of the window in the rect}
  end;
procedure DoGIcon(aWindow : WindowPtr);
  begin
  ... {draw the grow icon}
  end;
begin
  case message of
    wDrawMsg :
        DoDraw(theWindow, param);
    wHitMsg :
        MyWindowDef := DoHit(theWindow, param);
    wCalcRgnMsg :
        DoCalcRgn(theWindow);
    wInitMsg :
        DoInit(theWindow);
    wDisposeMsg :
        DoDispose(theWindow);
    wGrowMsg  :
      begin
        aRectPtr := RectPtr(param);
        DoGrow(theWindow, aRectPtr^);
      end;
    wGIconMsg :
        DoGIcon(theWindow);
  end;
end;

The Parameters

The varCode parameter tells the window definition routine what variation of the window we are doing. For example, in the standard round-corner document window, the varCode parameter tells the definition function the radius of the corners.

The window manager gets the varCode in the following ways: When you create a window from a resource, you specify the definition ID in the Window Record. The definition ID is actually the resource ID of the window definition function in the upper 12 bits, and the varCode in the lower 4 bits:

The Window manager calls the Resource manager with

defHandle := GetResource('WDEF',resourceID);

and stores the result in the windowDefProc field of the window record in the following format.

The variation code is then passed to the Window Definition function.

TheWindow is a Pointer to the window the message effects. Remember that type-casting the window pointer, which is a GrafPtr, into a Window Peek, is done by the following:

aWindowPeekVar := WindowPeek(aWindowPtrVar);

The message parameter tells you what operation you are to perform. The possible messages are: wDraw, wHit, wCalcRgns, wNew, wDispose, wGrow, and wDrawGIcon.

The param parameter is used to pass all kinds of stuff to your definition funtion. For instance, in the draw routine, you check the value of it to see if you are to draw the entire frame or just "toggle" the highlight state of the window's go-away box. In the grow message, it is a pointer to a rect and in the hit message it is the point in which the mouse button was pressed.

DoDraw Procedure

The DoDraw procedure is called in response to a wDraw message. It examines the value of param, if it is equal to wInGoAway then it toggles the state of the go-away box. In our example we do the highlighting differently, we just call InvertRect to toggle the state. If the value of param is 0, then we draw the entire window frame. The current port will already be set to the WindowMgrPort. If the go-away flag is true in the window record, we also draw the go-away region. If the highlighted field is true, we "highlight" the title bar, this shows the user that this window is the currently active one.

DoHit Function

The DoHit procedure is called in response to a wHit message. It is past the point (global coords) in the param parameter. It should determine where the point "hit" and return one of the following: 1) It should return wNoHit if it wasn't in the window. 2) It should return wInContent if the point was in the content region, and 3) it should return wInGrow if it was in the grow Region. It should also return wInGoAway if it was in the go-away rgn. The constants wInGrow and wInGoAway should only be returned if the window is active (highlighted = true).

DoCalcRgns Procedure

The DoCalcRgns procedure calculates the window's content and structure regions. The structure region is the entire window, including the title bar (if any), any shading, and the frame lines. In short it is the entire window. The content region is the area in which all drawing to the window will be clipped. It is always a sub-set of the structure region. Both of the regions are calculated from the windows portRect. The results of these calulations are stored in the windows strucRgn and contRgn fields.

The DoInit Procedure

The DoInit procedure is not used in our example. Its reason for being there, however, is to allow a definition procedure to create any additional data structures it may need. A handle to these data structures is stored in the dataHandle field of the window record. I used this feature when creating one of the TML Examples. The example creates a non-standard window, with highlighting like that on the Lisa (whoops.. Mac-XL). Its main feature is that it has a menu bar underneath the window's title bar, allowing each window to have its own menus. Anyway, in that example, I needed to store a bunch of menu handles when the window is created, and this message allowed me to do that.

DoDispose Procedure

The DoDispose procedure simply "un-o's" anything the DoInit procedure does. For instance, in the example I explained above, it calls DisposMenu for all the menus I created in the DoInit procedure. The DoDispose procedure, as you may have guessed, is called as a result of a CloseWindow or DisposeWindow call.

DoGrow Procedure

The DoGrow procedure is called after the Window definition function has returned a inGrow result from the Hit test routine. The window manager then sets the grafPort to the window manager port, the pen mode to notPatXor, and the penPat to gray. Then, as long as the user has the mouse down, the window manager repeatedly calls the definition function with the wGrow message. The DoGrow procedure must then draw the grow-image of the window, scaled to the rect which is passed by pointer in the param parameter. Our routine draws the outline of the entire window. It also shows the lines which delimit the title bar and the scroll bar areas.

DrawGIcon Procedure

The DrawGIcon procedure checks to see if the window is active. If active, it draws the grow icon in a manner that shows the window can be grown. If it is inactive, the DrawGIcon procedure draws the grow icon area in a manner which shows the window temporarily cannot be sized.

{
#RegWDEF.Pas
#
#This program illustrates the use of a standard Window 
#Definition routine.  It behaves exactly like the standard 
#window definition procedure. -=< almost >=-
#This example was written by Darryl Lovato.        
#Copyright (c) 1986 by TML Systems 
#
}

program RegWDEF; { the beginning}

{$I MemTypes.ipas} { read the memory defs}
{$I QuickDraw.ipas } { read the quickdraw defs}
{$I OSIntf.ipas  } { read operating system defs}
{$I Toolintf.ipas} { read the toolbox equates}

{$T APPL RWDF    } { set the type and creator}
{$B+    } { set the bundle bit}
{$L RegWDEFRes   } { link the resource file too...}

{
#    Global Contants Follow
}
const
  AppleMenuID = 1; { the Apple menu}
    AboutRegWDEFID = 1; { the About item}
  FileMenuID = 2;{ the File menu}
    QuitID = 1;  { the Quit item}
  EditMenuID = 3;{ the Edit menu}
  
  WindResID = 1; { the resource id of my window}
  AboutID = 3000;{ About Dialog id}

{
#   Global Variables Follow
}
var
  myMenus : Array[AppleMenuID..EditMenuID] of MenuHandle; 
  Done : Boolean;{ true when user selects quit}
  RegWDEFWindow : WindowPtr; {the window}
  GrowArea : rect; { rect wind can be grown}
  DragArea : rect; { rect wind can be dragged}
  myWindowPeek : WindowPeek;{ to get at the windows fields}
{
#
#    MyWindowDef function
}
function MyWindowDef(varCode : Integer;
 theWindow : WindowPtr;
 message : Integer;
 param : LongInt)
 : LongInt;
{------------- Semi-global types within the WDEF -------------}
type
  RectPtr = ^Rect;
{----------- Semi-global vars within the WDEF ------------}
var
  aRectPtr : RectPtr;
  myWindowPeek : WindowPeek;

{------------- DoDrawMessage procedure ---------------}
procedure DoDrawMessage(WindToDraw : WindowPtr;
   DrawParam : LongInt);
var
  TitleBarRect : Rect;
  CurrentY : Integer;
  index : Integer;
  GoAwayBox : Rect;

procedure DrawWindowTitle(aWindowPeek : WindowPeek;            
 theBox : Rect);
var
  TitleWidth : Integer;
  TitleBarWidth : Integer;
  leftEdge : Integer;
  eraseR : Rect;

begin
  TitleWidth := StringWidth(aWindowPeek^.titleHandle^^);
  TitleBarWidth := theBox.right - theBox.left;
  leftEdge := (TitleBarWidth - TitleWidth) DIV 2;
  if aWindowPeek^.GoAwayFlag then
    if leftEdge < 32 then
      leftEdge := 32;
  leftEdge := leftEdge + theBox.left; {local to global!!!}
  eraseR := theBox;
  InsetRect(eraseR,1,1);
  eraseR.left := leftEdge - 6;
  eraseR.right := leftEdge + TitleWidth + 6;
  EraseRect(eraseR);
  MoveTo(leftEdge,theBox.bottom - 5);
  DrawString(aWindowPeek^.titleHandle^^);
end;

begin
  myWindowPeek := WindowPeek(WindToDraw);
  if myWindowPeek^.visible then  {if the wind is visible, draw it}
    begin
      TitleBarRect := myWindowPeek^.strucRgn^^.rgnBBox;
      if DrawParam <> 0 then {we just need to toggle goAway box}
        begin {make room for title bar}
   TitleBarRect.bottom := TitleBarRect.top + 19;
   GoAwayBox := TitleBarRect;
   GoAwayBox.top := GoAwayBox.top + 4;
   GoAwayBox.left := GoAwayBox.left + 8;
   GoAwayBox.bottom := GoAwayBox.bottom - 4;
   GoAwayBox.right := GoAwayBox.left + 13;
   InsetRect(GoAwayBox,2,1); { move in on the sides}
   InvertRect(GoAwayBox);
 end {of if DrawParam = inGoAway}
      else {we need to draw window frame, and possibly hilite it}
        begin
   PenNormal;

   FrameRect(TitleBarRect);
   {make room for title bar}
   TitleBarRect.bottom := TitleBarRect.top + 19;

   FrameRect(TitleBarRect);
   InsetRect(TitleBarRect,1,1); {shrink by 1}
   EraseRect(TitleBarRect);
   InsetRect(TitleBarRect,-1,-1); {expand by 1}

   if myWindowPeek^.hilited then { add hiliting }
     begin
       currentY := TitleBarRect.top + 4; {draw the pattern}
       for index := 1 to 6 do 
         begin
   MoveTo(TitleBarRect.left + 2, currentY);
   LineTo(TitleBarRect.right - 3, currentY);
   currentY := currentY + 2;
 end;
       {draw title}
       DrawWindowTitle(myWindowPeek,TitleBarRect);
       if myWindowPeek^.GoAwayFlag then {goaway }
         begin
   GoAwayBox := TitleBarRect;
   GoAwayBox.top := GoAwayBox.top + 4;
   GoAwayBox.left := GoAwayBox.left + 8;
   GoAwayBox.bottom := GoAwayBox.bottom - 4;
   GoAwayBox.right := GoAwayBox.left + 13;
   EraseRect(GoAwayBox);
   InsetRect(GoAwayBox,1,0); { move in on sides}
   FrameRect(GoAwayBox); {and draw the box}
 end;
     end
   else {just draw the title}
     DrawWindowTitle(myWindowPeek,TitleBarRect);
 end; {of if DrawParam = inGoAway then.. else...}
    end; {of if window is visible...}
end;

{--------------- DoHitMessage function ---------------}

function DoHitMessage(WindToTest : WindowPtr;
 theParam : LongInt) : LongInt;
var
  globalPt : Point;
  aRect : Rect;
  GoAwayBox : Rect;
  aWindowPeek : WindowPeek;
  tempRect : Rect;
begin
  globalPt.h := LoWord(theParam);
  globalPt.v := HiWord(theParam);
  aWindowPeek := WindowPeek(WindToTest);
  aRect := aWindowPeek^.strucRgn^^.rgnBBox;
  aRect.bottom := aRect.top + 19; {create tBar Rect}
  tempRect := aWindowPeek^.strucRgn^^.rgnBBox;
  if PtInRect(globalPt,tempRect) then {in structure rgn?}
    begin
      tempRect := aWindowPeek^.contRgn^^.rgnBBox;
      if PtInRect(globalPt,tempRect) then {if in content rgn}
        begin
   if aWindowPeek^.hilited then {check the content box}
     begin
       aRect := aWindowPeek^.contRgn^^.rgnBBox;
       aRect.top := aRect.bottom - 15;{rect in low right}
       aRect.left := aRect.right - 15;
       if PtInRect(globalPt,aRect) then {it was in drag box}
         DoHitMessage := wInGrow
       else
         DoHitMessage := wInContent;
     end
   else
     DoHitMessage := wInContent;
 end
      else if PtInRect(globalPt,aRect) then {in drag or go-away}
        begin
   if aWindowPeek^.hilited then {check go-away box}
     begin
       GoAwayBox := aRect;
       GoAwayBox.top := GoAwayBox.top + 4;
       GoAwayBox.left := GoAwayBox.left + 8;
       GoAwayBox.bottom := GoAwayBox.bottom - 4;
       GoAwayBox.right := GoAwayBox.left + 13;
       InsetRect(GoAwayBox,1,0); { move in on the sides}
       if PtInRect(globalPt,GoAwayBox) then {in drag box}
         DoHitMessage := wInGoAway
       else
         DoHitMessage := wInDrag;
     end
   else
     DoHitMessage := wInDrag;
 end
      else {it was in our window frame}
        DoHitMessage := wNoHit;
    end
  else {it wasn't in our window at all}
    DoHitMessage := wNoHit;
end;

{------------ DoCalcRgnsMessage procedure -------------}
procedure DoCalcRgnsMessage(WindToCalc : WindowPtr);
var
  tempRect : Rect;
  aWindowPeek : WindowPeek;
  aRgn : RgnHandle;
begin
  tempRect := WindToCalc^.PortRect;
  
  OffsetRect(tempRect, -WindToCalc^.PortBits.Bounds.Left,
     -WindToCalc^.PortBits.Bounds.Top);
 
  aWindowPeek := WindowPeek(WindToCalc);
  RectRgn(aWindowPeek^.contRgn,tempRect); {content rgn}
  
  InsetRect(tempRect,-1,-1);
  tempRect.top := tempRect.top - 18; {make room for title bar}
  RectRgn(aWindowPeek^.strucRgn,tempRect); {struct rgn}
end;

{--------------- DoGrowMessage procedure -------------}
procedure DoGrowMessage(WindToGrow : WindowPtr;
   theGrowRect : Rect);

begin {note: we really dont need the window ptr, just the rect}
  theGrowRect.top := theGrowRect.top - 19;
  FrameRect(theGrowRect);
  theGrowRect.top := theGrowRect.top + 18;
  MoveTo(theGrowRect.left,theGrowRect.top); {drag area}
  LineTo(theGrowRect.right,theGrowRect.top);
  MoveTo(theGrowRect.right -15,theGrowRect.top); 
  LineTo(theGrowRect.right - 15, theGrowRect.bottom);
  MoveTo(theGrowRect.left,theGrowRect.bottom - 15);
  LineTo(theGrowRect.right,theGrowRect.bottom - 15);
end;

{------------ DoDrawSizeMessage procedure ------------}
procedure DoDrawSizeMessage(WindToDraw : WindowPtr);
var
  tempRect : Rect;
  boxRect : Rect;
begin
  SetPort(WindToDraw);
  tempRect := WindToDraw^.PortRect;
  tempRect.left := tempRect.right - 15;
  tempRect.top := tempRect.bottom - 15;
  boxRect := tempRect; {the grow icon area}

  myWindowPeek := WindowPeek(WindToDraw);
  
  tempRect.top := WindToDraw^.PortRect.top; {scroll frame}
  EraseRect(tempRect);
  MoveTo(tempRect.left,tempRect.top);
  LineTo(tempRect.left,tempRect.bottom);
  tempRect.right := tempRect.right - 15;
  tempRect.top := tempRect.bottom - 15;
  tempRect.left := WindToDraw^.PortRect.left;
  EraseRect(tempRect);
  tempRect.right := tempRect.right + 15;
  MoveTo(tempRect.left,tempRect.top);
  LineTo(tempRect.right,tempRect.top);

  if myWindowPeek^.hilited then {draw the grow icon}
    begin
      InsetRect(boxRect,1,1);
      boxRect.top := boxRect.top + 4;
      boxRect.left := boxRect.left + 4;
      FrameRect(boxRect);
      boxRect.right := boxRect.right - 2;
      boxRect.bottom := boxRect.bottom - 2;
      OffsetRect(boxRect,-2,-2);
      EraseRect(boxRect);
      FrameRect(boxRect);
     end
  else {erase the grow icon}
    begin
      InsetRect(boxRect,1,1);
      EraseRect(boxRect);
    end;
end;

{--------------- Main Proc within WDEF ----------------}

begin {case out on message & jump to appropriate routine}
  MyWindowDef := 0; {but first init result}
  case message of
    wDraw : { draw window frame}
      begin
        DoDrawMessage(theWindow, param);
      end;
    wHit :{ tell what rgn the mouse was pressed in}
      begin
        MyWindowDef := DoHitMessage(theWindow,param);
      end;
    wCalcRgns :  { calculate structRgn and contRgn}
      begin
        DoCalcRgnsMessage(theWindow);
      end;
    wNew :{ do any additional initialization}
      begin { we dont need to do any}
      end;
    wDispose : { do any additional disposal actions}
      begin { we dont need to do any}
      end;
    wGrow : { draw window's grow image}
      begin
        aRectPtr := RectPtr(param);
        DoGrowMessage(theWindow,aRectPtr^);
      end;
    wDrawGIcon : { draw size box in content rgn}
      begin
        DoDrawSizeMessage(theWindow);
      end;
  end;
end;

{#
#     ShowAbout procedure
#}

procedure ShowAbout; { give me some credit}
var
  theDlog : DialogPtr;
  theItem : Integer;
begin
  theDlog := GetNewDialog(AboutID,nil,Pointer(-1));
  ModalDialog(nil,theItem);
  DisposDialog(theDlog);
end;

procedure ProcessMenu(codeWord:Longint);
var
  menuNum : Integer;
  itemNum : Integer;
  NameHolder : str255;
  dummy : Integer;
  yuck : boolean;
begin
  if codeWord <> 0 then { nothing was selected}
    begin
      menuNum := HiWord(codeWord);
      itemNum := LoWord(codeWord);
      case menuNum of { the different menus}
        AppleMenuID :
   begin
     if itemNum < 3 then
       begin
         ShowAbout;
       end
     else
       begin
         GetItem(myMenus[AppleMenuID],
 itemNum,NameHolder);
 dummy := OpenDeskAcc(NameHolder);
       end;
   end;
 FileMenuID : 
   begin
     Done := true;
   end;
 EditMenuID :
   begin
     yuck := SystemEdit(itemNum - 1);
   end;
      end;
      HiliteMenu(0);
    end;
end;

procedure DealWithMouseDowns(theEvent: EventRecord);
var
  location : Integer;
  windowPointedTo : WindowPtr;
  mouseLoc : point;
  windowLoc : integer;
  VandH : Longint;
  Height : Integer;
  Width : Integer;

begin
  mouseLoc := theEvent.where;
  windowLoc := FindWindow(mouseLoc,windowPointedTo);
  case windowLoc of
    inMenuBar : 
      begin
        ProcessMenu(MenuSelect(mouseLoc));
      end;
    inSysWindow : 
      begin
        SystemClick(theEvent,windowPointedTo);
      end;
    inContent :
      begin
        if windowPointedTo <> FrontWindow then
   begin
     SelectWindow(windowPointedTo);
   end;
      end;
    inGrow :
      begin
        if windowPointedTo <> FrontWindow then
   begin
     SelectWindow(windowPointedTo);
   end
 else
   begin
     GrowArea.left := 150;
     GrowArea.top := 50;
     VandH := GrowWindow(windowPointedTo,
 mouseLoc,GrowArea);
     if VandH <> 0 then
       begin
         Height := HiWord(VandH);
 Width := LoWord(VandH);
 if Height< 50 then
   Height := 50;
 if Width < 150 then
   Width  := 150;
         SizeWindow(windowPointedTo,Width,Height,true);
         InvalRect(windowPointedTo^.portRect); 
      end;
   end;
      end;
    inDrag : 
      begin
        DragWindow(windowPointedTo,mouseLoc,DragArea);
 SelectWindow(windowPointedTo);
      end;
    inGoAway :
      begin
        if TrackGoAway(windowPointedTo,mouseLoc) then
   Done := true;
      end;
  end;
end;

procedure DealWithKeyDowns(theEvent: EventRecord);
type
  Trick = packed record
    case boolean of
      true : (long : Longint);
      false : (chr3,chr2,chr1,chr0 : char)
    end;
var
  CharCode : char;
  TrickVar : Trick;
begin
  TrickVar.long := theEvent.message;
  CharCode := TrickVar.chr0;
  if BitAnd(theEvent.modifiers,CmdKey) = CmdKey  then 
    begin
      ProcessMenu(MenuKey(CharCode));
    end;
end;

procedure DealWithActivates(theEvent: EventRecord);
var
  TargetWindow : WindowPtr;

begin
  TargetWindow := WindowPtr(theEvent.message);
  DrawGrowIcon(TargetWindow);
  if Odd(theEvent.modifiers) then
    begin
      SetPort(TargetWindow);
    end;
end;

procedure DealWithUpdates(theEvent: EventRecord);
var
  UpDateWindow : WindowPtr;
  tempPort : WindowPtr;

begin
  UpDateWindow := WindowPtr(theEvent.message);
  GetPort(tempPort);
    SetPort(UpDateWindow);
    BeginUpDate(UpDateWindow);
      EraseRect(UpDateWindow^.portRect);
      FillRect(RegWDEFWindow^.PortRect,ltGray);
      DrawGrowIcon(UpDateWindow);
    EndUpDate(UpDateWindow);
  SetPort(tempPort);
end;

{# MainEventLoop procedure
#
#}
procedure MainEventLoop;
var
  Event : EventRecord;
  ProcessIt : boolean;
begin
  repeat
    SystemTask;
    ProcessIt := GetNextEvent(everyEvent, Event); 
    if ProcessIt then
      begin
        case Event.what of
   mouseDown : DealWithMouseDowns(Event);
   AutoKey : DealWithKeyDowns(Event);
   KeyDown : DealWithKeyDowns(Event);
   ActivateEvt : DealWithActivates(Event);
   UpdateEvt : DealWithUpdates(Event);
 end;
      end;
  until Done;
end;

procedure SetupMemory;
var
  x : Longint;
begin
  x := ORD4(ApplicZone) + 128000;
  SetApplLimit(Pointer(x));
  MaxApplZone;
  MoreMasters;
  MoreMasters;
  MoreMasters;
end;

procedure SetupLimits;  { set up the dragging growing rects}
var
  Screen : Rect;
begin
  Screen := ScreenBits.bounds;
  with Screen do
    begin
      SetRect(DragArea,left+4,top+24,right-4,bottom-4);
      SetRect(GrowArea,left,top+24,right,bottom);
    end;
end;

procedure MakeMenus; { get the menus }
var
  index : Integer;
begin
  for index := AppleMenuID to EditMenuID do
    begin
      myMenus[index] := GetMenu(index);
      InsertMenu(myMenus[index],0);
    end;
  AddResMenu(myMenus[AppleMenuID],'DRVR');
  DrawMenuBar;
end;
{#################################################
#Program Execution Starts Here
###################################################}
begin
  Done := false; { we just started!!!}
  FlushEvents(everyEvent,0);{ get rid of lingering events}

  InitGraf(@thePort);{ we need QuickDraw}
  InitFonts;{ we need Fonts}
  InitWindows;   { we need Windows}
  InitMenus;{ we need Menus}
  TEInit; { we need Text Edit}
  InitDialogs(nil);{ we need Dialogs}
  InitCursor;    { show the cursor}

  SetupLimits;   { initialize the screen sizes}
  SetupMemory;   { do some memory management}
  MakeMenus;{ go create the menus}
  
  RegWDEFWindow := GetNewWindow(WindResID,
 nil,Pointer(-1));
  myWindowPeek := WindowPeek(RegWDEFWindow); 
  {note, the window is created invisible}
  
  myWindowPeek^.windowDefProc := NewHandle(0);
  myWindowPeek^.windowDefProc^ := Ptr(@MyWindowDef);
  
  ShowWindow(RegWDEFWindow); {....now we can show it!}
  SetPort(RegWDEFWindow);
  FillRect(RegWDEFWindow^.PortRect,ltGray);
  
  MainEventLoop; { ...and take care of business}
end.
 

Community Search:
MacTech Search:

Software Updates via MacUpdate

Latest Forum Discussions

See All

Fresh From the Land Down Under – The Tou...
After a two week hiatus, we are back with another episode of The TouchArcade Show. Eli is fresh off his trip to Australia, which according to him is very similar to America but more upside down. Also kangaroos all over. Other topics this week... | Read more »
TouchArcade Game of the Week: ‘Dungeon T...
I’m a little conflicted on this week’s pick. Pretty much everyone knows the legend of Dungeon Raid, the match-3 RPG hybrid that took the world by storm way back in 2011. Everyone at the time was obsessed with it, but for whatever reason the... | Read more »
SwitchArcade Round-Up: Reviews Featuring...
Hello gentle readers, and welcome to the SwitchArcade Round-Up for July 19th, 2024. In today’s article, we finish up the week with the unusual appearance of a review. I’ve spent my time with Hot Lap Racing, and I’m ready to give my verdict. After... | Read more »
Draknek Interview: Alan Hazelden on Thin...
Ever since I played my first release from Draknek & Friends years ago, I knew I wanted to sit down with Alan Hazelden and chat about the team, puzzle games, and much more. | Read more »
The Latest ‘Marvel Snap’ OTA Update Buff...
I don’t know about all of you, my fellow Marvel Snap (Free) players, but these days when I see a balance update I find myself clenching my… teeth and bracing for the impact to my decks. They’ve been pretty spicy of late, after all. How will the... | Read more »
‘Honkai Star Rail’ Version 2.4 “Finest D...
HoYoverse just announced the Honkai Star Rail (Free) version 2.4 “Finest Duel Under the Pristine Blue" update alongside a surprising collaboration. Honkai Star Rail 2.4 follows the 2.3 “Farewell, Penacony" update. Read about that here. | Read more »
‘Vampire Survivors+’ on Apple Arcade Wil...
Earlier this month, Apple revealed that poncle’s excellent Vampire Survivors+ () would be heading to Apple Arcade as a new App Store Great. I reached out to poncle to check in on the DLC for Vampire Survivors+ because only the first two DLCs were... | Read more »
Homerun Clash 2: Legends Derby opens for...
Since launching in 2018, Homerun Clash has performed admirably for HAEGIN, racking up 12 million players all eager to prove they could be the next baseball champions. Well, the title will soon be up for grabs again, as Homerun Clash 2: Legends... | Read more »
‘Neverness to Everness’ Is a Free To Pla...
Perfect World Games and Hotta Studio (Tower of Fantasy) announced a new free to play open world RPG in the form of Neverness to Everness a few days ago (via Gematsu). Neverness to Everness has an urban setting, and the two reveal trailers for it... | Read more »
Meditative Puzzler ‘Ouros’ Coming to iOS...
Ouros is a mediative puzzle game from developer Michael Kamm that launched on PC just a couple of months back, and today it has been revealed that the title is now heading to iOS and Android devices next month. Which is good news I say because this... | Read more »

Price Scanner via MacPrices.net

Amazon is still selling 16-inch MacBook Pros...
Prime Day in July is over, but Amazon is still selling 16-inch Apple MacBook Pros for $500-$600 off MSRP. Shipping is free. These are the lowest prices available this weekend for new 16″ Apple... Read more
Walmart continues to sell clearance 13-inch M...
Walmart continues to offer clearance, but new, Apple 13″ M1 MacBook Airs (8GB RAM, 256GB SSD) online for $699, $300 off original MSRP, in Space Gray, Silver, and Gold colors. These are new MacBooks... Read more
Apple is offering steep discounts, up to $600...
Apple has standard-configuration 16″ M3 Max MacBook Pros available, Certified Refurbished, starting at $2969 and ranging up to $600 off MSRP. Each model features a new outer case, shipping is free,... Read more
Save up to $480 with these 14-inch M3 Pro/M3...
Apple has 14″ M3 Pro and M3 Max MacBook Pros in stock today and available, Certified Refurbished, starting at $1699 and ranging up to $480 off MSRP. Each model features a new outer case, shipping is... Read more
Amazon has clearance 9th-generation WiFi iPad...
Amazon has Apple’s 9th generation 10.2″ WiFi iPads on sale for $80-$100 off MSRP, starting only $249. Their prices are the lowest available for new iPads anywhere: – 10″ 64GB WiFi iPad (Space Gray or... Read more
Apple is offering a $50 discount on 2nd-gener...
Apple has Certified Refurbished White and Midnight HomePods available for $249, Certified Refurbished. That’s $50 off MSRP and the lowest price currently available for a full-size Apple HomePod today... Read more
The latest MacBook Pro sale at Amazon: 16-inc...
Amazon is offering instant discounts on 16″ M3 Pro and 16″ M3 Max MacBook Pros ranging up to $400 off MSRP as part of their early July 4th sale. Shipping is free. These are the lowest prices... Read more
14-inch M3 Pro MacBook Pros with 36GB of RAM...
B&H Photo has 14″ M3 Pro MacBook Pros with 36GB of RAM and 512GB or 1TB SSDs in stock today and on sale for $200 off Apple’s MSRP, each including free 1-2 day shipping: – 14″ M3 Pro MacBook Pro (... Read more
14-inch M3 MacBook Pros with 16GB of RAM on s...
B&H Photo has 14″ M3 MacBook Pros with 16GB of RAM and 512GB or 1TB SSDs in stock today and on sale for $150-$200 off Apple’s MSRP, each including free 1-2 day shipping: – 14″ M3 MacBook Pro (... Read more
Amazon is offering $170-$200 discounts on new...
Amazon is offering a $170-$200 discount on every configuration and color of Apple’s M3-powered 15″ MacBook Airs. Prices start at $1129 for models with 8GB of RAM and 256GB of storage: – 15″ M3... Read more

Jobs Board

*Apple* Systems Engineer - Chenega Corporati...
…LLC,** a **Chenega Professional Services** ' company, is looking for a ** Apple Systems Engineer** to support the Information Technology Operations and Maintenance Read more
Solutions Engineer - *Apple* - SHI (United...
**Job Summary** An Apple Solution Engineer's primary role is tosupport SHI customers in their efforts to select, deploy, and manage Apple operating systems and Read more
*Apple* / Mac Administrator - JAMF Pro - Ame...
Amentum is seeking an ** Apple / Mac Administrator - JAMF Pro** to provide support with the Apple Ecosystem to include hardware and software to join our team and Read more
Operations Associate - *Apple* Blossom Mall...
Operations Associate - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Read more
Cashier - *Apple* Blossom Mall - JCPenney (...
Cashier - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Blossom Mall Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.