![](/file/12652/www.mactech.com.tar/www.mactech.com/sites/all/themes/custom_front/images/you_are_here_red.gif)
![](/file/12652/www.mactech.com.tar/www.mactech.com/sites/default/files/beta-site.gif)
|
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 Finder’s 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 I’ve 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 I’ve 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 ‘MDEF’s 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 don’t 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 wasn’t quite sure I hadn’t made a mistake, but now I’m 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 I’ll 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 ‘CDEF’s). 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”, you’d 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. It’s 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
Let’s 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 don’t 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, you’ll have to refer to the listing given below (e.g. : don’t 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”, it’s 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 doesn’t matter, only matters the coherence between the two declarations.
Coming back to our example, you’ll 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 programmer’s 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 it’s not the actual way the old and new Finders do it. I think my algorithm is closer to reality. I’ve 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 icon’s 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 don’t 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 trash’s ControlHandle is returned in ContrlRefCon. Then it looks for a double-click in case the control is “double-clickable” and hasn’t 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 User’s 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 icon’s 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 doesn’t 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 DA’s It shows at least the simplicity for the end programmer.
Future Extensions
A feature found in the Finder and that I didn’t 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 you’ve 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 MANAGER’S MESSAGES TO THE CDEF } {**********************************************} { Put this file in the project after MacPasLib and MacTraps. } { Don’t 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 Manager’s 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); { let’s 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); { let’s 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 : { let’s 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. } { Don’t put MacTraps that would generate unusefull glue for the Memory Manager. } { I prefer to declare DisposHandle as inline procedure : see below. } { Don’t 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. } { Don’t 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 doesn’t 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 icon’s 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-control’s 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. Don’t 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 don’t 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.
![](/file/12652/www.mactech.com.tar/www.mactech.com/sites/all/themes/custom_front/img/search_text.gif)
- SPREAD THE WORD:
- Slashdot
- Digg
- Del.icio.us
- Newsvine