Finder Icons
Volume Number: | | 5
|
Issue Number: | | 1
|
Column Tag: | | Pascal Procedures
|
Related Info: Menu Manager Control Manager Memory Manager
Finder Icon Controls
By Jean de Combret, Grenoble, France
Finder-like icon-controls
How to write, debug and use MDEF and CDEF resources.
Jean de Combret is a former river-hydraulics engineer, who worked with mathematical models human-unfriendly programs. He thinks the Mac could be a solution to make such programs more friendly and has therefore set up Diadème Ingénierie and written ONDULA. He is a member of Macintosh Alpes Club, as well as Didier Guillon, Jörg Langowski [hum... thanks! -JL] and a lot of other interesting folks.
Introduction
While developing my application, it appeared to me I needed an object-interface, somewhat like the Finders one, with icons, hierarchy (folders contain other icons), actions (by double-clicking, classifying, throwing away or choosing in a menu). So I decided to write my own objects, and the best way I found to do it was to make them user-controls.
VarCodes
All icons of the family Ive created bear the same appearance: an icon, and an underlying name. But each member of the family has different properties, which may be done by giving different varCodes to each variant. I choose a system of additive varCodes, although not all combinations have sense:
moveable=1;
means the control may be dragged inside its window (like all icons in the Finder);
doubleClickable=2;
means the control may generate an action by double-clicking it: it should then take an open appearance (like folders, disks and trash icons that generate a window, or like application icons that start-up applications);
trash=4;
means the control may swallow up another one released over its head. It should highlight while the mouse, dragging the control to be swallowed up, is still down and pointing to it (like trash, folders and disks icons in the Finder)
menu=8;
is a new type of control icon Ive imagined : it should generate a pop-up menu of icons when pressed. This is an alternate technique to the palette menus and tear off menus. The menu is by the way bound to a window.
Some examples of possible combinations are listed below:
a folder would be declared movable + doubleClickable + trash and its varCode would therefore be 7;
a growing menu of icons would be menu + trash i.e. 12 (menu for removing or choosing items, trash to add items);
an application icon would be declared movable + doubleClickable i.e. 3.
In fact, menu is exclusive of movable or doubleClickable.
Menu definition procedure and pop-up menus
Before building our custom control definition procedure, we must first build our custom icons menus. At that point, the two first problems are
to write a MDEF code resource ;
to make it work with pop-up menus.
Inside Macintosh indicates p.I-362 how to write MDEFs for pull-down menus. In my alpha release of the fifth volume (for which the French Macintosh Development Support failed to send me updates), I dont find anything about pop-up menus nor about custom menus. I just found two significant pieces of information in the Color Menu Manager interface in my LightSpeed Pascal libraries -a new trap declared as
{1}
PROCEDURE PopUpMenuSelect (menu : MenuHandle;
top , left , popUpItem : INTEGER) : LONGINT;
inline $A80B;
and a constant :
mPopUpMsg=4; ( sic )
This latter statement appeared later to be false. I learned by disassembling the standard code resource MDEF 0 of the new system file, that only values ranging from 0 to 3 are accepted as messages, and that the one corresponding to pop-up menu treatments is 3:
mPopUpMsg=3; ( right value )
By the way I learned that the routine responds to this new message by calculating menuRect, given menu, top, left and popUpItem parameters of PopUpMenuSelect transmitted respectively through the theMenu, hitPt and whichItem parameters from the menu definition procedure declaration :
{2}
PROCEDURE MyMenu (message : INTEGER;
theMenu : MenuHandle;
VAR menuRect : Rect;
hitPt : Point;
VAR whichItem : INTEGER);
Since I wrote most of this article, all of this has been confirmed by TechNote #172 from the November 1987 release. It just took 6 months to get it!
Before getting TechNote #172, I wasnt quite sure I hadnt made a mistake, but now Im sure: hitPt is not a point! Instead it receives left and top inverted from PopUpMenuSelect.
I also tried the trap with standard text menus. The two hints I shall give follow: ( I found the second by decompiling the ROM patches; next time Ill first have a look to Inside Macintosh p.351!)
pass -1 as beforeID parameter to InsertMenu (the same as for hierarchical menus) to indicate that theMenu is in the current menu list, but is not to be drawn in the menu bar.
pass a positive non-zero integer as MenuID to NewMenu or nothing will ever appear on the screen (you may also store it in the MENU resource read by GetMenu, of course).
Debugging A Code Resource (Part 1)
I shall indicate two techniques to test and debug code resources under LightSpeed Pascal. The first one, used here, is the roughest and should never be used for anything else than debugging. I learned the second one from the best Macintosh programming journal I know (I mean the April issue of MacTutor p.17 and p.30), and I should give an example of the use I made of it further in this article.
The problem is to access and debug the source text of a code resource while running a shell program that calls it via Menu Manager routines (or Control Manager routines for CDEFs). Normally the code resources is compiled separately and accessed through a handle to the MDEF resource. The Menu Manager routines use to lock the MDEF resource upon entry, dereference the handle, jump to its beginning and unlock it upon exit.
My technique consists in declaring the unit with the MDEF source text in the uses statement of a small debugging-purpose shell program, and I create a new menu as follows :
{3}
myMenu := GetMenu(128);
myProcPtr := @main;
myMenu^^.menuProc := @myProcPtr;
This way, the handle and its dereferenced pointer point to the stack, not at a masterpointer or a block within the heap. The HLock and HUnLock procedures may act on the high order bit of these pointers, it has no influence on the addresses (nevertheless be aware of TechNote #2 item 11). The Memory Manager never knows about the block and never tries to move it.
With this trick, you may freely use all the debugging facilities of LightSpeed Pascal: the Observe and LightsBug windows, the Step mode
Once all the bugs inside the MDEF code have been fixed (or at least seam to), you build your MDEF code resource. I gave mine a ResID of 128. Under ResEdit, you can see that the compiler gave to this resource a default attribute purgeable, youd never ask it to give. Instead I changed it to locked and preload, in order to have it always under the hand (a disk access while pulling a menu is not user-friendly) and to keep it in the low region of the application heap.
New Meaning of MENU Resource
The MDEF and CDEF are not the only user resources I wrote for my application. I like the flexibility of building all sort of data resources as well as compiling code resources. In the current example, my menu consists of icons, described by their names and their positions in the menu rectangle. Its slightly different from the standard MENU resource information. But in order to use the Menu Manager routines, I preferred interpreting the same MENU resources in a different way, rather than create a completely new resource type. Description of the resource format given p.I-364 of Inside Macintosh should be replaced by :
Number of bytes Contents
2 bytes MenuId
2 bytes Placeholder for menu width
2 bytes Placeholder for menu height
2 bytes Resource ID of MDEF
2 bytes Place holder for MDEF handle
4 bytes EnableFlags
n+1 bytes Title as Pascal string
for each menu item :
m+1 bytes Text of item as Pascal string
2 bytes Vertical coordinate of icon center
2 bytes Horizontal coordinate of center
1 byte 0, indicating end of menu items
(it is also a Pascal null string)
Note that this description occupies the same number of bytes that normal text menus do, which ensures the ability to use the standard procedures.
This description is almost the same as the one you can teach to ResEdit; I created a new TMPL resource in the ResEdit file itself, which I gave the name MPOP. However, in order to use the GetMenu routine, my menu resources shall not be of type MPOP but of type MENU. This is accomplished by creating a new MENU resource and opening it with the Open as command to indicate we wish to use the MPOP format instead of the MENU one to edit our resources (shortcut for Open as is shift-option-double-clicking).
The TMPL resource describes the structure of the MPOP resource, somewhat like a Pascal record type describes the structure of a Pascal record variable (for more details see the MPW chapter about ResEdit) :
Label Type
MenuID DWRD
width DWRD
height DWRD
procID DWRD
filler DWRD
enableFlags HLNG
title PSTR
***** LSTZ
menuItem PSTR
center.v DWRD
center.h DWRD
***** LSTE
Reading A Resource
In fact this new syntax allowed by ResEdit gives more generality and compactness than Pascal records do: strings in Pascal records always occupy 256 bytes in memory, even if only 10 are actually used. Consequently, Pascal is not able to decipher such resources. So I had to write some inline assembly routines for this purpose. These routines read a chosen type beginning at a given address that might be odd and return a Pascal formatted value on the stack. For strings it returns a StringHandle on the stack, pointing to a string of the actual size in the heap. I give here three of these inline routines :
{4}
FUNCTION GetNextByte
(VAR LongAddress : LONGINT) : BYTE;
FUNCTION GetNextInteger
(VAR LongAddress : LONGINT) : INTEGER;
FUNCTION GetNextString
(VAR LongAddress : LONGINT) : StringHandle;
These functions return NIL if allocation failed.
For each of these routines LongAddress is incremented by the amount of bytes read.
The same routines in Pascal would have called BlockMove, which is very efficient for larger blocks but far too long for such a few bytes.
As an example, here is what GetNextByte would look like in Pascal :
{5}
FUNCTION GetNextByte (VAR longAddress : LONGINT) : BYTE;
VARresult : BYTE;
BEGIN
result := 0;
BlockMove(POINTER(longAddress), POINTER(ORD(@result ) + 1), 1);
GetNextByte := result ;
longAddress:= longAddress+ 1;
END;
I added some other Pascal utilities for easy reading and writing :
{6}
FUNCTION SkipNextString (VAR LongAddress : LONGINT) : BYTE;
PROCEDURE SkipBytes (VAR LongAddress : LONGINT; byteCount : INTEGER);
Routines and Messages
Lets come to our central topic: the control definition procedure. First of all note that there are 9 messages to the CDEF code instead of only 4 to the MDEF code. Controls are more complex than menus and hence more versatile.
I find Inside Macintosh not systematic enough in describing the meanings of these messages and I dont know other information about them. So I decided to build my own complete table of what messages each routine of the Control Manager sends to the CDEF code. I wrote a small program to help me in this task by installing a spy a the entry of the CDEF code. Figure 1. shows the table resulting from this spying.
Fig. 1 : messages sent by the Control Manager routines
The program I used is listed below and I shall give here some explanations about the way I installed my spy, because it involves the second technique of building CDEF resources from the same source file than the host program.
Debugging a Code Resource (Part 2)
Here comes the clean way of doing it (Thanks to Larry Rosenstein and also to Don Melton and Mike Ritter for the basic idea). You create a 6-byte handle and put a JMP $xxxxxx instruction in the block, which jumps to your procedure. Then you declare this block as a CDEF resource which you give an unused ID. Then you can pass this ID to NewControl :
{7}
TYPE
CDEFcodeHdl = ^CDEFcodePtr;
CDEFcodePtr = ^CDEFcodeRecord;
CDEFcodeRecord = RECORD
jump : integer;
address : ProcPtr;
END;
VARmyControl : ControlHandle;
myCDEF : CDEFcodeHdl; myCDEFid : integer;
FUNCTION ControlDefProc (varCode : INTEGER;
theControl : ControlHandle; message : INTEGER;
param : LONGINT) : LONGINT;
BEGIN
{ put here the source of the CDEF }
END;
BEGIN { here begins your host program }
myCDEF := CDEFcodeHdl (NewHandle(6));
myCDEF^^.jump := $4EF9;
myCDEF^^.address := @ControlDefProc;
myCDEFid := UniqueID(CDEF);
AddResource(handle(myCDEF), CDEF, myCDEFid, );
{ *************************** }
{ write here the inits of your host program }
{ *************************** }
myControl := NewControl(theWindow, boundsRect, title, visible, value,
min, max, myCDEFid * 16 + varCode, refCon);
{ *************************** }
{ write here the body of your host program }
{ *************************** }
DisposeControl(myControl);
RmveResource(handle(myCDEF));
DisposHandle(handle(myCDEF));
{ ****************************** }
{ write here the disposals of your host program }
{ ****************************** }
END.
For more information, youll have to refer to the listing given below (e.g. : dont have a too large UniqueID, it must be less than maxint DIV 16 ).
Another interesting technique is the way of using routines passed by address from Pascal. Although Inside Macintosh says p.I-78 Only routines written in assembly language can actually call the routine designated by a pointer of type ProcPtr, its very easy to write inline code to do the job within Pascal programs. Suppose you have this function declaration :
{8}
FUNCTION MyFunction (firstArg : firstType;
secondArg : secondType;
VAR thirdArg : thirdType) : resultType;
If you want to call it by address (given by @MyFunction, or by a handle if the function is compiled as a code resource) you must declare an inline glue function.
For a function passed by pointer it should be :
{9}
FUNCTION CallMyFunction (firstArg : firstType;
secondArg : secondType;
VAR thirdArg : thirdType
MyFunctionAddress : ProcPtr) : resultType;
INLINE
$205F, {MOVE.L (A7)+,A0}
$4E90; {JSR (A0)}
or, for a function passed by handle (after having locked it):
{10}
FUNCTION CallMyFunction (firstArg : firstType;
secondArg : secondType;
VAR thirdArg : thirdType
MyFunctionResource : handle) : resultType;
INLINE
$205F, {MOVE.L (A7)+,A0}
$2050, {MOVE.L (A0),A0}
$4E90; {JSR (A0)}
As you can see the declaration is exactly the same as in the original function, except that we add one last parameter. This technique applies as well to procedures. The number of arguments doesnt matter, only matters the coherence between the two declarations.
Coming back to our example, youll notice a supplementary line in the inline code of my program, because tracing the CDEF resource with MacsBug showed that it relied on a function return value being previously cleared.
Implementing the Control Definition Procedure
My goal was to do as much work as possible within the CDEF code, in order to simplify the end programmers job of writing the host program.
Although movable controls should act through the DragControl routine, I grouped all actions of all the variety of controls under the TrackControl routine. I implement also custom initializations and disposals.
Here follows descriptions of :
what the ControlRecord fields are used to ;
how the control definition procedure responds to each message ;
how to use the Control Manager routines to make my controls work correctly.
Control Record fields
ContrlTitle contains the name that is used to find the related resources such as ICN# and MENU.
in order to speed up memory access to the icon and menu records related to the control, I store handles to them in the following structure :
{11}
TYPE
DataHandle = ^DataPointer;
DataPointer = ^DataRecord;
DataRecord = RECORD
theIcon : handle;
theMenu : MenuHandle;
END;
and I store the DataHandle in the ContrlData field.
I use the ContrlRefCon field to store the values returned from the CDEF routines :
- the ControlHandle of the trash in case the current control has been put in it;
- the choice made from the icon menu, as returned by PopUpMenuSelect.
ContrlHilite is not used.
I use 6 levels of ContrlValue ranging from ContrlMin = 0 to ContrlMax = 5. Rather than a continuous scale, they correspond to six different states of the controls (the ContrlHilite field could have been used for the same purpose):
This is the data of my icon (of type ICN#)
This is its mask.
RestState=0; ( same as the data on white background)
SelectState = 1;
OpenState = 2;
SelectOpenState = 3;
Technical note #55 describes how the Finder draws icons in that variety of ways. But in fact its not the actual way the old and new Finders do it. I think my algorithm is closer to reality. Ive studied it using a funny feature of MacsBug -the Step Spy command :
SS 400000 400000
that slows all 68xxx instructions, and is specially recommended to examine graphical aspects of an application.
CDEF Routines in Response to the Messages
drawCntl : draws the control with its title and its icon according to the state (i.e. its ContrlValue) ;
testCntl : tests if the point is inside the icons data or mask ;
calcCRgns : calculates the region, union of the rectangles enclosing the icon and the title. This region is used for any erasing of the control and updating of the underlying pixels, or for drawing the dotted outline when dragging the control ;
initCntl : stores the handles to the icon and to the menu in a structure, pointed to by another handle which is in turn stored in the ContrlData field, and sets the actionProc parameter to POINTER(-1), to indicate we implement a custom autoTrack routine ;
dispCntl : disposes the ContrlData handle but not the icon and menu handles which are resources and may be shared by other controls ;
posCntl : not used, because my controls dont have any indicator ;
thumbCntl : not used ;
dragCntl or autoTrack : the most important routine. First it sets the control to a selected state and deselects any other currently selected control. Then, if the control is movable, it detects the movements of the mouse,pulls a dotted outline and highlights the trashes the control flies over. If it was actually moved, it invalidates regions to be updated. If it was released over a trash, its value is set to 4 and the trashs ControlHandle is returned in ContrlRefCon. Then it looks for a double-click in case the control is double-clickable and hasnt been moved. In the other case where the control is a menu control, the routine generates the pop-up menu, by calling PopUpMenuSelect as described above and returns the choice in ContrlRefCon.
Note that a small problem arises in these routines when they call in turn other routines of the Control Manager -when the latter returns, the CDEF resource is unlocked by the Control Manager, although the next instructions are still in the CDEF. So it is imperative to re-lock the CDEF resource after each call to the Control Manager within the CDEF. If Apple had used HGetSate / HSetState instead of HLock / HUnLock to bracket the calls to CDEF, I think this problem would not exist.
Note also I let the user access to this last routine by two ways : TrackControl, which is more logic, and DragControl that calls drawCntl only when necessary, as shows figure 1., and thus makes a cleaner interface.
Control Manager Routines Users Guide
Here is the way the standard routines act on my custom controls:
NewControl or GetNewControl are used to create the controls with the following values of the parameters :
- boundsRect set to the 32x32 icons rectangle ;
- max = 5 ;
- min = 0 ;
- procID = 128 * 16 + varCode ;
- title = CNTL resource name
= ICN# resource name
= MENU resource name ;
TrackControl is used to make the controls work properly. Pass POINTER(-1) as actionProc, in order to let the Control Manager generate autoTrack messages.
DragControl is used for the same purpose (see above). Pass anything as bounds, slop and axis.
GetCRefCon is used to get the choice returned from the pop-up menu or the handle to the trash the current control was put in ;
SetCtlValue is used to close icons :
{12}
SetCtlValue(GetCtlValue(theOpenControl)-2);
or to deselect icons (such as a trash) :
{13}
SetCtlValue(GetCtlValue(theSelectedControl)-1);
HiliteControl doesnt change anything;
SizeControl only moves the gravity center of the control;
never use SetCtlMin and SetCtlMax;
the other routines (MoveControl, SetCTitle, HideControl, ShowControl) work the way you might expect.
Example Listing
I give hereafter the listing of the MDEF and the CDEF resources in LightSpeed Pascal as well as a minimum shell program as an example of how to use the custom controls. I apologize for the roughness of its interface: no standard menus, no DAs It shows at least the simplicity for the end programmer.
Future Extensions
A feature found in the Finder and that I didnt implement is the ability of editing the title of the icon. It would probably need to define two parts in the control.
In some applications, pop-up menus change their title accordingly to the current choice. It could be possible here at the condition that the menu handle of the control is left unchanged, even though the title or the icon handle are changed.
At last, what would be vachement classe and truly up-to-date custom Mac programming is a color-hierarchical-pop-up-icon-user-menu !
Please send me a copy once youve written this marvel, or simply send me bug-reports and comments to:
Jean de Combret
Diadème Ingénierie
25, avenue de Constantine
38100 GRENOBLE
France
Listing 1: Control manager example
{**********************************************}
{ SPYING THE CONTROL MANAGERS MESSAGES TO THE CDEF }
{**********************************************}
{ Put this file in the project after MacPasLib and MacTraps. }
{ Dont forget Use resource file in Run options of menu }
{ This resource file may be empty, or may contain a copy of }
{ system file reources CDEF 0 and 1 }
{**********************************************}
PROGRAM Controls;
CONST
CDEFID = 1;{ 0 for button, 1 for scroll bar }
TYPE
CDEFcodeHdl = ^CDEFcodePtr;
CDEFcodePtr = ^CDEFcodeRecord;
CDEFcodeRecord = RECORD
jump : integer;
address : ProcPtr;
END;
VAR
boundsRect, TextRect : rect;
myControl, whichControl : ControlHandle;
theEvent : eventRecord;
thePoint : point;
whichPart : integer;
theWindow, whichWindow : WindowPtr;
myFakeCDEF : CDEFcodeHdl;
myFakeCDEFid : integer;
CDEFProcHandle : handle;
LABEL
1, 2;
FUNCTION DoCDEF (varCode : integer; theControl : ControlHandle; message
: integer; param : longint; ProcHandle : handle) : longint;
INLINE
{ CDEF relies on prepared default value of 0 as funct. result:}
$42AF, $0010, {CLR.L 10(A7)}
{ JSR to a procedure passed by handle as last argument }
$205F, {MOVE.L (A7)+,A0}
$2050, {MOVE.L (A0),A0}
$4E90; {JSR (A0)}
FUNCTION ControlProc (varCode : integer; theControl : ControlHandle;
message : integer; param : longint) : longint;
BEGIN
writeln( message= , message, param= , param);
ControlProc := DoCDEF(varCode, theControl, message, param, CDEFProcHandle);
END;
BEGIN
{ create a intermediate CDEF resource : }
myFakeCDEF := CDEFcodeHdl(NewHandle(sizeof(CDEFcodeRecord)));
IF MemError <> NoErr THEN
GOTO 2;
myFakeCDEF^^.jump := $4EF9;
myFakeCDEF^^.address := @ControlProc;
REPEAT
myFakeCDEFid := UniqueID(CDEF);
{ in order to have 16*myFakeCDEFid < maxint : }
UNTIL myFakeCDEFid < 1000;
AddResource(handle(myFakeCDEF), CDEF, myFakeCDEFid, );
IF ResError <> NoErr THEN
GOTO 2;
SetRect(TextRect, 250, 40, 500, 330);
SetTextRect(TextRect);
ShowText;
SetRect(boundsRect, 40, 40, 200, 200);
theWindow := NewWindow(NIL, boundsrect, my window, true, 0, pointer(-1),
false, 0);
SetPort(theWindow);
CDEFProcHandle := GetResource(CDEF, CDEFID);
IF ResError <> NoErr THEN
GOTO 1;
HLock(CDEFProcHandle);
IF MemError <> NoErr THEN
GOTO 1;
SetRect(boundsRect, 10, 10, 90, 26);
{ now we begin to test the Control Managers routines : }
writeln(NewControl : );
myControl := NewControl(thePort, boundsRect, my control, true, 0, 0,
48, myFakeCDEFid * 16, 0);
SetCtlAction(myControl, pointer(-1));
writeln(SetCTitle : ); SetCTitle(myControl, new name);
writeln(HideControl : ); HideControl(myControl);
writeln(ShowControl : ); ShowControl(myControl);
writeln(HiliteControl : ); HiliteControl(myControl, 1);
writeln(HiliteControl : ); HiliteControl(myControl, 255);
writeln(HiliteControl : ); HiliteControl(myControl, 0);
writeln(SetCtlValue : ); SetCtlValue(myControl, 1);
writeln(SetCtlMax : ); SetCtlMax(myControl, 0);
writeln(SetCtlMax : ); SetCtlMax(myControl, 1);
writeln(SetCtlMin : ); SetCtlMin(myControl, 1);
writeln(SetCtlMin : ); SetCtlMin(myControl, 0);
writeln(SetCtlValue : ); SetCtlValue(myControl, 0);
writeln(MoveControl : ); MoveControl(myControl, 20, 20);
writeln(SizeControl : ); SizeControl(myControl, 100, 30);
{ lets have loop to test TrackControl and FindControl: }
writeln(The user should try actions on the control.);
writeln(End by clicking outside the control.);
FlushEvents(EveryEvent, 0); InitCursor;
REPEAT
REPEAT
UNTIL GetNextEvent(MDownMask, theEvent);
thePoint := theEvent.where;
whichPart := FindWindow(thePoint, whichWindow);
SetPort(whichWindow); GlobalToLocal(thePoint);
writeln(FindControl : );
whichPart :=
FindControl(thePoint, whichWindow, whichControl);
IF whichControl <> NIL THEN
BEGIN
writeln(TrackControl : );
whichPart :=
TrackControl(whichControl, thePoint, pointer(-1));
END;
UNTIL whichControl = NIL;
FlushEvents(MUpMask, 0);
{ lets have another loop to test DragControl (and FindControl) :
}
writeln(The user should try to drag the control.);
writeln(End by clicking outside the control.);
REPEAT
REPEAT
UNTIL GetNextEvent(MDownMask, theEvent);
thePoint := theEvent.where;
whichPart := FindWindow(thePoint, whichWindow);
SetPort(whichWindow); GlobalToLocal(thePoint);
writeln(FindControl : );
whichPart :=
FindControl(thePoint, whichWindow, whichControl);
IF whichControl <> NIL THEN
WITH whichWindow^ DO
BEGIN
writeln(DragControl : );
DragControl(whichControl, thePoint, PortRect, PortRect, noConstraint);
END;
UNTIL whichControl = NIL;
writeln(DisposControl : ); DisposeControl(myControl);
writeln(end);
1 :
{ lets remove our fake CDEF : }
RmveResource(handle(myFakeCDEF));
IF ResError <> NoErr THEN
GOTO 2;
DisposHandle(handle(myFakeCDEF));
{ error label : }
2 :
END.
{**********************************************}
{ BUILDING THE MDEF CODE RESOURCE }
{**********************************************}
{ Put this file in the MPOP Project after DAPasLib. }
{ Dont put MacTraps that would generate unusefull glue for the Memory
Manager. }
{ I prefer to declare DisposHandle as inline procedure : see below. }
{ Dont forget to Use resource file in Run options of menu Project.
}
{ This resource file must contain the MENU and ICN# resources}
{ that the PopTrap Project needs together with the compiled MDEF resource.
}
{ Build and save as resource code of type MDEF and ID 128 in file
MPOP code }
{**********************************************}
UNIT MPOP;
INTERFACE
{ the name Main indicates to LightSpeed Pascal compiler where the entry
point is }
PROCEDURE Main (message : integer; theMenu : MenuHandle; VAR menuRect
: rect; hitPt : point; VAR whichItem : integer);
IMPLEMENTATION
CONST
mPopUpMsg = 3;
{ and not 4 as written in early versions of new MenuMgr }
PROCEDURE CopyMask (srcBits, maskBits, dstBits : BitMap; srcRect, maskRect,
dstRect : Rect);
INLINE $A817;
PROCEDURE DisposHandle (h : handle);
{ to avoid putting the whole Memory Manager glue in our code resource
}
INLINE $205F, $A023, $31C0, $0220;
{***************************************}
{ first some utilities for reading MENU resources : }
FUNCTION GetNextByte (VAR LongAddress : longint) : byte;
INLINE
$205F, { MOVEA.L (A7)+,A0 }
$2250, { MOVEA.L (A0),A1 }
$5290, { ADDQ.L #$1,(A0) }
$204F, { MOVEA.L A7,A0 }
$4218, { CLR.B (A0)+ }
$1091; { MOVE.B (A1),(A0) }
FUNCTION GetNextInteger (VAR LongAddress : longint) : integer;
INLINE
$205F, { MOVEA.L (A7)+,A0 }
$2250, { MOVEA.L (A0),A1 }
$5490, { ADDQ.L #$2,(A0) }
$204F, { MOVEA.L A7,A0 }
$10D9, { MOVE.B (A1)+,(A0)+ }
$1091; { MOVE.B (A1),(A0) }
FUNCTION GetNextString (VAR LongAddress : longint) : StringHandle;
{ returns NIL if allocation failed }
INLINE
$205F, { MOVEA.L (A7)+,A0;A0:=@LongAddress }
$2250, { MOVEA.L (A0),A1 ;A1:=LongAddress }
$7000, { MOVEQ #$00,D0 ;countChars:=0 }
$1011, { MOVE.B (A1),D0 ;countChars:=LongAddress^ }
$2200, { MOVE.L D0,D1 ;save countChars }
$5200, { ADDQ.B #$1,D0;length:=countChars+1 }
$D190, { ADD.L D0,(A0)
;FuturLongAddress:=LongAddress+length }
$A122, { OSTRAP $A122 ;A0:=NewHandle(D0=length) }
$4A80, { TST.L D0 ;if MemError }
$660C, { BNE.S *+$000E ;<>0 goto error }
$2E88, { MOVE.L A0,(A7) ;GetChaine:=A0 }
$2050, { MOVEA.L (A0),A0 ;StringPtr }
{ loop;repeat }
$10D9, { MOVE.B (A1)+,(A0)+
;StringPtr^:=LongAddress^ }
$51C9, $FFFC, { DBF D1,*-$0002
;dec(length); until length<0 }
$6002, { BRA.S *+$0004 ;goto bottom }
{ error }
$4297; { CLR.L (A7) ;GetChaine:=NIL }
{ bottom }
FUNCTION SkipNextString (VAR LongAddress : longint) : byte;
VARlength : byte;
BEGIN
length := GetNextByte(LongAddress);
LongAddress := LongAddress + length;
SkipNextString := length;
END;
PROCEDURE SkipBytes (VAR LongAddress : longint;
byteCount : integer);
BEGIN
LongAddress := LongAddress + byteCount;
END;
{***************************************}
PROCEDURE Main;
FUNCTION GetItemCenter : point;
{ returns the ItemCenter in local coordinates, relative to menuRect }
{ theMenu is already locked }
VAR
LongAddress : longint;
length : byte;
i : integer;
ItemCenter : point;
BEGIN
LongAddress := ord(theMenu^) + 14;
length := SkipNextString(LongAddress);
i := 0;
REPEAT
i := i + 1;
length := SkipNextString(LongAddress);
IF length > 0 THEN
BEGIN
IF i = whichItem THEN
BEGIN
ItemCenter.v := GetNextInteger(LongAddress);
ItemCenter.h := GetNextInteger(LongAddress);
END
ELSE
BEGIN
SkipBytes(LongAddress, 4);
END;
END
ELSE { if length<=0 : }
SetPt(ItemCenter, 0, 0);
UNTIL (length <= 0) OR (i = whichItem);
GetItemCenter := ItemCenter;
END;
{***************************************}
PROCEDURE DoDrawMessage;
PROCEDURE PinString (theString : Str255;
center : point);
BEGIN
WITH center DO
MoveTo(h - StringWidth(theString) DIV 2, v);
DrawString(theString);
END;
PROCEDURE PlotIconDataCopy
(theIcon : handle; dstSquare : rect);
VAR
srcSquare : rect;
data : bitmap;
myPort : GrafPtr;
BEGIN
IF (theIcon <> NIL) THEN
BEGIN
SetRect(srcSquare, -16, -16, 16, 16);
data.rowBytes := 4;
data.baseAddr := ptr(theIcon^);
data.bounds := srcSquare;
GetPort(myPort);
CopyBits(data, myPort^.portbits, srcSquare, dstSquare, srcCopy, NIL);
END;
END;
VAR
IconRect : rect; IconName : StringHandle;
LongAddress : longint; NameLength : byte;
ItemCenter, TextCenter : point;
theIcon : handle;
BEGIN
LongAddress := ord(theMenu^) + 14;
NameLength := SkipNextString(LongAddress);
REPEAT
IconName := GetNextString(LongAddress);
NameLength := length(IconName^^);
IF NameLength > 0 THEN
BEGIN
theIcon := GetNamedResource(ICN#, IconName^^);
ItemCenter.v := GetNextInteger(LongAddress) + menuRect.top;
ItemCenter.h := GetNextInteger(LongAddress) + menuRect.left;
WITH ItemCenter DO
BEGIN
SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
SetPt(TextCenter, h, v + 20);
END;
PlotIconDataCopy(theIcon, IconRect);
TextFont(geneva);
TextSize(9);
PinString(IconName^^, TextCenter);
TextFont(systemFont);
TextSize(12);
END;
DisposHandle(handle(IconName));
UNTIL NameLength <= 0;
END; { of DoDrawMessage }
{***************************************}
PROCEDURE DoChooseMessage;
FUNCTION GetIconRect : rect;
{ returns the IconRect in global coordinates }
VAR
ItemCenter : point;
IconRect : rect;
BEGIN
ItemCenter := GetItemCenter;
WITH ItemCenter DO
BEGIN
IF (h = 0) AND (v = 0) THEN
SetRect(IconRect, 0, 0, 0, 0)
ELSE
SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
END;
WITH menuRect DO
OffSetRect(IconRect, left, top);
GetIconRect := IconRect;
END; { of GetIconRect }
PROCEDURE PlotIconMaskXor
(theIcon : handle; dstSquare : rect);
VAR
srcSquare : rect; mask : bitmap;
myPort : GrafPtr;
BEGIN
IF (theIcon <> NIL) THEN
BEGIN
SetRect(srcSquare, -16, -16, 16, 16);
mask.rowBytes := 4;
mask.baseAddr := ptr(ord4(theIcon^) + 128);
mask.bounds := srcSquare; GetPort(myPort);
CopyBits(mask, myPort^.portbits, srcSquare, dstSquare, srcXOr, NIL);
END;
END; { of PlotIconMaskXor }
FUNCTION GetIconName (whichItem : integer) : StringHandle; { theMenu
is already locked }
VAR
LongAddress : longint; length : byte;
i : integer; IconName : StringHandle;
BEGIN
LongAddress := ord(theMenu^) + 14;
length := SkipNextString(LongAddress);
i := 0;
REPEAT
i := i + 1;
IF i = whichItem THEN
BEGIN
IconName := GetNextString(LongAddress);
END
ELSE
BEGIN
length := SkipNextString(LongAddress);
IF length > 0 THEN
SkipBytes(LongAddress, 4)
ELSE
IconName := NIL;
END;
UNTIL (length <= 0) OR (i = whichItem);
GetIconName := IconName;
END;
PROCEDURE InvertIcon
(whichItem : integer; dstSquare : rect);
VAR
IconName : StringHandle;
myIcon : handle;
BEGIN
IconName := GetIconName(whichItem);
myIcon := GetNamedResource(ICN#, IconName^^);
PlotIconMaskXor(myIcon, dstSquare);
END;
VAR
itemNumber : integer; NameLength : byte;
LongAddress : longint; ItemCenter : point;
ItemRect, OldIconRect, IconRect : rect;
BEGIN { DoChooseMessage }
LongAddress := ord(theMenu^) + 14;
NameLength := SkipNextString(LongAddress);
itemNumber := 0;
REPEAT
itemNumber := itemNumber + 1;
NameLength := SkipNextString(LongAddress);
IF NameLength > 0 THEN
BEGIN
ItemCenter.v := GetNextInteger(LongAddress);
ItemCenter.h := GetNextInteger(LongAddress);
WITH ItemCenter DO
SetRect(ItemRect, h - 25, v - 25, h + 25, v + 25);
WITH menuRect DO
OffSetRect(ItemRect, left, top);
END;
UNTIL (NameLength <= 0) OR
(PtInRect(hitPt, ItemRect));
IF NameLength <= 0 THEN
{ hitPt is not in any item }
BEGIN
IF whichItem <> 0 THEN
BEGIN
InvertIcon(whichItem, GetIconRect);
whichItem := 0;
END;
END
ELSE IF itemNumber <> whichItem THEN
{ hitPt is in itemRect }
BEGIN
IF whichItem <> 0 THEN
InvertIcon(whichItem, GetIconRect);
WITH ItemCenter DO
SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
WITH MenuRect DO
OffSetRect(IconRect, left, top);
InvertIcon(itemNumber, IconRect);
whichItem := itemNumber;
END;
END; { of DoChooseMessage }
{***************************************}
PROCEDURE DoSizeMessage;
{ theMenu is already locked }
PROCEDURE RectAndPt (VAR theRect : rect;
thePoint : point);
BEGIN
WITH theRect, thePoint DO
{ we suppose that 0=left<right and 0=top<bottom }
BEGIN
IF h > right THEN right := h;
IF v > bottom THEN bottom := v;
END;
END;
VAR
LongAddress : longint; length : byte;
ItemCenter : point; Envelope : rect;
BEGIN
LongAddress := ord(theMenu^) + 14;
length := SkipNextString(LongAddress);
SetRect(Envelope, 0, 0, 0, 0);
REPEAT
length := SkipNextString(LongAddress);
IF length > 0 THEN
BEGIN
ItemCenter.v := GetNextInteger(LongAddress);
ItemCenter.h := GetNextInteger(LongAddress);
RectAndPt(envelope, ItemCenter);
END
UNTIL (length <= 0);
WITH theMenu^^, envelope DO
BEGIN
menuWidth := right + 25;
menuHeight := bottom + 25;
END;
END; { of DoSizeMessage }
{***************************************}
PROCEDURE DoPopUpMessage;
{ on entry: whichItem(=popUpItem) , }
{hitPt (= center of title icon) }
{theMenu (Locked) }
{ on exit : menuRect }
{ ThePort is allready set to WindowManager Port }
VAR
ItemCenter, IconCenter : point; dh, dv : integer;
WMPort : GrafPtr; mBarHeight : ^integer;
BEGIN
mBarHeight := pointer($BAA);
WITH theMenu^^, hitPt DO
SetRect(menuRect, h, v, h + menuWidth, v + MenuHeight);
IF whichItem > 0 THEN
BEGIN
ItemCenter := GetItemCenter;
WITH ItemCenter DO
SetPt(IconCenter, h, v - 5);
WITH IconCenter DO
IF NOT ((h = 0) AND (v = 0)) THEN
OffSetRect(menuRect, -h, -v)
ELSE
whichItem := 0;
END;
IF whichItem <= 0 THEN
OffSetRect(menuRect, -25, +25);
GetPort(WMPort);
WITH WMPort^ DO
BEGIN
IF menuRect.right + 8 > PortRect.right THEN
dh := PortRect.right - menuRect.right - 8
ELSE IF menuRect.left - 8 < PortRect.left THEN
dh := PortRect.left - menuRect.left + 8
ELSE dh := 0;
IF menuRect.bottom + 8 > PortRect.bottom
THEN
dv := PortRect.bottom - menuRect.bottom - 8
ELSE IF
menuRect.top - 8 < PortRect.top + mBarHeight^
THEN
dv := PortRect.top + mBarHeight^
- menuRect.top + 8
ELSE dv := 0;
END;
OffSetRect(menuRect, dh, dv);
END; { of DoPopUpMessage }
{***************************************}
BEGIN { of Main }
CASE message OF
mSizeMsg : DoSizeMessage;
mDrawMsg : DoDrawMessage;
mChooseMsg : DoChooseMessage;
mPopUpMsg : DoPopUpMessage;
END;
END;
END.
{**********************************************}
{ BUILDING THE CDEF CODE RESOURCE }
{**********************************************}
{ Put this file in the CDEF Project after DAPasLib, MacTraps, ROM85lib
and ROM85. }
{ Dont forget to Use resource file in Run options of menu Project.
}
{ This resource file must contain the WIND ,CNTL, MENU, ICN#, ICON, MDEF
}
{ resources that the Shell Project needs together with the compiled CDEF
resource. }
{ Build and save as resource code of type CDEF and ID 128 in file
CDEF code }
{**********************************************}
UNIT CDEF;
INTERFACE
USES ROM85;
FUNCTION Main (varCode : integer;
theControl : ControlHandle; message : integer;
param : longint) : longint;
IMPLEMENTATION
CONST
RestState = 0; SelectState = 1; OpenState = 2;
SelectOpenState = 3; ThrownAwayState = 4;
MenuReturnState = 5;
movableBit = 1; doubleClickableBit = 2;
trashBit = 3; menuBit = 4;
varCodeBase = 200;
{ bit-offset of end of varCode in ControlRecord }
integerLength = 16;
TYPE
DataHandle = ^DataPointer;
DataPointer = ^DataRecord;
DataRecord = RECORD
theIcon : handle;
theMenu : MenuHandle;
END;
FUNCTION PopUpMenuSelect (menu : MenuHandle;
top, left, popUpItem : integer) : longint;
INLINE
$A80B;
PROCEDURE PlotDoubleIcon (theIcon : handle;
State : integer; dstSquare : rect);
VAR
srcSquare : rect;
data, mask, destBitMap, scratchBitMap : bitmap;
theGrafPort : GrafPtr;
LightGrayIcon, DarkGrayIcon : handle;
BEGIN
IF (theIcon <> NIL) THEN
BEGIN
SetRect(srcSquare, -16, -16, 16, 16);
data.rowBytes := 4;
data.baseAddr := ptr(theIcon^);
data.bounds := srcSquare;
mask.rowBytes := 4;
mask.baseAddr := ptr(ord4(theIcon^) + 128);
mask.bounds := srcSquare;
GetPort(theGrafPort);
destBitMap := theGrafPort^.portbits;
CASE state OF
RestState :
BEGIN
CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
CopyBits(data, destBitMap, srcSquare, dstSquare, srcOr, NIL);
END;
SelectState :
BEGIN
{ old finder : }
CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
CopyBits(data, destBitMap, srcSquare, dstSquare, srcOr, NIL);
CopyBits(mask, destBitMap, srcSquare, dstSquare, srcXOr, NIL);
{ new finder would be : }
{CopyBits(mask, destBitMap, srcSquare, dstSquare, srcOr, nil);}
{CopyBits(data, destBitMap, srcSquare, dstSquare, srcBic, nil);}
END;
OpenState :
BEGIN
WITH scratchBitMap DO
BEGIN
LightGrayIcon := GetIcon(128);
BaseAddr := LightGrayIcon^;
bounds := srcSquare;
Rowbytes := 4;
END;
CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
CopyMask(scratchBitMap, mask, destBitMap, srcSquare, srcSquare, dstSquare);
END;
SelectOpenState :
BEGIN
WITH scratchBitMap DO
BEGIN
DarkGrayIcon := GetIcon(129);
BaseAddr := DarkGrayIcon^;
bounds := srcSquare;
Rowbytes := 4;
END;
CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
CopyMask(scratchBitMap, mask, destBitMap, srcSquare, srcSquare, dstSquare);
END;
OTHERWISE
END;
END
END; { of PlotDoubleIcon }
{ ***************************************************** }
FUNCTION distance (startPt, endPt : point) : integer;
BEGIN
distance := abs(startPt.h - endPt.h) + abs(startPt.v - endPt.v);
END;
FUNCTION InsideIcon (myPoint : point;
IconCenter : point;
myIcon : handle) : boolean;
VAR
bitOffset : longint;
scratchMap, dataMap, maskMap, sensitiveMap : bitmap;
square : rect;
x, y : integer;
LABEL
1;
BEGIN
HLock(myIcon);
SetRect(square, 0, 0, 32, 32);
WITH scratchMap DO
BEGIN
bounds := square;
BaseAddr := NewPtr(128);
IF MemError <> NoErr THEN
GOTO 1;
RowBytes := 4;
END;
WITH sensitiveMap DO
BEGIN
bounds := square;
BaseAddr := NewPtr(128);
IF MemError <> NoErr THEN
GOTO 1;
RowBytes := 4;
END;
WITH dataMap DO
BEGIN
bounds := square;
BaseAddr := myIcon^;
RowBytes := 4;
END;
WITH maskMap DO
BEGIN
bounds := square;
BaseAddr := Ptr(ord4(myIcon^) + 128);
RowBytes := 4;
END;
CopyBits(maskMap, scratchMap, square, square, srcCopy, NIL);
CopyBits(dataMap, scratchMap, square, square, srcOr, NIL);
CalcMask(scratchMap.baseAddr, sensitiveMap.baseAddr, 4, 4, 32, 2);
x := myPoint.h - IconCenter.h + 16;
y := myPoint.v - IconCenter.v + 16;
IF NOT ((x IN [0..31]) AND (y IN [0..31])) THEN
InsideIcon := false
ELSE
BEGIN
bitOffset := x + 32 * y;
InsideIcon := BitTst(sensitiveMap.baseAddr, bitOffset);
END;
HUnLock(myIcon);
DisposPtr(scratchMap.baseAddr);
DisposPtr(sensitiveMap.baseAddr);
1 :
IF MemError <> NoErr THEN
InsideIcon := false;
END;
FUNCTION DoubleClick (theControl : ControlHandle;
startPt : point; startTime : longint; VarCode : integer;
bounds : rect; VAR IconCenter : point) : boolean;
VAR
mouse : point; t : longint; d : integer;
theEvent : EventRecord; DoubleClicked : boolean;
PROCEDURE DragSquare (startPt : point;
VAR IconCenter : point);
VAR
oldFrame, frame, bounds : rect;
delta, mouse : point; theGrafPort : GrafPtr;
grayPattern : pattern; theTrash : ControlHandle;
PROCEDURE HighLightTrash (mouse : point);
VAR
where : integer; IconCenter : point;
OverFlownControl : ControlHandle;
BEGIN
where := FindControl(mouse, FrontWindow, OverFlownControl);
HLock(GetResource(CDEF, 128));
FrameRect(oldFrame);
IF theTrash <> OverFlownControl THEN
{ the control the mouse overflyes is no more theTrash }
BEGIN
IF theTrash <> NIL THEN
{ the mouse has ended overflying a trash }
BEGIN
SetCtlValue(theTrash, GetCtlValue(theTrash) - 1);
HLock(theTrash^^.ContrlDefProc);
END;
IF (OverFlownControl <> NIL) THEN
IF BitTst(pointer(OverFlownControl^),
varCodeBase - trashBit) AND
(theControl <> OverFlownControl)
THEN
{ the mouse begins overflying a trash }
BEGIN
SetCtlValue(OverFlownControl,
GetCtlValue(OverFlownControl) + 1);
HLock(OverFlownControl^^.ContrlDefProc);
theTrash := OverFlownControl;
END
ELSE
{ the mouse overflies something else than a trash }
theTrash := NIL
ELSE
{ the mouse doesnt overfly anything }
theTrash := NIL;
END;
END;
BEGIN { DragSquare }
theTrash := NIL;
StuffHex(@grayPattern, 55AA55AA55AA55AA);
GetPort(theGrafPort);
bounds := theGrafPort^.PortRect;
InSetRect(bounds, 16, 16);
delta := IconCenter;
SubPt(startPt, delta);
PenMode(PatXor);
WITH IconCenter DO
SetRect(oldFrame, h - 16, v - 16, h + 16, v + 16);
PenPat(grayPattern);
FrameRect(oldFrame);
{ instead of the surrounding square }
{ we could also drag the icons data or mask frame }
REPEAT
GetMouse(mouse); IconCenter := mouse;
AddPt(delta, IconCenter);
WITH IconCenter, bounds DO
BEGIN
IF h < left THEN h := left;
IF h > right - 1 THEN h := right - 1;
IF v < top THEN v := top;
IF v > bottom - 1 THEN v := bottom - 1;
END;
WITH IconCenter DO
SetRect(frame, h - 16, v - 16, h + 16, v + 16);
IF NOT EqualRect(oldFrame, frame) THEN
BEGIN
HighLightTrash(mouse);
FrameRect(frame); oldFrame := frame;
END;
UNTIL NOT WaitMouseUp;
FrameRect(frame); PenNormal;
END;
BEGIN { DoubleClick }
DoubleClicked := false;
BEGIN
{ if doubleClickable or movable : }
IF (BitTst(@varCode,
integerLength - doubleClickableBit)) OR
(BitTst(@varCode, integerLength - movableBit)) THEN
REPEAT
GetMouse(mouse);
d := distance(startPt, mouse);
UNTIL (NOT WaitMouseUp OR (d > 3));
IF (d > 3) AND BitTst(@varCode, integerLength - movableBit) THEN
DragSquare(startPt, IconCenter)
ELSE IF BitTst(@varCode,
integerLength - doubleClickableBit) THEN
REPEAT
GetMouse(mouse);
d := distance(startPt, mouse);
t := TickCount - startTime;
IF GetNextEvent(MDownMask, theEvent) THEN
DoubleClicked := true;
UNTIL DoubleClicked OR (d > 3) OR (t > GetDblTime);
DoubleClick := DoubleClicked;
END;
END;
{ ***************************************************** }
FUNCTION Main;
VAR
{ color under the title : }
whitePattern : pattern;
PROCEDURE DoDrawCntl;
VAR
IconCenter, TextCenter : point;
State, theLength, theHalfLength : integer;
TextFrame, IconFrame : rect;
myDataHandle : DataHandle;
BEGIN
State := GetCtlValue(theControl);
{ MenuReturnState is drawn like RestState, ThrownAwayState is not re-drawn
: }
IF State = MenuReturnState THEN
State := RestState;
IF ((State IN [RestState..SelectOpenState]) AND (theControl^^.ContrlVis
<> 0)) THEN
BEGIN
HLock(handle(theControl));
WITH theControl^^ DO
BEGIN
TextFont(geneva); TextFace([]);
TextMode(SrcOr); TextSize(9);
theLength := StringWidth(contrlTitle);
IF theLength < 32 THEN
theHalfLength := 16
ELSE
theHalfLength := theLength DIV 2;
WITH ContrlRect DO
SetPt(IconCenter, (right + left) DIV 2,
(bottom - 12 + top) DIV 2);
{ recalculate the rect surrounding the whole control : }
WITH IconCenter, ContrlRect DO
BEGIN
left := h - theHalfLength; top := v - 16;
right := h + theHalfLength; bottom := v + 16 + 12;
END;
WITH IconCenter, IconFrame DO
BEGIN
left := h - 16; top := v - 16;
right := h + 16; bottom := v + 16;
END;
{ draw the icon-controls title : }
WITH IconCenter DO
SetPt(TextCenter, h, v + 26);
WITH TextCenter DO
SetRect(TextFrame, h - theLength DIV 2,
v - 10, h + theLength DIV 2, v + 2);
StuffHex(@whitePattern, 0000000000000000);
FillRect(TextFrame, whitePattern);
WITH TextCenter DO
MoveTo(h - theLength DIV 2, v);
DrawString(contrlTitle);
{ draw the icon : }
myDataHandle := DataHandle(ContrlData);
HLock(myDataHandle^^.theIcon);
PlotDoubleIcon
(myDataHandle^^.theIcon, State, IconFrame);
HUnLock(myDataHandle^^.theIcon);
END;
HUnLock(handle(theControl));
END;
Main := 0;
END;
PROCEDURE DoTestCntl;
VAR
IconCenter, mouse : point;
myDataHandle : DataHandle;
BEGIN
HLock(handle(theControl));
WITH theControl^^ DO
BEGIN
SetPt(mouse, LoWord(param), HiWord(param));
IF PtInRect(mouse, ContrlRect) THEN
BEGIN
WITH ContrlRect DO
SetPt(IconCenter, (right + left) DIV 2,
(bottom - 12 + top) DIV 2);
myDataHandle := DataHandle(ContrlData);
Main := ord4(InsideIcon(mouse, IconCenter,
myDataHandle^^.theIcon));
END
ELSE
main := 0;
END;
HUnLock(handle(theControl));
END;
PROCEDURE DoCalcCRgns;
CONST
Lo3Bytes = $00FFFFFF;
VAR
IconFrame, TextFrame : rect; theTitle : Str255;
theLength, theHalfLength, halfWay : integer;
BEGIN
GetCTitle(theControl, theTitle);
theLength := StringWidth(theTitle);
theHalfLength := theLength DIV 2;
param := BitAnd(param, Lo3Bytes);
IconFrame := theControl^^.ContrlRect;
WITH IconFrame DO
BEGIN
bottom := bottom - 12; halfWay := (right + left) DIV 2;
left := halfWay - 16; right := halfWay + 16;
SetRect(TextFrame, halfWay - theHalfLength,
bottom, halfWay + theHalfLength, bottom + 12);
END;
OpenRgn;
FrameRect(IconFrame); FrameRect(TextFrame);
CloseRgn(RgnHandle(param));
Main := 0;
END;
PROCEDURE DeselectExcept
(theControl : ControlHandle);
VAR
myWindowPeek : WindowPeek;
aControl : ControlHandle;
BEGIN
myWindowPeek :=
WindowPeek(theControl^^.ContrlOwner);
aControl := myWindowPeek^.ControlList;
WHILE aControl <> NIL DO
BEGIN
IF (aControl <> theControl) THEN
BEGIN
IF (GetCtlValue(aControl) = 1) THEN
BEGIN
SetCtlValue(aControl, 0);
HLock(aControl^^.ContrlDefProc);
END
ELSE IF
(GetCtlValue(aControl) = 3) THEN
BEGIN
SetCtlValue(aControl, 2);
HLock(aControl^^.ContrlDefProc);
END
END;
aControl := aControl^^.nextControl;
END;
END;
PROCEDURE DoAutoTrack;
VAR
SavedClip, UpDateRegion : RgnHandle;
PopUpMenuHdl : MenuHandle;
{MDEFPtr : Ptr;{ for debugging only }
theTitle : Str255;
choosenItem, dummy : longint;
halfWay, theHalfLength, where : integer;
oldCenter, IconCenter, mouse, MenuTitleCenter : point;
theGrafPort : GrafPtr;
theTrash : ControlHandle;
myDataHandle : DataHandle;
isAMenu, isDoubleClickable, isMovable : boolean;
BEGIN
isAMenu := BitTst(@varCode, integerLength - MenuBit);
isDoubleClickable := BitTst(@varCode, integerLength - DoubleClickableBit);
isMovable := BitTst(@varCode, integerLength - MovableBit);
IF isAMenu OR isDoubleClickable OR isMovable THEN
BEGIN
IF GetCtlValue(theControl) = OpenState THEN
SetCtlValue(theControl, SelectOpenState)
ELSE IF GetCtlValue(theControl) = RestState
THEN SetCtlValue(theControl, SelectState);
HLock(theControl^^.ContrlDefProc);
END;
DeselectExcept(theControl);
GetMouse(mouse);
WITH theControl^^.ContrlRect DO
SetPt(IconCenter, (right + left) DIV 2,
(bottom - 12 + top) DIV 2);
oldCenter := IconCenter; GetPort(theGrafPort);
{ 1° : DOUBLE-CLICK }
IF DoubleClick(theControl, mouse, TickCount, varCode, theGrafPort^.PortRect,
IconCenter) THEN
BEGIN
SetCtlValue(theControl, SelectOpenState);
HLock(theControl^^.ContrlDefProc);
END
{ 2° : NO DRAGGING }
ELSE IF EqualPt(oldCenter, IconCenter) THEN
BEGIN
{ 2.1 : POPUPMENU }
IF isAMenu THEN
BEGIN
myDataHandle := DataHandle(theControl^^.ContrlData);
PopUpMenuHdl := myDataHandle^^.theMenu;
WITH theControl^^.ContrlRect, MenuTitleCenter DO
BEGIN
h := (left + right) DIV 2;
v := (top + bottom) DIV 2;
END;
LocalToGlobal(MenuTitleCenter);
WITH MenuTitleCenter DO
choosenItem := PopUpMenuSelect(PopUpMenuHdl, h, v, 0);
{ re-draw the control as in RestState : }
SetCtlValue(theControl, MenuReturnState);
HLock(theControl^^.ContrlDefProc);
SetCRefCon(theControl, choosenItem);
END
{ 2.2 : SIMPLE SELECTION OF A DOUBLE-CLICKABLE CONTROL }
{ the Control is already highlighted in the SelectState }
END
{ 3° : DRAGGING }
ELSE
BEGIN
GetMouse(mouse);
where := FindControl(mouse, FrontWindow, theTrash);
HLock(GetResource(CDEF, 128));
IF (theTrash <> NIL) THEN
{ 3.1 : THROWING THE CONTROL AWAY IN A TRASH }
IF BitTst(pointer(theTrash^),
varCodeBase - trashBit)
AND (theTrash <> theControl)
THEN
BEGIN
{ return theTrash in CRefCon }
{ without re-drawing it }
SetCRefCon(theControl, ord(theTrash));
SetCtlValue(theControl, ThrownAwayState);
HLock(theControl^^.ContrlDefProc);
END;
{ 3.2 : MOVING }
IF (GetCtlValue(theControl) <>
ThrownAwayState) THEN
BEGIN
WITH theControl^^.ContrlRect DO
theHalfLength := (right - left) DIV 2;
{ move the control without showing it : }
HideControl(theControl);
HLock(theControl^^.ContrlDefProc);
WITH IconCenter DO
MoveControl(theControl,
h - theHalfLength, v - 16);
HLock(theControl^^.ContrlDefProc);
theControl^^.ContrlValue := RestState;
{ the UpDate mechanism will do the re-drawing in such a way it lets the
previously hidden controls appear : }
SavedClip := NewRgn;
GetClip(SavedClip);
SetEmptyRgn(theGrafPort^.ClipRgn);
ShowControl(theControl);
HLock(theControl^^.ContrlDefProc);
SetClip(SavedClip);
{ re-use an initialised region for another purpose : }
UpDateRegion := SavedClip;
{ send the CalCRgns message to calculate UpDateRegion : }
dummy := Main(0, theControl,
calcCRgns, ord4(UpDateRegion));
EraseRgn(UpDateRegion);
InValRgn(UpDateRegion);
DisposeRgn(UpDateRegion);
END;
END;
Main := 0;
END;
PROCEDURE DoInitCntl;
VAR
myDataHandle : DataHandle;
theTitle : Str255;
BEGIN
GetCTitle(theControl, theTitle);
myDataHandle := DataHandle(NewHandle(sizeof(DataRecord)));
HLock(handle(myDataHandle));
WITH myDataHandle^^ DO
BEGIN
theIcon := GetNamedResource(ICN#, theTitle);
{ Initialisation should have called GetMenu : }
theMenu := MenuHandle(GetNamedResource(MENU, theTitle));
END;
HUnLock(handle(myDataHandle));
WITH theControl^^ DO
BEGIN
ContrlAction := pointer(-1);
ContrlData := handle(myDataHandle);
END;
END;
PROCEDURE DoDispCntl;
BEGIN
DisposHandle(theControl^^.ContrlData);
END;
BEGIN { Main procedure }
CASE message OF
drawCntl : DoDrawCntl;
testCntl : DoTestCntl;
calcCRgns : DoCalcCRgns;
initCntl : DoInitCntl;
dispCntl : DoDispCntl;
dragCntl : { for a smoother interface }
BEGIN
DoAutoTrack;
Main := 1; { to tell the Control Manager not to use the standard method
}
END;
autoTrack : DoAutoTrack;
OTHERWISE { dragCntl, posCntl , thumbCntl }
main := 0;
END;
END;
END.
{*********************************************}
{ SEE HOW SIMPLE IT IS FOR THE END-PROGRAMMER }
{ TO CREATE AND USE FINDER-LIKE ICONS! }
{*********************************************}
{ Put this file in the Shell Project after DAPasLib, MacTraps, ROM85lib
and ROM85, put also CDEF text if you plan to improve and debug it. Dont
forget to Use resource file CDEF Code in Run options of menu Project.
This resource file must contain the WIND ,CNTL, MENU, ICN#, ICON, MDEF
and CDEF resource. }
{**********************************************}
PROGRAM shell;
USES ROM85;
{ , CDEFIcones; { only for debugging purposes }
CONST
RestState = 0; SelectState = 1; OpenState = 2;
SelectOpenState = 3; ThrownAwayState = 4;
MenuReturnState = 5;
TYPE
CDEFcodeHdl = ^CDEFcodePtr;
CDEFcodePtr = ^CDEFcodeRecord;
CDEFcodeRecord = RECORD
jump : integer;
address : ProcPtr;
END;
VAR
whichWindow, myWindow : WindowPtr;
whichControl, theTrash : ControlHandle;
myCDEF : CDEFcodeHdl; theEvent : EventRecord;
theControl : ControlHandle; mouse : point;
FakeRect : rect; done : boolean; i : integer;
PROCEDURE ProcessMenu (where : longint);
VAR
MenuNb, ItemNb : integer; dummy : longint;
i : integer;
BEGIN
MenuNb := HiWord(where);
ItemNb := LoWord(where);
CASE MenuNb OF
1 :
FOR i := 1 TO ItemNb DO
BEGIN
SysBeep(5);
Delay(10, dummy);
END;
OTHERWISE
;
END;
END;
PROCEDURE ProcessEvent;
VAR
myWindowPeek : WindowPeek;
dummy : integer;
BEGIN
CASE theEvent.what OF
UpDateEvt :
BEGIN
whichWindow := WindowPtr(theEvent.message);
beginUpDate(whichWindow);
IF whichWindow = myWindow THEN
BEGIN
EraseRgn(myWindow^.VisRgn);
UpdtControl(myWindow, myWindow^.VisRgn);
END;
endUpDate(whichWindow);
END;
MouseDown :
BEGIN
CASE FindWindow(theEvent.where, whichWindow) OF
inContent :
BEGIN
mouse := theEvent.where;
GlobalToLocal(mouse);
IF FindControl(mouse, whichWindow,whichControl) <> 0 THEN
BEGIN
{ choose DragControl or TrackControl as you prefer: }
{ dummy:=TrackControl(theControl,mouse,pointer(-1)) }
SetRect(FakeRect, 0, 0, 0, 0);
DragControl(whichControl, mouse, FakeRect, FakeRect, noConstraint);
IF GetCtlValue(whichControl) = ThrownAwayState THEN
BEGIN
theTrash := ControlHandle(GetCRefCon(whichControl));
SetCtlValue(theTrash, GetCtlValue(theTrash) - 1);
DisposeControl(whichControl);
END
ELSE IF GetCtlValue(whichControl) = MenuReturnState THEN
BEGIN
ProcessMenu(GetCRefCon(whichControl));
{ the Control has already been re-drawn in RestState, }
{ so we dont need to re-redraw it again.}
whichControl^^.ContrlValue := 0;
END
ELSE IF GetCtlValue(whichControl) = SelectOpenState THEN
BEGIN
dummy := NoteAlert(128, NIL);
SetCtlValue(whichControl, RestState);
END
ELSE
;
END;
END;
inGoAway :
IF TrackGoAway(whichWindow, theEvent.where)
THEN done := true;
inDrag :
DragWindow(whichWindow, theEvent.where, ScreenBits.bounds);
OTHERWISE
;
END;
END;
OTHERWISE
;
END;
END;
BEGIN
{ create a intermediate CDEF resource : }
{myCDEF := CDEFcodeHdl(NewHandle(sizeof(CDEFcodeRecord))); { for
debugging only }
{myCDEF^^.jump := $4EF9; { for debugging only }
{myCDEF^^.address := @main; { for debugging only }
{AddResource(handle(myCDEF), CDEF, 128, ); { for debugging only }
myWindow := GetNewWindow(128, NIL, pointer(-1));
SetPort(myWindow);
{BackPat(gray); { or whatever background pattern you wish }
InsertMenu(GetMenu(128), -1);
FOR i := 128 TO 133 DO
theControl := GetNewControl(i, myWindow);
done := false;
SetCursor(arrow);
FlushEvents(EveryEvent, 0);
ShowWindow(myWindow);
REPEAT
IF GetNextEvent(EveryEvent, theEvent) THEN
ProcessEvent;
UNTIL done;
DisposeWindow(myWindow);
{RmveResource(handle(myCDEF));{ for debugging only }
{DisposHandle(handle(myCDEF));{ for debugging only }
END.