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
$99.76
Apple Inc.
+2.09
MSFT
$44.08
Microsoft Corpora
+0.45
GOOG
$520.84
Google Inc.
+9.67

MacTech Search:
Community Search:

Software Updates via MacUpdate

Apple iOS 8.1 - The latest version of Ap...
The latest version of iOS can be downloaded through iTunes. Apple iOS 8 comes with big updates to apps you use every day, like Messages and Photos. A whole new way to share content with your family.... Read more
TechTool Pro 7.0.5 - 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
PDFKey Pro 4.0.2 - Edit and print passwo...
PDFKey Pro can unlock PDF documents protected for printing and copying when you've forgotten your password. It can now also protect your PDF files with a password to prevent unauthorized access and/... Read more
Yasu 2.9.1 - System maintenance app; per...
Yasu was originally created with System Administrators who service large groups of workstations in mind, Yasu (Yet Another System Utility) was made to do a specific group of maintenance tasks... Read more
Hazel 3.3 - Create rules for organizing...
Hazel is your personal housekeeper, organizing and cleaning folders based on rules you define. Hazel can also manage your trash and uninstall your applications. Organize your files using a... Read more
Autopano Giga 3.7 - Stitch multiple imag...
Autopano Giga allows you to stitch 2, 20, or 2,000 images. Version 3.0 integrates impressive new features that will definitely make you adopt Autopano Pro or Autopano Giga: Choose between 9... Read more
MenuMeters 1.8 - CPU, memory, disk, and...
MenuMeters is a set of CPU, memory, disk, and network monitoring tools for Mac OS X. Although there are numerous other programs which do the same thing, none had quite the feature set I was looking... Read more
Coda 2.5 - One-window Web development su...
Coda is a powerful Web editor that puts everything in one place. An editor. Terminal. CSS. Files. With Coda 2, we went beyond expectations. With loads of new, much-requested features, a few... Read more
Arq 4.6.1 - Online backup to Google Driv...
Arq is super-easy online backup for the Mac. Back up to your own Google Drive storage (15GB free storage), your own Amazon Glacier ($.01/GB per month storage) or S3, or any SFTP server. Arq backs up... Read more
Airfoil 4.8.10 - Send audio from any app...
Airfoil allows you to send any audio to AirPort Express units, Apple TVs, and even other Macs and PCs, all in sync! It's your audio - everywhere. With Airfoil you can take audio from any... Read more

Latest Forum Discussions

See All

This Week at 148Apps: October 13-17, 201...
Expert App Reviewers   So little time and so very many apps. What’s a poor iPhone/iPad lover to do? Fortunately, 148Apps is here to give you the rundown on the latest and greatest releases. And we even have a tremendous back catalog of reviews; just... | Read more »
Angry Birds Transformers Review
Angry Birds Transformers Review By Jennifer Allen on October 20th, 2014 Our Rating: :: TRANSFORMED BIRDSUniversal App - Designed for iPhone and iPad Transformed in a way you wouldn’t expect, Angry Birds Transformers is a quite... | Read more »
GAMEVIL Announces the Upcoming Launch of...
GAMEVIL Announces the Upcoming Launch of Mark of the Dragon Posted by Jessica Fisher on October 20th, 2014 [ permalink ] Mark of the Dragon, by GAMEVIL, put | Read more »
Interview With the Angry Birds Transform...
Angry Birds Transformers recently transformed and rolled out worldwide. This run-and-gun title is a hit with young Transformers fans, but the ample references to classic Transformers fandom has also earned it a place in the hearts of long-time... | Read more »
Find Free Food on Campus with Ypay
Find Free Food on Campus with Ypay Posted by Jessica Fisher on October 20th, 2014 [ permalink ] iPhone App - Designed for the iPhone, compatible with the iPad | Read more »
Strung Along Review
Strung Along Review By Jordan Minor on October 20th, 2014 Our Rating: :: GOT NO STRINGSUniversal App - Designed for iPhone and iPad A cool gimmick and a great art style keep Strung Along from completely falling apart.   | Read more »
P2P file transferring app Send Anywhere...
File sharing services like Dropbox have security issues. Email attachments can be problematic when it comes to sharing large files. USB dongles don’t fit into your phone. Send Anywhere, a peer-to-peer file transferring application, solves all of... | Read more »
Zero Age Review
Zero Age Review By Jordan Minor on October 20th, 2014 Our Rating: :: MORE THAN ZEROiPad Only App - Designed for the iPad With its mind-bending puzzles and spellbinding visuals, Zero Age has it all.   | Read more »
Hay Ewe Review
Hay Ewe Review By Campbell Bird on October 20th, 2014 Our Rating: :: SAVE YOUR SHEEPLEUniversal App - Designed for iPhone and iPad Pave the way for your flock in this line drawing puzzle game from the creators of Worms.   | Read more »
My Very Hungry Caterpillar (Education)
My Very Hungry Caterpillar 1.0.0 Device: iOS Universal Category: Education Price: $3.99, Version: 1.0.0 (iTunes) Description: Care for your very own Very Hungry Caterpillar! My Very Hungry Caterpillar will captivate you as he crawls... | Read more »

Price Scanner via MacPrices.net

2013 15-inch 2.0GHz Retina MacBook Pro availa...
B&H Photo has leftover previous-generation 15″ 2.0GHz Retina MacBook Pros now available for $1599 including free shipping plus NY sales tax only. Their price is $400 off original MSRP. B&H... Read more
Updated iPad Prices
We’ve updated our iPad Air Price Tracker and our iPad mini Price Tracker with the latest information on prices and availability from Apple and other resellers, including the new iPad Air 2 and the... Read more
Apple Pay Available to Millions of Visa Cardh...
Visa Inc. brings secure, convenient payments to iPad Air 2 and iPad mini 3as well as iPhone 6 and 6 Plus. Starting October 20th, eligible Visa cardholders in the U.S. will be able to use Apple Pay,... Read more
Textkraft Pocket – the missing TextEdit for i...
infovole GmbH has announced the release and immediate availability of Textkraft Pocket 1.0, a professional text editor and note taking app for Apple’s iPhone. In March 2014 rumors were all about... Read more
C Spire to offer iPad Air 2 and iPad mini 3,...
C Spire on Friday announced that it will offer iPad Air 2 and iPad mini 3, both with Wi-Fi + Cellular, on its 4G+ LTE network in the coming weeks. C Spire will offer the new iPads with a range of... Read more
Belkin Announces Full Line of Keyboards and C...
Belkin International has unveiled a new lineup of keyboard cases and accessories for Apple’s newest iPads, featuring three QODE keyboards and a collection of thin, lightweight folios for both the... Read more
Verizon offers new iPad Air 2 preorders for $...
Verizon Wireless is accepting preorders for the new iPad Air 2, cellular models, for $100 off MSRP with a 2-year service agreement: - 16GB iPad Air 2 WiFi + Cellular: $529.99 - 64GB iPad Air 2 WiFi... Read more
Price drops on refurbished Mac minis, now ava...
The Apple Store has dropped prices on Apple Certified Refurbished previous-generation Mac minis, with models now available starting at $419. Apple’s one-year warranty is included with each mini, and... Read more
Apple refurbished 2014 MacBook Airs available...
The Apple Store has Apple Certified Refurbished 2014 MacBook Airs available for up to $180 off the cost of new models. An Apple one-year warranty is included with each MacBook, and shipping is free.... Read more
Refurbished 2013 MacBook Pros available for u...
The Apple Store has Apple Certified Refurbished 13″ and 15″ MacBook Pros available starting at $929. Apple’s one-year warranty is standard, and shipping is free: - 13″ 2.5GHz MacBook Pros (4GB RAM/... Read more

Jobs Board

*Apple* Retail - Multiple Positions (US) - A...
Job Description: Sales Specialist - Retail Customer Service and Sales Transform Apple Store visitors into loyal Apple customers. When customers enter the store, Read more
Position Opening at *Apple* - Apple (United...
…customers purchase our products, you're the one who helps them get more out of their new Apple technology. Your day in the Apple Store is filled with a range of Read more
Position Opening at *Apple* - Apple (United...
**Job Summary** At the Apple Store, you connect business professionals and entrepreneurs with the tools they need in order to put Apple solutions to work in their Read more
Position Opening at *Apple* - Apple (United...
**Job Summary** The Apple Store is a retail environment like no other - uniquely focused on delivering amazing customer experiences. As an Expert, you introduce people Read more
Position Opening at *Apple* - Apple (United...
**Job Summary** As businesses discover the power of Apple computers and mobile devices, it's your job - as a Solutions Engineer - to show them how to introduce these Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.