Editable Lists
Volume Number: | | 6
|
Issue Number: | | 4
|
Column Tag: | | Pascal Procedures
|
Related Info: List Manager Dialog Manager TextEdit
Editable Lists & User Items
By David Willcox, Chicago, IL
Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks.
Editable Lists and Other Dialog User Items
David Willcox is an Assistant Professor of Chemical Engineering at the University of Illinois at Chicago. He programs several tools for Data Acquisition in his lab. WillStein resulted from the development of a Gas Chromatography workstation running in conjunction with LabVIEW from National Instruments. The current article contains a few of the utilities required for this project.
Introduction
I have always wished that spreadsheets could be edited directly without having to first click in the cell and then click again in the edit window to insert a single character. In this article, I will combine the List Manager and TextEdit to provide an editable list in a Dialog. In addition, this demo shows:
how to avoid writing CDEFs for the Editable List and for Pop Up menu items.
validating the entry of numeric information while the user is typing
The List Manager and User Interface Woes
The List Manager provides a simple means for displaying a list of one or two dimensional data in a table. Previous articles in MacTutor have discussed using the List Manager for creating a spreadsheet, or for creating LDEFs to modify the operation of a list [MacTutor March 1989 and June 1980, respectively].
The standard List Manager only allows a list to be displayed, and a selection to be made from the list. There is no means provided for editing a list once it has been created. This has apparently caused spreadsheet designers to provide an Edit Window at the top of the screen for data entry. However, this is a nuisance if you need to make a small change to the middle of a string. To do this, you must first select a cell (with the mouse) and then move the mouse in order to click in the edit window to make the desired change.
This reminds me of the old command-line interface where a specific portion of the screen is devoted to commands and the rest of the screen is used for display. This seems like a throw back to the pre-Macizoan millennia. Cricket Graph is the only program that I have seen which allows a list to be edited directly. I consider this more in line with the Macintosh User Interface Guidelines of providing as direct an interface as possible for the user.
Figure 1. The Editable List Dialog
Defining the User Interface
It would have been nice if Apple had incorporated TextEdit into the List Manager. An additional flag could have been provided to allow a list to be editable just like allowing the list to autoscroll. However, the List Manager was designed for use in the Standard File Dialogs, et al, and I am grateful to Apple for standardizing those routines and providing them to everyone else even if they lack a few nifty features.
However, this leaves us with the problem of inventing a User Interface for an editable list, and then programming it to contain as many of these features as possible. This section defines the desired user interface, and the next section presents a means for programming it.
The user interface should be as direct as possible. Clicking in a cell should cause the insertion point to be placed at that point. Secondly, all previous List Manager operations should remain the same. For example, the tab, return, and arrow keys should still allow the user to move from cell to cell. However, this conflicts with TextEdit because there the cursor keys are used to move the insertion point. Also, using the return and tabs keys for this purpose means that the user can not enter multiple paragraphs into a cell, or use tab stops (if TextEdit has been modified). Therefore, priority has to be given to one of the Managers. I have assumed that a cell only contains a single line of text (a few words or a number), and therefore, we can safely give these events to the List Manager. Moving from cell to cell with the cursor keys should cause the entire text in the next cell to be selected.
Secondly, the user should still be allowed to make multiple selections from the list by holding down the shift key. In this case, the first cell selected is editable, and the cursor keys are restricted to moving to another cell in the range selected. These cells can then be copied to the clipboard, or information should be pasteable from the clipboard. I have implemented two forms of Paste in this program. How should a paste be performed if more than one row of information is contained on the clipboard? One way is to simply create a new row for each line in the clipboard; this is the standard type of Paste used in this program. Another way is to overwrite the information in the following rows of the list; this is done in this program when the option key is held down while selecting Paste.
Finally, the only problem left is to decide what to do about text that does not fit in a given cell. This would be important for spreadsheets where formulas can become very long. The ideal solution would be to allow the TextEdit field to be resizable by the user. The edit rectangle could default to the size of the cell (or to a preset larger size), and could then be resized to any size by the user. Scroll bars should be placed on the TextEdit field for long passages. Furthermore, the user should be able to move the TextEdit field anywhere on the screen since it will obscure a portion of the list which may have information needed by the user.
In addition, you may wish to prevent the user from modifying certain columns in the list, or entering text into a numeric field. There is nothing worse than entering an entire list of information only to find that it is invalid after pressing OK.
User Items in Dialogs
Now, how should this be implemented. In this example, I will discuss putting an editable list in a Dialog window in response to a request for information. Converting this to a normal Application window will be discussed later.
There are two options for putting this in a Dialog: using a CDEF or a user item. I try to avoid CDEFs, MDEFs, WDEFs, and xDEFs. The xDEFs do allow code to be reusable by precompiling them into resources, but they are more difficult to create than a user item since various regions have to be defined, and various messages have to be responded to. Also, Ive found that I often have to duplicate a lot of code in an xDEF which is already contained in my application. Finally, it is more difficult to use application Globals in an xDEF as discussed in the Tear-Off Menu article [MacTutor April 1988]. On the other hand, programming a user item is very similar to programming the main event loop of an application.
User items are discussed on IM-I, pages 405, 415-416, and 421. First, a user item must have a procedure for drawing the item. This procedure is called automatically when the item needs to be updated, and is therefore similar to handling an update event. This procedure has the following declaration:
{1}
procedure myItem (w:WindowPtr; itemNo:integer);
or
{2}
procedure myItem (d:DialogPtr; itemNo:integer);
Secondly, events are processed by a Filter Procedure with the declaration:
{3}
function myFilter (d:DialogPtr; var theEvent:EventRecord; var itemHit:
integer) :boolean
Only events specific to the user item must be processed, other events can simply be passed on to the operating system by setting myFilter to false. This filter procedure is then responsible for handling the mouse clicks, cursor keys, etc as discussed in the previous section. Therefore, the filter procedure can just be viewed as a mini Main Event Loop.
Implementation
Lets look at the program in the order in which it executes.
List Demo.p contains the main program. First, data for the List is stored in an array. Each element of the array will be a row in the list. Each field in the record structure corresponds to a column in the list. This information could come from a file, etc, or it could be blank until the user enters their information.
Secondly, the Dialog must be set up and events processed. This is done in DemoDialog in the List Demo Dialog.p file which is really the main program in this demo. First, the Dialog is loaded from its resource file, and then the user items must be initialized.
The first user item is then created to draw a box around the OK button so that the user knows that pressing the Enter key will signal ok. The OKBoxItem procedure is taken from IM-I, page 407. It is connected to the user item as shown on IM-I, page 421 by calling GetDItem followed by SetDItem with a pointer to the OKBoxItem procedure. Note that I have assumed that item 1 is the OK button, item 2 is the cancel button, and item 3 is a user item with the same box as item 1. Note that clicking in the OK button can return an itemHit of either 1 or 3 depending on which side of the bed your computer got up on that day, so check them both.
The second user item is a pop up menu item which is installed in the same way. I havent discussed this in the article, but I included it to demonstrate how to avoid writing CDEFs when creating a new type of control.
Next, the list itself is created. This is done in the SetUpListItem procedure. It installs the drawing procedure onto the user item, and initializes some global information. These globals are required in order to tell our filter procedure the underlying structure of the list, since the filter only receives events. These globals are stored in a List Global record which is then put in the refcon field of the Dialog. This contains the TextEdit record and other miscellaneous information since the filter procedure is not allowed to have globals.
{4}
ListGlobalType = record
window: WindowPtr;{the window which owns the list}
nListItem: integer;{item number in the dialog}
Box: rect;{box of the entire list including the scroll bars}
List: ListHandle;
selCell: cell;{cell corresponding to the TE record}
multiple: boolean;{is more than one cell selected?}
TEexists: boolean;
hTE: TEHandle;
TErect: rect;
largeTERect: boolean;
doubleClick: boolean;{perhaps a double click should mean that the OK
button was pressed}
Editable: packed array[0..30] of boolean;{these specify which columns
are editable by the user}
Number: packed array[0..30] of boolean; {these specify which columns
are numbers and which contain general text}
Integer: packed array[0..30] of boolean; {furthermore, should the column
be restricted to integer quantities}
end;
ListGlobalPtr = ^ListGlobalType;
ListGlobalHandle = ^ListGlobalPtr;
Notice that the FillDataList and SaveDataList procedures put the data onto the list, or take it from the list. These procedures use some List Utilities that I created to avoid LSetCell which requires a pointer to data which is almost always a Str255. Many of the ToolBox routines are very general, and I often prefer to create my own personal toolbox with commonly used routines. The List Utilities will be discussed later.
Now, for the main event. ModalDialog is called repeatedly and must process the List events. This is the Main Event Loop for the dialog. I will only discuss the processing of events related to the List; the other events are pretty self explanatory.
Only the mouseDown and keyDown events must be responded to by the ListFilterProc. MouseDown events are broken into two cases: does a TextEdit record currently exist, or does it not. If it does, the click can either be in the TE record or not. If not, the click can either be in another cell of the list, or not in the list at all. All of these tests are performed with the appropriate PtInRect test.
A click in a cell is tracked with LClick. However, LLastClick does not give us the cell that was selected. Instead, it gives the last cell which was clicked in. Wait, arent these cells the same? They arent the same if the user clicks in one cell, and then drags the mouse to a different cell. The last cell will be highlighted by the List Manager, but it will not be returned by LLastClick. Therefore, a GetMouse is done immediately after returning from LClick, and LClick is called again with that mouse location (in SetupCell). The second LClick returns immediately because the mouse button is not pressed. Fortunately, LClick does not check to see if the mouse was ever pressed.
The contents of the cell are then placed into a TextEdit record, and a box is drawn around it to emphasize its boundaries. At this point, I check to see if the text is too long to fit in the cell. If it is too long, a large TextEdit rectangle is created. Finally, a dummy click is sent to TEClick to place the insertion point at the correct location.
Now, clicks and keyDown events can be handled by TEClick and TEKey respectively with a few exceptions. If the key is a cursor key, the cell should be shifted accordingly. Note that SetupCell2 is used to set up a new TextEdit record with the entire contents selected. Also, DisposeCell is called to insure that only one cell is edited at a time. DisposeCell takes care of putting the TextEdit record back into the list. Similarly, a click outside of the current cell should dispose of that cell, and set up a new one.
Two tricky mouseDown events remain. First, a large TextEdit field will obscure several cells. Therefore, the field should be movable. I do this when the option key is down. After the move, the contents of the list below the old rectangle must be updated with LUpdate; also, some controls may need to be redrawn with DrawControls. The cursor should change to a set of arrows while the option key is down to indicate that this will work; however, the filter procedure is only called when a real event is detected, and not just when the option key is pressed.
Next, what happens if the user clicks in an editText item in the Dialog? The filter procedure must be signalled to stop processing the keyDown events. I do this by checking the itemType of the control. If it is an editText item, I dispose of my TextEdit record with DisposeCell. However, I have not done the reverse; therefore, when the user clicks back in the list, the insertion point in the editText item still flashes. There is probably a global for the dialog window that tells it to stop flashing this insertion point, but I have not implemented this.
Data/Procedure Abstraction
I would like to explain a little of the philosophy that I followed in creating the various utilities included in this implementation. Data and Procedure abstraction are becoming more popular with the rise of Artificial Intelligence languages and Object Oriented Compilers. One key idea in these areas is that certain low level details should be hidden in a set of sub-procedures. For example, I defined a procedure called DataRecords which determined the number of records in the handle via a GetHandleSize call. However, I wouldnt want to repeat the code with the GetHandleSize throughout a long program. What if I decided that I had too many records for a handle. Maybe I would like to dump some of them into a database on a hard drive. In this case, all I have to do is change the DataRecords procedure to check the size of the file. The rest of the program would not have to be changed.
I also did this with my Cursor key test. The WhichCursor function checks both the Mac Plus and Extended Keyboards since different keycodes are returned for the cursor keys. Now I am ready if Apple ever decides to create an Extended Extended keyboard with yet more keycodes.
Similarly, the List Utilities file contains routines which allow a str255 or number to be put onto or retrieved from the list without remembering the low level requirements of the List Manager. In this way, I can create a ToolBox Toolbox. Another example is the contained in the Memory Utilities. Apple recommends testing MemError after each Memory Manager Call. Instead of scattering a million MemError calls throughout my code, I instead added a boolean to all of the Memory Manager calls which checks the error condition. This boolean should then be an extra variable on all procedures (or a global variable). If there is an error, the calls should fall through and not attempt the operation requested since a handle may be corrupted. The main event loop can then check this error once every time through the loop, and bow out as gracefully as possible. No GrowZone functions are then required.
Numeric Conversion and Validation
The String Utilities file contains various routines for converting numbers to string and strings to numbers. These routines are discussed in the SANE Numerics Manual available from APDA. In particular, three variations of Num2Str were created to allow the format to be specified in several different ways. In particular, I have created a Significant Digit format which will always display the requested number of significant digits regardless of how larger or how small a number is.
In addition, I have written a simple program called IsANumber which tests to see if a string contains a valid number prior to using these conversions. This procedure can be used to test a List Item or an editText item after each key down event. An invalid key can then be ignored. This routine is general enough to check for decimal, scientific, or integer numbers. However, it is not very picky about the placement of commas since this would make it difficult to edit a large number. This routine was used to beep the user every time an illegal character is typed in a numeric field.
Modification for other purposes
This program can be modified in a number of different ways. First, an Editable List can be added to an application window by cutting and pasting the appropriate code into your main event loop. I hope that all spreadsheets will do this immediately. Lets eliminate the Edit Windows.
Secondly, what about Styled Text in the TextEdit record? Well, it is simple to use styled text in TextEdit, but the List Manager will eliminate the styles when it is put back on the list. Im afraid that this would require an LDEF which I am trying to avoid. This LDEF would have to manage the styleRecords for each of the cells in the list.
If such an LDEF were created, I would assume that it would be easy to create a Table Editor such as found in Word 4.0. All that is a list with editable text. However, we would have to add margins, tabs, carriage returns, and the like to make this a full featured table editor. Also, the LDEF would have to allow for rows and columns of variable size.
{File List Demo.p}
program Editable_Lists;
uses
DemoConstants, DemoDialog, MenuUtilities;
var
error: boolean;
i: integer;
data: DataHandle;
begin
error := false;
{set up the Menus}
SetMenuBar(GetNewMBar(mBarID));
DrawMenuBar;
for i := mFirstPopUp to mLastPopUp do
InsertMenu(GetMenu(i), -1);{-1 denotes a popup or hierarchal menu}
CreateData(data, 4, error);
if not error then
begin
data^^[0].name := Methane;
data^^[0].formula := CH4;
data^^[0].weight := 16;
data^^[0].reference := 87;
data^^[1].name := Carbon Dioxide is too long;
data^^[1].formula := CO2;
data^^[1].weight := 44;
data^^[1].reference := 125;
data^^[2].name := Methanol;
data^^[2].formula := CH3OH;
data^^[2].weight := 32;
data^^[2].reference := 1;
data^^[3].name := Carbon Monoxide;
data^^[3].formula := CO;
data^^[3].weight := 28;
data^^[3].reference := 124;
end;
DemoDialog(Data, error);
DisposData(Data, error);
end.
{File List Dialog Demo.p}
unit DemoDialog;
interface
uses
KeyBoard, Memory, ListUtilities, Dialogs, MenuUtilities, DemoConstants;
procedure DemoDialog (Data: DataHandle;
var error: boolean);
implementation
procedure FillDataList (Data: DataHandle;
ListGlobal: ListGlobalHandle; var error: boolean);
var
i: integer;
theCell: cell;
begin
if not error then
for i := 0 to DataRecords(Data, error) - 1 do
begin
theCell.v := i;
theCell.h := 0;
LSetCellString(data^^[i].name, theCell, ListGlobal^^.List);
theCell.h := 1;
LSetCellString(data^^[i].formula, theCell, ListGlobal^^.List);
theCell.h := 2;
LSetCellNumber(data^^[i].weight, 2, 0, theCell, ListGlobal^^.List);
theCell.h := 3;
LSetCellNumber(data^^[i].reference, 0, 0, theCell, ListGlobal^^.List);
end;
end;
{***************************}
procedure SaveDataList (Data: DataHandle;
ListGlobal: ListGlobalHandle; var error: boolean);
var
i: integer;
theCell: cell;
begin
if not error then
begin
DisposeCell(ListGlobal);{just in case a cell was currently active}
for i := 0 to DataRecords(Data, error) - 1 do
begin
theCell.v := i;
theCell.h := 0;
data^^[i].name := LGetCellString(theCell, ListGlobal^^.List);
theCell.h := 1;
data^^[i].formula := LGetCellString(theCell, ListGlobal^^.List);
theCell.h := 2;
data^^[i].weight := LGetCellNumber(theCell, ListGlobal^^.List);
theCell.h := 3;
data^^[i].reference := round(LGetCellNumber(theCell, ListGlobal^^.List));
end;
end;
end;
{***************************}
procedure SortDataList (Data: DataHandle;
ListGlobal: ListGlobalHandle;
SortType: integer; var error: boolean);
var
i, n, loop: integer;
changed, switch: boolean;
temp: DataRecord;
begin
if not error then
begin
SaveDataList(Data, ListGlobal, error);
{do a simple sort routine}
n := DataRecords(Data, error);
loop := 1;
repeat
changed := false;
for i := loop to n - 1 do
begin{do}
case SortType of
bSortName:
switch := (1 = IUCompString(Data^^[i - 1].name, Data^^[i].name));
bSortFormula:
switch := (1 = IUCompString(Data^^[i - 1].formula, Data^^[i].formula));
bSortWeight:
switch := (Data^^[i - 1].weight > Data^^[i].weight);
bSortReference:
switch := (Data^^[i - 1].reference > Data^^[i].reference);
end;{case}
if switch then
begin
changed := true;
Temp := Data^^[i - 1];
Data^^[i - 1] := Data^^[i];
Data^^[i] := Temp;
end;
end;{do}
if loop = n - 1 then
changed := false;
until not changed;
FillDataList(Data, ListGlobal, error);
SetUpCell2(ListGlobal^^.selCell, ListGlobal);
end;
end;
{***************************}
procedure DemoDialog;
var
Dlg: DialogPtr;
i, itemHit: integer;
ListGlobal: ListGlobalHandle;
rows: integer;
lastPopUpItem, EditItem: integer;
MenuID: integer;
oldData: DataHandle;
LastEditText: str255
begin
{save the old data in case the user cancels the dialog}
oldData := Data;
myHandToHand(handle(oldData), error);
if not error then
begin {error check}
mySetupDialog(128, Dlg, error);
{initialize the popup menu item}
SetUpPopUp(Dlg, uDemoPopUp, GetMenu2(mDemo));
SetUpPopUp(Dlg, uEditPopUp, GetMenu2(mEditPopUp));
lastPopUpItem := 1;
DrawPopUp(Dlg, uDemoPopUp, GetMenu2(mDemo), lastPopUpItem);
DrawPopUp(Dlg, uEditPopUp, GetMenu2(mEditPopUp), 1);
rows := DataRecords(data, error);
SetUpListItem(Dlg, nListItem, ListGlobal, cols, rows);
ListGlobal^^.number[0] := false;
ListGlobal^^.number[1] := false;
ListGlobal^^.integer[3] := true;
FillDataList(Data, ListGlobal, error);
{now, handle events for the ModalDialog}
repeat
ModalDialog(@ListFilterProc, itemHit);
case itemHit of
bDelete:
DeleteRow(ListGlobal);
bInsert:
InsertRow(ListGlobal);
bAppend:
AppendRow(ListGlobal);
bSortName, bSortFormula, bSortWeight, bSortReference:
SortDataList(data, ListGlobal, itemHit, error);
eSampleEditItem:
CheckNumberField(Dlg, eSampleEditItem, LastEditText, false);
uDemoPopUp:
begin
TrackPopUp(Dlg, uDemoPopUp, sDemoPopUp, GetMenu2(mDemo), MenuID, lastPopUpItem);
DrawPopUp(Dlg, uDemoPopUp, GetMenu2(mDemo), lastPopUpItem);
end;
uEditPopUp:
begin
EditItem := 1;
TrackPopUp(Dlg, uEditPopUp, sEditPopUp, GetMenu2(mEditPopUp), MenuID,
EditItem);
DrawPopUp(Dlg, uEditPopUp, GetMenu2(mEditPopUp), 1);
if MenuID > 0 then
case EditItem of
iCut:
HandleListKey(ListGlobal, xKey, 0, CmdKey);
iCopy:
HandleListKey(ListGlobal, cKey, 0, CmdKey);
iPaste:
HandleListKey(ListGlobal, vKey, 0, CmdKey);
iClear:
HandleListKey(ListGlobal, DummyClearKey, 0, CmdKey);
iOptionPaste:
HandleListKey(ListGlobal, DummyOptionPasteKey, 0, CmdKey);
end;
end;
end;{case}
until itemHit <= 3;
SaveDataList(data, ListGlobal, error);
if itemHit = bCancel then
begin{cancelled}
DisposData(data, error);
Data := oldData;
end{cancelled}
else{not cancelled}
DisposData(oldData, error);
DisposDialog(Dlg);
end;{error check}
end;
end.
unit DemoConstants;
interface
uses
Memory;
const
{resource IDs}
nDialogID = 128;
nWindowID = 128;
{menu constants}
mBarID = 128;
mApple = 128;
mFile = 128;
firstMenu = mApple;
lastMenu = mFile;
mDemo = 200;
mDemoSub = 201;
mEditPopUp = 202;
iCut = 1;
iCopy = 2;
iPaste = 3;
iClear = 4;
iOptionPaste = 5;
mFirstPopUp = mDemo;
mLastPopUp = mEditPopUp;
bOK = 1;
bCancel = 2;
uBox = 3;
uList = 4;
bSortName = 5;
bSortFormula = 6;
bSortWeight = 7;
bSortReference = 8;
bDelete = 9;
bInsert = 10;
bAppend = 11;
uDemoPopUp = 12;
sDemoPopUp = 13;
eSampleEditItem = 14;
sEditPopUp = 15;
uEditPopUp = 16;
nListItem = 4;
cols = 4;
type
DataRecord = record
name: str255;
formula: str255;
weight: extended;
reference: integer;
end;
DataArray = array[0..100] of DataRecord;
DataPtr = ^DataArray;
DataHandle = ^DataPtr;
procedure CreateData (var Data: DataHandle;
nRecords: integer; var error: boolean);
procedure ResizeData (Data: DataHandle;
nRecords: integer; var error: boolean);
procedure DisposData (Data: DataHandle; error: boolean);
function DataRecords (Data: DataHandle;
error: boolean): integer;
implementation
procedure CreateData;
begin
Data := DataHandle(myNewHandle(nRecords * sizeof(DataRecord), error));
end;
{**********************************}
procedure ResizeData;
begin
mySetHandleSize(handle(Data), nRecords * sizeof(DataRecord), error)
end;
{**********************************}
procedure DisposData;
begin
if not error then
DisposHandle(handle(Data));
end;
{**********************************}
function DataRecords;
begin
if not error then
DataRecords := gethandlesize(handle(data)) div sizeof(DataRecord);
end;
{**********************************}
end.
unit Dialogs;
interface
uses
Memory, Sane, StringUtilities;
procedure mySetupDialog (ID: integer;
var Dlg: DialogPtr; var error: boolean);
procedure SetUpFrameItem (Dlg: DialogPtr;
theItem: integer; error: boolean);
procedure CheckNumberField (Dlg: DialogPtr;
itemHit: integer; var LastText: Str255;
IsInteger: boolean);
implementation
{*******************************************}
procedure CheckNumberField;
var
itemType: integer;
item: handle;
box: rect;
itemText: Str255;
begin
GetDItem(Dlg, itemHit, itemType, item, box);
if itemType = EditText then
begin
GetIText(item, itemtext);
if not IsNumber(itemText, isInteger) then
begin
SetIText(item, LastText);
Sysbeep(60);
end
else
LastText := itemText;
end;
end;
{*********************************************}
procedure FrameItem (Dlg: DialogPtr; itemNo: integer);
var
itemType: integer;
item: handle;
box: rect;
begin
GetDItem(Dlg, itemNo, itemType, item, box);
FrameRect(box);
end;
{*********************************************}
procedure SetUpFrameItem;
var
itemType: integer;
item: handle;
box: rect;
begin
if not error then
begin
GetDItem(Dlg, theItem, itemType, item, box);
SetDItem(Dlg, theItem, itemType, handle(@FrameItem), box);
end;
end;
{*******************************************}
procedure OKBoxItem (Dlg: DialogPtr;
itemNo: integer);
var
itemType: integer;
item: handle;
box: rect;
begin
GetDItem(Dlg, 1, itemType, item, box);
penSize(3, 3);
InsetRect(box, -4, -4);
FrameRoundRect(box, 16, 16);
pensize(1, 1);
end;
{**************************}
procedure mySetupDialog;
var
itemType: integer;
item: handle;
box: rect;
begin
if not error then
begin
Dlg := GetNewDialog(ID, nil, pointer(-1));
if Dlg = nil then
begin
sysbeep(60);
end;
SetPort(Dlg);
{set up the frame box item}
GetDItem(Dlg, 3, itemType, item, box);
SetDItem(Dlg, 3, itemType, handle(@OKBoxItem), box);
end;
end;
{*********************************************}
end.
unit ListUtilities;
interface
uses
KeyBoard, Memory, Sane, StringUtilities;
type
ListGlobalType = record
window: WindowPtr;{the window which owns the list}
nListItem: integer;{item number in the dialog}
Box: rect;{box of the entire list including the scroll bars}
List: ListHandle;
selCell: cell;{cell corresponding to the TE record}
multiple: boolean;{is more than one cell selected?}
TEexists: boolean;
hTE: TEHandle;
TErect: rect;
largeTERect: boolean;
doubleClick: boolean;
Editable: packed array[0..30] of boolean;{is that column editable?}
Number: packed array[0..30] of boolean; {these specify which columns
are numbers and which contain general text}
Integer: packed array[0..30] of boolean; {furthermore, should the column
be restricted to integer quantities}
end;
ListGlobalPtr = ^ListGlobalType;
ListGlobalHandle = ^ListGlobalPtr;
function ListFilterProc (Dlg: WindowPtr; var theEvent: EventRecord;
var ItemHit: integer): boolean;
procedure SetUpListItem (Dlg: DialogPtr; nListItem: integer; var ListGlobal:
ListGlobalHandle; cols, rows: integer);
procedure SetUpList (w: WindowPtr;
var ListGlobal: ListGlobalHandle;
box: rect;{including the scroll bars}
cols, rows: integer);
procedure DisposeListGlobal (ListGlobal: ListGlobalHandle);
procedure HandleListKey (ListGlobal: ListGlobalHandle;
theKeyCode: integer; theChar: char; Modifiers: integer);
procedure DragGrayRect (startPoint: point; var dragRect: rect);
procedure UpdateLargeTERect (ListGlobal: ListGlobalHandle);
function LGetCellString (theCell: Cell;
List: ListHandle): str255;
function LGetCellNumber (theCell: Cell;
List: ListHandle): extended;
procedure LSetCellString (theStr: str255;
theCell: Cell;
List: ListHandle);
procedure LSetCellNumber (theNum: extended;
decimals, SigFigures: integer;
theCell: Cell;
List: ListHandle);
procedure SetUpCell (where: point;
ListGlobal: ListGlobalHandle);
procedure SetUpCell2 (theCell: cell;
ListGlobal: ListGlobalHandle);
procedure DisposeCell (ListGlobal: ListGlobalHandle);
procedure ClearListSelection (ListGlobal: ListGlobalHandle);
procedure InsertRow (ListGlobal: ListGlobalHandle);
procedure AppendRow (ListGlobal: ListGlobalHandle);
procedure DeleteRow (ListGlobal: ListGlobalHandle);
implementation
{*********************************************}
procedure MoveTERect (ListGlobal: ListGlobalHandle;
where: point);
var
newTERect: rect;
theText: handle;
error: boolean;
begin
newTERect := ListGlobal^^.TERect;
DragGrayRect(where, newTERect);
{now, move the TERect}
theText := handle(TEGetText(ListGlobal^^.hTE));
myHandToHand(theText, error);
TEDispose(ListGlobal^^.hTE);
ListGlobal^^.hTE := TENew(newTERect, newTERect);
TESetText(theText^, gethandlesize(theText), ListGlobal^^.hTE);
DisposHandle(theText);
{update the list hidden by the old rect}
UpdateLargeTERect(ListGlobal);
{redraw any obscured controls}
DrawControls(ListGlobal^^.window);
{draw the box and the text}
ListGlobal^^.TERect := newTERect;
EraseRect(ListGlobal^^.TERect);
InsetRect(ListGlobal^^.TERect, -1, -1);
FrameRect(ListGlobal^^.TERect);
InsetRect(ListGlobal^^.TERect, 1, 1);
TEAutoView(true, ListGlobal^^.hTE);
TEActivate(ListGlobal^^.hTE);
TEUpdate(ListGlobal^^.TERect, ListGlobal^^.hTE);
end;
{*********************************************}
procedure CutCopyClearList (ListGlobal: ListGlobalHandle;
whichKey: integer);
var
error: boolean;
theText: handle;
theCell: Cell;
ClipOffset, ClipResult: longint;
lastRow: integer;
done: boolean;
err: OSErr;
begin
error := false;
DisposeCell(ListGlobal);
LSetSelect(true, ListGlobal^^.selCell, ListGlobal^^.List);
theText := mynewhandle(0, error);
SetPt(theCell, 0, 0);
lastRow := 10000;
done := true;
while done and LGetSelect(true, theCell, ListGlobal^^.List) do
begin
if theCell.v > lastRow then
AppendString(theText, CR, error);
if theCell.v = lastRow then
AppendString(theText, tab, error);
AppendString(theText, LGetCellString(theCell, ListGlobal^^.List), error);
case whichKey of
xKey, dummyClearKey:
LClrCell(theCell, ListGlobal^^.List);
end;{case}
lastRow := theCell.v;
done := LNextCell(true, true, theCell, ListGlobal^^.List);
end;
if not (whichKey = dummyClearKey) then
begin
err := ZeroScrap;
err := PutScrap(gethandlesize(theText), TEXT, theText^);
end;
DisposHandle(theText);
SetUpCell2(ListGlobal^^.selCell, ListGlobal);
TESetSelect(0, 0, ListGlobal^^.hTE);
end;
{*********************************************}
procedure PasteList (ListGlobal: ListGlobalHandle;
OptionPressed: boolean);
var
error: boolean;
theText: CharsHandle;
ClipOffset, ClipResult, len, i: longint;
firstCell, theCell: Cell;
begin{paste}
error := false;
DisposeCell(ListGlobal);
theText := CharsHandle(mynewhandle(0, error));
ClipOffset := 0;
ClipResult := GetScrap(handle(theText), TEXT, ClipOffset);
firstCell := ListGlobal^^.selCell;
theCell := firstCell;
len := gethandlesize(handle(theText));
if len > 0 then
LClrCell(theCell, ListGlobal^^.List);
for i := 0 to len - 1 do
begin
if theText^^[i] = CR then
begin
theCell.h := firstCell.h;
if OptionPressed then
begin
theCell.v := theCell.v + 1;
if not PtInRect(theCell, ListGlobal^^.List^^.dataBounds) then
theCell.v := LAddRow(1, theCell.v + 1, ListGlobal^^.List);
end
else
theCell.v := LAddRow(1, theCell.v + 1, ListGlobal^^.List);
if ListGlobal^^.editable[theCell.h] then
LClrCell(theCell, ListGlobal^^.List);
end
else if (theText^^[i] = tab) or (theText^^[i] = comma) then
begin
theCell.h := theCell.h + 1;
if ListGlobal^^.editable[theCell.h] then
LClrCell(theCell, ListGlobal^^.List);
end
else if PtInRect(theCell, ListGlobal^^.List^^.dataBounds) then
if ListGlobal^^.editable[theCell.h] then
LAddToCell(@theText^^[i], 1, theCell, ListGlobal^^.List);
end;
DisposHandle(handle(theText));
ClearListSelection(ListGlobal);
end;
{*********************************************}
procedure HandleListKey (ListGlobal: ListGlobalHandle;
theKeyCode: integer;
theChar: char;
Modifiers: integer);
var
theCell: Cell;
error: boolean;
theText: handle;
LastString, theString: Str255;
begin
error := false;
if BitAnd(modifiers, CmdKey) = CmdKey then
case theKeyCode of
xKey:
CutCopyClearList(ListGlobal, xKey);
cKey:
CutCopyClearList(ListGlobal, cKey);
vKey, dummyOptionPasteKey:
PasteList(ListGlobal, OptionKeyDown or (theKeyCode = dummyOptionPasteKey));
dummyClearKey:
CutCopyClearList(ListGlobal, dummyClearKey);
end
else
begin
case WhichCursor(theKeyCode) of
RightCurs, TabCurs:
begin
theCell := ListGlobal^^.selCell;
theCell.h := theCell.h + 1;
DisposeCell(ListGlobal);
SetUpCell2(theCell, ListGlobal);
end; {tab}
DownCurs, Carriage:
begin{carriage return}
theCell := ListGlobal^^.selCell;
theCell.v := theCell.v + 1;
DisposeCell(ListGlobal);
SetupCell2(theCell, ListGlobal);
end; {carriage return}
LeftCurs:
begin{left}
theCell := ListGlobal^^.selCell;
theCell.h := theCell.h - 1;
DisposeCell(ListGlobal);
SetupCell2(theCell, ListGlobal);
end;{left}
UpCurs:
begin{up}
theCell := ListGlobal^^.selCell;
theCell.v := theCell.v - 1;
DisposeCell(ListGlobal);
SetupCell2(theCell, ListGlobal);
end;{up}
otherwise
begin
if ListGlobal^^.number[ListGlobal^^.selCell.h] then
begin
error := false;
theText := handle(TEGetText(ListGlobal^^.hTE));
handletoStr255(theText, LastString, error);
end;
TEKey(theChar, ListGlobal^^.hTE);
if ListGlobal^^.number[ListGlobal^^.selCell.h] then{check that it is
a number}
begin
theText := handle(TEGetText(ListGlobal^^.hTE));
handletoStr255(ListGlobal^^.hTE^^.hText, theString, error);
if not IsNumber(theString, ListGlobal^^.integer[ListGlobal^^.selCell.h])
then
begin
sysbeep(60);
TESetSelect(0, 32000, ListGlobal^^.hTE);
TEDelete(ListGlobal^^.hTE);
TESetText(ptrtoString(LastString), length(LastString), ListGlobal^^.hTE);
TEUpdate(ListGlobal^^.TErect, ListGlobal^^.hTE);
end;
end;
end;
end;
end;
end;
{*********************************************}
function ListFilterProc (Dlg: DialogPtr;var theEvent: EventRecord; var
ItemHit: integer): boolean;
type
FourChars = packed record
case integer of
0: (
one, two, three, four: char
);
1: (
b1, b2, b3, b4: byte
);
end;
var
where: point;
ListGlobal: ListGlobalHandle;
theCell: cell;
error, doubleClick: boolean;
theChar: char;
theKeyCode: byte;
ignore: boolean;
theItem, itemType: integer;
item: handle;
box: rect;
begin
ListFilterProc := false;
where := theEvent.where;
GlobalToLocal(where);
ListGlobal := ListGlobalHandle(WindowPeek(Dlg)^.refCon);
{check if the user is terminating the dialog with the Enter key}
if theEvent.what = KeyDown then
begin{enter key}
theChar := FourChars(theEvent.message).four;
theKeyCode := FourChars(theEvent.message).b3;
if theKeyCode = EnterKey then
begin
ListFilterProc := true;
itemHit := 1;
end;
end;
if ListGlobal^^.TEExists then
begin{TEExists}
TEIdle(ListGlobal^^.hTE);
ListFilterProc := true;
itemHit := ListGlobal^^.nListItem;
case theEvent.what of
mouseDown:
if PtInRect(where, ListGlobal^^.TErect) then
begin{it is a TE event}
if (theEvent.modifiers = OptionKey) and ListGlobal^^.largeTErect then
MoveTERect(ListGlobal, where)
else{just click in the TE rect}
TEClick(where, (theEvent.modifiers = ShiftKey), ListGlobal^^.hTE);
end{it is a TE event}
else if PtInRect(where, ListGlobal^^.box) then
begin{check other cells}
DisposeCell(ListGlobal);
{check if another cell was clicked in}
ignore := ListFilterProc(Dlg, theEvent, itemHit);
end
else
begin{not a list event}
{check if the user clicked in a EditText item, if so, we must eliminate
our insertion point}
theItem := FindDItem(Dlg, where) + 1;{FindDItem is zero based}
if theItem > 0 then
begin
GetDItem(Dlg, theItem, itemType, item, box);
if itemType = editText then
DisposeCell(ListGlobal);
end;
ListFilterProc := false;
end;{not a list event}
KeyDown:
HandleListKey(ListGlobal, theKeyCode, theChar, theEvent.modifiers);
end;{case}
end{TEExists}
{now process events when no TE record exists}
else if (theEvent.what = mouseDown) and PtInRect(where, ListGlobal^^.box)
then
begin
ListFilterProc := true;
itemHit := ListGlobal^^.nListItem;
if theEvent.modifiers <> ShiftKey then
ClearListSelection(ListGlobal);{reselect the original cell}
ListGlobal^^.doubleClick := LClick(where, theEvent.modifiers, ListGlobal^^.List);
GetMouse(where);
theCell.h := 0;
theCell.v := 0;
{The following is a fancy way of determining whether a single cell or
a group of cells were selected}
if LGetSelect(true, theCell, ListGlobal^^.List) then
begin
if (not LNextCell(true, true, theCell, ListGlobal^^.List)) or (not LGetSelect(true,
theCell, ListGlobal^^.List)) then
begin{only a single cell was selected}
doubleClick := LClick(where, theEvent.modifiers, ListGlobal^^.List);
GetMouse(where);
SetupCell(where, ListGlobal);
ListGlobal^^.multiple := false;
end
else
begin{multiple selection}
theCell.h := 0;
theCell.v := 0;
if LGetSelect(true, theCell, ListGlobal^^.List) then
begin
SetUpCell2(theCell, ListGlobal);
TESetSelect(0, 0, ListGlobal^^.hTE);
ListGlobal^^.multiple := true;
end;
end;{multiple selection}
end;
end
end;
{*********************************************}
procedure ListActionProc (Dlg: DialogPtr;
itemNo: integer);
var
itemType: integer;
item: handle;
box: rect;
boxRgn: RgnHandle;
ListGlobal: ListGlobalHandle;
begin
GetDItem(Dlg, itemNo, itemType, item, box);
boxRgn := NewRgn;
RectRgn(boxRgn, Dlg^.portRect);
longint(ListGlobal) := WindowPeek(Dlg)^.RefCon;
LUpdate(boxRgn, ListGlobal^^.List);
DisposeRgn(boxRgn);
box := ListGlobal^^.List^^.rView;
InsetRect(box, -1, -1);
FrameRect(box);
end;
{*********************************************}
procedure SetUpListItem (Dlg: DialogPtr; nListItem: integer; var ListGlobal:
ListGlobalHandle; cols, rows: integer);
var
error: boolean;
itemType: integer;
item: handle;
box: rect;
begin
error := false;
GetDItem(Dlg, nListItem, itemType, item, box);
SetDItem(Dlg, nListItem, itemType, handle(@ListActionProc), box);
ShowWindow(Dlg);
SetUpList(Dlg, ListGlobal, box, cols, rows);
ListGlobal^^.nListItem := nListItem;
end;
{*************************************}
procedure SetUpList;
var
error: boolean;
rView, dataBounds: rect;
cSize: point;
i: integer;
theFont: fontInfo;
nRows: integer;
begin
error := false;
ListGlobal := ListGlobalHandle(myNewHandle(sizeof(ListGlobalType), error));
WindowPeek(w)^.RefCon := longint(ListGlobal);
ListGlobal^^.window := w;
ListGlobal^^.box := box;
ListGlobal^^.TEExists := false;
ListGlobal^^.doubleClick := false;
GetFontInfo(theFont);
rView := box;
rView.right := rView.right - 15;
SetRect(dataBounds, 0, 0, cols, rows);
cSize.h := (rView.right - rView.left) div dataBounds.right;
nRows := ((rView.bottom - rView.top) div (theFont.ascent + theFont.descent));
cSize.v := (rView.bottom - rView.top) div nRows;
rView.bottom := rView.top + cSize.v * nRows;
ListGlobal^^.List := LNew(rView, dataBounds, cSize, 0, w, true, false,
false, true);
InsetRect(rView, -1, -1);
FrameRect(rView);
for i := 0 to cols - 1 do
begin
ListGlobal^^.editable[i] := true;
ListGlobal^^.number[i] := true;
ListGlobal^^.integer[i] := false;
end;
end;
{*********************************************}
procedure DisposeListGlobal (ListGlobal: ListGlobalHandle);
begin
DisposeCell(ListGlobal);
LDispose(ListGlobal^^.List);
DisposHandle(handle(ListGlobal));
end;
{*********************************************}
procedure UpdateLargeTERect;
var
UpdateRgn: RgnHandle;
rView: rect;
begin
UpdateRgn := NewRgn;
InsetRect(ListGlobal^^.TERect, -1, -1);
EraseRect(ListGlobal^^.TERect);
RectRgn(UpdateRgn, ListGlobal^^.TERect);
LUpdate(UpdateRgn, ListGlobal^^.List);
DisposeRgn(UpdateRgn);
rView := ListGlobal^^.List^^.rView;
InsetRect(rView, -1, -1);
FrameRect(rView);
end;
{*********************************************}
procedure DragGrayRect;
var
SavePen: PenState;
newMouse, oldMouse: point;
begin
GetPenState(SavePen);
PenMode(PatXor);{redrawing the same rect causes it to be erased}
PenPat(gray);
oldMouse := startPoint;
FrameRect(dragRect);
repeat{check to see if it is torn off}
GetMouse(newMouse);
if not EqualPt(newMouse, oldMouse) then
begin
FrameRect(dragRect);{erase}
OffsetRect(dragRect, newMouse.h - oldMouse.h, newMouse.v - oldMouse.v);
oldMouse := newMouse;
FrameRect(dragRect);{redraw}
end;
until not Button;{check to see if it is torn off}
FrameRect(dragRect);
SetPenState(SavePen);
end;
{*********************************************}
procedure VerifyCell (var theCell: Cell;
theList: ListHandle);
begin
if theCell.h < 0 then
begin
theCell.h := theList^^.dataBounds.right - 1;
theCell.v := theCell.v - 1;
if theCell.v < 0 then
theCell.v := theList^^.dataBounds.bottom - 1;
end;
if theCell.v < 0 then
begin
theCell.v := theList^^.dataBounds.bottom - 1;
theCell.h := theCell.h - 1;
if theCell.h < 0 then
theCell.h := theList^^.dataBounds.right - 1;
end;
if theCell.h >= theList^^.dataBounds.right then
begin
theCell.h := 0;
theCell.v := theCell.v + 1;
if theCell.v >= theList^^.dataBounds.bottom then
theCell.v := 0;
end;
if theCell.v >= theList^^.dataBounds.bottom then
begin
theCell.v := 0;
theCell.h := theCell.h + 1;
if theCell.h >= theList^^.dataBounds.right then
theCell.h := 0;
end;
end;
{*********************************************}
procedure LInitRow (ListGlobal: ListGlobalHandle;
row: integer);
var
i: integer;
theCell: Cell;
begin
theCell.v := row;
theCell.h := 0;
if not ListGlobal^^.number[0] then
LSetCellString(blank, theCell, ListGlobal^^.List);
for i := 1 to ListGlobal^^.List^^.dataBounds.right do
if ListGlobal^^.number[i - 1] then
begin
theCell.h := i - 1;
LSetCellNumber(0, 0, 0, theCell, ListGlobal^^.List);
end;
theCell.h := 0;
SetupCell2(theCell, ListGlobal);
end;
{*********************************************}
procedure InsertRow;
var
row: integer;
begin
if PtInRect(ListGlobal^^.selCell, ListGlobal^^.List^^.dataBounds) then
begin
DisposeCell(ListGlobal);
row := ListGlobal^^.selCell.v;
row := LAddRow(1, row, ListGlobal^^.List);
LInitRow(ListGlobal, row);
end;
end;
{*********************************************}
procedure AppendRow;
var
row: integer;
begin
DisposeCell(ListGlobal);
row := LAddRow(1, 10000, ListGlobal^^.List);
LInitRow(ListGlobal, row);
end;
{*********************************************}
procedure DeleteRow;
var
theCell: cell;
begin
if PtInRect(ListGlobal^^.selCell, ListGlobal^^.List^^.dataBounds) then
begin
theCell := ListGlobal^^.selCell;
DisposeCell(ListGlobal);
LDelRow(1, theCell.v, ListGlobal^^.List);
if theCell.v > 0 then
theCell.v := theCell.v - 1;
if ListGlobal^^.List^^.databounds.bottom > 0 then
SetupCell2(theCell, ListGlobal);
end;
end;
{*********************************************}
procedure SetUpCell2;
var
cellRect: rect;
begin
VerifyCell(theCell, ListGlobal^^.List);
LSetSelect(true, theCell, ListGlobal^^.List);
LAutoScroll(ListGlobal^^.List);
LRect(cellRect, theCell, ListGlobal^^.List);
SetUpCell(cellRect.topLeft, ListGlobal);
if ListGlobal^^.TEExists then
TESetSelect(0, 32000, ListGlobal^^.hTE);
end;
{*********************************************}
procedure SetUpCell;
var
theData: ptr;
dataLen: integer;
ignore: boolean;
width: integer;
begin
ignore := LClick(where, 0, ListGlobal^^.List);
ListGlobal^^.selCell := LLastClick(ListGlobal^^.List);
if PtInRect(ListGlobal^^.selCell, ListGlobal^^.List^^.dataBounds) and
ListGlobal^^.editable[ListGlobal^^.selCell.h] then
begin
ListGlobal^^.TEExists := true;
LSetSelect(true, ListGlobal^^.selCell, ListGlobal^^.List);
LRect(ListGlobal^^.TERect, ListGlobal^^.selCell, ListGlobal^^.List);
ignore := LClick(ListGlobal^^.TERect.topLeft, 0, ListGlobal^^.List);{clear
the old cell}
theData := NewPtr(255);
dataLen := 255;
LGetCell(theData, dataLen, ListGlobal^^.selCell, ListGlobal^^.List);
width := TextWidth(theData, 0, dataLen);
{check if the text is too wide for the cell}
if width > (ListGlobal^^.TERect.right - ListGlobal^^.TERect.left) then
begin
ListGlobal^^.TERect.right := ListGlobal^^.TERect.left + 3 * (ListGlobal^^.TERect.right
- ListGlobal^^.TERect.left);
ListGlobal^^.TERect.bottom := ListGlobal^^.TERect.top + 2 * (ListGlobal^^.TERect.bottom
- ListGlobal^^.TERect.top);
{CheckOnScreen(ListGlobal^^.TERect);}
InsetRect(ListGlobal^^.TERect, -1, -1);
FrameRect(ListGlobal^^.TERect);
InsetRect(ListGlobal^^.TERect, 1, 1);
ListGlobal^^.largeTERect := true;
end
else
ListGlobal^^.largeTERect := false;
ListGlobal^^.hTE := TENew(ListGlobal^^.TERect, ListGlobal^^.TERect);
TEAutoView(true, ListGlobal^^.hTE);
TESetText(theData, dataLen, ListGlobal^^.hTE);
DisposPtr(theData);
TEActivate(ListGlobal^^.hTE);
EraseRect(ListGlobal^^.TERect);
TEUpdate(ListGlobal^^.TERect, ListGlobal^^.hTE);
TEClick(where, false, ListGlobal^^.hTE)
end;
end;
{*********************************************}
procedure DisposeCell;
var
error: boolean;
theString: str255;
theText: handle;
begin
if ListGlobal^^.TEExists then
begin
ListGlobal^^.TEExists := false;
error := false;
theText := handle(TEGetText(ListGlobal^^.hTE));{does this handle need
to be disposed??}
HandleToStr255(theText, theString, error);
TEDispose(ListGlobal^^.hTE);
LSetCellString(theString, ListGlobal^^.selCell, ListGlobal^^.List);
LSetSelect(false, ListGlobal^^.selCell, ListGlobal^^.List);
if ListGlobal^^.largeTERect then
UpdateLargeTERect(ListGlobal);
end;
end;
{***********************************}
procedure ClearListSelection (ListGlobal: ListGlobalHandle);
var
theCell: Cell;
begin
if ListGlobal^^.multiple then
begin
SetPt(theCell, 0, 0);
while LGetSelect(true, theCell, ListGlobal^^.List) do
LSetSelect(false, theCell, ListGlobal^^.List);
end;
end;
{***********************************}
function LGetCellNumber;
begin
LGetCellNumber := stringToReal(LGetCellString(theCell, List));
end;
{*********************************************}
function LGetCellString;
var
theLen: integer;
thePtr: ptr;
theStr: str255;
begin
theLen := 255;
thePtr := NewPtr(theLen);
LGetCell(thePtr, theLen, theCell, List);
theStr[0] := char(theLen);
blockMove(thePtr, ptr(longint(@theStr) + 1), theLen);
LGetCellString := theStr;
DisposPtr(thePtr);
end;
{*********************************************}
procedure LSetCellString (theStr: str255;
theCell: Cell;
List: ListHandle);
begin
LSetCell(ptr(longint(@theStr) + 1), length(theStr), theCell, List);
end;
{*********************************************}
procedure LSetCellNumber (theNum: extended;
decimals, SigFigures: integer;
theCell: Cell; List: ListHandle);
begin
if SigFigures > 0 then
LSetCellString(RealToString(theNum, SigFigures), theCell, List)
else
LSetCellString(RealToFixed(theNum, decimals), theCell, List);
end;
{*********************************************}
end.
unit MenuUtilities;
interface
function GetMenu2 (menuID: integer): menuHandle;
procedure SetUpPopUp (Dlg: DialogPtr;
nPopUp: integer;
theMenu: menuHandle);
function PopUpFilterProc (Dlg: DialogPtr;
var theEvent: EventRecord;
var ItemHit: integer): boolean;
procedure TrackPopUp (Dlg: DialogPtr;
mMenuID: integer;
mTitleID: integer;
theMenu: MenuHandle;
var menuID, itemID: integer);
procedure DrawPopUp (Dlg: DialogPtr;
menuBoxID: integer;
theMenu: MenuHandle;
theItem: integer);
implementation
{*********************************************}
function GetMenu2 (menuID: integer): menuHandle;
begin
GetMenu2 := MenuHandle(GetResource(MENU, menuID));
end;
{*********************************************}
procedure DrawPopUp;
var
itemStr: str255;
item: handle;
box: rect;
itemType: integer;
info: FontInfo;
begin
GetItem(theMenu, theItem, itemStr);
GetDItem(Dlg, menuBoxID, itemType, item, box);
GetFontInfo(info);
EraseRect(box);
FrameRect(box);
{drop shadow}
moveto(box.left + 5, box.bottom);
lineto(box.right, box.bottom);
lineto(box.right, box.top + 5);
moveto(box.left + 10, box.bottom - info.descent - 2);
DrawString(itemStr);
end;
{*********************************************}
procedure InvertItem (Dlg: DialogPtr; whichItem: integer);
var
itemType: integer;
item: handle;
box: rect;
begin
GetDItem(Dlg, whichItem, itemType, item, box);
InvertRect(box);
end;
{*********************************************}
procedure TrackPopUp;
var
result: longint;
itemType: integer;
item: handle;
box: rect;
begin
if mTitleID > 0 then
InvertItem(Dlg, mtitleID);
InsertMenu(theMenu, -1);
GetDItem(Dlg, mMenuID, itemType, item, box);
LocalToGlobal(box.topLeft);
result := popUpMenuSelect(theMenu, box.top, box.left, itemID);
menuID := 0;
if result > 0 then
begin
ItemID := loWord(result);
menuID := hiWord(result);
DrawPopUp(Dlg, mMenuID, theMenu, itemID);
end;
if mTitleID > 0 then
InvertItem(Dlg, mtitleID);
end;
{*********************************************}
function PopUpFilterProc;
var
where: point;
i: integer;
itemType: integer;
item, lastItem: handle;
box: rect;
found: boolean;
begin
found := false;
where := theEvent.where;
GlobalToLocal(where);
i := 0;
item := nil;
if (theEvent.what = mouseDown) then
repeat
i := i + 1;
lastItem := item;
GetDItem(Dlg, i, itemType, item, box);
if (itemType = UserItem) and PtInRect(where, box) then
begin
found := true;
itemHit := i;
end;
until found or (item = lastItem);
PopUpFilterProc := found;
end;
{*********************************************}
procedure PopUpActionProc (theWindow: WindowPtr;
itemNo: integer);
var
itemType: integer;
item: handle;
box: rect;
begin
GetDItem(DialogPtr(theWindow), itemNo, itemType, item, box);
FrameRect(box);
end;
{*********************************************}
procedure SetUpPopUp;
var
itemType: integer;
item: handle;
box: rect;
begin
GetDItem(Dlg, nPopUp, itemType, item, box);
{set the procedure for the user item}
SetDItem(Dlg, nPopUp, itemType, handle(@PopUpActionProc), box);
end;
end.
unit StringUtilities;
interface
uses
Sane;
const
CR = char(13);
tab = char(9);
comma = char(44);
function PtrToString (var theStr: Str255): ptr;
procedure HandleToStr255 (aHandle: handle;
var theString: str255;
var error: boolean);
procedure AppendString (theText: handle;
theString: str255;
var error: boolean);
function IsNumber (theText: Str255;
IsInteger: boolean): boolean;
function StringToReal (number: Str255): extended;
function RealToFixed (number: extended;
decimals: integer): Str255;
function RealToFormat (number: extended;
theForm: DecForm): Str255;
function RealToString (number: extended;
sigFigs: integer): Str255;
implementation
{*********************************************}
function PtrToString (var theStr: Str255): ptr;
begin
PtrToString := ptr(longint(@theStr) + 1);
end;
{*********************************}
procedure HandleToStr255;
var
i, len: integer;
begin
if not error then
begin
theString := ;
len := GetHandleSize(aHandle);
if len > 255 then
len := 255;
for i := 1 to len do
theString := concat(theString, charsHandle(aHandle)^^[i - 1]);
end;
end;
{*********************************}
procedure AppendString;
var
err: OSErr;
begin
if not error then
begin
err := PtrAndHand(PtrToString(theString), theText, length(theString));
error := (err <> noErr);
end;
end;
{*********************************}
function OrderOfMagnitude (number: extended): integer;
{this is the order of magnitude which puts a number in scientific notation}
var
magnitude: extended;
begin
if number <> 0 then
begin
magnitude := ln(abs(number)) / ln(10);
if magnitude >= 0 then
magnitude := trunc(magnitude)
else if (trunc(magnitude) <> magnitude) then
magnitude := trunc(magnitude) - 1;
end
else
magnitude := 1;
OrderOfMagnitude := trunc(magnitude);
end;
{*********************************************}
function IsNumber (theText: Str255;
IsInteger: boolean): boolean;
var
oneExp, oneDec, badText: boolean;
i: integer;
begin
oneExp := false;
oneDec := false;
BadText := false;
for i := 1 to length(theText) do
case theText[i] of
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, ,:
;{do nothing}
e, E:
if oneExp then
badText := true
else
oneExp := true;
.:
if oneDec then
badText := true
else
oneDec := true;
-, -:
if not oneExp then
BadText := (i > 1);
otherwise
BadText := true;
end;{case}
if (oneExp or oneDec) and IsInteger then
badText := true;
IsNumber := not BadText;
end;
{********************************************}
function StringToReal;
begin
StringToReal := Str2Num(number);
end;
{*****************************************}
function RealToFixed;
var
order: integer;
tempStr: DecStr;
theForm: DecForm;
begin
order := OrderOfMagnitude(number);
theForm.digits := decimals;
theForm.style := FixedDecimal;
Num2Str(theForm, number, tempStr);
RealToFixed := tempStr;
end;
{*****************************************}
function RealToFormat;
var
tempStr: DecStr;
begin
Num2Str(theForm, number, tempStr);
RealToFormat := tempStr;
end;
{*****************************************}
function RealToString;
var
order: integer;
tempStr: str255;
theForm: DecForm;
begin
order := OrderOfMagnitude(number);
if (order > sigFigs) or (order < -1) then
begin
theForm.style := FloatDecimal;
theForm.digits := sigFigs - 1;
end
else
begin
theForm.style := FixedDecimal;
theForm.Digits := sigFigs - order - 1;
end;
Num2Str(theForm, number, tempStr);
RealToString := tempStr;
end;
end.
unit KeyBoard;
interface
const
LeftCursor = $46;
RightCursor = $42;
UpCursor = $4D;
DownCursor = $48;
{now for the Mac SE and II keyboards}
xLeftCursor = $7B;
xRightCursor = $7C;
xDownCursor = $7D;
xUpCursor = $7E;
ReturnKey = $24;
EnterKey = $4C;
TabKey = $30;
HelpKey = $72;
xKey = 7;
cKey = 8;
vKey = 9;
dummyClearKey = $FFFF;
dummyOptionPasteKey = $FFFE;
type
CursorType = (noCurs, LeftCurs, RightCurs, UpCurs, DownCurs, TabCurs,
Carriage);
function whichCursor (keyCode: byte): CursorType;
{The following were gratefully taken from Warren P. Michelsen}
{MacTutor, May 1988, page 9}
function SpaceKeyDown: boolean;
function PeriodKeyDown: boolean;
function CommandKeyDown: boolean;
function OptionKeyDown: boolean;
implementation
{*********************************************}
function TestKey (i: longint): boolean;
var
myKeys: keyMap;
begin
GetKeys(myKeys);
TestKey := BitTst(@myKeys[1], i)
end;
{*********************************************}
function SpaceKeyDown: boolean;
begin
SpaceKeyDown := TestKey(22);
end;
{*********************************************}
function whichCursor (keyCode: byte): CursorType;
begin
case KeyCode of
LeftCursor, xLeftCursor:
whichCursor := leftCurs;
RightCursor, xRightCursor:
whichCursor := RightCurs;
DownCursor, xDownCursor:
whichCursor := DownCurs;
UpCursor, xUpCursor:
whichCursor := UpCurs;
TabKey:
whichCursor := TabCurs;
ReturnKey:
whichCursor := Carriage;
otherwise
whichCursor := noCurs;
end;{case}
end;
{*********************************************}
function PeriodKeyDown: boolean;
begin
PeriodKeyDown := TestKey(8);
end;
{*********************************************}
function OptionKeyDown: boolean;
begin
OptionKeyDown := TestKey(29);
end;
{*********************************************}
function CommandKeyDown: boolean;
begin
CommandKeyDown := TestKey(16);
end;
end.
unit Memory;
interface
procedure mySetHandleSize (h: handle; newSize: size;
var error: boolean);
function myNewHandle (logicalSize: size;
var error: boolean): handle;
procedure myHandToHand (var h: handle; var error: boolean);
implementation
{*********************************************}
procedure mySetHandleSize;
begin
if not error then
begin
SetHandleSize(h, newsize);
error := (memError <> noErr);
end;
end;
{*********************************}
function myNewHandle;
begin
if not error then
begin
myNewHandle := NewHandle(logicalSize);
error := (memError <> noErr);
end;
end;
{*********************************}
procedure myHandToHand;
var
err: OSerr;
begin
if (not error) and (h <> nil) then
begin
err := HandToHand(h);
error := (err <> noErr);
end;
end;
end.