home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.mactech.com 2010
/
ftp.mactech.com.tar
/
ftp.mactech.com
/
macintosh-pascal
/
macintoshp-1.2-demos.sit.hqx
/
chap23pascal_demo
/
chap18pascal_demoPPC
/
ListsPascalPPC.p
< prev
next >
Wrap
Text File
|
1997-01-07
|
31KB
|
1,206 lines
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
// ListsPascalPPC.p
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
//
// This program allows the user to open a dialog box by choosing the Dialog With Lists
// item in the Demonstration menu.
//
// The dialog box contains two lists. The cells of one list contain text. The cells of
// the other list contain icon-like pictures and their titles.
//
// The text list uses the default list definition procedure.
//
// The picture list uses a custom list definition procedure. The source code for the
// custom list definition procedure is at the file LDEFPascal.p in the LDEFPascal folder.
//
// The currently active list is outlined by a two-pixel-wide border. The currently
// active list can be changed by clicking in the non-active list or by pressing the tab
// key.
//
// The text list uses the default cell-selection algorithm; accordingly, multiple cells,
// including discontiguous multiple cells, may be selected. The picture list also
// supports arrow key selection (of single or multiple cells) and type selection.
//
// The constant lOnlyOne is assigned to the selFlags field of the picture list's list
// record. Accordingly, the selection of multiple items is not possible in this list.
// Arrow key selection (of single cells) is, however, supported.
//
// When the dialog is dismissed by clicking on the OK button, or by double-clicking on a
// cell in the active list, the user's selections are displayed in a window opened by the
// program at program launch. (Note that the use of the Return, Enter, Esc and
// Command-period keys as alternatives to clicking the OK and Cancel buttons in the
// dialog box is not supported in this program.)
//
// The program utilizes the following resources:
//
// • An 'MBAR' resource, and 'MENU' resources for Apple, File, Edit and Demonstration
// menus (preload, non-purgeable).
//
// • A 'WIND' resource (purgeable) (initially visible) for the window in which the
// user's selections are displayed.
//
// • A'DLOG' resource (purgeable) and associated 'DITL' resource (purgeable) for the
// dialog box.
//
// • 'STR#' resources (purgeable) containing the text strings for the text list.
//
// • 'PICT' resources (non-purgeable) containing the images for the picture list.
//
// • An 'LDEF' resource (non-purgeable) containing the custom list definition procedure
// used by the picture list.
//
// • A 'SIZE' resource with the acceptSuspendResumeEvents and doesActivateOnFGSwitch
// flags set.
//
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }
program ListsPascal(input, output);
{ ………………………………………………………………………………………………………………… include the following Universal Interfaces }
uses
Windows, Fonts, Menus, TextEdit, Quickdraw, Dialogs, QuickdrawText, Processes, Types,
Memory, Events, TextUtils, ToolUtils, OSUtils, Devices, Lists, LowMem, SegLoad;
{ ………………………………………………………………………………………………………………………………………………… define the following constants }
const
mApple = 128;
iAbout = 1;
mFile = 129;
iQuit = 11;
mDemonstration = 131;
iDialog = 1;
rMenubar = 128;
rWindow = 128;
rDialog = 129;
iOK = 1;
iCancel = 2;
iUserItemText = 3;
iUserItemPict = 4;
rListCellStrings = 128;
rListCellPicts = 128;
rListCellPictTitles = 129;
kUpArrow = $1e;
kDownArrow = $1f;
kTab = $09;
kScrollBarWidth = 15;
kMaxKeyThresh = 120;
kSystemLDEF = 0;
kCustomLDEF = 128;
kMaxLong = $7FFFFFFF;
{ ………………………………………………………………………………………………………………………………………………………………………………… user-defined types }
type
ListsRec = record
textListHdl : ListRef;
pictListHdl : ListRef;
end;
ListsRecPtr = ^ListsRec;
ListsRecHandle = ^ListsRecPtr;
{ ……………………………………………………………………………………………………………………………………………………………………………………… global variables }
var
gDone : boolean;
gInBackground : boolean;
gWindowPtr : WindowPtr;
gCurrentListHdl : ListRef;
gTSString : string;
gTSResetThreshold : integer;
gTSLastKeyTime : longint;
gTSLastListHit : ListRef;
menubarHdl : Handle;
menuHdl : MenuHandle;
eventRec : EventRecord;
doSearchPartialMatchRD : ListSearchUPP; { For PowerPC }
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInitManagers }
procedure DoInitManagers;
begin
MaxApplZone;
MoreMasters;
InitGraf(@qd.thePort);
InitFonts;
InitWindows;
InitMenus;
TEInit;
InitDialogs(nil);
InitCursor;
FlushEvents(everyEvent, 0);
end;
{of procedure DoInitManagers}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDrawDialogDefaultButton }
procedure DoDrawDialogDefaultButton(theDialogPtr : DialogPtr);
var
oldPort : WindowPtr;
oldPenState : PenState;
itemType : integer;
itemHandle : Handle;
itemRect : Rect;
buttonOval : integer;
begin
GetPort(oldPort);
GetPenState(oldPenState);
GetDialogItem(theDialogPtr, iOK, itemType, itemHandle, itemRect);
SetPort(ControlHandle(itemHandle)^^.contrlOwner);
InsetRect(itemRect, -4, -4);
buttonOval := (itemRect.bottom - itemRect.top) div 2 + 2;
if (ControlHandle(itemHandle)^^.contrlHilite = 255) then
PenPat(qd.gray)
else
PenPat(qd.black);
PenSize(3, 3);
FrameRoundRect(itemRect, buttonOval, buttonOval);
SetPenState(oldPenState);
SetPort(oldPort);
end;
{of procedure DoDrawDialogDefaultButton}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAddRowsAndDataToPictList }
procedure DoAddRowsAndDataToPictList(pictListHdl : ListRef; pictListID : integer);
var
rowNumber, pictIndex : integer;
pictureHdl : PicHandle;
theCell : Cell;
begin
rowNumber := pictListHdl^^.dataBounds.bottom;
for pictIndex := pictListID to (pictListID + 5) do
begin
pictureHdl := GetPicture(pictIndex);
rowNumber := LAddRow(1, rowNumber, pictListHdl);
SetPt(theCell, 0, rowNumber);
LSetCell(@pictureHdl, sizeof(PicHandle), theCell, pictListHdl);
rowNumber := rowNumber + 1;
end;
end;
{of procedure DoAddRowsAndDataToPictList}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoCreatePictList }
function DoCreatePictList(theDialogPtr : DialogPtr; listRect : Rect;
numCols, lDef : integer) : ListRef;
var
dataBounds : Rect;
cellSize : Point;
pictListHdl : ListRef;
theCell : Cell;
begin
SetRect(dataBounds, 0, 0, numCols, 0);
SetPt(cellSize, 48, 48);
listRect.right := listRect.right - kScrollBarWidth;
pictListHdl := LNew(listRect, dataBounds, cellSize, lDef, theDialogPtr, true,
false, false, true);
pictListHdl^^.selFlags := lOnlyOne;
DoAddRowsAndDataToPictList(pictListHdl, rListCellPicts);
SetPt(theCell, 0, 0);
LSetSelect(true, theCell, pictListHdl);
DoCreatePictList := pictListHdl;
end;
{of function DoCreatePictList}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAddTextItemAlphabetically }
procedure DoAddTextItemAlphabetically(listHdl : ListRef; theString : string);
var
found : boolean;
totalRows, currentRow, cellDataOffset, cellDataLength : integer;
aCell : Cell;
begin
found := false;
totalRows := listHdl^^.dataBounds.bottom - listHdl^^.dataBounds.top;
currentRow := -1;
while not (found) do
begin
currentRow := currentRow + 1;
if (currentRow = totalRows) then
found := true
else begin
SetPt(aCell, 0, currentRow);
LGetCellDataLocation(cellDataOffset, cellDataLength, aCell, listHdl);
MoveHHi(Handle(listHdl^^.cells));
HLock(Handle(listHdl^^.cells));
if (IUMagPString(Ptr(longint(@theString) + 1),
(Ptr(longint(@listHdl^^.cells) + cellDataOffset)),
integer(theString[0]), cellDataLength, nil) = -1) then
begin
found := true;
end;
HUnlock(Handle(listHdl^^.cells));
end;
end;
currentRow := LAddRow(1, currentRow, listHdl);
SetPt(aCell, 0, currentRow);
LSetCell((Ptr(longint(@theString) + 1)), integer(theString[0]), aCell, listHdl);
end;
{of procedure DoAddTextAlphabetically}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAddRowsAndDataToTextList }
procedure DoAddRowsAndDataToTextList(textListHdl : ListRef; stringListID : integer);
var
stringIndex : integer;
theString : string;
begin
for stringIndex := 1 to 15 do
begin
GetIndString(theString, stringListID, stringIndex);
DoAddTextItemAlphabetically(textListHdl, theString);
end;
end;
{of procedure DoAddRowsAndDataToTextList}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoResetTypeSelection }
procedure DoResetTypeSelection;
begin
gTSString[0] := char(0);
gTSLastListHit := nil;
gTSLastKeyTime := 0;
gTSResetThreshold := 2 * LMGetKeyThresh;
if (gTSResetThreshold > kMaxKeyThresh) then
gTSResetThreshold := kMaxKeyThresh;
end;
{of procedure DoResetTypeSelection}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoCreateTextList }
function DoCreateTextList(theDialogPtr : DialogPtr; listRect : Rect;
numCols, lDef : integer) : ListRef;
var
dataBounds : Rect;
cellSize : Point;
textListHdl : ListRef;
theCell : Cell;
begin
SetRect(dataBounds, 0, 0, numCols, 0);
SetPt(cellSize, 0, 0);
listRect.right := listRect.right - kScrollBarWidth;
textListHdl := LNew(listRect, dataBounds, cellSize, lDef, theDialogPtr,
true, false, false, true);
DoAddRowsAndDataToTextList(textListHdl, rListCellStrings);
SetPt(theCell, 0, 0);
LSetSelect(true, theCell, textListHdl);
DoResetTypeSelection;
DoCreateTextList := textListHdl;
end;
{of function DoCreateTextList}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAdjustMenus }
procedure DoAdjustMenus;
var
fileMenuHdl, demoMenuHdl : MenuHandle;
begin
fileMenuHdl := GetMenuHandle(mFile);
demoMenuHdl := GetMenuHandle(mDemonstration);
if (WindowPeek(FrontWindow)^.windowKind = dialogKind) then
begin
DisableItem(fileMenuHdl, 0);
DisableItem(demoMenuHdl, 0);
end
else begin
EnableItem(fileMenuHdl, 0);
EnableItem(demoMenuHdl, 0);
end;
DrawMenuBar;
end;
{of procedure DoAdjustMenus}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoCreateDialogWithLists }
procedure DoCreateDialogWithLists;
var
modalDlgPtr : DialogPtr;
listsRecHdl : ListsRecHandle;
fontNum, itemType : integer;
itemHdl : Handle;
itemRect : Rect;
textListHdl, pictListHdl : ListRef;
begin
modalDlgPtr := GetNewDialog(rDialog, nil, WindowPtr(-1));
if (modalDlgPtr = nil) then
ExitToShell;
listsRecHdl := ListsRecHandle(NewHandle(sizeof(ListsRec)));
if (listsRecHdl = nil) then
ExitToShell;
SetWRefCon(modalDlgPtr, longint(listsRecHdl));
SetPort(modalDlgPtr);
GetFNum('Chicago', fontNum);
TextFont(fontNum);
TextSize(12);
GetDialogItem(modalDlgPtr, iUserItemText, itemType, itemHdl, itemRect);
textListHdl := DoCreateTextList(modalDlgPtr, itemRect, 1, kSystemLDEF);
GetDialogItem(modalDlgPtr, iUserItemPict, itemType, itemHdl, itemRect);
pictListHdl := DoCreatePictList(modalDlgPtr, itemRect, 1, kCustomLDEF);
listsRecHdl^^.textListHdl := textListHdl;
listsRecHdl^^.pictListHdl := pictListHdl;
textListHdl^^.refCon := longint(pictListHdl);
pictListHdl^^.refCon := longint(textListHdl);
gCurrentListHdl := textListHdl;
ShowWindow(modalDlgPtr);
DoAdjustMenus;
end;
{of procedure DoCreateDialogWithLists}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoMenuChoice }
procedure DoMenuChoice(menuChoice : longint);
var
menuID, menuItem : integer;
itemName : string;
daDriverRefNum : integer;
begin
menuID := HiWord(menuChoice);
menuItem := LoWord(menuChoice);
if (menuID = 0) then
Exit(DoMenuChoice);
case (menuID) of
mApple: begin
if (menuItem = iAbout) then
SysBeep(10)
else begin
GetMenuItemText(GetMenuHandle(mApple), menuItem, itemName);
daDriverRefNum := OpenDeskAcc(itemName);
end;
end;
mFile: begin
if (menuItem = iQuit) then
gDone := true;
end;
mDemonstration: begin
if (menuItem = iDialog) then
begin
SetPort(gWindowPtr);
EraseRect(gWindowPtr^.portRect);
DoCreateDialogWithLists;
end;
end;
end;
{of case statement}
HiliteMenu(0);
end;
{of procedure DoMenuChoice}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDisplaySelections }
procedure DoDisplaySelections;
var
listsRecHdl : ListsRecHandle;
textListHdl, pictListHdl : ListRef;
nextLine, cellIndex : integer;
theCell : Cell;
theString : string;
offset, dataLen : integer;
ignored : boolean;
begin
nextLine := 15;
listsRecHdl := ListsRecHandle(GetWRefCon(FrontWindow));
textListHdl := listsRecHdl^^.textListHdl;
pictListHdl := listsRecHdl^^.pictListHdl;
HideWindow(FrontWindow);
SetPort(gWindowPtr);
MoveTo(10, nextLine);
DrawString('TIMBER:');
MoveTo(120, nextLine);
DrawString('TOOL:');
for cellIndex := 0 to (textListHdl^^.dataBounds.bottom - 1) do
begin
SetPt(theCell, 0, cellIndex);
if (LGetSelect(false, theCell, textListHdl)) then
begin
LGetCellDataLocation(offset, dataLen, theCell, textListHdl);
LGetCell(Ptr(longint(@theString) + 1), dataLen, theCell, textListHdl);
theString[0] := char(dataLen);
nextLine := nextLine + 15;
MoveTo(10, nextLine);
DrawString(theString);
end;
end;
SetPt(theCell, 0, 0);
ignored := LGetSelect(true, theCell, pictListHdl);
GetIndString(theString, rListCellPictTitles, theCell.v + 1);
MoveTo(120, 30);
DrawString(theString);
end;
{of procedure DoDisplaySelections}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDrawActiveListBorder }
procedure DoDrawActiveListBorder(listHdl : ListRef);
var
oldPenState : PenState;
borderRect : Rect;
begin
GetPenState(oldPenState);
PenSize(2, 2);
borderRect := listHdl^^.rView;
borderRect.right := borderRect.right + kScrollBarWidth;
InsetRect(borderRect, -4, -4);
if ((listHdl = gCurrentListHdl) and listHdl^^.lActive) then
PenPat(qd.black)
else
PenPat(qd.white);
FrameRect(borderRect);
SetPenState(oldPenState);
end;
{of procedure DoDrawActiveListBorder}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDrawListsBorders }
procedure DoDrawListsBorders(textListHdl, pictListHdl : ListRef);
var
oldPenState : PenState;
borderRect : Rect;
begin
GetPenState(oldPenState);
PenSize(1, 1);
borderRect := textListHdl^^.rView;
InsetRect(borderRect, -1, -1);
FrameRect(borderRect);
borderRect := pictListHdl^^.rView;
InsetRect(borderRect, -1, -1);
FrameRect(borderRect);
SetPenState(oldPenState);
end;
{of procedure DoDrawListsBorders}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoRotateCurrentList }
procedure DoRotateCurrentList;
var
myWindowPtr : WindowPtr;
oldListHdl, newListHdl : ListRef;
begin
myWindowPtr := FrontWindow;
if (WindowPeek(myWindowPtr)^.windowKind <> dialogKind) then
Exit(DoRotateCurrentList);
oldListHdl := gCurrentListHdl;
newListHdl := ListRef(gCurrentListHdl^^.refCon);
gCurrentListHdl := newListHdl;
DoDrawActiveListBorder(oldListHdl);
DoDrawActiveListBorder(newListHdl);
end;
{of procedure DoRotateCurrentList}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoFindNewCellLoc }
procedure DoFindNewCellLoc(listHdl : ListRef; oldCellLoc : Cell; var newCellLoc : Cell;
charCode : UInt8; moveToTopBottom : boolean);
var
listRows : integer;
begin
listRows := listHdl^^.dataBounds.bottom - listHdl^^.dataBounds.top;
newCellLoc := oldCellLoc;
if (moveToTopBottom) then
begin
if (charCode = kUpArrow) then
newCellLoc.v := 0
else if (charCode = kDownArrow) then
newCellLoc.v := listRows - 1;
end
else begin
if (charCode = kUpArrow) then
begin
if (oldCellLoc.v <> 0) then
newCellLoc.v := oldCellLoc.v - 1;
end
else if (charCode = kDownArrow) then
begin
if (oldCellLoc.v <> listRows - 1) then
newCellLoc.v := oldCellLoc.v + 1;
end;
end;
end;
{of procedure DoFindNewCellLoc}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoFindFirstSelectedCell }
function DoFindFirstSelectedCell(listHdl : ListRef; var theCell : Cell) : boolean;
var
result : boolean;
begin
SetPt(theCell, 0, 0);
result := LGetSelect(true, theCell, listHdl);
DoFindFirstSelectedCell := result;
end;
{of function DoFindFirstSelectedCell}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoFindLastSelectedCell }
procedure DoFindLastSelectedCell(listHdl : ListRef; var theCell : Cell);
var
aCell : Cell;
moreCellsInList : boolean;
begin
if (DoFindFirstSelectedCell(listHdl, aCell)) then
begin
while (LGetSelect(true, aCell, listHdl)) do
begin
theCell := aCell;
moreCellsInList := LNextCell(true, true, aCell, listHdl);
end;
end;
end;
{of procedure DoFindLastSelectedCell}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoMakeCellVisible }
procedure DoMakeCellVisible(listHdl : ListRef; newSelection : Cell);
var
visibleRect : Rect;
dRows : integer;
begin
visibleRect := listHdl^^.visible;
if not(PtInRect(newSelection, visibleRect)) then
begin
if (newSelection.v > visibleRect.bottom - 1) then
dRows := newSelection.v - visibleRect.bottom + 1
else if (newSelection.v < visibleRect.top) then
dRows := newSelection.v - visibleRect.top;
LScroll(0, dRows, listHdl);
end;
end;
{of procedure DoMakeCellVisible}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoSelectOneCell }
procedure DoSelectOneCell(listHdl : ListRef; theCell : Cell) ;
var
nextSelectedCell : Cell;
moreCellsInList : boolean;
begin
if (DoFindFirstSelectedCell(listHdl, nextSelectedCell)) then
begin
while(LGetSelect(true, nextSelectedCell, listHdl)) do
begin
if (nextSelectedCell.v <> theCell.v) then
LSetSelect(false, nextSelectedCell, listHdl)
else
moreCellsInList := LNextCell(true, true, nextSelectedCell, listHdl);
end;
LSetSelect(true, theCell, listHdl);
end;
end;
{of procedure DoSelectOneCell}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoSearchPartialMatch }
function DoSearchPartialMatch(searchDataPtr, cellDataPtr : Ptr;
cellDataLen, searchDataLen : integer ) : integer;
var
result : integer;
begin
if ((cellDataLen > 0) and (cellDataLen >= searchDataLen)) then
result := IUMagIDString(cellDataPtr, searchDataPtr, searchDataLen, searchDataLen)
else
result := 1;
DoSearchPartialMatch := result;
end;
{of function DoSearchPartialMatch}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoTypeSelectSearch }
procedure DoTypeSelectSearch( listHdl : ListRef; var theEvent : EventRecord);
var
newChar : char;
theCell : Cell;
begin
newChar := chr(BAnd(theEvent.message, charCodeMask));
if ((gTSLastListHit <> listHdl) or ((theEvent.when - gTSLastKeyTime) >=
gTSResetThreshold) or (integer(gTSString[0]) = 255)) then
DoResetTypeSelection;
gTSLastListHit := listHdl;
gTSLastKeyTime := theEvent.when;
gTSString[0] := char(integer(gTSString[0]) + 1);
gTSString[integer(gTSString[0])] := newChar;
SetPt(theCell, 0, 0);
if (LSearch(Ptr(longint(@gTSString) + 1), integer(gTSString[0]),
doSearchPartialMatchRD, theCell, listHdl)) then { For PowerPC }
begin
LSetSelect(true, theCell, listHdl);
DoSelectOneCell(listHdl, theCell);
DoMakeCellVisible(listHdl, theCell);
end;
end;
{of procedure DoTypeSelectSearch}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoArrowKeyExtendSelection }
procedure DoArrowKeyExtendSelection(listHdl : ListRef; charCode : UInt8;
moveToTopBottom : boolean);
var
currentSelection, newSelection : Cell;
begin
if (DoFindFirstSelectedCell(listHdl, currentSelection)) then
begin
if (charCode = kDownArrow) then
DoFindLastSelectedCell(listHdl, currentSelection);
DoFindNewCellLoc(listHdl, currentSelection, newSelection, charCode,
moveToTopBottom);
if not (LGetSelect(false, newSelection, listHdl)) then
LSetSelect(true, newSelection, listHdl);
DoMakeCellVisible(listHdl, newSelection);
end;
end;
{of procedure DoArrowKeyExtendSelection}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoArrowKeyMoveSelection }
procedure DoArrowKeyMoveSelection(listHdl : ListRef; charCode : UInt8;
moveToTopBottom : boolean);
var
currentSelection, newSelection : Cell;
begin
if (DoFindFirstSelectedCell(listHdl, currentSelection)) then
begin
if (charCode = kDownArrow) then
DoFindLastSelectedCell(listHdl, currentSelection);
DoFindNewCellLoc(listHdl, currentSelection, newSelection, charCode,
moveToTopBottom);
DoSelectOneCell(listHdl, newSelection);
DoMakeCellVisible(listHdl, newSelection);
end;
end;
{of procedure DoArrowKeyMoveSelection}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoHandleArrowKey }
procedure DoHandleArrowKey(charCode : UInt8; var theEvent : EventRecord;
allowExtendSelect : boolean);
var
moveToTopBottom : boolean;
begin
moveToTopBottom := false;
if (BAnd(theEvent.modifiers, cmdKey) <> 0) then
moveToTopBottom := true;
if (allowExtendSelect and (BAnd(theEvent.modifiers, shiftKey) <> 0)) then
DoArrowKeyExtendSelection(gCurrentListHdl, charCode, moveToTopBottom)
else
DoArrowKeyMoveSelection(gCurrentListHdl, charCode, moveToTopBottom);
end;
{of procedure DoHandleArrowKey}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoItemHitInDialog }
procedure DoItemHitInDialog(myDialogPtr : DialogPtr; itemHit : integer);
var
listsRecHdl : ListsRecHandle;
begin
if ((itemHit = iOK) or (itemHit = iCancel)) then
begin
if (itemHit = iOK) then
DoDisplaySelections;
listsRecHdl := ListsRecHandle(GetWRefCon(myDialogPtr));
LDispose(listsRecHdl^^.textListHdl);
LDispose(listsRecHdl^^.pictListHdl);
DisposeHandle(Handle(listsRecHdl));
DisposeDialog(myDialogPtr);
DoAdjustMenus;
end;
end;
{of procedure DoItemHitInDialog}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInContent }
procedure DoInContent(var theEvent : EventRecord);
var
oldPort : GrafPtr;
listsRecHdl : ListsRecHandle;
textListHdl, pictListHdl : ListRef;
textListRect, pictListRect, gCurrentListRect : Rect;
mouseXY : Point;
isDoubleClick : boolean;
theDialogPtr : DialogPtr;
itemHit : integer;
begin
GetPort(oldPort);
listsRecHdl := ListsRecHandle(GetWRefCon(FrontWindow));
textListHdl := listsRecHdl^^.textListHdl;
pictListHdl := listsRecHdl^^.pictListHdl;
textListRect := listsRecHdl^^.textListHdl^^.rView;
pictListRect := listsRecHdl^^.pictListHdl^^.rView;
gCurrentListRect := gCurrentListHdl^^.rView;
textListRect.right := textListRect.right + kScrollBarWidth;
pictListRect.right := pictListRect.right + kScrollBarWidth;
gCurrentListRect.right := gCurrentListRect.right + kScrollBarWidth;
mouseXY := theEvent.where;
GlobalToLocal(mouseXY);
if ((PtInRect(mouseXY, textListRect) and (gCurrentListHdl <> textListHdl)) or
(PtInRect(mouseXY, pictListRect) and (gCurrentListHdl <> pictListHdl))) then
begin
DoRotateCurrentList;
end
else if (PtInRect(mouseXY, gCurrentListRect)) then
begin
SetPort(gCurrentListHdl^^.port);
isDoubleClick := LClick(mouseXY, theEvent.modifiers, gCurrentListHdl);
if (isDoubleClick) then
DoItemHitInDialog(FrontWindow, iOK);
end
else begin
if (DialogSelect(theEvent, theDialogPtr, itemHit)) then
DoItemHitInDialog(theDialogPtr, itemHit);
end;
SetPort(oldPort);
end;
{of procedure DoInContent}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoActivateDialog }
procedure DoActivateDialog(myWindowPtr : WindowPtr; becomingActive : Boolean);
var
listRecsHdl : ListsRecHandle;
textListHdl, pictListHdl : ListRef;
itemType : integer;
itemHdl : Handle;
itemRect : Rect;
begin
listRecsHdl := ListsRecHandle(GetWRefCon(myWindowPtr));
textListHdl := listRecsHdl^^.textListHdl;
pictListHdl := listRecsHdl^^.pictListHdl;
if (becomingActive) then
begin
GetDialogItem(DialogPtr(myWindowPtr), iOK, itemType, itemHdl, itemRect);
HiliteControl(ControlHandle(itemHdl), 0);
GetDialogItem(DialogPtr(myWindowPtr), iCancel, itemType, itemHdl, itemRect);
HiliteControl(ControlHandle(itemHdl), 0);
DoDrawDialogDefaultButton(myWindowPtr);
LActivate(true, textListHdl);
LActivate(true, pictListHdl);
DoDrawActiveListBorder(gCurrentListHdl);
DoResetTypeSelection;
end
else begin
GetDialogItem(DialogPtr(myWindowPtr), iOK, itemType, itemHdl, itemRect);
HiliteControl(ControlHandle(itemHdl), 255);
GetDialogItem(DialogPtr(myWindowPtr), iCancel, itemType, itemHdl, itemRect);
HiliteControl(ControlHandle(itemHdl), 255);
DoDrawDialogDefaultButton(myWindowPtr);
LActivate(false, textListHdl);
LActivate(false, pictListHdl);
DoDrawActiveListBorder(gCurrentListHdl);
end;
end;
{of procedure DoActivateDialog}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoOSEvent }
procedure DoOSEvent(var theEvent : EventRecord);
begin
case BAnd(BSR(theEvent.message, 24), $000000FF) of
suspendResumeMessage:
begin
gInBackground := BAnd(theEvent.message, resumeFlag) = 0;
if (WindowPeek(FrontWindow)^.windowKind = dialogKind) then
DoActivateDialog(FrontWindow, not (gInBackground));
end;
mouseMovedMessage:
begin
end;
end;
{of case statement}
end;
{of procedure DoOSEvent}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoActivate }
procedure DoActivate(var theEvent : EventRecord);
var
myWindowPtr : WindowPtr;
becomingActive : boolean;
begin
myWindowPtr := WindowPtr(theEvent.message);
becomingActive := (BAnd(theEvent.modifiers, activeFlag) = activeFlag);
if (WindowPeek(myWindowPtr)^.windowKind = dialogKind) then
DoActivateDialog(myWindowPtr, becomingActive);
end;
{of procedure DoActivate}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoUpdateLists }
procedure DoUpdateLists(myWindowPtr : WindowPtr);
var
listsRecHdl : ListsRecHandle;
textListHdl, pictListHdl : ListRef;
begin
listsRecHdl := ListsRecHandle(GetWRefCon(myWindowPtr));
textListHdl := listsRecHdl^^.textListHdl;
pictListHdl := listsRecHdl^^.pictListHdl;
SetPort(textListHdl^^.port);
LUpdate(textListHdl^^.port^.visRgn, textListHdl);
LUpdate(pictListHdl^^.port^.visRgn, pictListHdl);
DoDrawListsBorders(textListHdl, pictListHdl);
DoDrawActiveListBorder(textListHdl);
DoDrawActiveListBorder(pictListHdl);
end;
{of procedure DoUpdateLists}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoUpdate }
procedure DoUpdate(var theEvent : EventRecord);
var
myWindowPtr : WindowPtr;
begin
myWindowPtr := WindowPtr(theEvent.message);
BeginUpdate(myWindowPtr);
if (WindowPeek(myWindowPtr)^.windowKind = dialogKind) then
begin
UpdateDialog(myWindowPtr, myWindowPtr^.visRgn);
DoDrawDialogDefaultButton(myWindowPtr);
DoUpdateLists(myWindowPtr);
end;
EndUpdate(myWindowPtr);
end;
{of procedure DoUpdate}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoKeyDown }
procedure DoKeyDown(charCode : UInt8; var theEvent : EventRecord);
var
listsRecHdl : ListsRecHandle;
allowExtendSelect : boolean;
begin
if (WindowPeek(FrontWindow)^.windowKind = dialogKind) then
begin
listsRecHdl := ListsRecHandle(GetWRefCon(FrontWindow));
if (charCode = kTab) then
DoRotateCurrentList
else if ((charCode = kUpArrow) or (charCode = kDownArrow)) then
begin
if (gCurrentListHdl = listsRecHdl^^.textListHdl) then
allowExtendSelect := true
else
allowExtendSelect := false;
DoHandleArrowKey(charCode, theEvent, allowExtendSelect);
end
else begin
if (gCurrentListHdl = listsRecHdl^^.textListHdl) then
DoTypeSelectSearch(listsRecHdl^^.textListHdl, theEvent);
end;
end;
end;
{of procedure DoKeyDown}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoMouseDown }
procedure DoMouseDown(var theEvent : EventRecord);
var
partCode : integer;
myWindowPtr : WindowPtr;
begin
partCode := FindWindow(theEvent.where, myWindowPtr);
case (partCode) of
inMenuBar: begin
DoAdjustMenus;
DoMenuChoice(MenuSelect(theEvent.where));
end;
inSysWindow: begin
SystemClick(theEvent, myWindowPtr);
end;
inContent: begin
if (myWindowPtr <> FrontWindow) then
begin
if (WindowPeek(FrontWindow)^.windowKind = dialogKind) then
SysBeep(10)
else SelectWindow(myWindowPtr);
end
else begin
if (WindowPeek(FrontWindow)^.windowKind = dialogKind) then
DoInContent(theEvent);
end;
end;
inDrag: begin
if ((WindowPeek(FrontWindow)^.windowKind = dialogKind) and
(WindowPeek(myWindowPtr)^.windowKind <> dialogKind)) then
begin
SysBeep(10);
Exit(DoMouseDown);
end;
DragWindow(myWindowPtr, theEvent.where, qd.screenBits.bounds);
end;
end;
{of statement}
end;
{of procedure DoMouseDown}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoEvents }
procedure DoEvents(var theEvent : EventRecord);
var
charCode : UInt8;
begin
case (theEvent.what) of
mouseDown: begin
DoMouseDown(theEvent);
end;
keyDown, autoKey: begin
charCode := UInt8(BAnd(theEvent.message, charCodeMask));
if (BAnd(theEvent.modifiers, cmdKey) <> 0) then
begin
DoAdjustMenus;
DoMenuChoice(MenuKey(char(charCode)));
end;
DoKeyDown(charCode, theEvent);
end;
updateEvt: begin
DoUpdate(theEvent);
end;
activateEvt: begin
DoActivate(theEvent);
end;
osEvt: begin
DoOSEvent(theEvent);
HiliteMenu(0);
end;
end;
{of case statement}
end;
{of procedure DoEvents}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ start of main program }
begin
{ …………………………………………………………………………………………………………………………………………………………………… initialize managers }
DoInitManagers;
{ …………………………………………………………………………………………………………………………………………………………… create routine descriptors }
doSearchPartialMatchRD := NewListSearchProc(ProcPtr(@DoSearchPartialMatch));
{ For PowerPC }
{ …………………………………………………………………………………………………………………………………………………… set up menu bar and menus }
menubarHdl := GetNewMBar(rMenubar);
if (menubarHdl = nil) then
ExitToShell;
SetMenuBar(menubarHdl);
DrawMenuBar;
menuHdl := GetMenuHandle(mApple);
if (menuHdl = nil) then
ExitToShell
else
AppendResMenu(menuHdl, 'DRVR');
{ ………………………………………………………………………………………………………………………………………………………………………………………… open window }
gWindowPtr := GetNewWindow(rWindow, nil, WindowPtr(-1));
if (gWindowPtr = nil) then
ExitToShell;
SetPort(gWindowPtr);
TextSize(10);
{ ……………………………………………………………………………………………………………………………………………………………………………… enter eventLoop }
gDone := false;
while not (gDone) do
begin
if (WaitNextEvent(everyEvent, eventRec, kMaxLong, nil)) then
DoEvents(eventRec);
end;
end.
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }