TweetFollow Us on Twitter

Long Text Lists
Volume Number8
Issue Number:6
Column Tag:Pascal Workshop

Related Info: List Manager Dialog Manager

Long Text Lists in Object Pascal

Here's how you can do very big lists without using the List Manager.

By David Rand

Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks.

About the author

David Rand is a programmer at the Centre de recherches mathématiques of the Université de Montréal.

The purpose of this article is to present a scrollable vertical list of text implemented in Object Pascal without using the List Manager. The list appears in a sort of modeless dialog box, but without using the Dialog Manager. I will refer to this type of dialog box as a “pseudo-dialog”. Several other objects are also included in order to give a more general overview of the implementation of custom “dialog” items as objects. The result is a very small class library whose hierarchy is illustrated in Figure 1. The two main objects, both direct descendants of the generic object type TObject, are the type TPseudoDialog which implements the window, and the type TPDialogItem which represents a generic pseudo-dialog item and is the parent of all other object types in the hierarchy.

This demonstration illustrates the following:

• an application “shell” which manages events appropriately;

• activation and deactivation of most items as well as the pseudo-dialog as a whole;

• the use of distinct fonts, font sizes and font styles for the different items;

• communication between the main program and the objects in the pseudo-dialog;

• a one-dimensional scrollable text list whose contents are not limited to 32 K in size and whose font, font size and font style are chosen from menus;

• a variety of buttons, including toggle buttons and buttons with a three-dimensional appearance, with command key equivalents;

• a static text item;

• an icon item;

• a simple animation item;

• a simple installation method for items, allowing the programmer to configure other pseudo-dialogs using the items included here or one’s own implementations of new descendants of TPDialogItem.

Figure 1

Naming Conventions

All object type identifiers begin with the capital letter “T”. All object field names begin with lower case “f”. Every object includes an initialization method whose name is identical to the object’s type identifier except that the “T” is replaced by “I”. Parameters to such routines are the same as field names but with the ”f” replaced by “i”. For example, the method TIcon.IIcon(iBorder: Rect; iIconID: INTEGER) is used to initialize an instance of an object of type TIcon by assigning values to fields fBorder and fIconID.

The Pseudo-Dialog

The pseudo-dialog is illustrated in Figures 2 and 3. In Figure 2 BigList is the active application, whereas in the other figure BigList is in the background. The deactivation is visible in several ways: the unhighlighting of the title bar, the graying of the window’s border, the disappearance of the list’s scroll bar, the changed highlighting of the list’s selection, the graying of the button titles, and the graying of the static text’s border.

The way in which this demonstration program reacts to hits in the various items (via the mouse or the keyboard) can be seen in the routine ProcessTheReply in BigList.p.

Figure 2

The Objects

We now consider each of the objects in the hierarchy illustrated in Figure 1.

TObject

The generic object type defined in Object Pascal and ancestor of all other objects types.

TPseudoDialog

An instance of this type is a pseudo-dialog box such as the one illustrated in Figures 2 and 3. The window (stored in field fWindow) is implemented without use of the Dialog Manager, so the object’s methods must include activation, deactivation, update and idle routines, as well as routines which respond to mouse clicks. See the method HandleMouseEvents in BLObject.p. The method ItemInformation calls the Information method of each item (see type TPDialogItem below) and displays the results in a temporary window for debugging purposes. The items are stored as a linked list of objects to which the field fItems gives access. The field fActive indicates whether the window is or is not the active window.

TPDialogItem

This object type defines a generic pseudo-dialog item. No instance of it is ever created, but it is necessary in order to declare basic fields and methods common to all its descendants. The field fNexThing “points” to the next item in the linked list of pseudo-dialog items, fItsValue is the item number, fFlag stores three Boolean flags, and fBorder is the item’s rectangle. The three flags indicate whether the item is active (in the window-activation sense), whether it is enabled (i.e., can it respond to mouse clicks?) and whether it is animated (i.e., does it currently require idling?). The object’s methods include many which resemble those of object type TPseudoDialog; i.e., activation, deactivation, etc. The Information method returns a string briefly describing the item and is useful for debugging.

The objects discussed below are pseudo-dialog items, i.e., descendants of the generic item object TPDialogItem.

Figure 3

TVerticalList

This is the the most complex of the object types in Figure 1 and is illustrated on the left side of the pseudo-dialog box in Figures 2 and 3. It contains a long vertical list which is scrollable and in which a single entry can be selected at a time. The list contents are stored in a single relocatable block accessed via the object’s fData field. For the purposes of this demonstration a list of 10,000 entries is generated, each entry containing a number and a word. (The program has been tested with up to 100,000 entries, corresponding to about 1 Meg. of data in the list.) The entries must be separated by a blank character (ASCII #32) and the first and last bytes in the data must also be blanks. The following features are supported: drag-selecting; choice of font, font size and font style via the Font and Style menus; activation and deactivation (affecting the appearance of both the scroll bar and the selection); selection via the keyboard; and response to double-clicking. Selection from the keyboard starts at the first visible entry. For example in Figure 1, if the user typed “735” then the entry containing “7350•What” would be selected. When the user double-clicks in an entry, the object’s Click routine returns not only its item number in the function result’s low word, but also the code doubleClick in the high word. The application may then take whatever action is appropriate. In this demo, BigList reacts by calling the pseudo-dialog object’s RequestResponse method which then calls the list’s Response method in order to display the currently selected entry in an alert box.

TIcon

This is a simple object which, when enabled, draws an icon in its rectangle. The icon is read from a resource.

TAnimation

This object illustrates idling. It uses several frames (read from ‘PICT’ resources, numbered fBaseID + i, where i = 1, ,fNumber) to draw a simple back-and-forth animation sequence. When the object’s fFlag[animate] is false, the animation is halted, showing only the current frame.

TStaticTex

This simple object just draws a string of text in its rectangle and frames the rectangle with either a solid line (if the item is active) or a dotted line (if inactive). The object has its own font, font size and font style which are assigned when the instance is initialized.

TPlainButton

This object implements a plain button similar to that of the Dialog Manager but allowing choice of font, etc. It is also the ancestor of the three more complicated buttons described below. It has three fields: its title fTitle; the command key equivalents fEquiv (an array of two characters to permit use of upper and lower case); and fFont which stores the font, font size and font style to be used for the title. If the button’s rectangle is initially of zero height, then the initialization method IPlainButton will compute an appropriate value based on the title’s height. The command key fEquiv[1] is drawn (unless it is null) on the right end of the button, and the system font is always used (not the title’s font). The method VisualFeedback simulates a mouse click and is used when one of the button’s command keys is hit. In Figures 2 and 3, the first button, entitled “About ”, is of this type. Its command key is “1”. In this demonstration, BigList responds to a hit in this button by displaying the program’s about box.

TToggleButton

This object is very similar to its parent TPlainButton except for the additional field fStatus which takes values toggleOff and toggleOn. Thus it has the functionality of a checkBox, indicating an on-or-off status. When on, a second outline is drawn inside the button’s main outline. In Figures 2 and 3 the button entitled “Icon” is of this type and is shown “on”. Its command keys are “I” and “i”. In this demonstration, BigList responds to a hit in this button by toggling the enable flag of the TIcon item, causing it to appear or disappear.

TThreeDButton

The graphic response of this object when hit (by the mouse, or using an appropriate command key) simulates a three-dimensional button which is pushed down by the hit and then pops back up when released. This object contains no additional fields. It has the same functionality as its parent TPlainButton, but is more attractive. In this demonstration, BigList responds to a hit in this button by calling the pseudo-dialog’s ItemInformation method.

TToggl3DButton

This object type is a direct descendant of the previous type TThreeDButton and differs from it only in the addition of the field fStatus. Thus it has the functionality of type TToggleButton but is more attractive. (It would be more appropriate to implement this object as a descendant of both TToggleButton and TThreeDButton, but unfortunately Object Pascal does not allow multiple inheritance.) The “on” status of the button is visually indicated in two ways: the border is darkened and the button remains partially pushed down. (In fact the depth of button movement in the “off” and “on” positions is set by global constants shadow3Doff and shadow3Don in BLObject.P.) In Figures 2 and 3, the instance of this button is entitled “Animation” and is shown “on” (in its “off” state it would be identical to the button immediately above it). In this demonstration, BigList responds to a hit in this button by toggling the animate flag of the TAnimation item, causing it to start or stop moving.

Suggestions for further development

This program demonstrates several useful features, but does not however include those listed below. As they say in mathematics text books, the following are “left as an exercise for the reader”.

• handling of Apple events;

• the ability to edit the selected entry in the list, or to add or remove entries;

• a 2-dimensional list with contents not limited to 32 K;

• an editable text item (the field fFlag[animate] could be used to indicate whether the caret should flash);

• the ability to change the size of the vertical list, or the size of the pseudo-dialog itself (in fact, a method TVerticalList.Resize appears in BLObject.p, but is never used);

• selectability, i.e., the user’s ability to select a particular item in the pseudo-dialog so that subsequent events would apply to that item (for example, if the pseudo-dialog included a second list or an editable text item, selectability would be necessary in order to change the font in one item without affecting the other);

• Rez-compatible declarations of the pseudo-dialog and its items, which would allow resource-based configuration (rather than configuration in the Pascal code).

In this version of BigList, the only code used in the high word of the function result of Click and KeyIt methods is the code doubleClick. As more complicated pseudo-dialog items are implemented, further codes can be defined as needed.

Listing: BLObject.P
UNIT BLObject;
{••••• Objects, plus a few utility routines •••••}

INTERFACE

USES  Memtypes,QuickDraw,OSIntf,ToolIntf, 
      PackIntf,FixMath,ObjIntf;

CONST menuCount     =   5;
      ovalSize      =  16;  {For “FrameRoundRect”}
      shadow3Doff   =   3;
      shadow3Don    =   1;
      shadow3Ddiff  = shadow3Doff - shadow3Don;
      minBtnHeight  =  16;
      minBtnDescent =   4;
      scrWidth      =  15;
      scrBarMax     =1000;
      noItemHit     =  -1;
      hiliteMode    =$938;    {Color highlighting}
      textMarge     =   4;
      null          = CHR(0);
      vertListDelay =   4;
      threeDDelay   =   2;
      feedbackDelay =  10;
      animThreshold =   2;  {Ticks between frames}
      listKeyLeng   =  15;
      doubleClick   =   1;
      endOfStyle    =   9;
      origV  =  40;
      origH  =   2;
      toggleOff   =  0;
      toggleOn    =  1;
      scrBarShow  =    0;
      scrBarHide  =  255;
      {------------- RESOURCE ID’S --------------}
      alert1ID    =  129;
      blApplID    = 1000;
      exclamationBaseID = 1000;
      exclamationNumber =    7; {Number of frames}
      {------------- Menu resources -------------}
      applMID  =  1001;
      fileMID  =  applMID + 1;
      editMID  =  fileMID + 1;
      fontMID  =  editMID + 1;
      stylMID  =  fontMID + 1;

TYPE
   Str1        =  String[1];
   StrListKey  =  String[listKeyLeng];
   CharacterSet=  SET OF CHAR;
   FontIdent   =  PACKED RECORD
                     n : INTEGER;    {Font number}
                     s : Byte;         {Font size}
                     y : Style;       {Font style}
                  END;
   MouseIndex  =  (before, now);
   MouseFlags  =
      PACKED ARRAY[MouseIndex] OF BOOLEAN;
   ActivationType =  (active, enable, animate);
   PDItemFlagType =
      PACKED ARRAY[ActivationType] OF BOOLEAN;

   {------------------ Objects ------------------}
   TPseudoDialog = OBJECT (TObject)
      fWindow : WindowPtr;
      fItems  : TPDialogItem;
      fActive : BOOLEAN;
      PROCEDURE Free; OverRide;
      PROCEDURE IPseudoDialog
                (iBounds : Rect;
                  iTitle : Str255;
                 iWithGA : BOOLEAN;
                   iFont : FontIdent);
      PROCEDURE InstallItem(chose:TPDialogItem);
      PROCEDURE ItemInformation;
      PROCEDURE EnableDisableItem
                (index : INTEGER);
      PROCEDURE AnimateStuff;
      PROCEDURE DrawBorder;
      PROCEDURE ActivateWindow;
      PROCEDURE DeactivateWindow;
      PROCEDURE UpdateWindKernel;
      PROCEDURE UpdateWindow;
      PROCEDURE Idling;
      PROCEDURE SetFont;
      FUNCTION  Keying(c : CHAR;
                   modif : INTEGER) : LongInt;
      FUNCTION  MouseInContent(p : Point;
                modif : INTEGER) : LongInt;
      PROCEDURE MouseInDrag(p : Point);
      FUNCTION  HandleMouseEvents
                     (p : Point;
                  modif : INTEGER;
                thePart : INTEGER) : LongInt;
      PROCEDURE RequestResponse
                (theItem, theKind : INTEGER);
   END;

   TPDialogItem = OBJECT (TObject)
      fNexThing : TPDialogItem;
      fItsValue : INTEGER;
      fFlag     : PDItemFlagType;
      fBorder   : Rect;
      PROCEDURE Free; OverRide;
      PROCEDURE IPDialogItem(iBorder : Rect);
      FUNCTION  Information : Str255;
      PROCEDURE EnableDisable(index : INTEGER);
      PROCEDURE AnimateIt;
      PROCEDURE GetRectangle(VAR r : Rect);
      PROCEDURE Draw;
      PROCEDURE UpdateIt;
      PROCEDURE ActivateIt;
      PROCEDURE DeactivateIt;
      PROCEDURE Idle;
      PROCEDURE SetItemFont;
      FUNCTION  Click(p : Point;
                  modif : INTEGER) : LongInt;
      FUNCTION  KeyIt(c : CHAR;
                  modif : INTEGER) : LongInt;
      PROCEDURE Response(theItem,
                         theKind : INTEGER);
   END;

   TVerticalList = OBJECT (TPDialogItem)
      fLength,             {Entries in list}
      fSelect,             {Nº of selected entry}
      fOffLin : LongInt;   {Scrolled off top}
      fOffByt : LongInt;   {Before first visible}
      fData   : Handle;    {The entries}
      fFont   : FontIdent;
      fHeight,             {Cell height, pixels}
      fDescent: INTEGER;   {Font descent, pixels}
      fPort   : WindowPtr;
      fScroll : ControlHandle;

      fUserHitKeys : StrListKey;
      fLastKeyTime : LongInt;

      PROCEDURE Free; OverRide;
      PROCEDURE IVerticalList
                (iBorder : Rect;
                   iPort : WindowPtr);
      FUNCTION  Information : Str255; OverRide;
      PROCEDURE SetMeasures;
      PROCEDURE GetRectangle(VAR r : Rect);
                OverRide;
      FUNCTION  VisibleLines : INTEGER;
      PROCEDURE InstallData(theText : Handle);
      PROCEDURE DrawOneEntry(x,y : LongInt);
      PROCEDURE DrawEntries;
      FUNCTION  GetSelection : Str63;
      PROCEDURE SelectionRectangle(VAR r:Rect);
      PROCEDURE HiliteSelection;
      PROCEDURE ActivationSel(activate:BOOLEAN);
      PROCEDURE DrawEntsAndSel;
      PROCEDURE DrawBorder;
      PROCEDURE Draw; OverRide;
      PROCEDURE ActivateIt; OverRide;
      PROCEDURE DeactivateIt; OverRide;
      PROCEDURE SetItemFont; OverRide;
      PROCEDURE CheckScrollability;
      PROCEDURE SetScrollValue;
      PROCEDURE OneLineLess;
      PROCEDURE OneLineMore;
      PROCEDURE RecalOffByte;
      PROCEDURE OnePageLess;
      PROCEDURE OnePageMore;
      PROCEDURE Thumbing(p : Point);
      PROCEDURE Scrolling(part : INTEGER);
      PROCEDURE DragSelecting;
      FUNCTION  Click(p : Point;
                  modif : INTEGER) : LongInt;
                  OverRide;
      PROCEDURE CancelSelection;
      PROCEDURE SetSelection(newSel : LongInt);
      PROCEDURE ShowSelection;
      PROCEDURE InitKeyStuff;
      PROCEDURE SelectCellStart(c : CHAR);
      FUNCTION  KeyIt(c : CHAR;
                  modif : INTEGER) : LongInt;
                  OverRide;
      PROCEDURE Response(theItem,
                theKind : INTEGER); OverRide;
      PROCEDURE Resize(hauteur : INTEGER);
   END;

   TPlainButton = OBJECT (TPDialogItem)
      fTitle : Str15;
      fEquiv : PACKED ARRAY[1..2] OF CHAR;
      fFont  : FontIdent;
      PROCEDURE IPlainButton(iBorder : Rect;
                              iTitle : Str15;
                              iEquiv : CHAR;
                               iFont : FontIdent);
      FUNCTION  KeyInfo : Str15;
      FUNCTION  ButtonInfo : Str255;
      FUNCTION  Information : Str255; OverRide;
      FUNCTION  ExtraHeight : INTEGER;
      PROCEDURE DrawTitle(r : Rect);
      PROCEDURE Draw; OverRide;
      PROCEDURE ActivateIt; OverRide;
      PROCEDURE DeactivateIt; OverRide;
      FUNCTION  Click(p : Point;
                  modif : INTEGER) : LongInt;
                  OverRide;
      PROCEDURE Invert(r : Rect);
      FUNCTION  MouseReleasedHere : BOOLEAN;
      PROCEDURE VisualFeedback;
      FUNCTION  KeyIt(c : CHAR;
                  modif : INTEGER) : LongInt;
                  OverRide;
   END;

   TToggleButton = OBJECT (TPlainButton)
      fStatus : INTEGER;
      PROCEDURE IToggleButton(iBorder : Rect;
                               iTitle : Str15;
                               iEquiv : CHAR;
                                iFont : FontIdent;
                              iStatus : INTEGER);
      FUNCTION  ButtonInfo : Str255; OverRide;
      FUNCTION  ExtraHeight : INTEGER; OverRide;
      PROCEDURE Draw; OverRide;
      FUNCTION  Click(p : Point;
                  modif : INTEGER) : LongInt;
                  OverRide;
      PROCEDURE VisualFeedback; OverRide;
   END;

   TThreeDButton = OBJECT (TPlainButton)
      PROCEDURE IThreeDButton
                (iBorder : Rect;
                  iTitle : Str15;
                  iEquiv : CHAR;
                   iFont : FontIdent);
      FUNCTION  ButtonInfo : Str255; OverRide;
      FUNCTION  ExtraHeight : INTEGER; OverRide;
      PROCEDURE FancyBorder(r : Rect;
                      hilited : BOOLEAN);
      PROCEDURE DropShadow(r : Rect;
                       depth : INTEGER);
      PROCEDURE Draw; OverRide;
      PROCEDURE PushDown(VAR r : Rect;
                         depth : INTEGER);
      PROCEDURE PopUp(VAR r : Rect;
                      depth : INTEGER);
      FUNCTION  MouseReleasedHere : BOOLEAN;
                OverRide;
      PROCEDURE VisualFeedback; OverRide;
   END;

   TToggl3DButton = OBJECT (TThreeDButton)
      fStatus : INTEGER;
      PROCEDURE IToggl3DButton
                (iBorder : Rect;
                  iTitle : Str15;
                  iEquiv : CHAR;
                   iFont : FontIdent;
                 iStatus : INTEGER);
      FUNCTION  ButtonInfo : Str255; OverRide;
      PROCEDURE Draw; OverRide;
      FUNCTION  MouseReleasedHere : BOOLEAN;
                OverRide;
      FUNCTION  Click(p : Point;
                  modif : INTEGER) : LongInt;
                  OverRide;
      PROCEDURE VisualFeedback; OverRide;
   END;

   TIcon = OBJECT (TPDialogItem)
      fIconID : INTEGER;
      PROCEDURE IIcon(iBorder : Rect;
                      iIconID : INTEGER);
      FUNCTION  Information : Str255; OverRide;
      PROCEDURE Draw; OverRide;
   END;

   TAnimation = OBJECT (TPDialogItem)
      fBaseID  : INTEGER;
      fNumber  : INTEGER;
      fCurrent : INTEGER;
      fForward : BOOLEAN; {Direction of animation}
      fLastTim : LongInt;
      PROCEDURE IAnimation(iBorder : Rect;
                           iBaseID : INTEGER;
                           iNumber : INTEGER);
      FUNCTION  Information : Str255; OverRide;
      PROCEDURE NextFrame;
      PROCEDURE Idle; OverRide;
      PROCEDURE Draw; OverRide;
   END;

   TStaticText = OBJECT (TPDialogItem)
      fContents : Str255;
      fFont     : FontIdent;
      PROCEDURE IStaticText(iBorder : Rect;
                              iFont : FontIdent;
                          iContents : Str255);
      FUNCTION  Information : Str255; OverRide;
      PROCEDURE DrawBorder;
      PROCEDURE Draw; OverRide;
      PROCEDURE ActivateIt; OverRide;
      PROCEDURE DeactivateIt; OverRide;
   END;

VAR
   myMenus    : ARRAY[1..menuCount] OF MenuHandle;
   theFontMenu,
   theStylMenu: MenuHandle;
   styleVector: PACKED ARRAY[2..8] OF StyleItem;
   fakeDlg    : TPseudoDialog;
   theEvent   : EventRecord;
   weAreDone,
   inBckGrnd,
   wneExists,
   dublClick  : BOOLEAN;
   forNowFI,
   defaultFI  : FontIdent;
   entr,
   cRet,
   left,
   right,
   up,
   down,
   blnkChr    : CHAR;
   blnkPtr    : Ptr;
   zoomArea,
   dragArea   : Rect;
   XCursor,
   waitCursor : CursHandle;
   lastClikPoint : Point;
   lastClikTime  : LongInt;

PROCEDURE SetFontIdent(font : FontIdent);
PROCEDURE SetFontSizeFace(fn,fs : INTEGER;
                             fy : Style);
PROCEDURE GetFontIdent(VAR font : FontIdent);
PROCEDURE SetFontMenu;
PROCEDURE SetSizeMenu;
PROCEDURE SetStylMenu;
PROCEDURE FontMenuEvent(theItem : INTEGER);
PROCEDURE StyleMenuEvent(theItem : INTEGER);
 FUNCTION MakeStr1(c : CHAR) : Str1;
 FUNCTION IntString(x : LongInt)  :  Str15;
 FUNCTION StringInt(s : Str15) : LongInt;
 FUNCTION NumericStr(s : Str255)  :  BOOLEAN;
PROCEDURE MyInvertRect(r : Rect);
PROCEDURE RestoreClip;
PROCEDURE FrameTop(r : Rect);
PROCEDURE FrameBot(r : Rect);
PROCEDURE CentreRect(VAR r : Rect);
 FUNCTION ScrollBarShowHide(b : BOOLEAN) : Byte;
PROCEDURE SimpleAlert(s : Str255);
 FUNCTION GetKind(w : WindowPtr) : INTEGER;
PROCEDURE CheckMultipleClicks(p : Point);

IMPLEMENTATION
{$S Main}
{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Routines for getting and setting the font,     }
{ font size, and font style in the current port. }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE SetFontIdent(font : FontIdent);
BEGIN
   WITH font DO BEGIN
      TextFont(n);
      TextSize(s);
      TextFace(y);
   END;
END;

PROCEDURE SetFontSizeFace(fn,fs : INTEGER;
                             fy : Style);
BEGIN
   TextFont(fn);
   TextSize(fs);
   TextFace(fy);
END;

PROCEDURE GetFontIdent(VAR font : FontIdent);
BEGIN
   WITH font,thePort^ DO BEGIN
      n:= txFont;
      s:= txSize;
      y:= txFace;
   END;
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Routines which manage the Font and Style menus,}
{ including highlighting of font sizes in second }
{ half of Style menu. The current font, size and }
{ style are stored in global “forNowFI”.         }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE SetFontMenu;
VAR   fontName,
      itemName  :  Str255;
      i,size    :  INTEGER;
BEGIN
   GetFontName(forNowFI.n,fontName);
   i:= CountMItems(theFontMenu);
   WHILE i > 0 DO BEGIN
      GetItem(theFontMenu,i,itemName);
      CheckItem(theFontMenu,i,itemName=fo ntName);
      i:= i - 1;
   END;
   i:= CountMItems(theStylMenu);
   WHILE i > endOfStyle DO BEGIN
      GetItem(theStylMenu,i,itemName);
      IF NumericStr(itemName) THEN BEGIN
         size:= StringInt(itemName);
         IF RealFont(forNowFI.n,size) THEN
            SetItemStyle(theStylMenu,
            i,[bold,outline])
         ELSE SetItemStyle(theStylMenu,i,[]);
      END;
      i:= i - 1;
   END;
END;

PROCEDURE SetSizeMenu;
VAR   i  :  INTEGER;
      fSize  :  String[3];
      iSize  :  Str255;
BEGIN
   fSize:= IntString(forNowFI.s);
   i:= CountMItems(theStylMenu);
   WHILE i > endOfStyle DO BEGIN
      GetItem(theStylMenu,i,iSize);
      CheckItem(theStylMenu,i,iSize = fSize);
      i:= i - 1;
   END;
END;

PROCEDURE SetStylMenu;
VAR   i  :  INTEGER;
BEGIN
   CheckItem(theStylMenu,1,(forNowFI.y  = []));
   FOR i:= 2 TO endOfStyle-1 DO CheckItem
      (theStylMenu,i,
       (styleVector[i] IN forNowFI.y));
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Routines which respond to mouse hits in the    }
{ Font and Style menus.                          }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE FontMenuEvent(theItem : INTEGER);
VAR   theName  :  Str255;
BEGIN
   GetItem(theFontMenu,theItem,theName );
   GetFNum(theName,theItem);
   IF theItem <> forNowFI.n THEN BEGIN
      forNowFI.n:= theItem;
      SetFontMenu;
   END;
END;

PROCEDURE StyleMenuEvent(theItem : INTEGER);
VAR   theName  :  Str255;
      theStyle :  StyleItem;
BEGIN
   IF theItem < endOfStyle THEN BEGIN
      IF theItem = 1 THEN forNowFI.y:= []
      ELSE BEGIN
         theStyle:= styleVector[theItem];
         IF theStyle IN forNowFI.y THEN
            forNowFI.y:= forNowFI.y - [theStyle]
         ELSE BEGIN
            forNowFI.y:= forNowFI.y + [theStyle];
            IF theStyle = condense THEN
               forNowFI.y:= forNowFI.y - [extend]
            ELSE IF theStyle = extend THEN
               forNowFI.y:= forNowFI.y-[condense];
         END;
      END;
      SetStylMenu;
   END
   ELSE IF theItem > endOfStyle THEN BEGIN
      GetItem(theStylMenu,theItem,theName );
      IF NumericStr(theName) THEN BEGIN
         theItem:= StringInt(theName);
         IF theItem <> forNowFI.s THEN BEGIN
            forNowFI.s:= theItem;
            SetSizeMenu;
         END;
      END
      ELSE SysBeep(1);
   END;
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Various string-conversion routines.            }
{••••••••••••••••••••••••••••••••••••••••••••••••}
FUNCTION MakeStr1(c : CHAR) : Str1;
VAR   s  :  Str1;
BEGIN
   s[0]:= CHR(1);
   s[1]:= c;
   MakeStr1:= s;
END;

{ “IntString” converts "x" to string. }
FUNCTION IntString(x : LongInt)  :  Str15;
VAR   s  :  Str255;
BEGIN
   NumToString(x,s);
   IF Length(s) > 15 THEN s[0]:= CHR(15);
   IntString:= s;
END;

{ “StringInt” converts numeric “s” to LongInt}
FUNCTION StringInt(s : Str15) : LongInt;
VAR   x  :  LongInt;
BEGIN StringToNum(s,x); StringInt:= x; END;

{ “NumericStr” is a Boolean function, TRUE
  if and only if “s” is entirely numeric,
  with no leading sign, & of length at least 1. }
FUNCTION NumericStr(s : Str255)  :  BOOLEAN;
VAR   i  :  INTEGER;
BEGIN
   NumericStr:= FALSE;  {Default}
   i:= Length(s);
   IF i = 0 THEN Exit(NumericStr);
   REPEAT
      IF NOT (s[i] IN ['0'..'9']) THEN
         Exit(NumericStr);
      i:= i - 1;
   UNTIL i = 0;
   NumericStr:= TRUE;
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Various graphic routines.                      }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE MyInvertRect(r : Rect);
BEGIN
   BitClr(Ptr(hiliteMode),pHiliteBit); 
   InvertRect(r);
END;

PROCEDURE RestoreClip;
VAR   i  :  INTEGER;
      r  :  Rect;
BEGIN
   i:= MaxInt DIV 2;
   SetRect(r,-i,-i,i,i);
   ClipRect(r);
END;

PROCEDURE FrameTop(r : Rect);
BEGIN
   MoveTo(r.left,   r.bottom-1);
   LineTo(r.left,   r.top);
   LineTo(r.right-1,r.top);
END;

PROCEDURE FrameBot(r : Rect);
BEGIN
   MoveTo(r.left,   r.bottom-1);
   LineTo(r.right-1,r.bottom-1);
   LineTo(r.right-1,r.top);
END;

PROCEDURE CentreRect(VAR r : Rect);
VAR   x,y  :  INTEGER;
BEGIN
   WITH zoomArea DO BEGIN
      x:= ((right -left)-(r.right -r.left)) DIV 2;
      y:= ((bottom-top )-(r.bottom-r.top )) DIV 2;
   END;
   OffsetRect(r,x,y+origV);
END;

FUNCTION ScrollBarShowHide(b : BOOLEAN) : Byte;
BEGIN
   IF b THEN ScrollBarShowHide:= scrBarShow
        ELSE ScrollBarShowHide:= scrBarHide;
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Miscellaneous routines                         }
{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Alert box with one message & OK button }
PROCEDURE SimpleAlert(s : Str255);
VAR   g :  GrafPtr;
BEGIN
   GetPort(g);
   SetCursor(arrow);
   ParamText(s,'','','');
   IF NoteAlert(alert1ID,NIL) = ok THEN {Nada};
   SetCursor(waitCursor^^);
   SetPort(g);
END;

{ Returns windowKind of “w”. Zero if “w” is NIL.}
FUNCTION GetKind(w : WindowPtr) : INTEGER;
BEGIN
   IF w = NIL THEN GetKind:= 0
   ELSE GetKind:= WindowPeek(w)^.windowKind;
END;

{ Check for double clicks }
PROCEDURE CheckMultipleClicks(p : Point);
CONST clickSeuil = 4;
BEGIN
   dublClick:=
      (theEvent.when-lastClikTime) <= GetDblTime;
   IF dublClick THEN BEGIN
      SubPt(lastClikPoint,p);
      dublClick:= (ABS(p.h) < clickSeuil) AND
                  (ABS(p.v) < clickSeuil);
      { Don’t report a double-click until
        the mouse button is released. }
      IF dublClick THEN
         REPEAT UNTIL NOT WaitMouseUp;
   END;
   lastClikPoint:= theEvent.where;
   lastClikTime := theEvent.when;
END;

{ Encode low-word & high-word into a LongInt }
FUNCTION MakeLongInt(lo,hi : INTEGER) : LongInt;
BEGIN MakeLongInt:= lo + hi*$00010000; END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ METHODS OF OBJECT TYPE “TPseudoDialog”.        }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE TPseudoDialog.Free;
VAR   p  :  Ptr;
BEGIN
   IF fItems <> NIL THEN fItems.Free;
   p:= Ptr(fWindow);
   CloseWindow(fWindow);
   DisposPtr(p);
   INHERITED Free;
END;

PROCEDURE TPseudoDialog.IPseudoDialog
                   (iBounds : Rect;
                     iTitle : Str255;
                    iWithGA : BOOLEAN;
                      iFont : FontIdent);
VAR   wStorage  :  Ptr;
BEGIN
   wStorage:= NewPtr(SizeOf(WindowRecord));
   IF wStorage = NIL THEN ExitToShell;
   fWindow:= NewWindow(wStorage,iBounds,
      iTitle,FALSE,noGrowDocProc,
      WindowPtr(-1),iWithGA,ORD(SELF));
   SetPort(fWindow);
   SetFontIdent(iFont);
   fItems:= NIL;
   fActive:= FALSE;
END;

{ Install “chose” at end of linked list
  headed by “fItems”;
  also initialize “chose.fItsValue”.}
PROCEDURE TPseudoDialog.InstallItem
          (chose : TPDialogItem);
VAR   scan  :  TPDialogItem;
BEGIN
   IF fItems = NIL THEN BEGIN
      chose.fItsValue:= 1;
      fItems:= chose;
   END
   ELSE BEGIN
      chose.fItsValue:= 2;
      scan:= fItems;
      WHILE scan.fNexThing <> NIL DO BEGIN
         chose.fItsValue:= chose.fItsValue + 1;
         scan:= scan.fNexThing;
      END;
      scan.fNexThing:= chose;
   END;
END;

PROCEDURE TPseudoDialog.ItemInformation;
CONST lineHeight = 15;
VAR   w  :  WindowPtr;
      r  :  Rect;
      s  :  Str255;
      p  :  TPDialogItem;
      i  :  INTEGER;
BEGIN
   DeactivateWindow;
   SetRect(r,0,0,420,250);  CentreRect(r);
   GetWTitle(fWindow,s);
   s:= Concat('Items in “',s,'”');
   w:= NewWindow(NIL,r,s,TRUE,noGrowDocProc,
      WindowPtr(-1),FALSE,0);
   SetPort(w);
   SetFontSizeFace(geneva,9,[bold]);
   i:= 0;
   r:= w^.portRect;  r.left:= r.left + 5;
   p:= fItems;
   WHILE p <> NIL DO BEGIN
      i:= i + 1;
      r.top:= r.top + lineHeight;
      MoveTo(r.left,r.top);
      s:= p.Information;
      s:= Concat(IntString(i),'. ',s);
      IF i < 10 THEN s:= Concat(blnkChr,s);
      DrawString(s);
      p:= p.fNexThing;
   END;
   REPEAT SystemTask UNTIL Button;
   FlushEvents(everyEvent,0);
   DisposeWindow(w);
END;

PROCEDURE TPseudoDialog.EnableDisableItem
          (index : INTEGER);
BEGIN
   IF fItems <> NIL THEN BEGIN
      SetPort(fWindow);
      fItems.EnableDisable(index);
   END;
END;

PROCEDURE TPseudoDialog.AnimateStuff;
BEGIN
   IF fItems <> NIL THEN BEGIN
      SetPort(fWindow);
      fItems.AnimateIt;
   END;
END;

PROCEDURE TPseudoDialog.DrawBorder;
VAR   r  :  Rect;
BEGIN
   r:= fWindow^.portRect;
   InsetRect(r,2,2);
   PenSize(2,2);
   IF fActive THEN PenPat(black)
              ELSE PenPat(gray);
   FrameRect(r);
   PenNormal;
END;

PROCEDURE TPseudoDialog.ActivateWindow;
BEGIN
   {Following line prevents multiple activation}
   IF fActive THEN Exit(ActivateWindow);
   fActive:= TRUE;
   SetPort(fWindow);
   DrawBorder;
   IF fItems <> NIL THEN fItems.ActivateIt;
END;

PROCEDURE TPseudoDialog.DeactivateWindow;
BEGIN
   {Following line prevents multiple deactivation}
   IF NOT fActive THEN Exit(DeactivateWindow);
   fActive:= FALSE;
   SetPort(fWindow);
   DrawBorder;
   IF fItems <> NIL THEN fItems.DeactivateIt;
END;

PROCEDURE TPseudoDialog.UpdateWindKernel;
BEGIN
   DrawBorder;
   IF fItems <> NIL THEN fItems.UpdateIt;
END;

PROCEDURE TPseudoDialog.UpdateWindow;
VAR   g  :  GrafPtr;
BEGIN
   GetPort(g);
   SetPort(fWindow);
   BeginUpdate(fWindow);
   UpdateWindKernel;
   EndUpdate(fWindow);
   SetPort(g);
END;

PROCEDURE TPseudoDialog.Idling;
BEGIN
   IF fItems <> NIL THEN fItems.Idle;
END;

PROCEDURE TPseudoDialog.SetFont;
VAR   g  :  GrafPtr;
BEGIN
   GetPort(g);
   SetPort(fWindow);
   fItems.SetItemFont;
   SetPort(g);
END;

FUNCTION TPseudoDialog.Keying
         (c : CHAR;   modif : INTEGER) : LongInt;
VAR   result  :  INTEGER;
BEGIN
   IF fItems = NIL
      THEN Keying:= noItemHit
      ELSE Keying:= fItems.KeyIt(c,modif);
END;

FUNCTION TPseudoDialog.MouseInContent(p : Point;
                       modif : INTEGER) : LongInt;
BEGIN
   MouseInContent:= noItemHit;   {Default}
   IF fItems = NIL THEN Exit(MouseInContent);
   CheckMultipleClicks(p);
   GlobalToLocal(p);
   MouseInContent:= fItems.Click(p,modif);
END;

PROCEDURE TPseudoDialog.MouseInDrag(p : Point);
BEGIN DragWindow(fWindow,p,dragArea); END;

FUNCTION TPseudoDialog.HandleMouseEvents
               (p : Point;
            modif : INTEGER;
          thePart : INTEGER) : LongInt;
BEGIN
   HandleMouseEvents:= noItemHit; {Default}
   CASE thePart OF
     inContent:IF fWindow <> FrontWindow
                  THEN SelectWindow(fWindow)
                  ELSE HandleMouseEvents:=
                     MouseInContent(p,modif);
        inDrag:MouseInDrag(p);
   END;
END;

PROCEDURE TPseudoDialog.RequestResponse
          (theItem, theKind : INTEGER);
BEGIN
   IF fItems <> NIL THEN
      fItems.Response(theItem,theKind);
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ METHODS OF OBJECT TYPE “TPDialogItem”.         }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE TPDialogItem.Free;
BEGIN
   IF fNexThing <> NIL THEN fNexThing.Free;
   INHERITED Free;
END;

PROCEDURE TPDialogItem.IPDialogItem(iBorder:Rect);
BEGIN
   fNexThing:= NIL;  fItsValue:= noItemHit;
   { The above will be re-initialized
     by “TPseudoDialog.InstallItem” }
   fFlag[active] := FALSE;
   fFlag[enable] := FALSE;
   fFlag[animate]:= FALSE;
   fBorder:= iBorder;
END;

FUNCTION TPDialogItem.Information : Str255;
BEGIN
   Information:= '[Generic item]';
END;

PROCEDURE TPDialogItem.EnableDisable
          (index : INTEGER);
BEGIN
   IF index = fItsValue THEN BEGIN
      fFlag[enable]:= NOT fFlag[enable];
      Draw;
   END
   ELSE IF fNexThing <> NIL THEN
      fNexThing.EnableDisable(index);
END;

PROCEDURE TPDialogItem.AnimateIt;
BEGIN
   fFlag[animate]:= NOT fFlag[animate];
   IF fNexThing <> NIL THEN fNexThing.AnimateIt;
END;

PROCEDURE TPDialogItem.GetRectangle(VAR r:Rect);
BEGIN r:= fBorder; END;

PROCEDURE TPDialogItem.Draw; {Dummy ancestor}
BEGIN  SysBeep(1);  END;

{ Method “UpdateIt” must be sandwiched
  between “BeginUpdate” & “EndUpdate”.}
PROCEDURE TPDialogItem.UpdateIt;
BEGIN
   Draw;
   IF fNexThing <> NIL THEN fNexThing.UpdateIt;
END;

PROCEDURE TPDialogItem.ActivateIt;
BEGIN
   IF fNexThing <> NIL THEN fNexThing.ActivateIt;
END;

PROCEDURE TPDialogItem.DeactivateIt;
BEGIN
   IF fNexThing<>NIL THEN fNexThing.DeactivateIt;
END;

PROCEDURE TPDialogItem.Idle;
BEGIN
   IF fNexThing <> NIL THEN fNexThing.Idle;
END;

PROCEDURE TPDialogItem.SetItemFont;
BEGIN
   IF fNexThing <> NIL THEN fNexThing.SetItemFont;
END;

FUNCTION TPDialogItem.Click
         (p : Point;  modif : INTEGER) : LongInt;
VAR   r  :  Rect;
BEGIN
   GetRectangle(r);
   IF PtInRect(p,r) THEN BEGIN
      IF fFlag[enable] THEN Click:= fItsValue
                       ELSE Click:= noItemHit;
   END
   ELSE IF fNexThing = NIL THEN Click:= noItemHit
   ELSE Click:= fNexThing.Click(p,modif);
END;

{ Method “KeyIt” is a function so we can return an
  item number if appropriate for a particular key}
FUNCTION TPDialogItem.KeyIt
         (c : CHAR;  modif : INTEGER) : LongInt;
BEGIN
   IF fNexThing = NIL THEN KeyIt:= noItemHit
   ELSE KeyIt:= fNexThing.KeyIt(c,modif);
END;

PROCEDURE TPDialogItem.Response
          (theItem,theKind : INTEGER);
BEGIN
   IF fNexThing <> NIL THEN
      fNexThing.Response(theItem,theKind) ;
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ METHODS OF OBJECT TYPE “TVerticalList”.        }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE TVerticalList.Free;
BEGIN
   IF fData <> NIL THEN DisposHandle(fData);
   INHERITED Free;
END;

PROCEDURE TVerticalList.IVerticalList
          (iBorder : Rect;  iPort : WindowPtr);
BEGIN
   IPDialogItem(iBorder);
   fFlag[enable]:= TRUE;   {Override the default}
   fLength:= 0;
   fSelect:= 0;
   fOffLin:= 0;
   fOffByt:= 0;
   fData  := NIL;
   fFont  := forNowFI;
   SetMeasures;
   iBorder.left:= iBorder.right - scrWidth + 1;
   InsetRect(iBorder,-1,-1);
   fPort  := iPort;
   fScroll:= NewControl(iPort,iBorder,'',FALSE,
      0,0,scrBarMax,scrollBarProc,0);
   InitKeyStuff;
END;

FUNCTION TVerticalList.Information : Str255;
VAR   s  :  Str255;
BEGIN
   s:= Concat('List, ',
      IntString(fLength),' entries, ');
   IF fSelect = 0 THEN
      s:= Concat(s,'nothing selected, ')
   ELSE s:= Concat(s,'#',
      IntString(fSelect),' selected, ');
   s:= Concat(s,IntString(fOffLin),
      ' entries scrolled off top.');
   Information:= s;
END;

PROCEDURE TVerticalList.SetMeasures;
VAR   f  :  FontIdent;
      fm :  FMetricRec;
BEGIN
   f:= fFont;
   SetFontIdent(f);
   FontMetrics(fm);
   WITH fm DO BEGIN
      fHeight := FixRound(ascent+descent+leading);
      fDescent:= FixRound(descent);
   END;
END;

PROCEDURE TVerticalList.GetRectangle(VAR r:Rect);
BEGIN
   r:= fBorder;
   r.right:= r.right - scrWidth;
END;

FUNCTION TVerticalList.VisibleLines : INTEGER;
BEGIN
   VisibleLines:=
      (fBorder.bottom - fBorder.top) DIV fHeight;
END;

PROCEDURE TVerticalList.InstallData
          (theText : Handle);
VAR   x,lastOne,nextOne  :  LongInt;
BEGIN
   fLength:= 0;
   fSelect:= 0;
   fOffLin:= 0;
   fOffByt:= 0;
   IF fData <> NIL THEN DisposHandle(fData);
   fData:= theText;
   IF fData = NIL THEN Exit(InstallData);
   HLock(fData);
   x:= GetHandleSize(fData)-1; {Blank at end}
   nextOne:= 0;
   WHILE nextOne < x DO BEGIN
      lastOne:= nextOne + 1;
      nextOne:=
         Munger(fData,lastOne,blnkPtr,1,NIL, 0);
      fLength:= fLength + 1;
      IF nextOne < 0 THEN nextOne:= x; {Error!}
   END;
   HUnLock(fData);
   Draw;
END;

PROCEDURE TVerticalList.DrawOneEntry(x,y:LongInt);
BEGIN
   y:= y - x;
   IF y > MaxInt THEN y:= MaxInt;
   DrawText(Ptr(ORD(fData^)+x),0,y);
END;

{ “DrawEntries” just draws the entries, with
  port, clip & font maintenance done elsewhere. }
PROCEDURE TVerticalList.DrawEntries;
VAR   i,lastOne,nextOne,y  :  LongInt;
      x  :  INTEGER;
   PROCEDURE ExitDE;
   BEGIN HUnLock(fData); Exit(DrawEntries); END;
BEGIN
   i:= fOffLin;
   x:= fBorder.left + textMarge;
   nextOne:= fOffByt;
   HLock(fData);
   WHILE i < fLength DO BEGIN
      i:= i + 1;
      lastOne:= nextOne + 1;
      nextOne:=
         Munger(fData,lastOne,blnkPtr,1,NIL, 0);
      IF nextOne < 0 THEN ExitDE; {Error!}
      IF i > fOffLin THEN BEGIN
         y:= fBorder.top + (i-fOffLin)*fHeight;
         IF y > fBorder.bottom  THEN ExitDE;
         MoveTo(x,y-fDescent);
         DrawOneEntry(lastOne,nextOne);
      END;
   END;
   ExitDE;
END;

FUNCTION TVerticalList.GetSelection : Str63;
VAR   s  :  Str63;
      i  :  INTEGER;
      x,lastOne,nextOne  :  LongInt;
   PROCEDURE ExitGS;
   BEGIN
      HUnLock(fData);
      GetSelection:= s;
      Exit(GetSelection);
   END;
BEGIN
   s:= '';
   x:= fOffLin;
   nextOne:= fOffByt;
   HLock(fData);
   WHILE x < fSelect DO BEGIN
      x:= x + 1;
      lastOne:= nextOne + 1;
      nextOne:=
         Munger(fData,lastOne,blnkPtr,1,NIL, 0);
      IF nextOne < 0 THEN ExitGS; {Error!}
   END;
   i:= nextOne - lastOne;
   IF i > 63 THEN i:= 63;
   BlockMove(Ptr(ORD(fData^)+lastOne), 
      Ptr(ORD(@s)+1),i);
   s[0]:= CHR(i);
   ExitGS;
END;

PROCEDURE TVerticalList.SelectionRectangle
          (VAR r : Rect);
VAR   i  :  LongInt;
   PROCEDURE SelectionNotVisible;
   BEGIN
      SetRect(r,0,0,0,0);
      Exit(SelectionRectangle);
   END;
BEGIN
   i:= fSelect - fOffLin;
   IF i <= 0 THEN SelectionNotVisible;
   GetRectangle(r);
   i:= r.top + i*fHeight;
   IF i > r.bottom THEN SelectionNotVisible;
   r.bottom:= i;
   r.top:= i - fHeight;
END;

PROCEDURE TVerticalList.HiliteSelection;
VAR   r  :  Rect;
BEGIN
   SelectionRectangle(r);
   IF EqualPt(r.topLeft,r.botRight) THEN
      Exit(HiliteSelection);
   BitClr(Ptr(hiliteMode),pHiliteBit); 
   IF fFlag[active] THEN InvertRect(r)
   ELSE BEGIN
      PenSize(2,2);
      FrameRect(r);
      PenNormal;
   END;
END;

PROCEDURE TVerticalList.ActivationSel
          (activate : BOOLEAN);
VAR   r  :  Rect;
BEGIN
   IF fFlag[active] = activate THEN
      Exit(ActivationSel);
   fFlag[active]:= activate;
   SelectionRectangle(r);
   IF EqualPt(r.topLeft,r.botRight) THEN
      Exit(ActivationSel);
   InsetRect(r,2,2);
   MyInvertRect(r);
END;

PROCEDURE TVerticalList.DrawEntsAndSel;
VAR   r  :  Rect;
BEGIN
   GetRectangle(r);
   ClipRect(r);
   EraseRect(r);
   IF fData <> NIL THEN BEGIN
      DrawEntries;
      HiliteSelection;
   END;
   RestoreClip;
END;

PROCEDURE TVerticalList.DrawBorder;
VAR   r  :  Rect;
BEGIN
   GetRectangle(r);
   InsetRect(r,-1,-1);
   FrameRect(r);
END;

PROCEDURE TVerticalList.Draw;
VAR   r  :  Rect;
      f  :  FontIdent;
BEGIN
   f:= fFont;
   SetFontIdent(f);
   DrawBorder;
   DrawEntsAndSel;
   Draw1Control(fScroll);
END;

PROCEDURE TVerticalList.ActivateIt;
BEGIN
   ActivationSel(TRUE);
   ShowControl(fScroll);
   INHERITED ActivateIt;
END;

PROCEDURE TVerticalList.DeactivateIt;
VAR   r  :  Rect;
BEGIN
   ActivationSel(FALSE);
   HideControl(fScroll);
   DrawBorder;
   INHERITED DeactivateIt;
END;

PROCEDURE TVerticalList.SetItemFont;
BEGIN
   fFont:= forNowFI;
   SetMeasures;
   Draw;
   INHERITED SetItemFont;
END;

PROCEDURE TVerticalList.CheckScrollability;
VAR   vis  :  INTEGER;
BEGIN
   IF fData = NIL THEN
      HiliteControl(fScroll,scrBarHide)
   ELSE IF fOffLin > 0 THEN
      HiliteControl(fScroll,scrBarShow)
   ELSE BEGIN
      vis:= VisibleLines;
      HiliteControl(fScroll,
         ScrollBarShowHide(fLength > vis));
   END;
END;

PROCEDURE TVerticalList.SetScrollValue;
VAR   max,
      min,
      vis  :  INTEGER;
      ratio  :  Fract;
BEGIN
   min:= GetCtlMin(fScroll);
   max:= GetCtlMax(fScroll);
   vis:= VisibleLines;
   IF fLength <= vis THEN SetCtlValue(fScroll,min)
   ELSE BEGIN
      ratio:= FracDiv(fOffLin, fLength-vis);
      SetCtlValue(fScroll,FracMul(ratio,max-min));
   END;
END;

PROCEDURE TVerticalList.OneLineLess;
VAR   r  :  Rect;
      rgn  :  RgnHandle;
   PROCEDURE DrawFirstLine;
   VAR   i  :  LongInt;
         c  :  Str1;
   BEGIN
      i:= fOffByt;
      REPEAT
         i:= i - 1;
         IF i < 0 THEN Exit(DrawFirstLine);
         BlockMove(Ptr(ORD(fData^)+i),@c,1); 
      UNTIL c[0] = blnkChr;
      MoveTo(r.left+textMarge,
             r.top+fHeight-fDescent);
      DrawOneEntry(i+1,fOffByt);
      IF fSelect = fOffLin THEN BEGIN
         r.bottom:= r.top + fHeight;
         MyInvertRect(r);
      END;
      fOffLin:= fOffLin - 1;
      fOffByt:= i;
   END;
   PROCEDURE EraseLastLine;
   VAR   saveTop  :  INTEGER;
   BEGIN
      saveTop:= r.top;
      r.top:= r.top + VisibleLines*fHeight;
      EraseRect(r);
      r.top:= saveTop;
   END;
BEGIN
   IF fOffLin <= 0 THEN Exit(OneLineLess);
   GetRectangle(r);
   ClipRect(r);
   rgn:= NewRgn;
   ScrollRect(r,0,fHeight,rgn);
   EraseLastLine;
   DisposeRgn(rgn);
   HLock(fData);
   DrawFirstLine;
   HUnLock(fData);
   RestoreClip;
END;

PROCEDURE TVerticalList.OneLineMore;
VAR   r  :  Rect;
      rgn  :  RgnHandle;
      vis  :  INTEGER;
   PROCEDURE DrawLastLine;
   VAR   thisLine,
         lastLine,
         lastOne,
         nextOne  :  LongInt;
   BEGIN
      fOffLin:= fOffLin + 1;
      fOffByt:=
         Munger(fData,fOffByt+1,blnkPtr,1,NIL,0);
      IF nextOne < 0 THEN Exit(DrawLastLine);

      thisLine:= fOffLin;
      lastLine:= fOffLin + vis;
      nextOne:= fOffByt;
      WHILE thisLine < lastLine DO BEGIN
         thisLine:= thisLine + 1;
         lastOne:= nextOne + 1;
         nextOne:=
            Munger(fData,lastOne,blnkPtr,1,NIL,0);
         IF nextOne < 0 THEN Exit(DrawLastLine);
      END;
      r.bottom:= r.top + vis*fHeight;
      MoveTo(r.left+textMarge,r.bottom-fDescent);
      DrawOneEntry(lastOne,nextOne);
      IF fSelect = lastLine THEN BEGIN
         r.top:= r.bottom - fHeight;
         MyInvertRect(r);
      END;
   END;
BEGIN
   vis:= VisibleLines;
   IF fOffLin>=fLength-vis THEN Exit(OneLineMore);
   GetRectangle(r);
   ClipRect(r);
   rgn:= NewRgn;
   ScrollRect(r,0,-fHeight,rgn);
   DisposeRgn(rgn);
   HLock(fData);
   DrawLastLine;
   HUnLock(fData);
   RestoreClip;
END;

{ “RecalOffByte” recalculates "fOffByt". }
PROCEDURE TVerticalList.RecalOffByte;
VAR   i,lastOne  :  LongInt;
   PROCEDURE ExitROB;
   BEGIN HUnLock(fData); Exit(RecalOffByte);END;
BEGIN
   SetCursor(waitCursor^^);
   i:= 0;
   fOffByt:= 0;
   HLock(fData);
   WHILE i < fOffLin DO BEGIN
      i:= i + 1;
      lastOne:= fOffByt + 1;
      fOffByt:=
         Munger(fData,lastOne,blnkPtr,1,NIL, 0);
      IF fOffByt < 0 THEN BEGIN
         fOffLin:= 0;
         fOffByt:= 0;
         ExitROB;
      END;
   END;
   ExitROB;
END;

PROCEDURE TVerticalList.OnePageLess;
VAR   newOffLine  :  LongInt;
      c  :  Str1;
BEGIN
   IF fOffLin <= 0 THEN Exit(OnePageLess);
   newOffLine:= fOffLin - (VisibleLines-1);
   IF newOffLine <= 0 THEN BEGIN
      fOffLin:= 0;
      fOffByt:= 0;
   END
   ELSE WHILE fOffLin > newOffLine DO BEGIN
      fOffLin:= fOffLin - 1;
      REPEAT
         fOffByt:= fOffByt - 1;
         BlockMove(Ptr(ORD(fData^)+fOffByt),@c,1);
      UNTIL c[0] = blnkChr;
   END;
   DrawEntsAndSel;
END;

PROCEDURE TVerticalList.OnePageMore;
VAR   vis  :  INTEGER;
      max,
      newOffLine  :  LongInt;
BEGIN
   vis:= VisibleLines;
   max:= fLength - vis;
   IF fOffLin >= max THEN Exit(OnePageMore);
   newOffLine:= fOffLin + (vis-1);
   IF newOffLine > max THEN newOffLine:= max;
   WHILE fOffLin < newOffLine DO BEGIN
      fOffLin:= fOffLin + 1;
      fOffByt:=
         Munger(fData,fOffByt+1,blnkPtr,1,NIL,0);
   END;
   DrawEntsAndSel;
END;

PROCEDURE TVerticalList.Thumbing(p : Point);
VAR   min,
      apres  :  INTEGER;
      vis,
      avant  :  LongInt;
      ratio  :  Fract;
BEGIN
   min:= GetCtlMin(fScroll);
   avant:= GetCtlValue(fScroll);
   apres:= TrackControl(fScroll,p,NIL);
   apres:= GetCtlValue(fScroll);
   IF apres <> avant THEN BEGIN
      vis:= VisibleLines;
      IF fLength <= vis THEN
         SetCtlValue(fScroll,min)
      ELSE BEGIN
         avant:= fOffLin;
         ratio:= FracDiv(apres-min,
            GetCtlMax(fScroll)-min);
         vis:= fLength - vis;
         fOffLin:= FracMul(ratio,vis);
         IF fOffLin < 0 THEN fOffLin:= 0
         ELSE IF fOffLin>vis THEN fOffLin:= vis;
         IF fOffLin <> avant THEN BEGIN
            RecalOffByte;
            CheckScrollability;
            DrawEntsAndSel;
         END;
      END;
   END;
END;

PROCEDURE TVerticalList.Scrolling(part : INTEGER);
VAR   x  :  LongInt;
      r  :  Rect;
BEGIN
   CASE part OF
      inUpButton:
         BEGIN
            HiliteControl(fScroll,part);
            WHILE StillDown DO BEGIN
               Delay(vertListDelay,x);
               OneLineLess;
               SetScrollValue;
            END;
            HiliteControl(fScroll,toggleOff);
         END;
      inDownButton:
         BEGIN
            HiliteControl(fScroll,part);
            WHILE StillDown DO BEGIN
               Delay(vertListDelay,x);
               OneLineMore;
               SetScrollValue;
            END;
            HiliteControl(fScroll,toggleOff);
            GetRectangle(r);
            r.top:= r.top + VisibleLines*fHeight;
            InvalRect(r);
         END;
      inPageUp:
         WHILE StillDown DO BEGIN
            Delay(vertListDelay,x);
            OnePageLess;
            SetScrollValue;
         END;
      inPageDown:
         WHILE StillDown DO BEGIN
            Delay(vertListDelay,x);
            OnePageMore;
            SetScrollValue;
         END;
   END;
   CheckScrollability;
END;

PROCEDURE TVerticalList.DragSelecting;
VAR   r  :  Rect;
      p  :  Point;
      vis  :  INTEGER;
      lineHit  :  LongInt;
BEGIN
   GetRectangle(r);
   vis:= (r.bottom - r.top) DIV fHeight;
   REPEAT
      GetMouse(p);
      IF PtInRect(p,r) THEN BEGIN
         lineHit:=
            fOffLin + (p.v-r.top) DIV fHeight + 1;
         SetSelection(lineHit);
      END
      ELSE IF p.v < r.top THEN BEGIN
         OneLineLess;
         SetScrollValue;
         SetSelection(fOffLin+1);
      END
      ELSE IF p.v > r.bottom THEN BEGIN
         OneLineMore;
         SetScrollValue;
         SetSelection(fOffLin+vis);
      END;
   UNTIL NOT StillDown;
END;

FUNCTION TVerticalList.Click
         (p : Point;  modif : INTEGER) : LongInt;
VAR   r  :  Rect;
      f  :  FontIdent;
      c  :  ControlHandle;
      part  :  INTEGER;
   PROCEDURE ClickInEntries;
   VAR   i  :  INTEGER;
         lineHit  :  LongInt;
   BEGIN
      SetFontIdent(f);
      Click:= fItsValue;
      i:= (p.v - r.top) DIV fHeight + 1;
      lineHit:= fOffLin + i;
      IF BAnd(modif,shiftKey) = 0 THEN BEGIN
         SetSelection(lineHit);
         IF dublClick THEN BEGIN
            GetMouse(p);
            r.bottom:= r.top + i*fHeight;
            r.top   := r.bottom - fHeight;
            IF PtInRect(p,r) THEN Click:=
               MakeLongInt(fItsValue,doubleClick); 
         END
         ELSE IF StillDown THEN DragSelecting;
      END
      { Below, shift-clicking }
      ELSE IF fSelect=lineHit THEN
         CancelSelection
      ELSE SetSelection(lineHit);
   END;
BEGIN
   GetRectangle(r);
   part:= FindControl(p,fPort,c);
   f:= fFont;
   IF c = fScroll THEN BEGIN
      SetFontIdent(f);
      Click:= fItsValue;
      IF part = inThumb THEN Thumbing(p)
                        ELSE Scrolling(part);
   END
   ELSE IF PtInRect(p,r) THEN ClickInEntries
   ELSE IF fNexThing = NIL THEN Click:= noItemHit
   ELSE Click:= fNexThing.Click(p,modif);
END;

PROCEDURE TVerticalList.CancelSelection;
BEGIN
   IF fSelect = 0 THEN Exit(CancelSelection);
   HiliteSelection;
   fSelect:= 0;
END;

PROCEDURE TVerticalList.SetSelection
          (newSel : LongInt);
VAR   i  :  LongInt;
      g  :  GrafPtr;
BEGIN
   IF newSel = fSelect THEN Exit(SetSelection);
   GetPort(g);
   SetPort(fPort);
   CancelSelection;
   IF (newSel>=0) AND (newSel<=fLength)
   THEN BEGIN
      fSelect:= newSel;
      HiliteSelection;
   END;
   SetPort(g);
END;

PROCEDURE TVerticalList.ShowSelection;
VAR   i  :  LongInt;
      v  :  INTEGER;
BEGIN
   IF fSelect = 0 THEN Exit(ShowSelection);
   i:= fSelect - fOffLin;
   v:= VisibleLines;
   IF (i>0) AND (i<=v) THEN Exit(ShowSelection);
   v:= v DIV 2;      {Centre vertically}
   IF v = 0 THEN v:= 1;
   fOffLin:= fSelect - v;
   IF fOffLin < 0 THEN fOffLin:= 0;
   RecalOffByte;
   SetScrollValue;
   Draw;
END;

PROCEDURE TVerticalList.InitKeyStuff;
BEGIN
   fUserHitKeys:= '';
   fLastKeyTime:= 0;
END;

PROCEDURE TVerticalList.SelectCellStart(c : CHAR);
VAR   sUser  :  StrListKey;
      iUser  :  INTEGER;
   FUNCTION NewKeyString : BOOLEAN;
   VAR   x  :  LongInt;
   BEGIN
      x:= TickCount;
      iUser:= Length(sUser);
      IF iUser = 0 THEN NewKeyString:= TRUE
      ELSE IF iUser = listKeyLeng THEN
         NewKeyString:= TRUE
      ELSE NewKeyString:=
         (x - fLastKeyTime > GetDblTime);
      fLastKeyTime:= x;
   END;
   PROCEDURE ScanForMatch;
   VAR   sList  :  StrListKey;
         iList,     {Use a LongInt to be safe}
         i,
         lastOne,
         nextOne,
         timeHere  :  LongInt;
      PROCEDURE ExitSCS;
      BEGIN
         HUnLock(fData);
         {Compensate for time spent here}
         fLastKeyTime:=
            fLastKeyTime + (TickCount-timeHere);
         Exit(SelectCellStart);
      END;
   BEGIN
      timeHere:= TickCount;
      SetCursor(waitCursor^^);
      i:= fOffLin; nextOne:= fOffByt; {From top}
      HLock(fData);
      WHILE i < fLength DO BEGIN
         i:= i + 1;
         lastOne:= nextOne + 1;
         nextOne:=
            Munger(fData,lastOne,blnkPtr,1,NIL,0);
         IF nextOne < 0 THEN ExitSCS;     {Error!}
         iList:= nextOne - lastOne;
         IF iList > iUser THEN iList:= iUser;
         BlockMove(Ptr(ORD(fData^)+lastOne), 
            Ptr(ORD(@sList)+1),iList);
         sList[0]:= CHR(iList);
         IF IUEqualString(sList,sUser) = 0 THEN
         BEGIN
            SetSelection(i);
            ShowSelection;
            ExitSCS;
         END;
      END;
      ExitSCS;
   END;
BEGIN
   CancelSelection;
   sUser:= fUserHitKeys;
   IF NewKeyString THEN sUser:= MakeStr1(c)
   ELSE sUser:= Concat(sUser,MakeStr1(c));
   iUser:= Length(sUser);
   fUserHitKeys:= sUser;
   ScanForMatch;
END;

FUNCTION TVerticalList.KeyIt
         (c : CHAR;  modif : INTEGER) : LongInt;
BEGIN
   IF c IN [left,right,up,down] THEN BEGIN
      KeyIt:= fItsValue;
      IF c= up THEN SetSelection(fSelect-1)
      ELSE IF c = down THEN
         SetSelection(fSelect+1);
      ShowSelection;
   END
   ELSE IF c IN [entr,cRet] THEN BEGIN
      ShowSelection;
      KeyIt:= MakeLongInt(fItsValue,doubleClick); 
   END
   ELSE IF BAnd(modif,cmdKey) <> 0 THEN
      KeyIt:= INHERITED KeyIt(c,modif)
   ELSE IF c >= blnkChr THEN BEGIN
      KeyIt:= fItsValue;
      SelectCellStart(c);
   END
   ELSE KeyIt:= INHERITED KeyIt(c,modif);
END;

PROCEDURE TVerticalList.Response
          (theItem,theKind : INTEGER);
VAR   s  :  Str255;
BEGIN
   IF theItem <> fItsValue THEN
      INHERITED Response(theItem,theKind)
   ELSE IF theKind = doubleClick THEN BEGIN
      IF (fSelect<fOffLin) OR (fSelect<=0) THEN
         SysBeep(1)
      ELSE BEGIN
         s:= GetSelection;
         s:= Concat('Entry #',
            IntString(fSelect),' is:',cRet,s);
         SetDAFont(fFont.n);
         SimpleAlert(s);
         SetDAFont(systemFont);
      END;
   END;
END;

PROCEDURE TVerticalList.Resize(hauteur:INTEGER);
VAR   r  :  Rect;
      g  :  GrafPtr;
BEGIN
   r:= fBorder;
   fBorder.bottom:= fBorder.top + hauteur;
   IF fBorder.bottom > r.bottom THEN BEGIN
      GetPort(g);
      SetPort(fPort);
      r.top:= r.bottom;
      r.bottom:= fBorder.bottom;
      InvalRect(r);
      SetPort(g);
   END;
   SizeControl(fScroll,scrWidth+1,hauteur+2);
   CheckScrollability;
END;

END.

Listing:  BLInit.P
UNIT  BLInit; {•••• Initialization routines ••••}

INTERFACE

USES  Memtypes,QuickDraw,OSIntf,ToolIntf, 
      PackIntf,FixMath,ObjIntf,BLObject;

PROCEDURE InitBigList;
PROCEDURE SetUpMenus;
PROCEDURE SetUpPseudoDialog;

IMPLEMENTATION
{$S SegInit}
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE InitBigList;
   PROCEDURE SetUpMultiFinder;   {Set “wneExists”}
   CONST WNETrapNum= $60; {Nº of “WaitNextEvent”}
         UnImplTrap = $9F;  {Unimplemented trap #}
   VAR   world  :  SysEnvRec;
         error  :  OSErr;
   BEGIN
      error:= SysEnvirons(1,world);
      IF error = noErr THEN BEGIN
         IF world.machineType<0 THEN ExitToShell;
         wneExists:= (world.machineType >= 0) AND
           (NGetTrapAddress(WNETrapNum,ToolTrap)<>
            NGetTrapAddress(UnImplTrap,ToolTrap));
      END
      ELSE wneExists:= FALSE;
   END;
BEGIN
   {Basic toolbox initializations}
   MaxApplZone;
   InitGraf(@thePort);
   InitFonts;
   InitWindows;
   InitMenus;
   TEInit;
   InitDialogs(NIL);
   {Event-management globals}
   weAreDone:= FALSE;
   inBckGrnd:= FALSE;
   SetUpMultiFinder;
   dublClick:= FALSE;
   SetPt(lastClikPoint,0,0);
   lastClikTime:= 0;
   FlushEvents(everyEvent,0);
   {Initialize the cursors}
   XCursor:= GetCursor(crossCursor);
   HLock(Handle(XCursor));
   waitCursor:= GetCursor(watchCursor);
   HLock(Handle(waitCursor));
   SetCursor(waitCursor^^);
   {Init. “styleVector” for top of Style menu}
   styleVector[2]:= bold;
   styleVector[3]:= italic;
   styleVector[4]:= underline;
   styleVector[5]:= outline;
   styleVector[6]:= shadow;
   styleVector[7]:= condense;
   styleVector[8]:= extend;
   {Other stuff}
   forNowFI.n:= systemFont;
   forNowFI.s:= 12;
   forNowFI.y:= [];
   defaultFI:= forNowFI;
   entr := CHR( 3);
   cRet := CHR(13);
   left := CHR(28);
   right:= CHR(29);
   up   := CHR(30);
   down := CHR(31);
   blnkChr:= ' ';
   blnkPtr:= Ptr(ORD(@blnkChr)+1);  {With Munger}
   WITH screenBits.bounds DO BEGIN
      SetRect(zoomArea,left+origH,top+origV,
         right-origH,bottom-origH);
      SetRect(dragArea,left+4,top+24,
         right-4,bottom-4);
   END;
END;
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE SetUpMenus;
BEGIN
   myMenus[1]:= GetMenu(applMID);
   AddResMenu(myMenus[1],'DRVR');
   InsertMenu(myMenus[1],0);
   myMenus[2]:= GetMenu(fileMID);
   InsertMenu(myMenus[2],0);
   myMenus[3]:= GetMenu(editMID);
   InsertMenu(myMenus[3],0);
   myMenus[4]:= GetMenu(fontMID);
   AddResMenu(myMenus[4],'FONT');
   InsertMenu(myMenus[4],0);
   theFontMenu:= myMenus[4];
   myMenus[5]:= GetMenu(stylMID);
   InsertMenu(myMenus[5],0);
   theStylMenu:= myMenus[5];
   SetFontMenu;
   SetSizeMenu;
   SetStylMenu;
   DrawMenuBar;
END;
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE CheckMemError;
VAR   e  :  OSErr;
BEGIN
   e:= MemError;
   IF e = noErr THEN Exit(CheckMemError);
   SimpleAlert(Concat('Error #',IntString(e)));
   ExitToShell;
END;
{••••••••••••••••••••••••••••••••••••••••••••••••}
{ THE DATA MUST START & END WITH A BLANK. }
PROCEDURE InstallSomeDataInList(v:TVerticalList);
CONST numberOfEntries = 10000;
VAR   h  :  Handle;
      s  :  Str255;
      i,x  :  LongInt;
BEGIN
   h:= NewHandle(1);
   CheckMemError;
   s[0]:= blnkChr;
   BlockMove(@s,h^,1);
   x:= 1;
   FOR i:= 1 TO numberOfEntries DO BEGIN
      CASE i MOD 5 OF
       0:s:= 'What';
       1:s:= 'fools';
       2:s:= 'these';
       3:s:= 'mortals';
       4:s:= 'be!';
      END;
      s:= Concat(IntString(i),'•',s,blnkChr);
      x:= Munger(h,x,NIL,0,Ptr(ORD(@s)+1),
         Length(s));
      CheckMemError;
   END;
   v.InstallData(h);
END;
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE SetUpPseudoDialog;
VAR   r  :  Rect;
      f  :  FontIdent;
      theVL  :  TVerticalList;
      thePB  :  TPlainButton;
      theTB  :  TToggleButton;
      the3D  :  TThreeDButton;
      theT3  :  TToggl3DButton;
      theST  :  TStaticText;
      theIC  :  TIcon;
      theAN  :  TAnimation;
   PROCEDURE SetF(nn:INTEGER;ss:Byte;yy:Style);
   BEGIN f.n:= nn; f.s:= ss; f.y:= yy; END;
BEGIN
   New(fakeDlg);
   SetRect(r,105,50,405,300);
   SetF(systemFont,12,[]);
   fakeDlg.IPseudoDialog(r,
      'Big List Demonstration',FALSE,f);
   New(theVL);
   SetRect(r, 10, 10,110,240);
   theVL.IVerticalList(r,fakeDlg.fWindow);
   InstallSomeDataInList(theVL);
   fakeDlg.InstallItem(theVL);
   New(thePB);
   SetRect(r,125,10,280,10); {Force computation}
   SetF(geneva,9,[bold,extend]);
   thePB.IPlainButton(r,'About ','1',f);
   fakeDlg.InstallItem(thePB);
   New(theTB);
   SetRect(r,125,45,280,45); {Force computation}
   SetF(systemFont,12,[bold]);
   theTB.IToggleButton(r,'Icon','I',f, toggleOff);
   fakeDlg.InstallItem(theTB);
   New(the3D);
   SetRect(r,125,80,280,80); {Force computation}
   SetF(systemFont,12,[italic]);
   the3D.IThreeDButton(r,'Window info','W',f);
   fakeDlg.InstallItem(the3D);
   New(theT3);
   SetRect(r,125,115,280,115); {Force computation}
   SetF(monaco,12,[outline]);
   theT3.IToggl3DButton(r,'Animation', 'A',f,
      toggleOff);
   fakeDlg.InstallItem(theT3);
   New(theST);
   SetRect(r,125,160,280,190);
   SetF(geneva,9,[]);
   theST.IStaticText(r,f,
'Alas & alack, these words are but static text.');
   fakeDlg.InstallItem(theST);
   New(theIC);
   SetRect(r,140,208,140,208);{Only top,left used}
   theIC.IIcon(r,blApplID);
   fakeDlg.InstallItem(theIC);
   New(theAN);
   SetRect(r,230,190,280,240);{Only top,left used}
   theAN.IAnimation(r,exclamationBaseID,
      exclamationNumber);
   fakeDlg.InstallItem(theAN);
   ShowWindow(fakeDlg.fWindow);
END;

END.
Listing:  BigList.P
PROGRAM BigList; {Main event-management routines}

USES  Memtypes,QuickDraw,OSIntf,ToolIntf, 
      PackIntf,FixMath,ObjIntf,BLObject,BLInit;

CONST theSignature      = 'BLDR';
      {Constants for event management}
      kOSEvent          = app4Evt;
      kSuspResmMessage  =   1;
      kResumeMask       =   1;
      kMouseMovMessage  = $FA;

PROCEDURE _DataInit;  EXTERNAL;

{$S SegAbout}
{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Routines for the About box }
FUNCTION NameOfSoftWare : Str255;
VAR   s  :  Str255;
      i  :  INTEGER;
      h  :  Handle;
BEGIN
   h:= GetResource(theSignature,0);
   IF (h <> NIL) AND (ResError = noErr)
      THEN s:= StringHandle(h)^^
      ELSE GetAppParms(s,i,h);
   NameOfSoftWare:= s;
END;

PROCEDURE AboutBox;
BEGIN SimpleAlert(NameOfSoftWare); END;

{$S Main}
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE DoIdleProcessing;
VAR   w  :  WindowPtr;
      k  :  INTEGER;
BEGIN
   fakeDlg.Idling;
   IF inBckGrnd THEN Exit(DoIdleProcessing);
   w:= FrontWindow;
   k:= GetKind(w);    {Will be zero if "w" is NIL}
   IF k = dialogKind THEN
      TEIdle(DialogPeek(w)^.textH);
END;

PROCEDURE SuspendOrResume;
BEGIN
   inBckGrnd:=
      (BAnd(theEvent.message,kResumeMask)  = 0);
   IF FrontWindow = fakeDlg.fWindow THEN BEGIN
      IF inBckGrnd THEN fakeDlg.DeactivateWindow
                   ELSE fakeDlg.ActivateWindow;
   END;
END;

PROCEDURE DoCommand(mResult : LONGINT);
VAR   theItem,
      theMenu  :  INTEGER;
   PROCEDURE OuvrirAccessoire;
   VAR   g  :  GrafPtr;
         s  :  Str255;
   BEGIN
      GetPort(g);
      GetItem(myMenus[1],theItem,s);
      theItem:= OpenDeskAcc(s);
      SetPort(g);
   END;
BEGIN
   SetCursor(waitCursor^^);
   theMenu:= HiWord(mResult);
   theItem:= LoWord(mResult);
   CASE theMenu OF
      applMID:IF theItem=1 THEN AboutBox
                           ELSE OuvrirAccessoire;
      fileMID:weAreDone:= (theItem = 1);
      editMID:IF SystemEdit(theItem-1) THEN;
      fontMID:BEGIN
                 FontMenuEvent(theItem);
                 IF fakeDlg <> NIL THEN
                    fakeDlg.SetFont;
              END;
      stylMID:BEGIN
                 StyleMenuEvent(theItem);
                 IF fakeDlg <> NIL THEN
                    fakeDlg.SetFont;
              END;
   END;
   HiliteMenu(0);
END;

PROCEDURE ProcessTheReply(theReply : LongInt);
CONST m = 'Congratulations, you just hit the ';
VAR   x,y  :  INTEGER;
BEGIN
   x:= LoWord(theReply);
   y:= HiWord(theReply);
   IF y = 0 THEN CASE x OF
      1: {Single click in list, do nothing};
      2: AboutBox;
      3: fakeDlg.EnableDisableItem(7);
      4: fakeDlg.ItemInformation;
      5: fakeDlg.AnimateStuff;
      6: SimpleAlert(Concat(m,'static text.'));
      7: SimpleAlert(Concat(m,'icon.'));
      8: SimpleAlert(Concat(m,'animation.')) ;
   END
   ELSE fakeDlg.RequestResponse(x,y);
END;

PROCEDURE PerformMouse;
VAR   w  :  WindowPtr;
      k  :  LongInt;
      p  :  Point;
BEGIN
   p:= theEvent.where;
   k:= FindWindow(p,w);
   CASE k OF
        inDesk:SysBeep(1);
     inMenuBar:DoCommand(MenuSelect(p)); 
   inSysWindow:SystemClick(theEvent,w) ;
     inContent,
        inDrag:IF w = fakeDlg.fWindow THEN BEGIN
                  k:= fakeDlg.HandleMouseEvents
                      (p,theEvent.modifiers,k);
                  ProcessTheReply(k);
               END;
      inZoomIn,
     inZoomOut,
        inGrow: {Nothing};
      inGoAway: {Nothing};
   END;
END;

PROCEDURE PerformKey;
VAR   c  :  CHAR;
      x  :  LongInt;

   PROCEDURE MaybeInFakeDlg;
   BEGIN
      IF FrontWindow = fakeDlg.fWindow THEN
         ProcessTheReply(
            fakeDlg.Keying(c,theEvent.modifiers));
   END;

BEGIN
   c:= CHR(BAnd(theEvent.message,charCodeMask));
   IF BAnd(theEvent.modifiers,cmdKey) = 0 THEN
      MaybeInFakeDlg
   ELSE BEGIN
      x:= MenuKey(c);
      IF HiWord(x) = 0 THEN MaybeInFakeDlg
                       ELSE DoCommand(x);
   END;
END;

PROCEDURE PerformActivate(w : WindowPtr);
BEGIN
   IF w = fakeDlg.fWindow THEN BEGIN
      IF Odd(theEvent.modifiers)
         THEN fakeDlg.ActivateWindow
         ELSE fakeDlg.DeactivateWindow;
   END;
END;

PROCEDURE PerformUpdate(w : WindowPtr);
BEGIN
   IF w = fakeDlg.fWindow THEN
      fakeDlg.UpdateWindow;
END;

PROCEDURE ProcessDiskEvent(evtMessage : LongInt);
VAR   e  :  OSErr;
      p  :  Point;
BEGIN
   SetPt(p,100,100);
   IF HiWord(evtMessage) <> noErr THEN
      e:= DIBadMount(p,evtMessage);
END;

PROCEDURE ProcessOsEvent;
BEGIN
   CASE BAnd(BRotL(theEvent.message,8),$FF) OF
      kMouseMovMessage : DoIdleProcessing;
      kSuspResmMessage : SuspendOrResume;
   END;
END;

PROCEDURE DoEventProcessing;
VAR   x  :  LongInt;
BEGIN
   x:= theEvent.message;
   CASE theEvent.what OF
      nullEvent   : DoIdleProcessing;
      mouseDown   : PerformMouse;
      keyDown,
      autoKey     : PerformKey;
      activateEvt : PerformActivate(WindowPtr(x));
      updateEvt   : PerformUpdate(WindowPtr(x));
      diskEvt     : ProcessDiskEvent(x);
      kOSEvent    : ProcessOsEvent;
   END;
END;

PROCEDURE MainEventLoop;
CONST sleep = 2;
VAR   gotEvent :  BOOLEAN;
BEGIN
   WHILE NOT weAreDone DO BEGIN
      SetCursor(arrow);
      IF wneExists THEN
         gotEvent:= WaitNextEvent
         (everyEvent,theEvent,sleep,NIL)
      ELSE BEGIN
         SystemTask;
         gotEvent:= GetNextEvent
            (everyEvent,theEvent);
      END;
      IF gotEvent THEN DoEventProcessing
                  ELSE DoIdleProcessing;
   END;
END;
{••••••• P R I N C I P A L     B L O C K ••••••••}
BEGIN
   UnloadSeg(@_DataInit);
   InitBigList;
   SetUpMenus;
   SetUpPseudoDialog;
   UnLoadSeg(@InitBigList);     {SegInit}
   InitCursor;
   MainEventLoop;
   fakeDlg.Free;
END.

 
AAPL
$118.93
Apple Inc.
-0.07
MSFT
$47.81
Microsoft Corpora
+0.06
GOOG
$541.83
Google Inc.
+1.46

MacTech Search:
Community Search:

Software Updates via MacUpdate

Adobe Photoshop Elements 13.0 - Consumer...
Adobe Photoshop Elements 12--the #1 selling consumer photo editing software--helps you edit pictures with powerful, easy-to-use options and share them via print, the web, Facebook, and more.Version... Read more
Skype 7.2.0.412 - Voice-over-internet ph...
Skype allows you to talk to friends, family and co-workers across the Internet without the inconvenience of long distance telephone charges. Using peer-to-peer data transmission technology, Skype... Read more
HoudahSpot 3.9.6 - Advanced file search...
HoudahSpot is a powerful file search tool built upon MacOS X Spotlight. Spotlight unleashed Create detailed queries to locate the exact file you need Narrow down searches. Zero in on files Save... Read more
RapidWeaver 6.0.3 - Create template-base...
RapidWeaver is a next-generation Web design application to help you easily create professional-looking Web sites in minutes. No knowledge of complex code is required, RapidWeaver will take care of... Read more
iPhoto Library Manager 4.1.10 - Manage m...
iPhoto Library Manager lets you organize your photos into multiple iPhoto libraries. Separate your high school and college photos from your latest summer vacation pictures. Or keep some photo... Read more
iExplorer 3.5.1.9 - View and transfer al...
iExplorer is an iPhone browser for Mac lets you view the files on your iOS device. By using a drag and drop interface, you can quickly copy files and folders between your Mac and your iPhone or... Read more
MacUpdate Desktop 6.0.3 - Discover and i...
MacUpdate Desktop 6 brings seamless 1-click installs and version updates to your Mac. With a free MacUpdate account and MacUpdate Desktop 6, Mac users can now install almost any Mac app on macupdate.... Read more
SteerMouse 4.2.2 - Powerful third-party...
SteerMouse is an advanced driver for USB and Bluetooth mice. It also supports Apple Mighty Mouse very well. SteerMouse can assign various functions to buttons that Apple's software does not allow,... Read more
iMazing 1.1 - Complete iOS device manage...
iMazing (was DiskAid) is the ultimate iOS device manager with capabilities far beyond what iTunes offers. With iMazing and your iOS device (iPhone, iPad, or iPod), you can: Copy music to and from... Read more
PopChar X 7.0 - Floating window shows av...
PopChar X helps you get the most out of your font collection. With its crystal-clear interface, PopChar X provides a frustration-free way to access any font's special characters. Expanded... Read more

Latest Forum Discussions

See All

Mystery Case Files: Dire Grove, Sacred G...
Mystery Case Files: Dire Grove, Sacred Grove HD Review By Jennifer Allen on November 28th, 2014 Our Rating: iPad Only App - Designed for the iPad A decent new installment for the popular Mystery Case Files series.   | Read more »
Castaway Paradise – Tips, Tricks, and St...
Ahoy there, castaways: Were you curious about our own thoughts regarding this pristine shipwreck? Check out our Castaway Paradise review! Castaway Paradise is out for iOS, finally giving mobile gamers the opportunity to enjoy the idyllic lifestyle... | Read more »
Castaway Paradise VIP Subs are on Sale f...
Castaway Paradise VIP Subs are on Sale for a Limited Time, and a Special Holiday Update is Coming Soon Posted by Rob Rich on November 28th, 2014 [ | Read more »
Primitive Review
Primitive Review By Jordan Minor on November 28th, 2014 Our Rating: :: FOLK ARTUniversal App - Designed for iPhone and iPad True to its name, Primitive is about as straightforward as runners get.   | Read more »
7 tips to get ahead of the competition i...
7 tips to get ahead of the competition in Dynasty of Dungeons Posted by Simon Reed on November 28th, 2014 [ permalink ] Playcrab has launched their action-packed new dungeon crawler, Dynasty of Dungeons, today. | Read more »
Master of Tea Kung Fu Review
Master of Tea Kung Fu Review By Jordan Minor on November 28th, 2014 Our Rating: :: ONE DROP RULESUniversal App - Designed for iPhone and iPad Master of Tea Kung Fu is a creative and complex caffeinated brawler.   | Read more »
Monster Strike Review
Monster Strike Review By Campbell Bird on November 28th, 2014 Our Rating: :: BILLIARD STRATEGYUniversal App - Designed for iPhone and iPad Collect monsters and battle by flinging them across the battlefield in this strangely... | Read more »
Proun+ Review
Proun+ Review By Jennifer Allen on November 28th, 2014 Our Rating: :: TWITCHY RACINGUniversal App - Designed for iPhone and iPad Twitchy racing aplenty in Proun+, an enjoyably tricky title.   | Read more »
Lucha Amigos (Games)
Lucha Amigos 1.0 Device: iOS Universal Category: Games Price: $1.99, Version: 1.0 (iTunes) Description: Forget Ninja Turtles, and meet Wrestlers Turtles! Crazier, Spicier and…Bouncier! Sling carapaces of 7 Luchadores to knock all... | Read more »
Record of Agarest War Zero (Games)
Record of Agarest War Zero 1.0 Device: iOS Universal Category: Games Price: $7.99, Version: 1.0 (iTunes) Description: HyperDevbox Holiday Turkey Black Friday Special Pricing! To celebrate the opening of the holiday season HyperDevbox... | Read more »

Price Scanner via MacPrices.net

Best Black Friday Deal: 15-inch Retina MacBoo...
 B&H Photo has the new 2014 15″ Retina MacBook Pros on sale for $300 off MSRP as part of their Black Friday sale. Shipping is free, and B&H charges NY sales tax only: - 15″ 2.2GHz Retina... Read more
Up To 75% Off Infovole Text Apps Over Black F...
Infovole’s entire range of apps, including the Textkraft family of word processors for iPads and iPhones, is being offered at 50-75% off over the Black Friday and Cyber Monday weekend. The five-day... Read more
Black Friday: Up to $60 off Mac minis, NY tax...
 B&H Photo has new 2014 Mac minis on sale for up to $60 off MSRP as part of their Black Friday sale. Shipping is free, and B&H charges NY sales tax only: - 1.4GHz Mac mini: $449.99 $50 off... Read more
Black Friday: 27-inch 5K iMac for $2299, save...
 B&H Photo continues to offer Black Friday sale prices on the 27″ 3.5GHz 5K iMac, in stock today and on sale for $2299 including free shipping plus NY sales tax only. Their price is $200 off MSRP... Read more
Karalux Announces 24K Gold-Plated iPhone 6
Karalux, a Vietnam-based jewellery firm, has launched a unique 24 karat gold-plated iPhone 6 version with gold-cast monolithic dragon on its back panel. The real 24 karat gold plated enclosure doesn’... Read more
Black Friday: 13-inch 2.6GHz Retina MacBook P...
 B&H Photo has lowered their price for the 13″ 2.6GHz/128GB Retina MacBook Pro to $1159 for Black Friday. That’s $140 off MSRP, and it’s the lowest price for this model (except for Apple’s $1099... Read more
View all the Black Friday sales on our Mac Pr...
We’ve updated our Mac Price Trackers with the latest information on prices, bundles, and availability on systems from Apple’s authorized internet/catalog resellers. View Black Friday sale prices at a... Read more
Black Friday: 11-inch MacBook Air for $779, s...
 Best Buy has lowered their price for the 2014 11″ 1.4GHz/128GB MacBook Air to $779.99 for Black Friday. That’s $120 off MSRP. Choose free shipping or free local store pickup (if available). Sale... Read more
Apple Store Black Friday sale for 2014: $100...
BLACK FRIDAY The Apple Store has posted their Black Friday deals for 2014. Receive a $100 PRODUCT(RED) branded iTunes gift card with the purchase of select Macs, $50 with iPads, and $25 with iPods,... Read more
Black Friday: 15% off iTunes Gift Cards
Staples is offering 15% off $50 and $100 iTunes Gift Cards on their online store as part of their Black Friday sale. Click here for more information. Shipping is free. Best Buy is offering $100... Read more

Jobs Board

Position Opening at *Apple* - Apple (United...
…Summary** As a Specialist, you help create the energy and excitement around Apple products, providing the right solutions and getting products into customers' hands. You Read more
Position Opening at *Apple* - Apple (United...
**Job Summary** Being a Business Manager at an Apple Store means you're the catalyst for businesses to discover and leverage the power, ease, and flexibility of Apple Read more
*Apple* Solutions Consultant (ASC) - Apple (...
**Job Summary** The ASC is an Apple employee who serves as an Apple brand ambassador and influencer in a Reseller's store. The ASC's role is to grow Apple Read more
Senior Event Manager, *Apple* Retail Market...
…This senior level position is responsible for leading and imagining the Apple Retail Team's global event strategy. Delivering an overarching brand story; in-store, Read more
*Apple* Retail - Multiple Positions (US) - A...
Sales Specialist - Retail Customer Service and Sales Transform Apple Store visitors into loyal Apple customers. When customers enter the store, you're also the Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.