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.

 

Community Search:
MacTech Search:

Software Updates via MacUpdate

Remotix 3.1.4 - Access all your computer...
Remotix is a fast and powerful application to easily access multiple Macs (and PCs) from your own Mac. Features Complete Apple Screen Sharing support - including Mac OS X login, clipboard... Read more
DesktopLyrics 2.6.6 - Displays current i...
DesktopLyrics is an application that displays the lyrics of the song currently playing in "iTunes" right on your desktop. The lyrics for the song have to be set in iTunes; DesktopLyrics does nothing... Read more
VOX 2.5.1 - Music player that supports m...
VOX is a beautiful music player that supports many filetypes. The beauty is in its simplicity, yet behind the minimal exterior lies a powerful music player with a ton of features and support for all... Read more
NetNewsWire 4.0.0 - RSS and Atom news re...
NetNewsWire is the best way to keep up with the sites and authors you read most regularly. Let NetNewsWire pull down the latest articles, and read them in a distraction-free and Mac-like way. Native... Read more
MacUpdate Desktop 6.0.6 - Search and ins...
MacUpdate Desktop 6 brings seamless 1-click installs and version updates to your Mac. With a free MacUpdate account and MacUpdate Desktop 6, Mac users can now install almost any Mac app on macupdate.... Read more
ForkLift 2.6.5 - Powerful file manager:...
ForkLift is a powerful file manager and ferociously fast FTP client clothed in a clean and versatile UI that offers the combination of absolute simplicity and raw power expected from a well-executed... Read more
Drive Genius 4.1.0 - Powerful system uti...
Drive Genius 4 gives you faster performance from your Mac while also protecting it. The award-winning and improved DrivePulse feature alerts you to hard drive issues before they become major problems... Read more
OnyX 2.9.7 - Maintenance and optimizatio...
OnyX is a multifunctional utility for OS X. It allows you to verify the startup disk and the structure of its System files, to run miscellaneous tasks of system maintenance, to configure the hidden... Read more
DEVONthink Pro 2.8.5 - Knowledge base, i...
DEVONthink Pro is your essential assistant for today's world, where almost everything is digital. From shopping receipts to important research papers, your life often fills your hard drive in the... Read more
Backblaze 4.0.1.878 - Online backup serv...
Backblaze is an online backup service designed from the ground-up for the Mac.With unlimited storage available for $5 per month, as well as a free 15-day trial, peace of mind is within reach with... Read more

Carbo - Handwriting in the Digital Age...
Carbo - Handwriting in the Digital Age 1.0 Device: iOS Universal Category: Productivity Price: $3.99, Version: 1.0 (iTunes) Description: | Read more »
The Apple Watch isn't Great as a Fi...
| Read more »
Show the World What You See With Stre.am...
Live broadcasting is getting popular on mobile devices, which is why you can now get Stre.am, by Infinite Takes. [Read more] | Read more »
PhotoTime's 2.1 Update Adds Apple W...
The latest PhotoTime update is adding even more functionality to the handy photo organizing app. Yep, including Apple Watch support. [Read more] | Read more »
Oh My Glob! Adventure Time Puzzle Quest...
Finn and Jake are taking over D3 Go!'s popular puzzle game series in the upcoming Adventure Time Puzzle Quest. [Read more] | Read more »
Earthcore: Shattered Elements - Tips, Tr...
At first glance, Earthcore: Shattered Elements seems like a rather simple card-battling game. Once you’re introduced to skills that will change quite a bit. Even more so once you start to acquire hero cards. But it’s not so complicated that we... | Read more »
Dungeon999F (Games)
Dungeon999F 1.33 Device: iOS Universal Category: Games Price: $.99, Version: 1.33 (iTunes) Description: "The game you must play at least once in your life!" "The game with potential of million downloads globally!" ...is what the... | Read more »
Mixels Rush - Use Mixes, Maxes and Murps...
Mixels Rush - Use Mixes, Maxes and Murps to Outrun the Nixels 1.0.0 Device: iOS Universal Category: Games Price: $2.99, Version: 1.0.0 (iTunes) Description: Use awesome new Mixels and make crazy combinations to beat the annoying... | Read more »
Battles of the Ancient World II (Games)
Battles of the Ancient World II 1.0 Device: iOS Universal Category: Games Price: $2.99, Version: 1.0 (iTunes) Description: | Read more »
Sword Of Xolan (Games)
Sword Of Xolan 1.0.4 Device: iOS Universal Category: Games Price: $.99, Version: 1.0.4 (iTunes) Description: Sword of Xolan is an action platformer game that includes the juice of pixel art style. Xolan is a young and brave man who... | Read more »

Price Scanner via MacPrices.net

Sale! 16GB iPad mini 3 for $349, save $50
B&H Photo has the 16GB iPad mini 3 WiFi on sale for $349 including free shipping plus NY sales tax only. Their price is $50 off MSRP, and it’s the lowest price available for this model. Read more
Price drop on 2014 15-inch Retina MacBook Pro...
B&H Photo has dropped prices on 2014 15″ Retina MacBook Pros by $200. Shipping is free, and B&H charges NY sales tax only: - 15″ 2.2GHz Retina MacBook Pro: $1799.99 save $200 - 15″ 2.5GHz... Read more
Will iOS 9 Finally Bring Productivity Friendl...
Ah, the irony. From its original announcement in 2010, Apple has doggedly insisted that the iPad remain “simple,” thus arbitrarily limiting its considerable potential as a content creation and... Read more
13-inch 2.5GHz MacBook Pro (refurbished) avai...
The Apple Store has Apple Certified Refurbished 13″ 2.5GHz MacBook Pros available for $829, or $270 off the cost of new models. Apple’s one-year warranty is standard, and shipping is free: - 13″ 2.... Read more
Mac Pros on sale for up to $260 off MSRP
B&H Photo has Mac Pros on sale for up to $260 off MSRP. Shipping is free, and B&H charges sales tax in NY only: - 3.7GHz 4-core Mac Pro: $2799, $200 off MSRP - 3.5GHz 6-core Mac Pro: $3719.99... Read more
Save up to $600 with Apple refurbished Mac Pr...
The Apple Store has Apple Certified Refurbished Mac Pros available for up to $600 off the cost of new models. An Apple one-year warranty is included with each Mac Pro, and shipping is free. The... Read more
Apple drops price on refurbished 15-inch 2.2G...
The Apple Store has dropped their price on the Apple Certified Refurbished 2014 15″ 2.2GHz Retina MacBook Pro to $1609, $390 off original MSRP. Apple’s one-year warranty is included, and shipping is... Read more
Apple restocks refurbished Mac minis for up t...
The Apple Store has restocked Apple Certified Refurbished 2014 Mac minis, with models available starting at $419. Apple’s one-year warranty is included with each mini, and shipping is free: - 1.4GHz... Read more
Cover For iPhone Helps You Create Beautiful P...
Taking photos, editing and sharing them is one of the things most of people do on their iPhones for fun, especially if they’re users of social media. Unfortunately, many iOS photo-editing solutions... Read more
Password Keyboard 1.0 For iOS Handles Logins...
Pfaeffikon, Switzerland based Power APP has introduced Password Keyboard 1.0.0, their new password utility developed for iPhone, iPad and iPod touch devices. Password Keyboard is designed to simplify... Read more

Jobs Board

Project Manager / Business Analyst, WW *Appl...
…a senior project manager / business analyst to work within our Worldwide Apple Fulfillment Operations and the Business Process Re-engineering team. This role will work Read more
Visual Merchandise Manager %u2013 Accessories...
…to be part of an incredible team. Imagine what you could do here. At Apple , great ideas have a way of becoming reality very quickly. Our Accessories assortment makes Read more
*Apple* Solutions Consultant - Retail Sales...
**Job Summary** As an Apple Solutions Consultant (ASC) you are the link between our customers and our products. Your role is to drive the Apple business in a retail Read more
*Apple* Solutions Consultant - Retail Sales...
**Job Summary** The ASC is an Apple employee who serves as the Apple business manager and influencer in a hyper-business critical Reseller's store which delivers Read more
Technical Project Manager - *Apple* Pay - A...
**Job Summary** Apple Pay is seeking an experienced technical PM…manage the rollout of features to merchants for the Apple Pay platform in the US Within this role Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.