|
Volume Number: | 7 | |
Issue Number: | 8 | |
Column Tag: | MacOOPs! |
Related Info: Dialog Manager Standard File
Modeless SFDialongs
By Brendan Murphy, Palatine, IL
[Brendan has been programming on the Macintosh since 1986. He is a graduate of the University of Minnesota Institute of Technology. He is currently employed full time by Motorola as a software engineer working on cellular switching software and he is also employed part time by the US Bureau of Mines (Twin Cities Research Center) as a Macintosh programmer creating Hydrologic applications. His expertise is in OOD and OOP with emphasis on MacApp and TCL.]
Jumping over ROM in a single bound....
I have always believed that what makes a Mac a Mac is not its hardware, but its operating system. The stuff in ROM and in the system folder really make the Mac what it is. The converse is also true, what is not in ROM is not part of the Mac. This can sometimes be a good thing. For example, what if there was a DOS manager which turned the Mac into a command line interface and back again at the whim of a system call. It would be unimaginable the affect on Mac software if such a manager had been included in the original operating system. There is also a down side to what is “not in ROM” as is so often state in Inside Mac I-V. If it ain’t there, it ain’t there--your stuck! This statement isn’t completely true, otherwise I would not be writing this article. This leads me to the motivation behind this article. What if you could have SFPutFile and SFGetFile dialogs that were modeless! Your probably thinking that is impossible! Ok, so your not thinking that it is impossible, but you have to admit it would be a difficult thing to accomplish.
Let’s think about a scenario for a few sentences. You launch Think Pascal 3.0 and you create a new project. So far, so good. Then it comes time to add files to the project, but you become a little annoyed and then potentially psychotic after adding fifty implementation files. What is the cause of those mental aberrations? Those jack-in-the-box SFGetFile dialogs that keep flashing on the screen every time you select a file. After you calm down with a diet seven up, you realize it was not Think Pascal’s fault, but it is a deficiency in the toolbox. Let’s alter the scenario and add the new modeless SFGetFile dialog. This time everything seems smoother and more peaceful. There are no annoying flashes on the screen. You can flip back and forth between windows with out having to close the SFGetFile dialog. Now you drink your diet seven up at your leisure and without massive brow strain. A happy ending to the scenario wouldn’t you say.
Pandora’s Dialog
The first thing to consider when using the modeless dialogs, is how should the modeless get and save dialogs behave. (I’ll refer to SFPutFile and SFGetFile dialogs as Save and Get dialogs respectively from now on.) Having modeless get and save dialogs provides a tremendous amount of flexibility to the programmer. This flexibility also has a dark side. If the get and save dialogs are used in an inconsistent manner across different applications then only confusion will result in the end user. Therefore I propose three guidelines to govern the use of modeless get and save dialogs. I am sure more guidelines could be added, but I will leave that up for debate among the Mac developer community.
1) Make clear the target of the get or save operation. In most situations this will be the top (not necessarily active) document window.
2) Operations should be sequential. An example of where operations could become non-sequential is when the user clicks on the save and open button several times and the the file system saves and gets files asynchronously. Make sure saving and getting sequences are logically interlocked.
3) Keep it simple. Don’t make the user’s life difficult with overly complicated get and save dialogs.
Full Reverse!
When I first started this project I knew I had to reverse engineer the modal get and save dialogs. After doing so, I discover some semi-startling facts. One of the first things I noticed was that the pulldown menu for the path names was not a pop-up menu, but a list from the list manager! The next thing I noticed was the interaction of all the elements in the modal dialogs were more complex than meets the eye or mouse. I’m not sure if I caught all of the complexities, but I am sure someone out there will find them for me. I would appreciate it if you do find some inconsistency in the modeless get and save dialogs that you will inform me of them.
The Nitty Gritty.
Today, not only do you have the burden to learn the toolbox but also OOP libraries like MacApp and TCL (essentially second toolboxes). CSFDialogs are a set of object-oriented classes based on TCL. You will need Think Pascal 3.x or better and TCL. I have created a sample starter application with all the necessary overrides. There is also a custom list definition project. All these files will add about 2000+ physical lines of code (comments not included) and about 12 k+ to your application.
There are three basic classes you need to be aware of--CSFWindow and its two subclasses CSFGetWindow and CSFSaveWindow. Most of the work is done in these three classes. You will have to create subclasses of these classes to make them work in your own application. CSFGetWindow and CSFSaveWindow override the methods of CSFWindow. When you create your subclasses, you will need to override a similar set of methods. I suggest beginning with a copying the CSFGetWindow or CSFSaveWindow class type declarations and modifying them from that point. If you want to to use the dialogs without modifications, you will have to override “PROCEDURE FileSelected (TheReply: SFReply);” in order to do something useful with the reply when a file is selected or there is a click in the save button. Subclasses of the director classes will also have to be created to install your subclass windows. The CApplication class has also been overriden so that the CSFSwitchboard may be installed. Make sure your application installs CSFApplication.
I have used Hungarian notation in the naming of fields and classes. Fields of objects start with f (e.g. fEmpty), classes start with C, constants start with k, and global variables start with g. SF stands for “Snazzy File”.
Where’s the override!
Described below is the main window class methods for the modeless get and save dialogs. The key to understanding this project is understanding the inner workings of CSFWindow. When you create your subclasses, follow the example of CSFGetWindow and CSFSaveWindow in how they modify CSFWindow.
CSFWindow = OBJECT(CWindow)
This class is the heart of the modeless dialogs. Normally you would not directly create subclasses of this class, but subclasses of CSFGetWindow and CSFSaveWindow. Make sure to create subclasses of the directors to install your window subclass.
PROCEDURE ICSFWindow (TheDirector: CDirector);
Initialize the window and all its buttons. Don’t override this method but override MoreInitializations.
PROCEDURE MoreInitializations;
Override this method to install your buttons and perform any necessary adjustments. The window is not visible when this method is called.
PROCEDURE SetfViewRect;
Override this method to position the main file selection box.
PROCEDURE DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord);
Override;
Intercept special characters like tabs and returns.
PROCEDURE DoCommand (TheCommand: Longint);
Override;
Override this method to insert your own commands. Make sure to call the inherited DoCommand if your routine does not handle the command.
PROCEDURE Update;
Override;
Do not override this method, but override MoreUpdates instead.
PROCEDURE MoreUpdates;
Override this method to do any additional drawing or updating to the window. This method is called by Update.
PROCEDURE Free;
Override;
If you allocate any memory, dispose or free it here. Make sure to call the inherited free to free the rest of the dialog.
PROCEDURE DoClick (hitPt: Point; modifierKeys: integer; when: longint);
Override;
This method mainly handles dispatching clicks to the file box and the pull down menu.
PROCEDURE Activate;
Override;
With modeless dialogs we don’t hold the system hostage, therefore there is no guarantee as to the current status of the mounted volumes when the window is activated. The dialog is updated to reflect the current state of affairs.
PROCEDURE Deactivate;
Override;
Deactivate the window and clean up.
PROCEDURE Close;
Override;
Close the window and its document.
FUNCTION CountDrives: Integer;
Count the number of mounted drives.
FUNCTION GetNextVol: Integer;
Index to the next mounted volume and return the its volume reference number.
FUNCTION CheckDrives: Boolean;
Check the statuses of the floppy drives and store there volume reference numbers.
PROCEDURE DoEject;
Eject the disk.
PROCEDURE DoDrive;
Find the next mounted drive.
PROCEDURE DoCancel;
The default method closes the dialog. In most cases you will want to override this method so it won’t close the dialog, but cancel any actions that are in progress.
PROCEDURE DoStatus;
Update the status of the buttons. Override this method if you are adding new controls.
FUNCTION FileFilter (ParamBlock: CInfoPBPtr): Boolean;
This method is called when reading files from a directory on the disk. If you want a file to appear in the file box, override this method and return true.
FUNCTION ActiveFilter (ParamBlock: CInfoPBPtr): Boolean;
This method is called when reading files from a directory on the disk. If you want a file to be active and selectable (not grayed out), override this method and return true.
PROCEDURE FillDialog (VRefNum: Integer);
Update the file box with the directory indicated by VRefNum.
PROCEDURE SetPathRect;
Resize the pull down menu for the path names.
PROCEDURE FindPath (VRefNum: Integer);
From the directory specified in VRefNum, find the path name to this directory and store in the list.
FUNCTION FindSelection: Str255;
Return the first selected file in the file box as a Pascal string Str255.
PROCEDURE DoSelection;
Handle a selected file. Do not override this method. FileSelected is called from here.
PROCEDURE FileSelected (TheReply: SFReply);
This method must be overriden! This is where a selected file is returned for processing. I suggest processing files asynchronously. This will allow your application to continue processing events and make the dialog more flexible. I also suggest setting up a “completion” routine to run after the operation is done to update the dialog.
FUNCTION RedAlert (AlertID: Integer): Integer;
Display alert messages. Override this method if you have specialized alerts. Make sure that the inherited method is called if you don’t handle the alert. (Yes, this is a cheap reference to Star Trek.)
LDEF
This program would not be complete without a custom list definition. The path name menu is a list from the list manager. There are two parts to this custom list definition. The first resides in the actual list definition and the second part is the ClickLoop routine that resides in the main source code. The ClickLoop routine allows scrolling of the pull down menu. This is necessary because of the custom list definition. The data for each item in the list is a text string. The first two characters of the text string are controlling characters and the rest is the actual text. The first character is ‘+’ for active or ‘-’ for inactive. The second character represents what icon to draw with the text. The various icons are defined as follows.
‘!’: File
‘@’: Closed Folder
‘#’: Application
‘$’: Open Folder
‘%’: Hard Drive
‘^’: Floppy Disk
Neat things you could do...
Here are some ideas you could add to your subclasses.
1) Have a pulldown menu to allow the user to randomly select mounted volumes.
2) As a variant to the first idea, make the pulldown menu hierarchical and allow the user to select the working directory within the volume.
3) Combine get and save operations into one dialog.
4) Add sound effects to the operations of the dialog.
5) Implement multiple file selection. Open more than one file at a time.
6) Have a pulldown menu that selects the document to be saved from among the open “dirty” documents.
Conclusion
After reading this article there are probably a lot of unanswered questions. These questions are left to the reader as an exercise (I always hated that in college). I’m not going to produce a Think C version or a MacApp version. I leave this honor to some hearty soul out there. I will release a maintenance version if enough bugs or deficiencies are brought to my attention. My hope for this piece of software is that it will someday be incorporated into Apple’s system software (7.x or 8.x) and thus make this article a moot exercise for future programmers.
In the future, I plan to write more articles on TCL and perhaps MacApp. I am already “cooking up” some ideas to remove some of the short comings of TCL, but I have not yet decided which idea to pursue. Half the battle is coming up with the idea and half the battle is sticking with the idea and half the battle is implementing the idea. Yes, that adds up to 3/2 which goes to show that anything worth doing, is more work than you thought.
Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks. Note--In the following listings, an "..." between sections of code signifies code deleted. The deleted code is the same as found in the TCL Starter application. I have only included the changes to the starter application. The full source code for this project can be found on the source disk.
Listing: CSFDialogs.p { Written by Brendan Murphy } { Version 1.0 } UNIT CSFDialogs; INTERFACE { TwilightZone } USES TCL, Disks; { Make sure you have included 'Disks.p' in your project } CONST cmdDiskEvent = 552; ScrDmpEnb = $2F8; { Global } { Button stuff } kScrollBarWidth = 15; kButtonHeight = 17; kGetButtonOffset = 264; kSaveButtonOffset = 226; { Resource IDs } kRadioButton = 1; kCheckButton = 2; KPushButton = 3; { Buttons } kCancelButton = 20001; kEjectButton = 20002; kDriveButton = 20003; kOpenButton = 20004; kSaveButton = 20005; { More commands } kSelection = 21000; kEmptyText = 21001; kNonEmptyText = 21002; { Red Alert Errors } kDiskNotFound = -3994; kSystemError = -3995; kExistingFile = -3996; kLockedDisk = -3997; TYPE { Shows volume name and icon } CSFVolumeBox = OBJECT(CPane) PROCEDURE Draw (VAR Area: Rect); Override; PROCEDURE DoClick (hitPt: Point; modifierKeys: integer; when: longint); Override; END; { Text edit box for save dialog } CSFEditText = OBJECT(CEditText) fEmpty: Boolean; { Anybody Home? } PROCEDURE IEditText (anEnclosure: CView; aSupervisor: CBureaucrat; aWidth, aHeight, aHEncl, aVEncl: integer; aHSizing, aVSizing: SizingOption; aLineWidth: integer); Override; PROCEDURE DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord); Override; PROCEDURE SetText; FUNCTION IsEmpty: Boolean; PROCEDURE Dawdle (VAR maxSleep: Longint); Override; PROCEDURE SelectText; FUNCTION GetStr255: Str255; END; { Main window class } CSFWindow = OBJECT(CWindow) fInitTime: Boolean; { Button references } fEject, fDrive, fCancel: CButton; fVolumeBox: CSFVolumeBox; { Holds the file listings } fFileList: ListHandle; fViewRect: Rect; { Holds the path to the directory } fPathList: ListHandle; fPathRect: Rect; fMenuWidth: Integer; fMenuHeight: Integer; fDriveIndex: Integer; fDrive1, fDrive2: Integer; { Internal directory information } fCurrentWD: Integer; { Holds current working directory } fGood: Boolean; fName: Str255; fVName: Str255; PROCEDURE ICSFWindow (TheDirector: CDirector); PROCEDURE MoreInitializations; PROCEDURE SetfViewRect; PROCEDURE DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord); Override; PROCEDURE DoCommand (TheCommand: Longint); Override; PROCEDURE Update; Override; PROCEDURE MoreUpdates; PROCEDURE Free; Override; PROCEDURE DoClick (hitPt: Point; modifierKeys: integer; when: longint); Override; PROCEDURE Activate; Override; PROCEDURE Deactivate; Override; PROCEDURE Close; Override; FUNCTION CountDrives: Integer; FUNCTION GetNextVol: Integer; FUNCTION CheckDrives: Boolean; PROCEDURE DoEject; PROCEDURE DoDrive; PROCEDURE DoCancel; PROCEDURE DoStatus; FUNCTION FileFilter (ParamBlock: CInfoPBPtr): Boolean; FUNCTION ActiveFilter (ParamBlock: CInfoPBPtr): Boolean; PROCEDURE FillDialog (VRefNum: Integer); PROCEDURE SetPathRect; PROCEDURE FindPath (VRefNum: Integer); FUNCTION FindSelection: Str255; PROCEDURE DoSelection; PROCEDURE FileSelected (TheReply: SFReply); FUNCTION RedAlert (AlertID: Integer): Integer; END; { Subclasses of main window } { You will want to override these subclasses } CSFGetWindow = OBJECT(CSFWindow) fOpen: CButton; PROCEDURE MoreInitializations; Override; PROCEDURE DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord); Override; PROCEDURE SetfViewRect; Override; PROCEDURE MoreUpdates; Override; PROCEDURE DoStatus; Override; PROCEDURE DoClick (hitPt: Point; modifierKeys: integer; when: longint); Override; PROCEDURE DoCommand (TheCommand: Longint); Override; PROCEDURE Free; Override; PROCEDURE DoOpen; END; CSFSaveWindow = OBJECT(CSFWindow) fSave: CButton; fFileName: CSFEditText; fPromptString: Str255; PROCEDURE MoreInitializations; Override; PROCEDURE SetfViewRect; Override; FUNCTION ActiveFilter (ParamBlock: CInfoPBPtr): Boolean; Override; PROCEDURE Activate; Override; PROCEDURE DoCommand (TheCommand: Longint); Override; PROCEDURE MoreUpdates; Override; PROCEDURE Free; Override; FUNCTION FileExists (vRefNum: Integer; TheName: Str255): Boolean; PROCEDURE DoSave; END; { Also make sure to create subclasses of these directors } CSFDialog = OBJECT(CDirector) PROCEDURE ICSFDialog; END; CSFGetDialog = OBJECT(CSFDialog) PROCEDURE ICSFDialog; Override; END; CSFSaveDialog = OBJECT(CSFDialog) PROCEDURE ICSFDialog; Override; END; { You don't have to do anything with the switchboard since } { it is installed by the CSFApplication } CSFSwitchboard = OBJECT(CSwitchBoard) PROCEDURE DoDiskEvent (macEvent: EventRecord); Override; END; { Make sure this class is installed in your application! } CSFApplication = OBJECT(CApplication) PROCEDURE ICSFApplication (extraMasters: integer; aRainyDayFund, aCreditLimit: Size); END; IMPLEMENTATION VAR { This list handle is critcal to the ClickLoop routine. } { It holds the current path menu list. } ThePathList: ListHandle; ThePathCell: Cell; FUNCTION IsDirectory (ParamBlock: CInfoPBPtr): Boolean; { Is this a directory? } BEGIN IsDirectory := BitTst(@ParamBlock^.ioFLAttrib, 3); END; PROCEDURE DropShadow (TheRect: Rect); { Draw a shadow around the box } BEGIN Moveto(TheRect.Left + 1, TheRect.Bottom); Lineto(TheRect.Right, TheRect.Bottom); Lineto(TheRect.Right, TheRect.Top + 1); END; PROCEDURE FKeyEnable (OnOff: Boolean); { Turn off function keys } { Can't normaly intercept all disk events } { because they are masked out by the system } { before they are put in the event queue. } VAR P: Ptr; BEGIN { Enable Shift-Command-Keys } P := Ptr(ScrDmpEnb); IF OnOff THEN P^ := $FF ELSE P^ := $00 END; FUNCTION GetCellContents (TheCell: Cell; TheList: Listhandle): Str255; { Transform the cell data into a Pascal string. } VAR TempStr: Str255; DataLength: Integer; BEGIN TempStr := ''; DataLength := 255; LGetCell(Ptr(Longint(@TempStr) + 1), DataLength, TheCell, TheList); BlockMove(Ptr(Longint(@DataLength) + 1), @TempStr, 1); GetCellContents := TempStr; END; FUNCTION ClickLoop: Boolean; { Gives those pull down menus that special flavor } { Since we use a custom LDEF, we must roll our own here } { and damn the torpedos!!! } VAR ThePoint, TheCell, TheNewCell: Point; Contents: Str255; OffSet: Integer; BEGIN OffSet := 0; WHILE StillDown DO BEGIN GetMouse(ThePoint); IF NOT PtInRect(ThePoint, ThePathList^^.rView) THEN BEGIN { We are not in the menu } SetPt(TheCell, 0, 0); { Cell Selected? } IF LGetSelect(True, TheCell, ThePathList) THEN BEGIN LSetSelect(False, TheCell, ThePathList); SetPt(ThePathCell, 0, 0); END; { Should we scroll? } IF (ThePoint.h > ThePathList^^.rView.Left) AND (ThePoint.h < ThePathList^^.rView.Right) THEN BEGIN { Up or down? } IF (ThePoint.v >= ThePathList^^.rView.Top) THEN BEGIN SetPt(TheCell, 0, ((ThePathList^^.rView.Bottom - ThePathList^^.rView.Top + 1) DIV ThePathList^^.CellSize.v) + Offset); IF TheCell.v < ThePathList^^.dataBounds.Bottom THEN BEGIN LScroll(0, 1, ThePathList); IF Offset < ThePathList^^.dataBounds.Bottom THEN Offset := Offset + 1; END; END ELSE BEGIN SetPt(TheCell, 0, ((ThePathList^^.rView.Top - 1) DIV ThePathList^^.CellSize.v) + Offset); IF TheCell.v > 0 THEN BEGIN LScroll(0, -1, ThePathList); IF Offset > 0 THEN Offset := Offset - 1; END; END; END; END ELSE BEGIN { We are in the menu } SetPt(TheCell, 0, 0); IF LGetSelect(True, TheCell, ThePathList) THEN BEGIN SetPt(TheNewCell, 0, ((ThePoint.v - ThePathList^^.rView.Top) DIV ThePathList^^.CellSize.v) + Offset); { Do we need to select a cell? } IF TheNewCell.v <> TheCell.v THEN BEGIN LSetSelect(False, TheCell, ThePathList); LSetSelect(True, TheNewCell, ThePathList); ThePathCell := TheNewCell; END; END ELSE BEGIN { Nothing turned on so turn something on } SetPt(TheCell, 0, ((ThePoint.v - ThePathList^^.rView.Top) DIV ThePathList^^.CellSize.v) + Offset); LSetSelect(True, TheCell, ThePathList); ThePathCell := TheCell; END; END; END; { Scroll menu back } IF Offset > 0 THEN BEGIN LDoDraw(False, ThePathList); LScroll(0, -Offset, ThePathList); LDoDraw(True, ThePathList); END; ClickLoop := False; END; FUNCTION ChangeDirectory (VRefNum: Integer; TheFolder: Str255): Integer; { Change the working directory } VAR ParamBlock: CInfoPBPtr; WDBlock: WDPBPtr; Err: OSErr; BEGIN ParamBlock := CInfoPBPtr(NewPtr(SizeOf(CInfoPBRec))); WDBlock := WDPBPtr(NewPtr(SizeOf(WDPBRec))); { Find out where we are } Err := NoErr; WITH WDBlock^ DO BEGIN ioCompletion := NIL; ioNamePtr := NIL; ioVRefNum := VRefNum; ioWDIndex := 0; ioWDProcID := 0; END; Err := PBGetWDInfo(WDBlock, False); { Open directory named TheFolder. } { You would think Apple would provide } { more higher level routines to do this } { kind of work. } ParamBlock^.ioDrParID := WDBlock^.ioWDDirID; WITH ParamBlock^ DO BEGIN ioCompletion := NIL; ioNamePtr := @TheFolder; ioVRefNum := VRefNum; ioDrDirID := 0; ioDirID := 0; ioFVersNum := 0; ioFDirIndex := 0; END; Err := PBGetCatInfo(ParamBlock, False); { Open working directory } WITH WDBlock^ DO BEGIN ioCompletion := NIL; ioNamePtr := NIL; ioVRefNum := VRefNum; ioWDDirID := ParamBlock^.ioDrDirID; ioWDProcID := 0; END; Err := PBOpenWD(WDBlock, False); IF Err <> NoErr THEN ChangeDirectory := 0 ELSE ChangeDirectory := WDBlock^.ioVRefNum; DisposPtr(Ptr(ParamBlock)); END; FUNCTION FindParent (VRefNum: Integer; Levels: Integer): Integer; { From a given working directory, find working directory number for that directory. } VAR ParamBlock: CInfoPBPtr; WDBlock: WDPBPtr; Err: OSErr; i: Integer; TheName: Str255; BEGIN ParamBlock := CInfoPBPtr(NewPtr(SizeOf(CInfoPBRec))); WDBlock := WDPBPtr(NewPtr(SizeOf(WDPBRec))); Err := NoErr; WITH WDBlock^ DO BEGIN ioCompletion := NIL; ioNamePtr := NIL; ioVRefNum := VRefNum; ioWDIndex := 0; ioWDProcID := 0; END; Err := PBGetWDInfo(WDBlock, False); { Find directory ID } ParamBlock^.ioDrParID := WDBlock^.ioWDDirID; i := 1; WHILE (Err = NoErr) AND (i <= (Levels + 1)) DO BEGIN WITH ParamBlock^ DO BEGIN ioCompletion := NIL; ioNamePtr := NIL; ioVRefNum := VRefNum; ioDrDirID := 0; ioDirID := ioDrParID; { We want the parent directory name } ioFVersNum := 0; ioFDirIndex := -1; { Causes it to give information on ioDrDirID } END; Err := PBGetCatInfo(ParamBlock, False); i := i + 1; END; { Open working directory } WITH WDBlock^ DO BEGIN ioCompletion := NIL; ioNamePtr := NIL; ioVRefNum := VRefNum; ioWDDirID := ParamBlock^.ioDrDirID; ioWDProcID := 0; END; Err := PBOpenWD(WDBlock, False); IF Err <> NoErr THEN FindParent := 0 ELSE FindParent := WDBlock^.ioVRefNum; DisposPtr(Ptr(ParamBlock)); END; FUNCTION GetVRefNum (WorkingDir: Integer): Integer; { Take a working directory and convert it to a volume number } VAR Ignore: Longint; VRefNum: Integer; Err: OSErr; BEGIN { GetWDInfo is a high level equivalent of the PB routine } { but not documented in IM} Err := GetWDInfo(WorkingDir, VRefNum, Ignore, Ignore); GetVRefNum := VRefNum; END; FUNCTION GetCurWDRefNum: Integer; { Get the current system working directory } CONST CurDirStore = $398; VAR Pb: WDPBRec; DirID: Longint; Index: Integer; Err: OSErr; BEGIN BlockMove(Ptr(CurDirStore), @DirID, 4); Index := 1; REPEAT WITH Pb DO BEGIN ioCompletion := NIL; ioNamePtr := NIL; ioVRefNum := 0; ioWDIndex := Index; ioWDPROCID := 0; ioWDVRefNum := 0; END; Err := PBGetWDInfo(@Pb, True); Index := Index + 1; UNTIL (Err <> NoErr) OR (DirID = PB.ioWDDirID); IF Err = NoErr THEN GetCurWDRefNum := Pb.ioVRefNum ELSE GetCurWDRefNum := 0; END; PROCEDURE DrawFloppyDisk (Left, Top: Integer); { Draw floppy disk icon } BEGIN Moveto(Left + 5, Top + 2); Lineto(Left + 14, Top + 2); Lineto(Left + 16, Top + 4); Lineto(Left + 16, Top + 13); Lineto(Left + 5, Top + 13); Moveto(Left + 4, Top + 12); Lineto(Left + 4, Top + 3); Moveto(Left + 13, Top + 3); Lineto(Left + 13, Top + 5); Moveto(Left + 12, Top + 6); Lineto(Left + 8, Top + 6); Moveto(Left + 7, Top + 5); Lineto(Left + 7, Top + 3); Moveto(Left + 11, Top + 3); Lineto(Left + 11, Top + 4); Moveto(Left + 7, Top + 12); Lineto(Left + 7, Top + 10); Moveto(Left + 8, Top + 9); Lineto(Left + 12, Top + 9); Moveto(Left + 13, Top + 10); Lineto(Left + 13, Top + 12); END; PROCEDURE DrawHardDrive (Left, Top: Integer); { Draw hard disk icon } BEGIN Moveto(Left + 3, Top + 6); Lineto(Left + 3, Top + 9); Moveto(Left + 4, Top + 10); Lineto(Left + 18, Top + 10); Moveto(Left + 19, Top + 9); Lineto(Left + 19, Top + 6); Moveto(Left + 18, Top + 5); Lineto(Left + 4, Top + 5); Moveto(Left + 5, Top + 8); Lineto(Left + 5, Top + 8); END; PROCEDURE TrimVolumeName (Area: Rect; Offset: Integer; VAR TheVolume: Str255); { the volume name down to size and add a '...' } VAR TheLength: Integer; TrimmedVolume: Str255; BEGIN TheLength := (Area.Right - Area.Left) - Offset; IF Thelength >= StringWidth(TheVolume) THEN Exit(TrimVolumeName); TrimmedVolume := Concat(Omit(TheVolume, Length(TheVolume), 1), CHR($C9)); WHILE StringWidth(TrimmedVolume) >= TheLength DO BEGIN TrimmedVolume := Concat(Omit(TrimmedVolume, Length(TrimmedVolume) - 1, 2), CHR($C9)); END; TheVolume := TrimmedVolume; END; PROCEDURE CSFVolumeBox.Draw (VAR Area: Rect); Override; { Draw the icon and then the volume name } VAR TheVolume: Str255; VRefNum: Integer; Err: OSErr; BEGIN EraseRect(Area); Err := GetVol(@TheVolume, VRefNum); IF CSFWindow(ItsEnclosure).CheckDrives THEN BEGIN { Check floopy drives } IF (CSFWindow(ItsEnclosure).fDrive1 = GetVRefNum(VRefNum)) OR (CSFWindow(ItsEnclosure).fDrive2 = GetVRefNum(VRefNum)) THEN DrawFloppyDisk(0, 0) ELSE DrawHardDrive(0, 0); END ELSE DrawHardDrive(0, 0); TrimVolumeName(Frame, 23, TheVolume); Moveto(23, 12); DrawString(TheVolume); END; PROCEDURE CSFVolumeBox.DoClick (hitPt: Point; modifierKeys: integer; when: longint); Override; { Change directory if clicked in } VAR TheWindow: CSFWindow; Temp: Integer; BEGIN { Step up one directory level } TheWindow := CSFWindow(ItsEnclosure); Temp := FindParent(TheWindow.fCurrentWD, 1); IF Temp <> 0 THEN BEGIN TheWindow.fCurrentWD := Temp; TheWindow.FillDialog(TheWindow.fCurrentWD); TheWindow.FindPath(TheWindow.fCurrentWD); CSFWindow(ItsEnclosure).DoStatus; END; INHERITED DoClick(hitPt, modifierKeys, when); END; PROCEDURE CSFEditText.IEditText (anEnclosure: CView; aSupervisor: CBureaucrat; aWidth, aHeight, aHEncl, aVEncl: integer; aHSizing, aVSizing: SizingOption; aLineWidth: integer); Override; { Initialize the text edit box } BEGIN INHERITED IEditText(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, aVEncl, aHSizing, aVSizing, aLineWidth); { Override settext to insert different text } SetText; END; PROCEDURE CSFEditText.DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord); Override; { We have to intercept special keys to process them as clicks instead } BEGIN CASE keyCode OF $24, $34: { return or enter } DoCommand(kSaveButton); $30: { tab } DoCommand(kDriveButton); OTHERWISE INHERITED DoKeyDown(theChar, keyCode, macEvent); END; { Did we delete everything? } IF IsEmpty THEN BEGIN IF NOT fEmpty THEN BEGIN fEmpty := True; DoCommand(kEmptyText); END; END ELSE BEGIN IF fEmpty THEN BEGIN fEmpty := False; DoCommand(kNonEmptyText); END; END; END; FUNCTION CSFEditText.IsEmpty: Boolean; { Is the party over? } VAR DataLength: Longint; BEGIN DataLength := macTE^^.teLength; IF DataLength = 0 THEN IsEmpty := True ELSE IsEmpty := False; END; PROCEDURE CSFEditText.SetText; { Set the initial text in the edit box } BEGIN fEmpty := False; SetTextString('Untitled'); DoCommand(kNonEmptyText); END; PROCEDURE CSFEditText.Dawdle (VAR maxSleep: Longint); Override; { Is the edit box empty for any other reason, then notify the dialog } BEGIN INHERITED Dawdle(maxSleep); IF IsEmpty THEN BEGIN IF NOT fEmpty THEN BEGIN fEmpty := True; DoCommand(kEmptyText); END; END ELSE BEGIN IF fEmpty THEN BEGIN fEmpty := False; DoCommand(kNonEmptyText); END; END; END; PROCEDURE CSFEditText.SelectText; { Highlite everything } BEGIN TESetSelect(0, Maxint, macTe); END; FUNCTION CSFEditText.GetStr255: Str255; { Return a Pascal string of the first 255 characters } VAR Temp: Str255; DataLength: Longint; TheCharsHandle: CharsHandle; BEGIN Temp := ''; DataLength := macTE^^.teLength; IF DataLength > 0 THEN BEGIN IF DataLength > 255 THEN DataLength := 255; BlockMove(Ptr(Longint(@DataLength) + 3), @Temp, 1); TheCharsHandle := GetTextHandle; HLock(Handle(TheCharsHandle)); BlockMove(Ptr(TheCharsHandle^), Ptr(Longint(@Temp) + 1), DataLength); HUnLock(Handle(TheCharsHandle)); END; GetStr255 := Temp; END; PROCEDURE CSFWindow.ICSFWindow (TheDirector: CDirector); { Initialize the window. Do not override. } VAR TheSize, ViewRect, DataBounds, TheRect: Rect; CellSize: Point; Err: OSErr; TheText, TheName: Str255; TheLength, h, v, TheWidth, TheCenter, Ignore: Integer; BEGIN { Init the window } IWindow(9999, False, gDeskTop, TheDirector); Prepare; TextFont(SystemFont); Move(100, 100); SetTitle('Open'); SetRect(TheSize, 0, 0, 70, kButtonHeight); { Create some buttons } New(fEject); fEject.IButton(KPushButton, Self, Self); fEject.SetClickCmd(kEjectButton); fEject.ChangeSize(TheSize, False); fEject.SetTitle('Eject'); IF NOT CheckDrives THEN fEject.Deactivate; fEject.Show; New(fDrive); fDrive.IButton(KPushButton, Self, Self); fDrive.SetClickCmd(kDriveButton); fDrive.ChangeSize(TheSize, False); fDrive.SetTitle('Drive'); IF CountDrives = 1 THEN fDrive.Deactivate; fDrive.Show; New(fCancel); fCancel.IButton(KPushButton, Self, Self); fCancel.SetClickCmd(kCancelButton); fCancel.ChangeSize(TheSize, False); fCancel.SetTitle('Cancel'); fCancel.Show; { Create the main file box } SetfViewRect; SetRect(DataBounds, 0, 0, 1, 0); SetPt(CellSize, 1000, 16); ClipRect(GetMacPort^.PortRect); fFileList := LNew(fViewRect, DataBounds, CellSize, 13000, GetMacPort, True, False, False, True); fFileList^^.selFlags := lOnlyOne; SetRect(fViewRect, fViewRect.Left, fViewRect.Top, fViewRect.Right + kScrollBarWidth, fViewRect.Bottom); InsetRect(fViewRect, -1, -1); FrameRect(fViewRect); fCurrentWD := GetCurWDRefNum; { Fill the pull down menu } Err := GetVol(@TheName, Ignore); TheWidth := StringWidth(TheName) + 28; TheCenter := (fViewRect.Right - fViewRect.Left + 16) DIV 2; SetRect(fPathRect, TheCenter - (TheWidth DIV 2), fViewRect.Top - 23, TheCenter + (TheWidth DIV 2), fViewRect.Top - 7); SetRect(DataBounds, 0, 0, 1, 0); SetPt(CellSize, 1000, 16); ClipRect(GetMacPort^.PortRect); fPathList := LNew(fPathRect, DataBounds, CellSize, 13000, GetMacPort, True, False, False, False); fPathList^^.LClikLoop := @ClickLoop; ThePathList := fPathList; FindPath(fCurrentWD); FrameRect(fPathRect); DropShadow(fPathRect); { Here is where your initializations occur } MoreInitializations; New(fVolumeBox); fVolumeBox.IPane(Self, Self, (MacPort^.PortRect.Right - 3) - (fViewRect.Right + 3), 16, fViewRect.Right + 3, fViewRect.Top, sizFIXEDLEFT, sizFIXEDTOP); fVolumeBox.SetWantsClicks(True); fVolumeBox.Show; fDriveIndex := 0; fGood := False; fName := ''; fVName := ''; { Show the window } Select; fInitTime := True; END; PROCEDURE CSFWindow.MoreInitializations; { Override me! } BEGIN { Does nothing } END; PROCEDURE CSFWindow.SetfViewRect; { Set the file box rect } BEGIN SetRect(fViewRect, 10, 30, 170, 158); END; PROCEDURE CSFWindow.DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord); Override; { Intercept the tab key } BEGIN CASE keyCode OF $30: { tab } DoCommand(kDriveButton); OTHERWISE INHERITED DoKeyDown(theChar, keyCode, macEvent); END; END; PROCEDURE CSFWindow.DoCommand (TheCommand: Longint); Override; { Handle basic commands } BEGIN CASE (TheCommand) OF kCancelButton: DoCancel; kEjectButton: DoEject; kDriveButton: DoDrive; cmdDiskEvent: DoStatus; OTHERWISE INHERITED DoCommand(TheCommand); END; END; PROCEDURE CSFWindow.Update; Override; VAR savePort: GrafPtr;{ The current port } updateRect: Rect; { Bounding box of update region } BEGIN GetPort(savePort);{ Save the original port } Prepare; BeginUpdate(macPort); { Start the update process } { This restricts the visible area } { to just the update region, } { meaning that no drawing will } { occur outside this region } ClipRect(macPort^.portRect); { Clip to the entire window } { Your updates occur here } MoreUpdates; IF itsSubviews <> NIL THEN BEGIN { Draw all subviews } updateRect := macPort^.visRgn^^.rgnBBox; itsSubviews.DoForEach1(Pane_Draw, @updateRect); END; EndUpdate(macPort); { End the update process } SetPort(savePort);{ Restore the original port } END; PROCEDURE CSFWindow.MoreUpdates; { Override to do your updates } VAR TheRect: Rect; BEGIN { update the file box } LUpdate(macPort^.VisRgn, fFileList); FrameRect(fViewRect); { update the pull down menu } LUpdate(MacPort^.VisRgn, fPathList); FrameRect(fPathRect); DropShadow(fPathRect); END; PROCEDURE CSFWindow.Free; Override; { Dispose of the buttons and stuff } BEGIN fEject.Free; fDrive.Free; fCancel.Free; LDispose(fFileList); LDispose(fPathList); INHERITED Free; END; PROCEDURE CSFWindow.Activate; Override; { Set up globals and disable function keys } VAR TheCell: Cell; BEGIN INHERITED Activate; FKeyEnable(False); gGopher := Self; ThePathList := fPathList; FillDialog(fCurrentWD); { if theis a new window then select } IF fInitTime THEN BEGIN SetPt(TheCell, 0, 0); LSetSelect(True, TheCell, fFileList); fInitTime := False END; DoStatus; END; PROCEDURE CSFWindow.Deactivate; Override; { Clean up after ourselves } BEGIN FKeyEnable(True); INHERITED Deactivate; END; PROCEDURE CSFWindow.Close; Override; { The party is over } BEGIN FKeyEnable(True); INHERITED Close; END; FUNCTION CSFWindow.CountDrives: Integer; { Count the number of mounted volumes } VAR Index, Count: Integer; Err: OSErr; PB: HParamBlockRec; BEGIN IF CheckDrives THEN ; Index := 0; Count := 0; Err := NoErr; WHILE Err <> nsvErr DO BEGIN Index := Index + 1; WITH PB DO BEGIN ioCompletion := NIL; ioNamePtr := NIL; ioVolIndex := Index; END; Err := PBHGetVInfo(@PB, False); IF (PB.ioVDrvInfo = 0) AND NOT (Err = nsvErr) THEN BEGIN Err := NoErr; Cycle; END; IF Err <> nsvErr THEN Count := Count + 1; END; CountDrives := Count; END; FUNCTION CSFWindow.GetNextVol: Integer; { Find the next mounted volume } VAR Index: Integer; Err: OSErr; PB: HParamBlockRec; BEGIN IF CheckDrives THEN ; Index := fDriveIndex; Err := paramErr; WHILE Err <> NoErr DO BEGIN Index := Index + 1; WITH PB DO BEGIN ioCompletion := NIL; ioNamePtr := NIL; ioVolIndex := Index; END; Err := PBHGetVInfo(@PB, False); IF (PB.ioVDrvInfo = 0) AND NOT (Err = nsvErr) THEN BEGIN Err := nsvErr; Cycle; END; IF Err = nsvErr THEN Index := 0; END; fDriveIndex := Index; GetNextVol := PB.ioVRefNum; END; FUNCTION CSFWindow.CheckDrives: Boolean; { Check the status of the floppy disk drives } VAR FreeBytes: Longint; Err, Ignore: OSErr; Index: Integer; Status: DrvSts; BEGIN CheckDrives := False; fDrive1 := 0; fDrive2 := 0; Err := DriveStatus(1, Status); IF (Status.Installed = 1) AND (Status.DiskInPlace <> 0) THEN Ignore := GetVInfo(1, NIL, fDrive1, FreeBytes); Err := DriveStatus(2, Status); IF (Status.Installed = 1) AND (Status.DiskInPlace <> 0) THEN Ignore := GetVInfo(2, NIL, fDrive2, FreeBytes); IF (fDrive1 <> 0) OR (fDrive2 <> 0) THEN CheckDrives := True; END; PROCEDURE CSFWindow.DoEject; { Eject a floppy disk } VAR WorkingDir: Integer; b: boolean; BEGIN IF fDriveIndex <> 1 THEN BEGIN b := gError.CheckOSError(Eject(NIL, fCurrentWD)); fCurrentWD := GetNextVol; FillDialog(fCurrentWD); FindPath(fCurrentWD); DoStatus; END; END; PROCEDURE CSFWindow.DoDrive; { Change drives } BEGIN IF fDrive.IsActive THEN BEGIN fCurrentWD := GetNextVol; FillDialog(fCurrentWD); FindPath(fCurrentWD); DoStatus; END; END; PROCEDURE CSFWindow.DoCancel; { Close the window } { Override this method to cancel your operations } BEGIN Close; END; PROCEDURE CSFWindow.DoStatus; { Bring buttons upto date } VAR Err: OSErr; VRefNum: Integer; BEGIN { more than one volume mounted } IF CountDrives > 1 THEN fDrive.Activate ELSE fDrive.Deactivate; { Ejectable disks in place } IF CheckDrives THEN BEGIN IF (GetVRefNum(fCurrentWD) = fDrive1) OR (GetVRefNum(fCurrentWD) = fDrive2) THEN fEject.Activate ELSE fEject.Deactivate; END ELSE BEGIN fEject.Deactivate; END; fVolumeBox.Refresh; END; PROCEDURE CSFWindow.DoClick (hitPt: Point; modifierKeys: integer; when: longint); Override; { Handle clicks in the file box and the puldown menu } VAR b: Boolean; TheCell: Cell; TheLength: Integer; TheDirectory, TheName: Str255; TheRect: Rect; TheSelection: Str255; Temp: Integer; Err: OSErr; BEGIN { Click in file box? } IF PtInRect(hitPt, fViewRect) THEN BEGIN Prepare; ClipRect(MacPort^.PortRect); B := LClick(hitPt, modifierKeys, fFileList); TheSelection := FindSelection; { Inactive } IF TheSelection[1] = '-' THEN BEGIN SetPt(TheCell, 0, 0); IF LGetSelect(True, TheCell, fFileList) THEN BEGIN LSetSelect(False, TheCell, fFileList); DoStatus; END; END { Open the file of directory } ELSE IF (gClicks > 1) THEN BEGIN IF TheSelection[1] = '+' THEN BEGIN IF TheSelection[2] = '@' THEN BEGIN { Directory } fCurrentWD := ChangeDirectory(fCurrentWD, Omit(TheSelection, 1, 2)); FillDialog(fCurrentWD); FindPath(fCurrentWD); DoStatus; END ELSE BEGIN { File } fGood := True; fName := Omit(TheSelection, 1, 2); Err := GetVol(@fVName, Temp); DoCommand(kSelection); END; END; END; END; { Pull down menu } IF PtInRect(hitPt, fPathRect) THEN BEGIN Prepare; ClipRect(MacPort^.PortRect); LSize(fMenuWidth, fMenuHeight, fPathList); fPathRect := fPathList^^.rView; InsetRect(fPathRect, -1, -1); EraseRect(fPathRect); FrameRect(fPathRect); DropShadow(fPathRect); LUpdate(MacPort^.VisRgn, fPathList); B := LClick(hitPt, modifierKeys, fPathList); LSetSelect(False, ThePathCell, fPathList); IF ThePathCell.v > 0 THEN BEGIN { Move up directory tree } fCurrentWD := FindParent(fCurrentWD, ThePathCell.v); FillDialog(fCurrentWD); FindPath(fCurrentWD); END ELSE BEGIN SetPathRect; END; END; INHERITED DoClick(hitPt, modifierKeys, when); END; FUNCTION CSFWindow.FileFilter (ParamBlock: CInfoPBPtr): Boolean; { Filter out unwanted files from showing in the file box } BEGIN { False means to show the file } FileFilter := False; END; FUNCTION CSFWindow.ActiveFilter (ParamBlock: CInfoPBPtr): Boolean; { Activate the file--not grayed out } BEGIN ActiveFilter := True; END; PROCEDURE CSFWindow.FillDialog (VRefNum: Integer); { Read the directory and fill the file box } VAR Err: OSErr; Count, Index: Integer; TheTitle: Str255; ParamBlock: CInfoPBPtr; TheName: Str255; TheCell: Cell; BEGIN Err := SetVol(NIL, VRefNum); ParamBlock := CInfoPBPtr(NewPtr(SizeOf(CInfoPBRec))); Index := 1; TheCell.h := 0; Err := NoErr; LDoDraw(False, fFileList); LDelRow(0, 0, fFileList); WHILE (Err = NoErr) DO BEGIN TheName := ''; WITH ParamBlock^ DO BEGIN ioCompletion := NIL; ioNamePtr := @TheName; ioVRefNum := VRefNum; ioDirID := 0; ioDrDirID := 0; ioFVersNum := 0; ioFDirIndex := Index; END; Err := PBGetCatInfo(ParamBlock, False); IF (Err = fnfErr) THEN Leave; IF Err <> NoErr THEN BEGIN { Ka-Boom } Index := RedAlert(kSystemError); Leave; END; { Include file or directory? } IF FileFilter(ParamBlock) THEN BEGIN Cycle; END; { Is it a directory } IF IsDirectory(ParamBlock) THEN BEGIN TheName := Concat('@', TheName); END ELSE BEGIN IF ParamBlock^.ioFlFndrInfo.fdType = 'APPL' THEN TheName := Concat('#', TheName) ELSE TheName := Concat('!', TheName); END; { Grayed? } IF ActiveFilter(ParamBlock) THEN BEGIN { Activate } TheName := Concat('+', TheName); END ELSE BEGIN { Dectivate } TheName := Concat('-', TheName); END; { Stuff it } TheCell.v := LAddRow(1, Maxint, fFileList); LSetCell(Ptr(@TheName[1]), Length(TheName), TheCell, fFileList); Index := Index + 1; END; LDoDraw(True, fFileList); Prepare; ClipRect(GetMacPort^.PortRect); EraseRect(fFileList^^.rView); LUpdate(MacPort^.VisRgn, fFileList); DisposPtr(Ptr(ParamBlock)); END; PROCEDURE CSFWindow.SetPathRect; { Find the pull down menu rect } VAR TheString, TheDirectory: Str255; TheCell: Cell; TheLength: Integer; TheRect: Rect; BEGIN { Out with the old } TheRect := fPathRect; InsetRect(TheRect, -1, -1); EraseRect(TheRect); InvalRect(TheRect); SetPt(TheCell, 0, 0); IF LGetSelect(True, TheCell, fPathList) THEN ; TheDirectory := GetCellContents(TheCell, fPathList); TheLength := StringWidth(TheDirectory) + 28; LSize(TheLength, fPathList^^.CellSize.v, fPathList); fPathList^^.rView.Left := (((fViewRect.Right - fViewRect.Left + 16) DIV 2) + fViewRect.Left) - (TheLength DIV 2); fPathList^^.rView.Right := fPathList^^.rView.Left + TheLength; fPathRect := fPathList^^.rView; SetPt(TheCell, 0, 0); TheString := GetCellContents(TheCell, fPathList); TheString := Omit(TheString, 1, 2); TheLength := StringWidth(TheString); fPathRect := fPathList^^.rView; fPathRect.Right := fPathRect.Left + TheLength + 28; InsetRect(fPathRect, -1, -1); { In with the new } InvalRect(TheRect); TheRect := fPathRect; InsetRect(TheRect, -1, -1); InvalRect(TheRect); EraseRect(TheRect); Update; END; PROCEDURE CSFWindow.FindPath (VRefNum: Integer); { Fill the pull down menu } VAR ParamBlock: CInfoPBPtr; TheName, LastName: Str255; Err: OSErr; TheCell: Cell; TheWidth, PathWidth, Ignore: Integer; FirstWidth: Boolean; BEGIN IF VRefNum = 0 THEN Err := GetVol(NIL, VRefNum); Err := SetVol(NIL, VRefNum); LastName := ''; FirstWidth := True; fMenuWidth := 0; fMenuHeight := 0; { Clear the List } LDoDraw(False, fPathList); LDelRow(0, 0, fPathList); ParamBlock := CInfoPBPtr(NewPtr(SizeOf(CInfoPBRec))); WITH ParamBlock^ DO BEGIN ioCompletion := NIL; ioNamePtr := NIL; ioVRefNum := VRefNum; ioDirID := 0; ioFVersNum := 0; ioFDirIndex := 0; END; Err := PBGetCatInfo(ParamBlock, False); Err := NoErr; WHILE Err = NoErr DO BEGIN TheName := ''; WITH ParamBlock^ DO BEGIN ioCompletion := NIL; ioNamePtr := @TheName; ioVRefNum := VRefNum; ioDirID := 0; ioDrDirID := ioDrParID; { We want the parent directory name } ioFVersNum := 0; ioFDirIndex := -1; { Causes it to give information on ioDrDirID } END; Err := PBGetCatInfo(ParamBlock, False); IF Err = NoErr THEN BEGIN { Determine a length and compare it, if it is larger then store the value } TheWidth := StringWidth(TheName) + 28; IF FirstWidth THEN BEGIN FirstWidth := False; PathWidth := TheWidth; END; IF TheWidth > fMenuWidth THEN fMenuWidth := TheWidth; LastName := TheName; { Add a new row to the list } TheName := Concat('+$', TheName); TheCell.h := 0; TheCell.v := LAddRow(1, Maxint, fPathList); LSetCell(Ptr(@TheName[1]), Length(TheName), TheCell, fPathList); { Increment the height } fMenuHeight := fMenuHeight + 16; END ELSE BEGIN { Change the icon of the last item } IF LastName <> '' THEN BEGIN Ignore := GetVol(NIL, VRefNum); IF CheckDrives THEN BEGIN IF (fDrive1 = GetVRefNum(VRefNum)) OR (fDrive2 = GetVRefNum(VRefNum)) THEN TheName := Concat('+^', LastName) ELSE TheName := Concat('+%', LastName); END ELSE TheName := Concat('+%', LastName); LSetCell(Ptr(@TheName[1]), Length(TheName), TheCell, fPathList); END ELSE sysbeep(1); END; END; IF fMenuHeight >= (MacPort^.PortRect.Bottom - fPathRect.Top - 10) THEN fMenuHeight := ((MacPort^.PortRect.Bottom - fPathRect.Top - 10) DIV 16) * 16; InsetRect(fPathRect, -1, -1); EraseRect(fPathRect); LSize(fMenuWidth, 16, fPathList); LDoDraw(True, fPathList); SetPathRect; FrameRect(fPathRect); DropShadow(fPathRect); DisposPtr(Ptr(ParamBlock)); END; FUNCTION CSFWindow.FindSelection: Str255; { Find the first selected item in the file box } VAR TheCell: Cell; BEGIN SetPt(TheCell, 0, 0); IF LGetSelect(True, TheCell, fFileList) THEN FindSelection := GetCellContents(TheCell, fFileList) ELSE FindSelection := ''; END; PROCEDURE CSFWindow.DoSelection; { Set up the SFReply } VAR TheReply: SFReply; FndrInfo: FInfo; Err: OSErr; BEGIN { Set up the reply } WITH TheReply DO BEGIN Good := fGood; Copy := False; Err := GetFInfo(Self.fName, fCurrentWD, FndrInfo); fType := FndrInfo.fdType; vRefNum := fCurrentWD; Version := 0; fName := Self.fName; END; FileSelected(TheReply); END; PROCEDURE CSFWindow.FileSelected (TheReply: SFReply); { Override me!!!!!!!!! This where you handle the reply. } BEGIN Sysbeep(1); END; FUNCTION CSFWindow.RedAlert (AlertID: Integer): Integer; { Display error alerts } CONST kAlertOffset = 15; TYPE AlertTHndl = ^AlertTPtr; AlertTPtr = ^AlertTemplate; VAR TheAlert: AlertTHndl; TheAlertRect, TheRect, TheBounds, TheFrame: Rect; ThePoint: Point; BEGIN { Get the alert } TheAlert := AlertTHndl(GetResource('ALRT', AlertID)); HNoPurge(Handle(TheAlert)); { Move the alert } TheAlertRect := TheAlert^^.boundsRect; gDeskTop.GetBounds(TheBounds); TheFrame := MacPort^.PortRect; LocalToGlobal(TheFrame.TopLeft); LocalToGlobal(TheFrame.BotRight); IF SectRect(TheBounds, TheFrame, TheRect) THEN BEGIN ThePoint.v := TheRect.Bottom - TheAlertRect.Bottom - kAlertOffset; ThePoint.h := TheRect.Left + kAlertOffset; IF NOT PtInRect(ThePoint, TheBounds) THEN BEGIN IF ThePoint.v < TheBounds.Left THEN ThePoint.v := TheBounds.Left; IF ThePoint.h < TheBounds.Top THEN ThePoint.h := TheBounds.Top; END; SetRect(TheAlertRect, ThePoint.h, ThePoint.v, ThePoint.h + TheAlert^^.boundsRect.Right, ThePoint.v + TheAlert^^.boundsRect.Bottom); IF TheAlertRect.Right > TheBounds.Right THEN BEGIN TheAlertRect.Left := TheAlertRect.Left - (TheAlertRect.Right - TheBounds.Right); TheAlertRect.Right := TheAlertRect.Left + (TheAlertRect.Right - TheBounds.Right); END; IF TheAlertRect.Bottom > TheBounds.Bottom THEN BEGIN TheAlertRect.Top := TheAlertRect.Top - (TheAlertRect.Bottom - TheBounds.Bottom); TheAlertRect.Bottom := TheAlertRect.Top + (TheAlertRect.Bottom - TheBounds.Bottom); END; END ELSE BEGIN SetRect(TheAlertRect, TheAlertRect.Left + 100, TheAlertRect.Top + 100, TheAlertRect.Right + 100, TheAlertRect.Bottom + 100); END; { Display the alert } TheAlert^^.boundsRect := TheAlertRect; RedAlert := Alert(AlertID, NIL); HPurge(Handle(TheAlert)); ReleaseResource(Handle(TheAlert)); END; PROCEDURE CSFGetWindow.MoreInitializations; Override; { Follow this example to do your initializations } VAR TheSize: Rect; BEGIN fEject.Offset(kGetButtonOffset, 76, True); fDrive.Offset(kGetButtonOffset, 101, True); fCancel.Offset(kGetButtonOffset, 171, True); SetRect(TheSize, 0, 0, 70, kButtonHeight); New(fOpen); fOpen.IButton(KPushButton, Self, Self); fOpen.SetClickCmd(kOpenButton); fOpen.ChangeSize(TheSize, False); fOpen.Offset(kGetButtonOffset, 146, False); fOpen.SetTitle('Open'); fOpen.Deactivate; fOpen.Show; ChangeSize(363, 215); END; PROCEDURE CSFGetWindow.DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord); Override; { Special key handling } BEGIN CASE keyCode OF $24, $34: DoCommand(kOpenButton); OTHERWISE INHERITED DoKeyDown(theChar, keyCode, macEvent); END; END; PROCEDURE CSFGetWindow.SetfViewRect; Override; { Resize the file box } BEGIN SetRect(fViewRect, 20, 47, 237 - kScrollBarWidth, 47 + (9 * 16)); END; PROCEDURE CSFGetWindow.DoCommand (TheCommand: Longint); Override; { Do the commands for this subclass } BEGIN CASE TheCommand OF kOpenButton: DoOpen; kSelection: DoSelection; OTHERWISE INHERITED DoCommand(TheCommand); END; END; PROCEDURE CSFGetWindow.MoreUpdates; Override; { Add our updates } BEGIN INHERITED MoreUpdates; PenPat(Gray); Moveto(260, 132); Lineto(338, 132); PenNormal; END; PROCEDURE CSFGetWindow.DoStatus; Override; { Add the open button to the status logic } VAR TheCell: Cell; BEGIN INHERITED DoStatus; SetPt(TheCell, 0, 0); IF LGetSelect(True, TheCell, fFileList) THEN BEGIN fOpen.Activate; END ELSE BEGIN fOpen.Deactivate; END; END; PROCEDURE CSFGetWindow.DoClick (hitPt: Point; modifierKeys: integer; when: longint); Override; { Make sure we have the correct file selected } VAR TheCell: Cell; SaveDirectory: Integer; BEGIN SaveDirectory := fCurrentWD; INHERITED DoClick(hitPt, modifierKeys, when); IF (SaveDirectory <> fCurrentWD) AND (fFileList^^.dataBounds.Bottom > 0) THEN BEGIN Prepare; ClipRect(MacPort^.PortRect); SetPt(TheCell, 0, 0); LSetSelect(True, TheCell, fFileList); END; SetPt(TheCell, 0, 0); IF LGetSelect(True, TheCell, fFileList) THEN BEGIN fOpen.Activate; END ELSE BEGIN fOpen.Deactivate; END; END; PROCEDURE CSFGetWindow.Free; Override; { Get rid of the open button } BEGIN fOpen.Free; INHERITED Free; END; PROCEDURE CSFGetWindow.DoOpen; { Respond to the open button } VAR TheRect: Rect; TheSelection: Str255; TheCell: Cell; Temp: Integer; Err: OSErr; BEGIN IF fOpen.IsActive THEN BEGIN TheSelection := FindSelection; IF TheSelection[1] = '+' THEN BEGIN IF TheSelection[2] = '@' THEN BEGIN { Directory selected } fCurrentWD := ChangeDirectory(fCurrentWD, Omit(TheSelection, 1, 2)); FillDialog(fCurrentWD); FindPath(fCurrentWD); TheRect := fPathRect; InsetRect(TheRect, -1, -1); InvalRect(TheRect); EraseRect(TheRect); Update; DoStatus; Prepare; ClipRect(MacPort^.PortRect); SetPt(TheCell, 0, 0); LSetSelect(True, TheCell, fFileList); IF LGetSelect(True, TheCell, fFileList) THEN fOpen.Activate; END ELSE BEGIN { File selected } fGood := True; fName := Omit(TheSelection, 1, 2); Err := GetVol(@fVName, Temp); DoCommand(kSelection); END; END; END; END; PROCEDURE CSFSaveWindow.MoreInitializations; Override; { Move existing buttons and add the save button and edit box } VAR TheSize: Rect; BEGIN fEject.Offset(kSaveButtonOffset, 64, True); fDrive.Offset(kSaveButtonOffset, 90, True); fCancel.Offset(kSaveButtonOffset, 166, True); SetRect(TheSize, 0, 0, 70, kButtonHeight); New(fSave); fSave.IButton(KPushButton, Self, Self); fSave.SetClickCmd(kSaveButton); fSave.ChangeSize(TheSize, False); fSave.Offset(kSaveButtonOffset, 140, False); fSave.SetTitle('Save'); fSave.Deactivate; fSave.Show; fPromptString := 'Save file as '; New(fFileName); fFileName.IEditText(Self, Self, fViewRect.Right - fViewRect.Left - 4, 16, fViewRect.Left + 2, fViewRect.Bottom + 30, sizFIXEDLEFT, sizFIXEDTOP, -1); fFileName.SelectText; fFileName.Show; ChangeSize(319, 199); SetTitle('Save'); END; PROCEDURE CSFSaveWindow.SetfViewRect; Override; { Move the file box } BEGIN SetRect(fViewRect, 22, 37, 204 - kScrollBarWidth, 37 + (6 * 16)); END; FUNCTION CSFSaveWindow.ActiveFilter (ParamBlock: CInfoPBPtr): Boolean; Override; { Only activate directories } BEGIN IF ParamBlock^.ioFlFndrInfo.fdType = 'APPL' THEN BEGIN ActiveFilter := False; Exit(ActiveFilter); END; IF IsDirectory(ParamBlock) THEN ActiveFilter := True ELSE ActiveFilter := False; END; PROCEDURE CSFSaveWindow.Activate; Override; { Set the gopher to the edit box } BEGIN INHERITED Activate; gGopher := fFileName; END; PROCEDURE CSFSaveWindow.DoCommand (TheCommand: Longint); Override; { Handle the commands for this subclass } BEGIN CASE TheCommand OF kSaveButton: DoSave; kSelection: DoSelection; kEmptyText: fSave.Deactivate; kNonEmptyText: fSave.Activate; OTHERWISE INHERITED DoCommand(TheCommand); END; END; PROCEDURE CSFSaveWindow.MoreUpdates; Override; { Update edit box } VAR TheRect: Rect; BEGIN INHERITED MoreUpdates; IF IsVisible THEN BEGIN TheRect := fFileName.Frame; fFileName.FrameToEnclR(TheRect); InSetRect(TheRect, -3, -3); FrameRect(TheRect); END; Moveto(fViewRect.Left, fViewRect.Bottom + 21); DrawString(fPromptString); END; PROCEDURE CSFSaveWindow.Free; Override; { Dispose of the save button and edit box } BEGIN fSave.Free; fFileName.Free; INHERITED Free; END; FUNCTION CSFSaveWindow.FileExists (vRefNum: Integer; TheName: Str255): Boolean; { Find out if the file is already on the disk } VAR FndrInfo: FInfo; Err: OSErr; Ignore: Integer; ParamBlock: CInfoPBRec; BEGIN Prepare; WITH ParamBlock DO BEGIN ioCompletion := NIL; ioNamePtr := @TheName; ioVRefNum := VRefNum; ioDrDirID := 0; ioDirID := 0; ioFVersNum := 0; ioFDirIndex := 0; END; Err := PBGetCatInfo(@ParamBlock, False); IF IsDirectory(@ParamBlock) THEN BEGIN Err := NoErr; END; CASE Err OF fnfErr: BEGIN FileExists := False; END; NoErr: BEGIN CASE Rename(TheName, vRefNum, TheName) OF fLckdErr, vLckdErr, wPrErr: BEGIN Ignore := RedAlert(kLockedDisk); FileExists := True; Exit(FileExists); END; END; ParamText(TheName, '', '', ''); IF RedAlert(kExistingFile) = 1 THEN FileExists := True ELSE FileExists := False; END; OTHERWISE BEGIN Ignore := RedAlert(kSystemError); FileExists := True; END; END; END; PROCEDURE CSFSaveWindow.DoSave; { Respond to the save button } VAR Temp: Integer; Err: OSErr; BEGIN IF fSave.IsActive THEN BEGIN fGood := True; fName := fFileName.GetStr255; Err := GetVol(@fVName, Temp); IF NOT FileExists(Temp, fName) THEN BEGIN DoCommand(kSelection); FillDialog(fCurrentWD); END; END; END; PROCEDURE CSFDialog.ICSFDialog; { Initialize and install our window subclass } BEGIN IDirector(gApplication); New(CSFWindow(ItsWindow)); CSFWindow(ItsWindow).ICSFWindow(Self); FKeyEnable(False); END; PROCEDURE CSFGetDialog.ICSFDialog; Override; { Initialize and install our window subclass } BEGIN IDirector(gApplication); New(CSFGetWindow(ItsWindow)); CSFGetWindow(ItsWindow).ICSFWindow(Self); FKeyEnable(False); END; PROCEDURE CSFSaveDialog.ICSFDialog; Override; { Initialize and install our window subclass } BEGIN IDirector(gApplication); New(CSFSaveWindow(ItsWindow)); CSFSaveWindow(ItsWindow).ICSFWindow(Self); itsGopher := CSFSaveWindow(ItsWindow).fFileName; FKeyEnable(False); END; PROCEDURE CSFSwitchboard.DoDiskEvent (macEvent: EventRecord); Override; { Intercept disk events } BEGIN INHERITED DoDiskEvent(macEvent); gGopher.DoCommand(cmdDiskEvent); END; PROCEDURE CSFApplication.ICSFApplication (extraMasters: integer; aRainyDayFund, aCreditLimit: Size); { Install the new switchboard } CONST JUMPBUFFER_A1 = 5;{ Index of A1 in JumpBuffer } BEGIN MenuDisable := LongPtr($B54);{ Low-memory global } nullStr := ''; { We haven't reached the event loop yet. } { Flag A1 (jump addr) so we don't try to jump there. } eventLoopJump[JUMPBUFFER_A1] := 0; InitToolbox; InitMemory(extraMasters, aRainyDayFund, aCreditLimit); { Instance Variables } IBureaucrat(NIL); { Install CSF switchboard } new(CSFSwitchboard(itsSwitchboard)); itsSwitchboard.ISwitchboard; new(itsDirectors); itsDirectors.ICluster; new(itsIdleChores); itsIdleChores.IList; new(itsUrgentChores); itsUrgentChores.ICluster; urgentsToDo := FALSE; running := TRUE; { Global Variables } gSignature := '????'; gHasWNE := WNEIsImplemented; gSleepTime := 0;{ We want an early first Idle } new(gError); { Cursors } gIBeamCursor := GetCursor(iBeamCursor); HNoPurge(Handle(gIBeamCursor)); gWatchCursor := GetCursor(watchCursor); HNoPurge(Handle(gWatchCursor)); gUtilRgn := NewRgn; MakeDesktop; MakeClipboard; MakeDecorator; SetUpFileParameters; SetUpMenus; gGopher := SELF; gLastViewHit := NIL; gLastMouseUp.when := 0; gClicks := 0; END; END.
Listing: StarterIntf.p UNIT StarterIntf; INTERFACE USES TCL, CSFDialogs; CONST CSFOpenCmd = 9998; CSFSaveCmd = 9999; ... TYPE CStarterApp = OBJECT(CSFApplication) ... IMPLEMENTATION END.
Listing: CStarterApp.p UNIT CStarterApp; INTERFACE USES TCL, CSFDialogs, StarterIntf; IMPLEMENTATION PROCEDURE CStarterApp.IStarterApp; BEGIN ICSFApplication(4, 20480, 2048); END; ... PROCEDURE CStarterApp.DoCommand (theCommand: longint); VAR aCSFGetDialog: CSFGetDialog; aCSFSaveDialog: CSFSaveDialog; BEGIN CASE theCommand OF CSFOpenCmd: BEGIN New(aCSFGetDialog); aCSFGetDialog.ICSFDialog END; CSFSaveCmd: BEGIN New(aCSFSaveDialog); aCSFSaveDialog.ICSFDialog END; OTHERWISE { Invoke inherited method } { to handle other commands } INHERITED DoCommand(theCommand); END; END; PROCEDURE CStarterApp.UpdateMenus; BEGIN INHERITED UpdateMenus; { Enable standard commands} gBartender.EnableCmd(CSFOpenCmd); gBartender.EnableCmd(CSFSaveCmd); END; ... END.
Listing: CStarterDoc.p UNIT CStarterDoc; INTERFACE USES TCL, CSFDialogs, StarterIntf; IMPLEMENTATION ... END.
Listing: CStarterPane.p UNIT CStarterPane; INTERFACE USES TCL, CSFDialogs, StarterIntf; IMPLEMENTATION ... END.
Listing: Starter.p PROGRAM Starter; {$I-} USES TCL, CSFDialogs, StarterIntf; BEGIN ... END. Listing: CSFLDEF.p { Written by Brendan Murphy } { Version 1.0 } { The first two bytes of cell data represent display info } { Byte 1: '+' is active, '-' is inactive } { Byte 2: Defined below } { '!': File } { '@': Closed Folder } {'#': Application } {'$': Open Folder } {'%': Hard Drive } {'^': Floppy Disk } UNIT SimpleListLDEF; { List definition for pop-up menu } INTERFACE PROCEDURE Main (message: Integer; select: Boolean; VAR TheRect: Rect; theCell: Cell; dataOffSet: Integer; dataLen: Integer; theList: ListHandle); IMPLEMENTATION PROCEDURE Main (message: Integer; select: Boolean; VAR theRect: Rect; theCell: Cell; dataOffSet: Integer; dataLen: Integer; theList: ListHandle); PROCEDURE DrawOpenFolder; BEGIN WITH TheRect DO BEGIN Moveto(Left + 17, Top + 11); Lineto(Left + 17, Top + 11); Moveto(Left + 16, Top + 10); Lineto(Left + 16, Top + 9); Moveto(Left + 15, Top + 8); Lineto(Left + 15, Top + 7); Moveto(Left + 14, Top + 6); Lineto(Left + 4, Top + 6); Moveto(Left + 4, Top + 7); Lineto(Left + 4, Top + 7); Moveto(Left + 5, Top + 8); Lineto(Left + 5, Top + 9); Moveto(Left + 6, Top + 10); Lineto(Left + 6, Top + 11); Moveto(Left + 7, Top + 12); Lineto(Left + 18, Top + 12); Lineto(Left + 18, Top + 5); Moveto(Left + 17, Top + 4); Lineto(Left + 11, Top + 4); Moveto(Left + 10, Top + 3); Lineto(Left + 7, Top + 3); Moveto(Left + 6, Top + 4); Lineto(Left + 6, Top + 5); END; END; PROCEDURE DrawClosedFolder; BEGIN WITH TheRect DO BEGIN Moveto(Left + 6, Top + 4); Lineto(Left + 6, Top + 11); Lineto(Left + 18, Top + 11); Lineto(Left + 18, Top + 5); Moveto(Left + 17, Top + 4); Lineto(Left + 11, Top + 4); Moveto(Left + 10, Top + 3); Lineto(Left + 7, Top + 3); END; END; PROCEDURE DrawFile; BEGIN WITH TheRect DO BEGIN Moveto(Left + 8, Top + 12); Lineto(Left + 8, Top + 2); Lineto(Left + 14, Top + 2); Lineto(Left + 16, Top + 4); Lineto(Left + 16, Top + 12); Lineto(Left + 8, Top + 12); Moveto(Left + 14, Top + 3); Lineto(Left + 14, Top + 4); Lineto(Left + 15, Top + 4); END; END; PROCEDURE DrawHardDrive; BEGIN WITH TheRect DO BEGIN Moveto(Left + 3, Top + 6); Lineto(Left + 3, Top + 9); Moveto(Left + 4, Top + 10); Lineto(Left + 18, Top + 10); Moveto(Left + 19, Top + 9); Lineto(Left + 19, Top + 6); Moveto(Left + 18, Top + 5); Lineto(Left + 4, Top + 5); Moveto(Left + 5, Top + 8); Lineto(Left + 5, Top + 8); END; END; PROCEDURE DrawApplication; BEGIN WITH TheRect DO BEGIN Moveto(Left + 15, Top + 10); Lineto(Left + 14, Top + 10); Lineto(Left + 12, Top + 12); Lineto(Left + 7, Top + 7); Lineto(Left + 12, Top + 2); Lineto(Left + 17, Top + 7); Lineto(Left + 16, Top + 8); Lineto(Left + 14, Top + 6); Lineto(Left + 13, Top + 6); Lineto(Left + 11, Top + 8); Lineto(Left + 14, Top + 8); Lineto(Left + 13, Top + 9); Lineto(Left + 14, Top + 10); Lineto(Left + 15, Top + 10); Pensize(2, 1); Moveto(Left + 16, Top + 9); Lineto(Left + 16, Top + 11); PenNormal; END; END; PROCEDURE DrawFloppyDisk; BEGIN WITH TheRect DO BEGIN Moveto(Left + 5, Top + 2); Lineto(Left + 14, Top + 2); Lineto(Left + 16, Top + 4); Lineto(Left + 16, Top + 13); Lineto(Left + 5, Top + 13); Moveto(Left + 4, Top + 12); Lineto(Left + 4, Top + 3); Moveto(Left + 13, Top + 3); Lineto(Left + 13, Top + 5); Moveto(Left + 12, Top + 6); Lineto(Left + 8, Top + 6); Moveto(Left + 7, Top + 5); Lineto(Left + 7, Top + 3); Moveto(Left + 11, Top + 3); Lineto(Left + 11, Top + 4); Moveto(Left + 7, Top + 12); Lineto(Left + 7, Top + 10); Moveto(Left + 8, Top + 9); Lineto(Left + 12, Top + 9); Moveto(Left + 13, Top + 10); Lineto(Left + 13, Top + 12); END; END; PROCEDURE TrimName (Area: Rect; Offset: Integer; VAR TheVolume: Str255); { Trim the name and add '...' if needed } VAR TheLength: Integer; TrimmedName: Str255; BEGIN TheLength := (Area.Right - Area.Left) - Offset; IF Thelength >= StringWidth(TheVolume) THEN Exit(TrimName); TrimmedName := Concat(Omit(TheVolume, Length(TheVolume), 1), CHR($C9)); WHILE StringWidth(TrimmedName) >= TheLength DO BEGIN TrimmedName := Concat(Omit(TrimmedName, Length(TrimmedName) - 1, 2), CHR($C9)); END; TheVolume := TrimmedName; END; PROCEDURE Initialize; { Add your initializations here } BEGIN END; PROCEDURE Close; { Reverse what ever you did for initialization here } BEGIN END; PROCEDURE DrawCell; VAR TheData: Str255; DataLength: Integer; P: Ptr; Frame: Rect; ThePattern: Pattern; Grayed: Boolean; BEGIN { Get the cell data } DataLength := 255; LGetCell(Ptr(Longint(@TheData) + 1), DataLength, TheCell, TheList); P := @TheData; P^ := Ptr(Longint(@DataLength) + 1)^; { Clear the cell } SetRect(Frame, TheRect.left + 5, TheRect.Top + 2, TheRect.left + 17, TheRect.Bottom - 2); EraseRect(TheRect); { Draw the icon } { The first two characters are info bytes } CASE (TheData[2]) OF '!': { File } DrawFile; '@': { Closed Folder } DrawClosedFolder; '#': { Application } DrawApplication; '$': { Open Folder } DrawOpenFolder; '%': { Hard Drive } DrawHardDrive; '^': { Floppy Disk } DrawFloppyDisk; OTHERWISE DrawFile; END; { Trim cell data draw it } MoveTo(TheRect.left + 24, TheRect.bottom - 4); Grayed := TheData[1] = '-'; TheData := Omit(TheData, 1, 2); TrimName(TheRect, 24, TheData); DrawString(TheData); { If inactive then gray out } IF Grayed THEN BEGIN GetIndPattern(ThePattern, sysPatListID, 4); PenPat(ThePattern); PenMode(PatBic); PaintRect(TheRect); Pennormal; END ELSE BEGIN IF Select THEN InvertRect(TheRect); END; END; PROCEDURE DoHilite; VAR TheData: Str255; DataLength: Integer; P: Ptr; BEGIN { Get the cell data } DataLength := 255; LGetCell(Ptr(Longint(@TheData) + 1), DataLength, TheCell, TheList); P := @TheData; P^ := Ptr(Longint(@DataLength) + 1)^; { If active then highlite } IF TheData[1] = '+' THEN InvertRect(theRect); END; BEGIN { Dispatch on message type } CASE message OF lInitMsg: Initialize; lDrawMsg: DrawCell; lHiliteMsg: DoHilite; lCloseMsg: Close; END; END; END.
Listing: CSFResources.r #include "Types.r" #include "SysTypes.r" resource 'CNTL' (1, "Radio Button", locked, preload) { {0, 0, 0, 0}, 0, visible, 1, 0, radioButProc, 0, "" }; resource 'CNTL' (2, "Check Box", locked, preload) { {0, 0, 0, 0}, 0, visible, 1, 0, checkBoxProc, 0, "" }; resource 'CNTL' (3, "Push Button", locked, preload) { {0, 0, 0, 0}, 0, visible, 1, 0, pushButProc, 0, "" }; resource 'WIND' (9999, "OSF Window") { {0, 0, 200, 320}, documentProc, invisible, goAway, 0x0, "" }; resource 'MENU' (2, "File", preload) { 2, textMenuProc, 0x7FFFF803, enabled, "File", { /* array: 13 elements */ /* [1] */ "New#2", noIcon, "N", noMark, plain; /* [2] */ "Modeless Open #9998", noIcon, noKey, noMark, plain; /* [3] */ "Modeless Save #9999", noIcon, noKey, noMark, plain; /* [4] */ "-", noIcon, noKey, noMark, plain; /* [5] */ "Close#4", noIcon, "W", noMark, plain; /* [6] */ "Save#5", noIcon, "S", noMark, plain; /* [7] */ "Save As #6", noIcon, noKey, noMark, plain; /* [8] */ "Revert to Saved#7", noIcon, noKey, noMark, plain; /* [9] */ "-", noIcon, noKey, noMark, plain; /* [10] */ "Page Setup #8", noIcon, noKey, noMark, plain; /* [11] */ "Print #9", noIcon, noKey, noMark, plain; /* [12] */ "-", noIcon, noKey, noMark, plain; /* [13] */ "Quit#1", noIcon, "Q", noMark, plain } };
- SPREAD THE WORD:
- Slashdot
- Digg
- Del.icio.us
- Newsvine