|
| Volume Number | 8 | |
| 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.
- SPREAD THE WORD:
- Slashdot
- Digg
- Del.icio.us
- Newsvine
