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
$116.47
Apple Inc.
+0.16
MSFT
$47.98
Microsoft Corpora
-0.72
GOOG
$537.50
Google Inc.
+2.67

MacTech Search:
Community Search:

Software Updates via MacUpdate

StatsBar 1.9 - Monitor system processes...
StatsBar gives you a comprehensive and detailed analysis of the following areas of your Mac: CPU usage Memory usage Disk usage Network and bandwidth usage Battery power and health (MacBooks only)... Read more
Cyberduck 4.6 - FTP and SFTP browser. (F...
Cyberduck is a robust FTP/FTP-TLS/SFTP browser for the Mac whose lack of visual clutter and cleverly intuitive features make it easy to use. Support for external editors and system technologies such... Read more
Maya 2015 - Professional 3D modeling and...
Maya is an award-winning software and powerful, integrated 3D modeling, animation, visual effects, and rendering solution. Because Maya is based on an open architecture, all your work can be scripted... Read more
Evernote 6.0.1 - Create searchable notes...
Evernote allows you to easily capture information in any environment using whatever device or platform you find most convenient, and makes this information accessible and searchable at anytime, from... Read more
calibre 2.11 - Complete e-library manage...
Calibre is a complete e-book library manager. Organize your collection, convert your books to multiple formats, and sync with all of your devices. Let Calibre be your multi-tasking digital... Read more
Herald 5.0.1 - Notification plugin for M...
Note: Versions 2.1.3 (for OS X 10.7), 3.0.6 (for OS X 10.8), and 4.0.8 (for OS X 10.9) are no longer supported by the developer. Herald is a notification plugin for Mail.app, Apple's Mac OS X email... Read more
Firetask 3.7 - Innovative task managemen...
Firetask uniquely combines the advantages of classical priority-and-due-date-based task management with GTD. Stay focused and on top of your commitments - Firetask's "Today" view shows all relevant... Read more
TechTool Pro 7.0.6 - Hard drive and syst...
TechTool Pro is now 7, and this is the most advanced version of the acclaimed Macintosh troubleshooting utility created in its 20-year history. Micromat has redeveloped TechTool Pro 7 to be fully 64... Read more
PhotoDesk 3.0.1 - Instagram client for p...
PhotoDesk lets you view, like, comment, and download Instagram pictures/videos! (NO Uploads! / Image Posting! Instagram forbids that! AND you *need* an *existing* Instagram account). But you can do... Read more
SuperDuper! 2.7.3 - Advanced disk clonin...
SuperDuper! is an advanced, yet easy to use disk copying program. It can, of course, make a straight copy, or "clone" -- useful when you want to move all your data from one machine to another, or do... Read more

Latest Forum Discussions

See All

Ubisoft Gives Everyone Two New Ways to E...
Ubisoft Gives Everyone Two New Ways to Earn In-Game Stuff for Far Cry 4 Posted by Jessica Fisher on November 21st, 2014 [ permalink ] | Read more »
Golfinity – Tips, Tricks, Strategies, an...
Dig this: Would you like to know what we thought of being an infinite golfer? Check out our Golfinity review! Golfinity offers unlimited ways to test your skills at golf. Here are a few ways to make sure your score doesn’t get too high and your... | Read more »
Dark Hearts, The Sequel to Haunting Meli...
Dark Hearts, The Sequel to Haunting Melissa, is Available Now Posted by Jessica Fisher on November 21st, 2014 [ permalink ] Universal App - Designed for iPhone and iPad | Read more »
Meowza! Toyze Brings Talking Tom to Life...
Meowza! | Read more »
Square Enix Announces New Tactical RPG f...
Square Enix Announces New Tactical RPG for Mobile, Heavenstrike Rivals. Posted by Jessica Fisher on November 21st, 2014 [ permalink ] With their epic stories and gorgeous graphics, | Read more »
Quest for Revenge (Games)
Quest for Revenge 1.0.0 Device: iOS Universal Category: Games Price: $4.99, Version: 1.0.0 (iTunes) Description: The great Kingdom of the west has fallen. The gods ignore the prayers of the desperate. A dark warlord has extinguished... | Read more »
Threadz is a New Writing Adventure for Y...
Threadz is a New Writing Adventure for You and Your Friends Posted by Jessica Fisher on November 21st, 2014 [ permalink ] In the tradition of round-robin storytelling, | Read more »
SteelSeries Stratus XL Hardware Review
Made by: SteelSeries Price: $59.99 Hardware/iOS Integration Rating: 4 out of 5 stars Usability Rating: 4.5 out of 5 stars Reuse Value Rating: 4.25 out of 5 stars Build Quality Rating: 4.5 out of 5 stars Overall Rating: 4.31 out of 5 stars | Read more »
ACDSee (Photography)
ACDSee 1.0.0 Device: iOS iPhone Category: Photography Price: $1.99, Version: 1.0.0 (iTunes) Description: Capture, perfect, and share your photos with ACDSee. The ACDSee iPhone app combines an innovative camera, a powerful photo... | Read more »
ProTube for YouTube (Entertainment)
ProTube for YouTube 2.0.2 Device: iOS Universal Category: Entertainment Price: $1.99, Version: 2.0.2 (iTunes) Description: ProTube is the ultimate, fully featured YouTube app. With it's highly polished design, ProTube offers ad-free... | Read more »

Price Scanner via MacPrices.net

Save up to $400 with Apple refurbished 2014 1...
The Apple Store has restocked Apple Certified Refurbished 2014 15″ Retina MacBook Pros for up to $400 off the cost of new models. An Apple one-year warranty is included with each model, and shipping... Read more
New 13-inch 1.4GHz MacBook Air on sale for $8...
 Adorama has the 2014 13″ 1.4GHz/128GB MacBook Air on sale for $899.99 including free shipping plus NY & NJ tax only. Their price is $100 off MSRP. B&H Photo has the 13″ 1.4GHz/128GB MacBook... Read more
Apple Expected to Reverse Nine-Month Tablet S...
Apple and Samsung combined accounted for 62 percent of the nearly 36 million branded tablets shipped in 3Q 2014, according to early vendor shipment share estimates from market intelligence firm ABI... Read more
Stratos: 30 Percent of US Smartphone Owners t...
Stratos, Inc., creator of the Bluetooth Connected Card Platform, has announced results from its 2014 Holiday Mobile Payments Survey. The consumer survey found that nearly one out of three (30 percent... Read more
2014 1.4GHz Mac mini on sale for $449, save $...
 B&H Photo has lowered their price on the new 1.4GHz Mac mini to $449.99 including free shipping plus NY tax only. Their price is $50 off MSRP, and it’s the lowest price available for this new... Read more
Check Apple prices on any device with the iTr...
MacPrices is proud to offer readers a free iOS app (iPhones, iPads, & iPod touch) and Android app (Google Play and Amazon App Store) called iTracx, which allows you to glance at today’s lowest... Read more
64GB iPod touch on sale for $249, save $50
Best Buy has the 64GB iPod touch on sale for $249 on their online store for a limited time. Their price is $50 off MSRP. Choose free shipping or free local store pickup (if available). Sale price for... Read more
15″ 2.2GHz Retina MacBook Pro on sale for $17...
 B&H Photo has the 2014 15″ 2.2GHz Retina MacBook Pro on sale for $1799.99 for a limited time. Shipping is free, and B&H charges NY sales tax only. B&H will also include free copies of... Read more
New Logitech AnyAngle Case/Stand Brings Flexi...
Logitec has announced the newest addition to its suite of tablet products — the Logitech AnyAngle. A protective case with an any-angle stand for iPad Air 2 and all iPad mini models, AnyAngle is the... Read more
Notebook PC Shipments Rise Year-Over-Year as...
According to preliminary results from the upcoming DisplaySearch Quarterly Mobile PC Shipment and Forecast Report, the global notebook PC market grew 10 percent year-over-year in Q3’14 to 49.4... Read more

Jobs Board

*Apple* Solutions Consultant (ASC)- Retail S...
**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
Project Manager, *Apple* Financial Services...
**Job Summary** Apple Financial Services (AFS) offers consumers, businesses and educational institutions ways to finance Apple purchases. We work with national and Read more
*Apple* Store Leader Program - College Gradu...
Job Description: Job Summary As an Apple Store Leader Program agent, you can continue your education as you major in the art of leadership at the Apple Store. You'll 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
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
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.