SFDialongs
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 aint there, it aint there--your stuck! This statement isnt 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.
Lets 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 Pascals fault, but it is a deficiency in the toolbox. Lets 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 wouldnt you say.
Pandoras Dialog
The first thing to consider when using the modeless dialogs, is how should the modeless get and save dialogs behave. (Ill 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. Dont make the users 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. Im 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.
Wheres 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. Dont 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 dont 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 wont 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 dont 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). Im 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 Apples 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
}
};