home *** CD-ROM | disk | FTP | other *** search
Wrap
Text File | 1990-11-12 | 93.6 KB | 3,034 lines | [ TEXT/PJMM]
{ **************************************************** } { C D L O G } { **************************************************** } { CDlog is a TCL-compatible class that uses DLOG and DITL resources to create } { modal and modeless dialogs. It has all (as far as I know) the capabilities of Dialog } { Manager dialogs, and a few extensions which utilize TCL features: } {} { - It creates a radio group for each sequence of radio buttons, which means } { your code doesn't have to do much to support radio groups, which is what } { you expect of TCL applications. } {} { - It supports command numbers in button, check box, radio button, and control } { titles. (Following the TCL menu convention, put "#number" at the end of the } { title. If you want a "#" in the title, put it before the "#number", or if the } { item has no command number, put a "#" at the end anyway.) } {} { - It supports tabbing through edit text items (as does the Dialog Manager), but } { it also support shift-tab to go to the previous edit text item. } {} { - It supports various editing capabilites for editText fields. This is not all- } { inclusive: the edits are ones that I needed. Still, at least 2 or 3 should be } { useful in your applications.} {} { - If your application creates a CDModalDesktop (included) rather than CDesktop, } { CDlog can provide Modal Dialogs. See CDModalDesktop. } {} { CDlog contains a number of classes and a fair amount of code. It is distributed in } { one source file. This is probably NOT how you should use it. I did it this way to } { simplify distribution. } {} { I did not spend a long time designing CDlog and the associated classes. I have the } { usual excuses. I would appreciate positive and/or negative comments or } { suggestions on how it might be improved. } { **************************************************** } { 10/1/90- } { 11/1/90 John Cardinal 1.0. Limited testing. Not fully commented or documented. } { 11/12/90 John Cardinal 1.1. - Changed SectPanes to correct for zero origin in CList's. } { - Adjusted call to SectPanes in CDRadioGroup.CalcBorder } { to correspond to above. } { - Added CDIcon.NewIcon and CDPicture.NewPicture methods. } { Changed IDIcon and IDPicture to use Newxxxx methods. } { - Changed CDGraphic.DoClick to react to quick click. Not sure } { if this is correct behavior. } { - Changed CompuServe upload to include example application. } { ******************************* } { } { Copyright © 1990 by John Cardinal } { All rights reserved. } {} { John Cardinal } { C/O Epsilon } { 50 Cambridge Street } { Burlington, MA 01803 } { } { CompuServe: 73230,3725 } {} {{ You may use this software in commercial or } { non-commercial programs. You may alter it } { to suit your application needs. You may distribute } { this source to other users, but you may not } { charge a fee for that distribution, other than } { shipping and handling fees, and the author's name } { and the complete text of this copyright notice } { must be left intact in the source. } {} { The author makes no warranty, either express or } { implied, regarding the enclosed computer } { software. Use this software at your own risk. } {} { I'd like to acknowledge the efforts of: } { Gregory H. Dow and Greg Howe (authers of TCL) } { Philip Keller (author of CDialog) } { Belvidere Computing } { 3002 Belvidere Ave. S.W. } { Seattle , WA 98126 } { (CDialog is a Think C } { class that is similar to CDlog) } { Spec Bowers (author of AppMaker) } {} { I got ideas and in some cases borrowed code } { from software written by the above. } {} { For those of you who are familiar with } { CDialog: CDlog is similar to CDialog in that it } { is a TCL-compatible class that uses DLOG and } { DITL resources to create modeless dialogs. } { Some of the class names are the same. But... } { CDlog uses a different approach. In particular, } { the main class (CDlog) is a subclass of } { CDirector (rather than CDocument), and the } { Dialog Manager is not used. } { ******************************* } unit CDlog; interface uses Script, TCL; const { Constants for use with CDEditText "SetEdit" method. } CdCrOkOff = 2; { Don't process CR as click on button one. } CdEtxOkOff = 4; { Don't process Enter as click on button one. } CdEscOff = 8; { Don't process ESC as click on button two. } CdCrFiltOn = 16; { Don't allow CR as input character. } CdSpecFiltOn = 32; { Don't allow special characters, with the exception of TE editing chars. } CdNspFiltOn = 64; { Don't allow characters that are not valid in NSP. } CdClidFiltOn = 128; { Don't allow characters that are not valid in client IDs. } CdLenFiltOn = 256; { Don't allow the field to grow beyond "maxLength" bytes. } CdCMSFiltOn = 512; { Don't allow characters that are not valid in CMS filenames. } CdNumFiltOn = 1024; { Don't allow non-numerics. } CdUpDownOn = 2048; { Treat up and down arrow keys as commands. } CdLeftRightOn = 4096; { Treat left and right arrow keys as commands. } { NOTE: CdNspFiltOn and CdClidFiltOn are very specific to my applications; I left them} { in to avoid having two versions. Ignore them.} { Commands issued by CDEditText.DoKeyDown } cmdArrowLeft = 2101; { User pressed left arrow } cmdArrowRight = 2102; { User pressed right arrow } cmdArrowUp = 2103; { User pressed up arrow } cmdArrowDown = 2104; { User pressed down arrow } cmdBadChar = 2105; { *User keyed a character that is invalid for the current field } cmdBadLength = 2106; { *Current field is full; no more characters allowed } cmdOkEquiv = 2107; { User pressed an character that is an equivalent for the OK button } cmdCancelEquiv = 2108; { User pressed an character that is an equivalent for the Cancel button } type CDDitlItemRec = record { This record maps the basics of DITL entries } placeHolder: longint; { A placeholder } boundsRect: Rect; { Location rectangle } typeLen: integer; { First is type, second byte is length } dummy: Str255; {Takes up space; don't reference} end; { **************************************************** } { C D C O N T R O L } {} { CDControl implements ToolBox controls in CDlog dialog windows. CDControl is } { based on CControl with additions from CButton, in order to allow controls to } { act like buttons. } {} { You should not need to override this class. } {} { SUPERCLASS = CControl} { SUBCLASSES = CDButton, CDCheckBox} { **************************************************** } CDControl = object(CControl) saveHilite: integer; { Hilte state (for preserving across activate/deactivate) } clickCmd: longint; { Command to issue to supervisor upon GoodClick } txFont: integer; { GrafPort characteristics } txFace: Style; txMode: integer; txSize: integer; procedure IDControl ( { Initialize CDControl } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec); { DITL item info } procedure IDControlX ( { Extra initialization for CDControl } item: CDDitlItemRec); { DITL item info } procedure Activate; override; procedure Deactivate; override; procedure Draw (var area: Rect); override; procedure DoGoodClick (whichPart: integer); override; procedure SetClickCmd (aClickCmd: longint); procedure Hilite ( { Send HiliteControl message to control } hiliteState: integer); { Passed argument } end; {CDControl} { **************************************************** } { C D B U T T O N } {} { CDButton implements simple buttons in CDlog dialog windows. } {} { You should not need to override this class. } {} { SUPERCLASS = CDControl} { SUBCLASSES = CDRadioButton} { **************************************************** } CDButton = object(CDControl) procedure IDButton ( { Initialize CDButton } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec); { DITL item info } end; { **************************************************** } { C D R A D I O B U T T O N } {} { CDRadioButton implements radio buttons in CDlog dialog windows. } {} { You should not need to override this class. } {} { SUPERCLASS = CDButton} { SUBCLASSES = None} { **************************************************** } CDRadioButton = object(CDButton) idNumber: integer; procedure IDRadioButton ( { Initialize CDRadioButton } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; { DITL item } anIdNumber: integer); { ID number used by CRadioGroup } procedure DoGoodClick (whichPart: integer); override; function GetIdNumber: integer; end; { **************************************************** } { C D C H E C K B O X } {} { CDCheckBox implements check boxes in CDlog dialog windows. } {} { You should not need to override this class. } {} { SUPERCLASS = CDControl} { SUBCLASSES = None} { **************************************************** } CDCheckBox = object(CDControl) procedure IDCheckBox ( { Initialize CDCheckBox } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec); { DITL item info } procedure DoGoodClick (whichPart: integer); override; procedure ToggleCheck; function IsChecked: Boolean; end; { **************************************************** } { C D G R A P H I C } {} { CDGRAPHIC is an abstract class used to implement various graphics in CDlog } { dialog windows. } {} { You should probably not override this class. } {} { SUPERCLASS = CPane} { SUBCLASSES = CDIcon, CDPicture, CDUser} { **************************************************** } CDGraphic = object(CPane) clickCmd: integer; state: integer; procedure SetClickCmd ( { Set command to issue upon click } aClickCmd: longint); { Command number } procedure DoClick ( { Handle clicks } hitPt: Point; { Mouse location in Frame coords } modifierKeys: integer; { State of modifier keys } when: longint); { Tick time of mouse click } override; procedure DoGoodClick ( { Handle "good" click } whichPart: integer); procedure Hilite ( { Reset hilite state, and redraw } aState: integer); end; { **************************************************** } { C D I C O N } {} { CDIcon implements icons in CDlog dialog windows. } {} { You should not need to override this class. } {} { SUPERCLASS = CDGraphic} { SUBCLASSES = None} { **************************************************** } CDIcon = object(CDGraphic) theIconID: integer; theIcon: Handle; procedure IDIcon ( { Initialize CDIcon } anEnclosure: CView; { Standard IPane parms } aSupervisor: CBureaucrat; aWidth: integer; aHeight: integer; aHEncl: integer; aVEncl: integer; aHSizing: SizingOption; aVSizing: SizingOption; anIconID: integer); { ID of ICON resource } { (and default clickCmd) } procedure Free; override; procedure Draw ( { Draw a CDIcon } var area: Rect); override; procedure NewIcon ( { Change to new icon } anIconID: integer); end; {CDIcon} { **************************************************** } { C D P I C T U R E } {} { CDPicture implements pictures in CDlog dialog windows. } {} { You should not need to override this class. } {} { SUPERCLASS = CDGraphic} { SUBCLASSES = None} { **************************************************** } CDPicture = object(CDGraphic) thePictID: integer; { ID of PICT resource } thePicture: PicHandle; procedure IDPicture ( { Initialize CDPicture } anEnclosure: CView; { Standard IPane parms } aSupervisor: CBureaucrat; aWidth: integer; aHeight: integer; aHEncl: integer; aVEncl: integer; aHSizing: SizingOption; aVSizing: SizingOption; aPictID: integer); { ID of PICT resource } { (and default clickCmd) } procedure Free; override; procedure Draw ( { Draw a CDPicture } var area: Rect); override; procedure NewPicture ( { Change to new picture } aPictID: integer); end; {CDPicture} { **************************************************** } { C D U S E R } {} { CDUser implements user items in CDlog dialog windows. } {} { NOTE: I don't recommend using this class. I provided this class so that I would } { have something to create when a DITL contains a user item. In real life, it } { would probably be easier to 'manually' add your own panes in the initialize } { method of your CDlog subclass. } {} { SUPERCLASS = CDGraphic} { SUBCLASSES = None} { **************************************************** } CDUser = object(CDGraphic) procedure IDUser ( { Initialize CDUser } anEnclosure: CView; { Standard IPane parms } aSupervisor: CBureaucrat; aWidth: integer; aHeight: integer; aHEncl: integer; aVEncl: integer; aHSizing: SizingOption; aVSizing: SizingOption); procedure Hilite ( { Reset hilite state, and redraw } aState: integer); { New state } override; end; {CDUser} { **************************************************** } { C D E D I T T E X T } {} { CDEditText implements editable text fields in CDlog dialog windows. } {} { SUPERCLASS = CEditText} { SUBCLASSES = None} { **************************************************** } CDEditText = object(CEditText) clickCmd: longint; { Command to issue upon click or change to field } filter: integer; { Mask for editing keystrokes } maxLength: integer; { Maximum length of field } procedure IDEditText ( { Same parameters as CEditText } anEnclosure: CView; aSupervisor: CBureaucrat; aWidth, aHeight, aHEncl, aVEncl: integer; aHSizing, aVSizing: SizingOption; aLineWidth: integer); procedure DoCommand ( { Do a command } theCommand: longint); override; procedure DoClick ( { Handle clicks } hitPt: Point; { Mouse location in Frame coords } modifierKeys: integer; { State of modifier keys } when: longint); { Tick time of mouse click } override; procedure SetClickCmd ( { Set command to issue upon click or change to field } aClickCmd: longint); { Command number } procedure DoKeyDown ( { Handle key-down } theChar: char; { Key character } keyCode: Byte; { Key code } macEvent: EventRecord); { Mac event record } override; procedure SetSelect ( { Set selection range } start: longint; { Start of selection range } stop: longint); { End of selection range } procedure SetEdit ( { Set editing control variables } aFilter: integer; { The filter mask } aMaxLength: integer); { The maximum length } end; { **************************************************** } { C D M O D A L D E S K T O P } {} { CDModalDesktop provides the base support required to implement modal CDlog } { dialog windows . } {} { NOTE: Override the MakeDesktop method in your application class if you want } { to support modal CDlogs dialog windows. Example: } {} { PROCEDURE CYourApp.MakeDesktop;} { VAR} { aDeskTop: CDModalDesktop;} {} { BEGIN} { new(aDesktop); { Use a CDModalDesktop Desktop } { gDeskTop := aDeskTop; { Set the global variable } { gDesktop.IDesktop(SELF); { Send the init message } { END;} {} { You should not need to override this class. } {} { SUPERCLASS = CDesktop} { SUBCLASSES = None} { **************************************************** } CDModalDeskTop = object(CDesktop) procedure DispatchClick (var macEvent: EventRecord); override; end; { **************************************************** } { C D T I T L E D B O R D E R } {} { CTitledBorder implements titled borders. It is used by CDRadioGroup and other } { classes in CDlog. It is not dependant on CDlog, however, and may be used in } { any TCL pane. } {} { You should not need to override this class. } {} { SUPERCLASS = CBorder} { SUBCLASS = None} { See also: CDRadioGroup} { **************************************************** } CTitledBorder = object(CBorder) itsTitle: Str255; { Title to draw at top left of rectangle } txFont: integer; { GrafPort text characteristics } txFace: Style; txMode: integer; txSize: integer; procedure ITitledBorder (anEnclosure: CView; aSupervisor: CBureaucrat; aWidth, aHeight, aHEncl, aVEncl: integer; aHSizing, aVSizing: SizingOption; aTitle: Str255); procedure SetTitle ( { Set the title } aTitle: Str255); procedure Draw (var area: Rect); override; end; { **************************************************** } { C D R A D I O G R O U P } {} { CDRadioGroup implements radio groups for CDlog dialog windows. } {} { The initial reason I needed this class was because I was not using CRadioButton } { (or a subclass), so the usual CRadioGroup class was not an option. Later, I } { added a titled border, which is the other significant difference between this } { class and CRadioGroup. } {} { You should not need to override this class. } {} { SUPERCLASS = CBureaucrat} { SUBCLASS = None} { See also: CDRadioGroup} { **************************************************** } CDRadioGroup = object(CBureaucrat) {* Instance Variables *} itsButtons: CCluster; { Individual radio buttons } station: CDRadioButton; { Currently selected button } itsBorder: CTitledBorder; {* Instance Methods *} procedure IDRadioGroup (anEnclosure: CView; aSupervisor: CBureaucrat; aTitle: Str255); procedure Free; override; procedure AddButton (theRadioButton: CDRadioButton); procedure RemoveButton (theRadioButton: CDRadioButton); procedure ChangeStation (theStation: CDRadioButton); function GetStation: CDRadioButton; procedure SetStationID (aStationID: integer); function GetStationID: integer; procedure CalcBorder (aWidth, aHeight: integer); procedure SetBorderTitle (aStr: Str255); { Set the title of the border } end; { **************************************************** } { C D L O G W I N D } {} { CDlogWind implements the CWindow-subclass for CDlog dialog windows. } {} { You should not need to override this class. } {} { SUPERCLASS = CWindow} { SUBCLASS = None} { **************************************************** } CDlogWind = object(CWindow) { CWindow except DLOG resource } modal: boolean; procedure IDlogWind ( { Initialize CDlogWind } DLOGid: integer; { ID of DLOG resource } aFloating: Boolean; { True if floating window (+FWDesktop)} anEnclosure: CDesktop; { Typically gDeskTop } aSupervisor: CDirector); { Typically gApplication } procedure MakeMacWindow ( { Make Mac ToolBox window } WINDid: integer); { ID of DLOG resource } override; function GetModal: boolean; procedure SetModal (aModal: boolean); end; {CDlogWind} { **************************************************** } { C D L O G } {} { CDlog implements dialog windows using DITL and DLOG resources. } {} { Normally, you create a subclass of CDlog and override the DoCommand method } { (at least) to implement the specific behavior of the dialog. } {} { You may want to override one or more of the MAKEsomething methods, but } { that should be the exception, not the rule. } {} { SUPERCLASS = CDirector} { SUBCLASS = None} { **************************************************** } CDlog = object(CDirector) itsDocument: CDocument; { Owner document, if any } itsDlogID: integer; { ID of DLOG resource } itsPanes: CList; { List of all items; subclasses of CPane } itsTEPanes: CList; { List of all CDEditText items } itsActiveTE: integer; { Index to itsTEPanes for active CDEditText item } itsRadioGroups: CList; { List of all RadioGroups } procedure IDlog ( { Make a dialog } DLOGid: integer; { DLOG resource id } aFloating: Boolean; { True if Floating window required; unsupported at present } aDocument: CDocument; { Owner document, if any } aSupervisor: CApplication; { The application } aFont: integer; { Font for window, text items } aSize: integer); { Font size for same } procedure Free; override; function Close (quitting: boolean): boolean; override; procedure GetDItem ( { Get item info } item: integer; { The item } var kind: integer; { Its itemType } var h: CObject; { Its object reference (CPane) } var r: Rect); { Its enclosure } procedure ActivatePrevTE; { Activate previous TE in list } procedure ActivateNextTE; { Activate next TE in list } procedure ActivateThisTE (tePane: CDEditText); { Activate TE that was clicked } procedure UpdateMenus; { Enable/disable menu items } override; procedure DoCommand ( { Handle commands } theCommand: longint); { The command number } override; procedure SetEdit ( { Set editing control variables } anItem: integer; { Item number of edit text field } aFilter: integer; { The filter mask } aMaxLength: integer); { The maximum length } procedure GetIText ( { Get item text } anItem: integer; { Item number of text field } var str: Str255); { The text in a string } procedure SetIText ( { Set item text } anItem: integer; { Item number of text field } str: Str255); { New text for the item } procedure DoKeyDown ( { Handle key-down } theChar: char; { Key character } keyCode: Byte; { Key code } macEvent: EventRecord); { Mac event record } override; procedure DoButton ( { Simulate clicking a button } itemNumber: integer); { Item number of button to 'click' } function GetControlHandle ( { Get ControlHandle for give item } itemNumber: integer): ControlHandle; { Item number } function MakeButton ( { Make a CDButton for IDlog } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; { DITL item } enabled: boolean): CPane; { True if clicks accepted } function MakeCheckBox ( { Make a CDCheckBox for IDlog } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; { DITL item } enabled: boolean): CPane; { True if clicks accepted } function MakeRadioButton ( { Make a CDRadioButton for IDlog } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; { DITL item } enabled: boolean; { True if clicks accepted } anId: integer): CPane; { ID number used by CRadioGroup } function MakeControl ( { Make a CDControl for IDlog } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; { DITL item } enabled: boolean): CPane; { True if clicks accepted } function MakeIcon ( { Make a CDIcon for IDlog } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; { DITL item } enabled: boolean): CPane; { True if clicks accepted } function MakePicture ( { Make a CDPicture for IDlog } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; { DITL item } enabled: boolean): CPane; { True if clicks accepted } function MakeUser ( { Make a CDUser for IDlog } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; { DITL item } enabled: boolean): CPane; { True if clicks accepted } function MakeEditText ( { Make a CDEditText for IDlog } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; { DITL item } enabled: boolean): CPane; { True if clicks accepted } function MakeStaticText ( { Make a CStaticText for IDlog } anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; { DITL item } enabled: boolean): CPane; { True if clicks accepted } end; { **************************************************** } { P R O C E D U R A L U T I L I T I E S } { **************************************************** } { **************************************************** } { SectPanes } {} { SectPanes is a utility that constructs a rectangle that encloses a series of CPane } { objects stored in a list (CCluster or CList). If you had 10 CPane (or subclass) } { objects in a list, you could make a rectangle that encloses the 3rd, 4th and 5th } { with:} {} { SectPane(thePaneList, 3, 5, theEnclosingRect);} {} { **************************************************** } procedure SectPanes ( { Construct enclosing frame from } { a series of CPanes in a list } list: CCluster; { The list of panes } first, last: integer; { The first and last the define the series } var theFrame: Rect); { The enclosing rectangle } implementation const BORDER_OFFSET = 3; type CDlogTemplate = record { DLOG template - see IM I-423 for details } boundsRect: Rect; WDEFid: integer; visible: integer; goAwayFlag: integer; refCon: longint; itemsID: integer; title: Str255; end; {CDlogTemplate} CDlogTemplateP = ^CDlogTemplate; CDlogTemplateH = ^CDlogTemplateP; CCntlTemplate = record { CNTL template - see IM I-333 for details } boundsRect: Rect; value: integer; isVisible: integer; max: integer; min: integer; procID: integer; refCon: longint; title: Str255; end; {CCntlTemplate} CCntlTemplateP = ^CCntlTemplate; CCntlTemplateH = ^CCntlTemplateP; { **************************************************** } { C D F R E E C H O R E } {} { CDFreeChore sends a Free message to an object at "urgent chore" time. This } { approach avoids conflicts when an object should to be free'd, but methods in } { the call chain may need it to survive until the call chain is unwound. } {} { Not used at present.} {} { SUPERCLASS = CChore} { SUBCLASS = None} { **************************************************** } CDFreeChore = object(CChore) theObject: CObject; { The object to be Free'd } procedure IDFreeChore (anObject: CObject); { Set 'theObject' and AssignUrgentChore } procedure Perform (var maxSleep: longint); { Free theObject } override; end; { **************************************************** } { P R O C E D U R A L U T I L I T I E S } { **************************************************** } procedure SectPanes ( { Construct enclosing frame from } { series of CPanes in a list } list: CCluster; { The panes } first, last: integer; { The first and last the define the series } var theFrame: Rect); { The enclosing rectangle } var aPane: CPane; index: integer; aRect: Rect; begin with theFrame do begin left := 32767; top := 32767; right := 0; bottom := 0; end; for index := first to last do begin aPane := CPane(list.items^^[index - 1]); aPane.GetFrame(aRect); aPane.FrameToEnclR(aRect); with aRect do begin if left < theFrame.left then theFrame.left := left; if top < theFrame.top then theFrame.top := top; if right > theFrame.right then theFrame.right := right; if bottom > theFrame.bottom then theFrame.bottom := bottom; end; end; end; { ****************************************************} { PositionDlog} {} { Center the bounding box of a dialog or alert in the upper third} { of the screen. This is the preferred location according to the} { Human Interface Guidelines.} {} { A modified version taken from PositionDialog in TCL.p; avoids conflict with} { menubar when dialog has titlebar by using bigger offset from top (27 v 7).} { ****************************************************} procedure PositionDlog (theType: ResType; theID: integer); var theRect: Rect; theRectPtr: RectPtr; { Ptr to bounding box of dialog } theTemplate: Handle; { Handle to resource template } left, { Left side of centered rect } top: integer; { Top side of centered rect } begin { The first field of the resource template for DLOG's and ALRT's } { is its bounding box. Get a pointer to this rectangle. This } { handle dereferencing is safe since the remaining statements in } { this function do not move memory (assignment and simple math). } theTemplate := GetResource(theType, theID); CheckResource(theTemplate); theRectPtr := RectPtr(theTemplate^); theRect := theRectPtr^; { Center horizontally on screen } left := (screenBits.bounds.right - (theRect.right - theRect.left)) div 2; { Leave twice as much space as above } top := (screenBits.bounds.bottom - (theRect.bottom - theRect.top)) div 3; { Don't put rect under menu bar } if top < GetMBarHeight + 27 then top := GetMBarHeight + 27; theRect.right := theRect.right + left - theRect.left; theRect.left := left; theRect.bottom := theRect.bottom + top - theRect.top; theRect.top := top; theRectPtr^ := theRect; end; function ParseCmdNumber (var aTitle: Str255): longint; var cmdNumber: longint; cmdString: Str255; i: integer; begin {ParseCmdNumber} for i := length(aTitle) downto 1 do if aTitle[i] = '#' then begin cmdString := Copy(aTitle, i + 1, length(aTitle) - i); {$PUSH} {$R-} aTitle[0] := Chr(i - 1); {$POP} StringToNum(cmdString, cmdNumber); ParseCmdNumber := cmdNumber; Exit(ParseCmdNumber); end; ParseCmdNumber := 0; end; {ParseCmdNumber} { **************************************************** } { C D F R E E C H O R E M E T H O D S } { **************************************************** } { IDFreeChore } {} { Initialize a CDFreeChore. } {} { **************************************************** } procedure CDFreeChore.IDFreeChore (anObject: CObject); begin theObject := anObject; gApplication.AssignUrgentChore(SELF); end; { **************************************************** } { Perform } {} { Free an object.} {} { **************************************************** } procedure CDFreeChore.Perform (var maxSleep: longint); begin theObject.Free; end; { **************************************************** } { C D C O N T R O L M E T H O D S } { **************************************************** } { IDControl } {} { First step in initializing a CDControl. A CDControl acts more like CButton than } { CControl. } {} { **************************************************** } procedure CDControl.IDControl (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec); var resID: integer; controlTmpl: CCntlTemplateH; aRect: Rect; begin IView(anEnclosure, aSupervisor); macPort := itsEnclosure.GetMacPort; resID := IntPtr(Ord(@item) + sizeOf(CDDitlItemRec) - sizeOf(Str255))^; controlTmpl := CCntlTemplateH(GetResource('CNTL', resID)); CheckResource(Handle(controlTmpl)); HLock(Handle(controlTmpl)); with controlTmpl^^ do begin with boundsRect do OffsetRect(boundsRect, -left, -top); with item.boundsRect do OffsetRect(controlTmpl^^.boundsRect, left, top); clickCmd := ParseCmdNumber(title); macControl := NewControl(macPort, boundsRect, title, (isVisible <> 0), value, min, max, procID, refCon);{(controlTmpl^^.isVisible <> 0)} end; HUnlock(Handle(controlTmpl)); ReleaseResource(Handle(controlTmpl)); IDControlX(item); end; { **************************************************** } { IDControlX } {} { Second step in initializing a CDControl. } {} { **************************************************** } procedure CDControl.IDControlX (item: CDDitlItemRec); begin txFont := macPort^.txFont; txFace := macPort^.txFace; txMode := macPort^.txMode; txSize := macPort^.txSize; saveHilite := macControl^^.contrlHilite; visible := (macControl^^.contrlVis = 255); active := TRUE; autoRefresh := TRUE; wantsClicks := TRUE; hEncl := item.boundsRect.left; vEncl := item.boundsRect.top; with macControl^^.contrlRect do begin width := right - left; height := bottom - top; end; {with macControl^^.contrlRect} hSizing := sizFIXEDSTICKY; vSizing := sizFIXEDSTICKY; CalcFrame; CalcAperture; itsEnvironment := nil; itsEnclosure.AddSubview(self); end; {IDControlX} { **************************************************** } { Draw (OVERRIDE)} {} { Other classes are not as nice as they should be; they change the GrafPort's } { text characteristics and don't restore them: This class saves the info } { and restores it before drawing. } {} { **************************************************** } procedure CDControl.Draw (var area: Rect); begin TextFont(txFont); TextFace(txFace); TextMode(txMode); TextSize(txSize); inherited Draw(area); end; {****************************************************} { Activate (OVERRIDE)} {} { Activate a Control} {} {****************************************************} procedure CDControl.Activate; var tempRect: Rect; begin if not active then begin active := TRUE; Prepare; HidePen; HiliteControl(macControl, saveHilite); ShowPen; tempRect := aperture; DrawAll(tempRect); FrameToWindR(tempRect); ValidRect(tempRect); end; end; {****************************************************} { Deactivate (OVERRIDE)} {} { Deactivate a Control} {} {****************************************************} procedure CDControl.Deactivate; var tempRect: Rect; begin if active then begin saveHilite := macControl^^.contrlHilite; active := FALSE; Prepare; HidePen; HiliteControl(macControl, 255); ShowPen; tempRect := aperture; DrawAll(tempRect); end; end; {**** C L I C K H A N D L I N G M E T H O D S ****} { **************************************************** } { DoGoodClick (OVERRIDE)} {} { A CDControl responds to a good click (the mouse being pressed } { and released within the button) by passing a particular command } { to its supervisor. } {} { **************************************************** } procedure CDControl.DoGoodClick (whichPart: integer); begin if clickCmd <> cmdNull then { Issue the appropriate command } itsSupervisor.DoCommand(clickCmd); end; { **************************************************** } { SetClickCmd} {} { Specify the command which is sent to a CDControl's supervisor } { after a confirmed click. } {} { **************************************************** } procedure CDControl.SetClickCmd (aClickCmd: longint); begin clickCmd := aClickCmd; { Set instance variable } end; { **************************************************** } { Hilite} {} { Interface to the Control Manager HiliteControl procedure. } {} { **************************************************** } procedure CDControl.Hilite ( { Send HiliteControl message to control } hiliteState: integer); { Passed argument } begin Prepare; HiliteControl(macControl, hiliteState); saveHilite := hiliteState; end; { **************************************************** } { C D B U T T O N M E T H O D S } { **************************************************** } { IDButton } {} { Initialize a CDButton. } {} { **************************************************** } procedure CDButton.IDButton (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec); var theTitle: Str255; begin IView(anEnclosure, aSupervisor); macPort := itsEnclosure.GetMacPort; with item do begin theTitle := StringPtr(Ord(@item) + sizeOf(CDDitlItemRec) - SizeOf(Str255) - 1)^; clickCmd := ParseCmdNumber(theTitle); macControl := NewControl(macPort, boundsRect, theTitle, TRUE, 0, 0, 1, pushButProc, 0); end; IDControlX(item); end; {IDButton} { **************************************************** } { C D R A D I O B U T T O N M E T H O D S } { **************************************************** } { IDRadioButton } {} { Initialize a CDRadioButton. } {} { **************************************************** } procedure CDRadioButton.IDRadioButton (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; anIdNumber: integer); var theTitle: Str255; begin IView(anEnclosure, aSupervisor); macPort := itsEnclosure.GetMacPort; with item do begin theTitle := StringPtr(Ord(@item) + sizeOf(CDDitlItemRec) - SizeOf(Str255) - 1)^; clickCmd := ParseCmdNumber(theTitle); macControl := NewControl(macPort, boundsRect, theTitle, TRUE, 0, 0, 1, radioButProc, 0); end; IDControlX(item); idNumber := anIdNumber; end; {IDRadioButton} { **************************************************** } { DoGoodClick (OVERRIDE)} {} { A RadioButton responds to a good click (the mouse being pressed and } { released within the button) by relaying a command to its supervisor } { if it is not already selected. } {} { **************************************************** } procedure CDRadioButton.DoGoodClick (whichPart: integer); begin if GetCtlValue(macControl) = BUTTON_OFF then CDRadioGroup(itsSupervisor).ChangeStation(SELF); if clickCmd <> cmdNull then { Issue the appropriate command } itsSupervisor.DoCommand(clickCmd); end; { **************************************************** } { GetIdNumber} {} { Return id number of a CDRadioButton. } {} { **************************************************** } function CDRadioButton.GetIdNumber: integer; begin GetIdNumber := idNumber; { Return instance variable } end; { **************************************************** } { C D C H E C K B O X M E T H O D S } { **************************************************** } { IDCheckBox } {} { Initialize a CDCheckBox. } {} { **************************************************** } procedure CDCheckBox.IDCheckBox (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec); var theTitle: Str255; begin IView(anEnclosure, aSupervisor); macPort := itsEnclosure.GetMacPort; with item do begin theTitle := StringPtr(Ord(@item) + sizeOf(CDDitlItemRec) - SizeOf(Str255) - 1)^; clickCmd := ParseCmdNumber(theTitle); macControl := NewControl(macPort, boundsRect, theTitle, TRUE, 0, 0, 1, checkBoxProc, 0); end; IDControlX(item); end; {IDCheckBox} { **************************************************** } { DoGoodClick (OVERRIDE)} {} { A CDCheckBox responds to a good click (the mouse being pressed} { and released within the button) by flipping the setting on/off} { and possibly passing a command to its supervisor. Under most} { circumstances, there will be no such command.} {} { **************************************************** } procedure CDCheckBox.DoGoodClick (whichPart: integer); begin SetValue(1 - GetCtlValue(macControl)); if clickCmd <> cmdNull then { Issue the appropriate command } itsSupervisor.DoCommand(clickCmd); end; { **************************************************** } { ToggleChecked} {} { Reverse CDCheckBox; checked to unchecked and vice-versa} {} { **************************************************** } procedure CDCheckBox.ToggleCheck; begin SetValue(1 - GetCtlValue(macControl)); end; { **************************************************** } { IsChecked} {} { Determine whether a CDCheckBox is checked or unchecked} {} { **************************************************** } function CDCheckBox.IsChecked: Boolean; begin IsChecked := GetCtlValue(macControl) = BUTTON_ON; end; { **************************************************** } { C D G R A P H I C M E T H O D S } { **************************************************** } { SetClickCmd } {} { Specify the command which is sent to a CDGraphic's supervisor } { after a confirmed click. } {} { **************************************************** } procedure CDGraphic.SetClickCmd (aClickCmd: longint); begin clickCmd := aClickCmd; { Set instance variable } end; { **************************************************** } { DoClick } {} { Handle a mouse click on a graphic. } {} { **************************************************** } procedure CDGraphic.DoClick (hitPt: Point; modifierKeys: integer; when: longint); var inRect: boolean; aRect: Rect; aPoint: Point; begin inRect := TRUE; Hilite(Ord(inRect)); aRect := frame; while StillDown do begin GetMouse(aPoint); if PtInRect(aPoint, aRect) <> inRect then begin inRect := not inRect; Hilite(Ord(inRect)); end; {if PtInRect(aPoint, aRect) <> inRect} end; {WHILE StillDown} if inRect then DoGoodClick(Ord(inRect)); end; {DoClick} { **************************************************** } { DoGoodClick } {} { A CDGraphic responds to a good click (the mouse being pressed } { and released within the button) by passing a particular command } { to its supervisor, and setting state to Ord(FALSE). } {} { **************************************************** } procedure CDGraphic.DoGoodClick (whichPart: integer); begin Hilite(Ord(FALSE)); if clickCmd <> cmdNull then { Issue the appropriate command } itsSupervisor.DoCommand(clickCmd); end; { **************************************************** } { Hilite } {} { Handle a mouse click on a graphic. } {} { **************************************************** } procedure CDGraphic.Hilite (aState: integer); var aRect: Rect; begin if state <> aState then begin state := aState; aRect := Frame; InvertRect(aRect); end; {IF state <> aState} end; {Hilite} { **************************************************** } { C D I C O N M E T H O D S } { **************************************************** } { IDIcon } {} { Initialize a CDIcon. } {} { **************************************************** } procedure CDIcon.IDIcon (anEnclosure: CView; aSupervisor: CBureaucrat; aWidth: integer; aHeight: integer; aHEncl: integer; aVEncl: integer; aHSizing: SizingOption; aVSizing: SizingOption; anIconID: integer); begin IPane(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, aVEncl, aHSizing, aVSizing); theIcon := nil; NewIcon(anIconID); end; {IDIcon} { **************************************************** } { Free } {} { Free a CDIcon. } {} { **************************************************** } procedure CDIcon.Free; begin if theIcon <> nil then ReleaseResource(Handle(theIcon)); inherited Free; end; { **************************************************** } { Draw } {} { Draw a CDIcon. } {} { **************************************************** } procedure CDIcon.Draw (var area: Rect); var aRect: Rect; begin aRect := frame; LoadResource(theIcon); PlotIcon(aRect, theIcon); end; {Draw} { **************************************************** } { NewIcon} {} { Specify a new ICON id. } {} { **************************************************** } procedure CDIcon.NewIcon (anIconID: integer); begin if theIcon <> nil then ReleaseResource(Handle(theIcon)); clickCmd := anIconID; theIconID := anIconID; theIcon := GetIcon(theIconID); CheckResource(theIcon); Refresh; end; {NewIcon} { **************************************************** } { C D P I C T U R E M E T H O D S } { **************************************************** } { IDPicture } {} { Initialize a CDPicture. } {} { **************************************************** } procedure CDPicture.IDPicture (anEnclosure: CView; aSupervisor: CBureaucrat; aWidth: integer; aHeight: integer; aHEncl: integer; aVEncl: integer; aHSizing: SizingOption; aVSizing: SizingOption; aPictID: integer); begin IPane(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, aVEncl, aHSizing, aVSizing); thePicture := nil; NewPicture(aPictID); end; {IDPicture} { **************************************************** } { Free } {} { Free a CDPicture. } {} { **************************************************** } procedure CDPicture.Free; begin if thePicture <> nil then ReleaseResource(Handle(thePicture)); inherited Free; end; { **************************************************** } { Draw } {} { Draw a CDPicture. } {} { **************************************************** } procedure CDPicture.Draw (var area: Rect); var aRect: Rect; begin aRect := frame; LoadResource(Handle(thePicture)); DrawPicture(thePicture, aRect); end; {Draw} { **************************************************** } { NewPicture} {} { Specify a new PICT id. } {} { **************************************************** } procedure CDPicture.NewPicture (aPictID: integer); begin if thePicture <> nil then ReleaseResource(Handle(thePicture)); clickCmd := aPictID; thePictID := aPictID; thePicture := GetPicture(thePictID); CheckResource(Handle(thePicture)); Refresh; end; {NewPicture} { **************************************************** } { C D U S E R M E T H O D S } { **************************************************** } { IDUser } {} { Initialize a CDUser. } {} { **************************************************** } procedure CDUser.IDUser (anEnclosure: CView; aSupervisor: CBureaucrat; aWidth: integer; aHeight: integer; aHEncl: integer; aVEncl: integer; aHSizing: SizingOption; aVSizing: SizingOption); begin IPane(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, aVEncl, aHSizing, aVSizing); end; {IDUser} { **************************************************** } { Hilite } {} { Hilite a CDUser. } {} { **************************************************** } procedure CDUser.Hilite (aState: integer); begin end; {Hilite} { **************************************************** } { C D E D I T T E X T M E T H O D S } { **************************************************** } procedure CDEditText.IDEditText ( { Same parameters as CEditText } anEnclosure: CView; aSupervisor: CBureaucrat; aWidth, aHeight, aHEncl, aVEncl: integer; aHSizing, aVSizing: SizingOption; aLineWidth: integer); begin IEditText(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, aVEncl, aHSizing, aVSizing, aLineWidth); clickCmd := cmdNull; filter := 0; maxLength := 0; end; { **************************************************** } { DoCommand } {} { Do a command. Watches for paste commands that cause text to grow beyond } { "maxLength" bytes. } {} { **************************************************** } procedure CDEditText.DoCommand (theCommand: longint); begin inherited DoCommand(theCommand); if theCommand = cmdPaste then begin { Pasting avoids the length editing done in DoKeyDown; catch it here.} if (maxLength > 0) & (macTE^^.teLength > maxLength) then begin { Unhealthy growth? } with macTE^^ do begin selStart := teLength - (teLength - maxLength); selEnd := teLength; end; TEDelete(macTE); { Surgically remove } AdjustBounds; ScrollToSelection; end; { IF teLength > maxLength } { Pasting avoids the character-by-character editing done in DoKeyDown.} if filter <> 0 then begin {This is going to be messy once I get around to it.} end; {IF filter <> 0} end; { IF theCommand = cmdPaste } if (theCommand >= cmdUndo) & (theCommand <= cmdClear) & (clickCmd <> cmdNull) then itsSupervisor.DoCommand(clickCmd); { Issue the appropriate command } end; { **************************************************** } { DoClick } {} { Handle click on an CDEditText item. } {} { **************************************************** } procedure CDEditText.DoClick ( { Handle clicks } hitPt: Point; { Mouse location in Frame coords } modifierKeys: integer; { State of modifier keys } when: longint); { Tick time of mouse click } begin CDlog(itsSupervisor).ActivateThisTE(self); inherited DoClick(hitPt, modifierKeys, when); if clickCmd <> cmdNull then { Issue the appropriate command } itsSupervisor.DoCommand(clickCmd); end; { **************************************************** } { SetClickCmd } {} { Specify the command which is sent to a CDEditText's supervisor } { after a confirmed click. } {} { **************************************************** } procedure CDEditText.SetClickCmd ( { Set command to issue upon click } aClickCmd: longint); { Specified command number } begin clickCmd := aClickCmd; end; { **************************************************** } { DoKeyDown } {} { Handle special keys before TextEdit sees them. } {} { **************************************************** } procedure CDEditText.DoKeyDown ( { Handle key-down } theChar: char; { Key character } keyCode: Byte; { Key code } macEvent: EventRecord); { Mac event record } { filter is a field that controls optional behavior. The field is set by adding a set of constants:} {} { CdCrOkOff (2) means CR <> item 1} {} { CdEtxOkOff (4) means ETX <> item 1} {} { CdEscOff (8) means ESC <> item 2} {} { CdCrFiltOn (16) means filter (prevent) CR.} {} { CdSpecFiltOn (32) means filter (prevent) all other special, except HT, BS, and} { the arrow keys, which have editing uses with TE.} {} { CdNspFiltOn (64) means filter (prevent) all characters that are invalid as} { part of NSP keyword names, except HT, BS, and the arrow} { keys, which have editing uses with TE.} {} {} { CdClidFiltOn (128) means filter (prevent) all characters that are invalid as} { part of client ids, and uppercase input.} {} { CdLenFiltOn (256) means apply the length check; prevent field from growing} { beyond "maxLength" bytes.} {} { CdCMSFiltOn (512) means filter (prevent) all characters that are not alphabetic} { or numeric, and uppercase lowercase characters. (Intended} { for CMS filenames)} {} { CdNumFiltOn (1024) means filter (prevent) all characters that are not numeric.} {} { CdUpDownOn (2048) means treat up and down arrow keys as commands.} {} { CdLeftRightOn (4096) means treat left and right arrow keys as commands.} {} { Read the above descriptions carefully; some are "negative" flags} { (meaning that turning the bit on prevents some action), and some} { are positive (meaning that turning the bit on causes some action).} {} { For example, if you DON'T want CR to mean "click on item 1", and} { you DO want CR filtered, you would "SetEdit(CdCrOkOff+CdCrFiltOn);"} {} { If features conflict, the processing basically occurs in the order} { they are listed above.} {} { Set filter to 0 to get the default editing.} {} const ETX = $03; HT = $09; CR = $0D; ESC = $1B; LKEY = $1C; RKEY = $1D; UKEY = $1E; DKEY = $1F; crOkMask = $02; { Negative: feature OFF if bit set} etxOkMask = $04; { Negative: feature OFF if bit set} escCanMask = $08; { Negative: feature OFF if bit set} crFiltMask = $10; {#1 Positive: feature ON if bit set} specFiltMask = $20; {#1 Positive: feature ON if bit set} nspFiltMask = $40; {#1 Positive: feature ON if bit set} clidFiltMask = $80; {#1 Positive: feature ON if bit set} lenFiltMask = $100; {#2 Positive: feature ON if bit set} CMSFiltMask = $200; {#1 Positive: feature ON if bit set} NumFiltMask = $400; {#1 Positive: feature ON if bit set} VertMask = $800; {#3 Positive: feature ON if bit set} HorizMask = $1000; {#3 Positive: feature ON if bit set} {} { 1) For the items marked by #1, the program returns command} { "cmdBadChar" to the program when it filters a character.} {} { 2) For the items marked by #2, the program returns command} { "cmdBadLength" to the program when it filters a character.} {} { 3) For the items marked by #3, the program returns command} { "cmdArrowLeft, cmdArrowRight, cmdArrowUp, or cmdArrowDown"} { to the program when it detects the the correspoding arrow key.} {} { The positive features are tested against the filter;} { the negative features are tested against the NOT of the filter (notFilter).} {} type Char4 = packed record {Useful for accessing ...} case integer of 0: ( chr3, chr2, chr1, chr0: char {chars within a longint} ); 1: ( int1, int0: integer {int's within a longint} ); end; var cmd: longint; notFilter: integer; begin cmd := 0; notFilter := BNOT(filter); {Uppercase characters in CdCMSFiltOn or CdClidFiltOn case} if ((BAnd(CMSFiltMask, filter) <> 0) | (BAnd(ClidFiltMask, filter) <> 0)) & (Ord(theChar) in [$61..$7A]) then begin { Uppercase a lowercase character } theChar := Chr(Ord(theChar) - 32); { Uppercase it } Char4(macEvent.message).Chr0 := theChar; { Put it in event } end; {CMSFiltMask or ClidFiltMask and lowercase character} {Check for special characters} if (BAnd(HorizMask, filter) <> 0) & (Ord(theChar) in [LKEY..RKEY]) then { Filter arrow keys } cmd := cmdArrowLeft + Ord(theChar) - LKEY { Inform caller } else if (BAnd(VertMask, filter) <> 0) & (Ord(theChar) in [UKEY..DKEY]) then { Filter arrow keys } cmd := cmdArrowLeft + Ord(theChar) - LKEY { Inform caller } else if (BAnd(crOkMask, notFilter) <> 0) and (Ord(theChar) = CR) then { Return = OK } cmd := cmdOkEquiv { Simulate clicking OK } else if (BAnd(etxOkMask, notFilter) <> 0) and (Ord(theChar) = ETX) then { Enter = OK } cmd := cmdOkEquiv { Simulate clicking OK } else if (BAnd(escCanMask, notFilter) <> 0) and (Ord(theChar) = ESC) then { ESC = CANCEL } cmd := cmdCancelEquiv { Simulate clicking Cancel } else if (BAnd(crFiltMask, filter) <> 0) and (Ord(theChar) = CR) then { Filter CR } cmd := cmdBadChar { Note bad character } else if (BAnd(specFiltMask, filter) <> 0) & (not (Ord(theChar) in [$08..$09, $0D, $1C..$1F, $20, $21, $23..$7E])) then { Filter characters disallowed in this context } cmd := cmdBadChar { Note bad character } else if (BAnd(nspFiltMask, filter) <> 0) & (not (Ord(theChar) in [$08..$09, $0D, $1C..$1F, $30..$39, $41..$5A, $61..$7A])) then { Filter characters disallowed in this context } cmd := cmdBadChar { Note bad character } else if (BAnd(clidFiltMask, filter) <> 0) & (not (Ord(theChar) in [$08..$09, $0D, $1C..$1F, $24, $41..$5A])) then { Filter characters disallowed in this context } cmd := cmdBadChar { Note bad character } else if (BAnd(CMSFiltMask, filter) <> 0) & (not (Ord(theChar) in [$08..$09, $0D, $1C..$1F, $24, $30..$39, $41..$5A])) then { Filter characters disallowed in this context } cmd := cmdBadChar { Note bad character } else if (BAnd(numFiltMask, filter) <> 0) & (not (Ord(theChar) in [$08..$09, $0D, $1C..$1F, $30..$39])) then { Filter characters disallowed in this context } cmd := cmdBadChar { Note bad character } else if (BAnd(lenFiltMask, filter) <> 0) & (not (Ord(theChar) in [$08..$09, $0D, $1C..$1F])) then {Check length} with macTE^^ do if (selStart = selEnd) and (teLength = maxLength) then cmd := cmdBadLength; { Note too many characters } if cmd <> 0 then DoCommand(cmd) { One more special character to check for... } else if (theChar = Chr(HT)) then if (BAnd(macEvent.modifiers, shiftKey) <> 0) then { Shift - tab } CDlog(itsSupervisor).ActivatePrevTE else { Tab } CDlog(itsSupervisor).ActivateNextTE else begin inherited DoKeyDown(theChar, keyCode, macEvent); { Everything else} if clickCmd <> cmdNull then { Issue the appropriate command } itsSupervisor.DoCommand(clickCmd); end; end; { **************************************************** } { SetSelect } {} { Set the selection range for a CDEditText item. } {} { **************************************************** } procedure CDEditText.SetSelect ( { Set selection range } start: longint; { Start of selection range } stop: longint); { End of selection range } begin TESetSelect(start, stop, macTE); end; { **************************************************** } { SetEdit } {} { Set the filter and maxLength fields for a CDEditText item. } {} { **************************************************** } procedure CDEditText.SetEdit ( { Set editing control variables } aFilter: integer; { The filter mask } aMaxLength: integer); { The maximum length } begin filter := aFilter; maxLength := aMaxLength; end; { **************************************************** } { C T I T L E D B O R D E R M E T H O D S } { **************************************************** } procedure CTitledBorder.ITitledBorder (anEnclosure: CView; aSupervisor: CBureaucrat; aWidth, aHeight, aHEncl, aVEncl: integer; aHSizing, aVSizing: SizingOption; aTitle: Str255); begin IBorder(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, aVEncl, aHSizing, aVSizing); itsTitle := Concat(' ', aTitle, ' '); txFont := macPort^.txFont; txFace := macPort^.txFace; txMode := macPort^.txMode; txSize := macPort^.txSize; end; procedure CTitledBorder.SetTitle (aTitle: Str255); var theRect: Rect; theFontInfo: FontInfo; begin Prepare; TextFont(txFont); { Set grafport's text characteristics } TextFace(txFace); TextSize(txSize); GetFontInfo(theFontInfo); theRect := frame; with theRect, theFontInfo do bottom := top + ascent + descent + leading; RefreshRect(theRect); itsTitle := Concat(' ', aTitle, ' '); end; procedure CTitledBorder.Draw (var area: Rect); var r: Rect; aStr: Str255; aFontInfo: FontInfo; begin TextFont(txFont); { Set grafport's text characteristics } TextFace(txFace); TextSize(txSize); GetFontInfo(aFontInfo); r := frame; if itsTitle <> '' then r.top := r.top + aFontInfo.ascent div 2; r.right := r.right - dropShadow; r.bottom := r.bottom - dropShadow; PenNormal; PenSize(thickness, thickness); FrameRect(r); if dropShadow > 0 then begin PenSize(dropShadow, dropShadow); MoveTo(frame.left + dropShadow, frame.bottom - dropShadow); LineTo(frame.right - dropShadow, frame.bottom - dropShadow); LineTo(frame.right - dropShadow, frame.top + dropShadow); end; if itsTitle <> '' then begin MoveTo(frame.left + BORDER_OFFSET + BORDER_OFFSET, frame.top + aFontInfo.ascent); aStr := itsTitle; TextMode(srcCopy); DrawString(aStr); TextMode(txMode); end; end; { **************************************************** } { C D R A D I O G R O U P M E T H O D S } { **************************************************** } { IDRadioGroup} {} { Initialize a CDRadioGroup object} {} { **************************************************** } procedure CDRadioGroup.IDRadioGroup (anEnclosure: CView; aSupervisor: CBureaucrat; aTitle: Str255); begin IBureaucrat(aSupervisor); { Initialize superclass } new(itsButtons); { Create cluster for storing } itsButtons.ICluster; { buttons belonging to the group } station := nil; { No station is selected yet } new(itsBorder); itsBorder.ITitledBorder(anEnclosure, aSupervisor, 0, 0, 0, 0, sizFIXEDLEFT, sizFIXEDTOP, aTitle); end; { **************************************************** } { Free (OVERRIDE)} {} { Dispose of a RadioGroup object.} {} { **************************************************** } procedure CDRadioGroup.Free; begin itsButtons.Free; inherited Free; end; { **************************************************** } { AddButton} {} { Add a RadioButton to the group} {} { **************************************************** } procedure CDRadioGroup.AddButton (theRadioButton: CDRadioButton); begin itsButtons.Add(theRadioButton); end; { **************************************************** } { RemoveButton} {} { Remove a RadioButton from the group} {} { **************************************************** } procedure CDRadioGroup.RemoveButton (theRadioButton: CDRadioButton); begin itsButtons.Remove(theRadioButton); end; { **************************************************** } { ChangeStation} {} { Change the current station} {} { **************************************************** } procedure CDRadioGroup.ChangeStation (theStation: CDRadioButton); begin if station <> nil then station.SetValue(BUTTON_OFF); station := theStation; station.SetValue(BUTTON_ON); end; { **************************************************** } { GetStation} {} { Return the current station} {} { **************************************************** } function CDRadioGroup.GetStation: CDRadioButton; begin GetStation := station; end; { **************************************************** } { SetStationID} {} { Set the current station, specified by an ID number} {} { **************************************************** } function Test_StationID (theRadioButton: CDRadioButton; theID: Ptr): Boolean; begin Test_StationID := theRadioButton.GetIdNumber = IntPtr(theID)^; end; procedure CDRadioGroup.SetStationID (aStationID: integer); var newStation: CDRadioButton; begin if station <> nil then if station.GetIdNumber <> aStationID then station.SetValue(BUTTON_OFF); newStation := CDRadioButton(itsButtons.FindItem1(Test_StationID, @aStationID)); if newStation <> nil then begin station := newStation; station.SetValue(BUTTON_ON); end; end; { **************************************************** } { GetStationID} {} { Return the current station's ID number} {} { **************************************************** } function CDRadioGroup.GetStationID: integer; begin if station = nil then GetStationID := NO_STATION else GetStationID := station.GetIdNumber end; procedure CDRadioGroup.SetBorderTitle (aStr: Str255); begin itsBorder.SetTitle(aStr); end; procedure CDRadioGroup.CalcBorder (aWidth, aHeight: integer); var theFrame: Rect; aRect: Rect; index: integer; aFontInfo: FontInfo; hOrigin: longint; vOrigin: longint; begin SectPanes(itsButtons, 1, itsButtons.GetNumItems, theFrame); GetFontInfo(aFontInfo); with aFontInfo do theFrame.top := theFrame.top - (ascent + descent + leading); InsetRect(theFrame, -BORDER_OFFSET, -BORDER_OFFSET); with theFrame do begin if aWidth <> 0 then right := left + aWidth; if aHeight <> 0 then bottom := top + aHeight; end; {WITH theFrame} { Determine the difference between the new frame and the old frame. } itsBorder.Refresh; itsBorder.GetFrame(aRect); with aRect do begin left := theFrame.left - left; top := theFrame.top - top; right := theFrame.right - right; bottom := theFrame.bottom - bottom; end; { Change the size and location of the frame. } itsBorder.ChangeSize(aRect, FALSE); itsBorder.Place(theFrame.left, theFrame.top, TRUE); end; { **************************************************** } { C D M O D A L D E S K T O P M E T H O D S } { **************************************************** } { DispatchClick {OVERRIDE) } {} { Respond to a mouse down. Determine where the mouse down occurred } { and send the appropriate messages to the affected objects. The } { where field of macEvent is in Global coordinates. } {} { **************************************************** } procedure CDModalDeskTop.DispatchClick (var macEvent: EventRecord); var thePart: integer; { Location of mouse click } macWindow: WindowPtr; { Window where click occurred } theWindow: CWindow; { Corresponding window object } menuChoice: longint; { Selection from a menu } modal: boolean; { FrontMost window is modal } theTop: CWindow; { Top Window (9/25/90 J. Cardinal Modal Support) } begin theTop := GetTopWindow; { 9/25/90 J. Cardinal Modal Support } if Member(theTop, CDlogWind) then { 9/25/90 J. Cardinal Modal Support } modal := CDlogWind(theTop).GetModal { 9/25/90 J. Cardinal Modal Support } else { 9/25/90 J. Cardinal Modal Support } modal := FALSE; { 9/25/90 J. Cardinal Modal Support } thePart := FindWindow(macEvent.where, macWindow); if (macWindow <> nil) & (thePart <> inSysWindow) then theWindow := CWindow(GetWRefCon(macWindow)); if modal & (theWindow <> theTop) then begin { 9/25/90 J. Cardinal Modal Support } if thePart <> inMenuBar then begin { 9/25/90 J. Cardinal Modal Support } SysBeep(1); { 9/25/90 J. Cardinal Modal Support } Exit(DispatchClick); { 9/25/90 J. Cardinal Modal Support } end; { 9/25/90 J. Cardinal Modal Support } end; { 9/25/90 J. Cardinal Modal Support } case thePart of inDesk: begin CountClicks(SELF, macEvent); DoClick(macEvent.where, macEvent.modifiers, macEvent.when); end; inMenuBar: begin gBartender.UpdateAllMenus; menuChoice := MenuSelect(macEvent.where); if HiWord(menuChoice) <> 0 then begin gGopher.DoCommand(gBartender.FindCmdNumber(HiWord(menuChoice), LoWord(menuChoice))); HiliteMenu(0); end; end; inSysWindow: SystemClick(macEvent, macWindow); inContent: begin if (not theWindow.active) | (theWindow.floating & (WindowPtr(macWindow) <> FrontWindow)) then begin theWindow.Select; if not theWindow.actClick then Exit(DispatchClick) else theWindow.Activate; end; if theWindow.wantsClicks then begin UpdateWindows; theWindow.DispatchClick(macEvent); end else begin CountClicks(SELF, macEvent); DoClick(macEvent.where, macEvent.modifiers, macEvent.when); end; end; inDrag: theWindow.Drag(macEvent); inGrow: theWindow.Resize(macEvent); inGoAway: if TrackGoAway(macWindow, macEvent.where) then theWindow.Close; inZoomIn, inZoomOut: if TrackBox(macWindow, macEvent.where, thePart) then theWindow.Zoom(thePart); end; end; { **************************************************** } { C D D L O G W I N D M E T H O D S } { **************************************************** } { IDlogWind } {} { Initialize a DlogWind object. } {} { Copied from CWindow source, changing WIND to DLOG, and adding DLOG } { template definition. } {} { **************************************************** } procedure CDlogWind.IDlogWind (DLOGid: integer; aFloating: Boolean; anEnclosure: CDesktop; aSupervisor: CDirector); var theDLOG: CDlogTemplateH; theDLOGP: CDlogTemplateP; saveVis: integer; behindWindow: WindowPtr; begin modal := FALSE; IView(anEnclosure, aSupervisor); { Initialize superclass. } { Because we maintain our own window list and have to do } { a lot of manual activating/deactivating to support } { floating windows, it is imperative that windows be } { invisible when initially created. Therefore, we read the } { the WIND resource template and set the visible flag to } { FALSE (after saving the original value). } theDLOG := CDlogTemplateH(GetResource('DLOG', DLOGid)); CheckResource(Handle(theDLOG)); theDLOGP := theDLOG^; saveVis := theDLOGP^.visible; theDLOGP^.visible := 0; floating := aFloating; MakeMacWindow(DLOGid); SetWRefCon(macPort, longint(SELF)); WindowPeek(macPort)^.windowKind := OBJ_WINDOW_KIND; sizeRect := GetGrayRgn^^.rgnBBox; sizeRect.left := MIN_WSIZE; sizeRect.top := MIN_WSIZE; actClick := FALSE; wantsClicks := TRUE; CDesktop(itsEnclosure).AddWind(SELF); if saveVis <> 0 then begin theDLOG := CDlogTemplateH(GetResource('DLOG', DLOGid)); theDLOG^^.visible := 1; Select; end; end; { **************************************************** } { MakeMacWindow } {} { Create a new Toolbox window record using the specified DLOG } { resource ID. This method creates a normal Mac window and lets } { the window manager allocate space for the window record. Subclasses } { should override this method to perform their own memory allocation } { or to create a color window. For compatibility with the Desktop } { class, the convention of putting floating windows in front and } { non-floating windows in back should be observed. } {} { **************************************************** } procedure CDlogWind.MakeMacWindow (WINDid: integer); var bottomWindow: CWindow; DLOGtmpl: CDlogTemplateH; begin DLOGtmpl := CDlogTemplateH(GetResource('DLOG', WINDid)); CheckResource(Handle(DLOGtmpl)); HLock(Handle(DLOGtmpl)); with DLOGtmpl^^ do if floating then macPort := NewWindow(nil, boundsRect, title, (visible <> 0), WDEFid, WindowPtr(-1), (goAwayFlag <> 0), refCon) else begin { Put the window behind the application's bottom window, but } { in front of THINK Pascal's windows (if any). } bottomWindow := gDesktop.GetBottomWindow; if bottomWindow = nil then macPort := NewWindow(nil, boundsRect, title, (visible <> 0), WDEFid, WindowPtr(-1), (goAwayFlag <> 0), refCon) else macPort := NewWindow(nil, boundsRect, title, (visible <> 0), WDEFid, bottomWindow.GetMacPort, (goAwayFlag <> 0), refCon); end; HUnlock(Handle(DLOGtmpl)); ReleaseResource(Handle(DLOGtmpl)); end; function CDlogWind.GetModal: boolean; begin GetModal := modal; end; procedure CDlogWind.SetModal (aModal: boolean); begin modal := aModal; end; { **************************************************** } { C D L O G M E T H O D S } { **************************************************** } { IDlog } {} { Until now, things have been fairly clean and simple. It gets a little } { messy here, though things are still pretty simple: } { 1 Make a window, using info taken from a DLOG resource. } { 2 Initialize some instance variables (notably, lists of panes). } { 3 Get the DITL resource, set pointer to first item, and loop over items: } { 3.0 Copy item from resource to local variable. } { 3.1 Clean up itemType, determine if item is enabled, etc. } { 3.2 Make a new object based on itemType. } { 3.4 Do some item-specific initialization. } { 3.5 Advance pointer to next item. } { 4 Activate first EditText field, if any. } {} { **************************************************** } procedure CDlog.IDlog (DLOGid: integer; aFloating: Boolean; aDocument: CDocument; aSupervisor: CApplication; aFont: integer; aSize: integer); const itemButton = ctrlItem + btnCtrl; itemCheckbox = ctrlItem + chkCtrl; itemRadio = ctrlItem + radCtrl; itemControl = ctrlItem + resCtrl; var curPort: GrafPtr; {For save/restore of QuickDraw port} aDialog: CDlogWind; {The window for this dialog} DLOGtmpl: CDlogTemplateH; {Handle to a DLOG resource} DITLtmpl: Handle; {Handle to a DITL resource} DITLPtr: Ptr; {Pointer INTO a DITL; points at "items"} nItems: integer; {Number of items in dialog} index: integer; {Controls loop over items in dialog} item: CDDitlItemRec; {A dialog item; see IM-I pg 427} itemType: integer; {Item type} itemLen: integer; {Item length} enabled: boolean; {TRUE if item enabled (handles clicks)} aPane: CPane; {A spare CPane used during item initialization} radioCount: integer; {Number of radio buttons in the current group} {... if zero, we need to init an new group} radioGroup: CDRadioGroup; {The current radio group, if any} begin inherited IDirector(aSupervisor); {Initialize superclass} New(aDialog); {Make the dialog window.} PositionDlog('DLOG', DLOGid); {Put it in preferred location} aDialog.IDlogWind(DLOGid, aFloating, gDesktop, self); {Initialize the dialog window} itsWindow := aDialog; {Save window in instance variable} GetPort(curPort); {Muck about to set text characteristics} SetPort(itsWindow.macPort); TextFont(aFont); TextSize(aSize); SetPort(curPort); {Initialize instance variables} itsDocument := aDocument; {Save this in case dialog communicates with document} itsDlogID := DLOGid; {Save this for no clear reason... identifies DLOG?} new(itsPanes); {List of panes corresponding to DITL items} itsPanes.IList; new(itsTEPanes); {List of edit text panes} itsTEPanes.IList; itsActiveTE := 0; new(itsRadioGroups); {List of radio groups, which supervise the radio buttons} itsRadioGroups.IList; {Get the DITL id out of the DLOG resource, and then get the DITL resource.} DLOGtmpl := CDlogTemplateH(GetResource('DLOG', DLOGid)); CheckResource(Handle(DLOGtmpl)); DITLtmpl := GetResource('DITL', DLOGtmpl^^.itemsID); CheckResource(Handle(DITLtmpl)); ReleaseResource(Handle(DLOGtmpl)); {Don't need DLOG anymore} HLock(Handle(DITLtmpl)); {Lock it; we use a pointer into it (DITLPtr)} {Prepare to loop over the DITL} DITLPtr := DITLtmpl^; nItems := IntPtr(DITLPtr)^; {First thing in DITL is number of items - 1 (integer)} DITLPtr := Ptr(Ord4(DITLPtr) + 2); {Push pointer past number of items} for index := 0 to nItems do begin BlockMove(DITLPtr, @item, SizeOf(item)); {Copy next item to the local variable} with item do begin itemType := BAnd(BSR(typeLen, 8), $FF); {Isolate itemType} enabled := (BAnd(itemType, itemDisable) = 0); {Set enabled from hi-order bit of itemType} itemType := BAnd(itemType, $7F); {... and mask it to (finally) get itemType} itemLen := BAnd(typeLen, $FF); {Item length is easy} if itemType <> itemRadio then radioCount := 0; {If this is not radiobutton, set to init next radiogroup} case itemType of itemButton: itsPanes.Add(CObject(MakeButton(itsWindow, self, item, enabled))); itemCheckbox: itsPanes.Add(CObject(MakeCheckBox(itsWindow, self, item, enabled))); itemRadio: begin if radioCount = 0 then begin {Need new radio group?} new(radioGroup); {…yes…} radioGroup.IDRadioGroup(itsWindow, self, ''); itsRadioGroups.Add(CObject(radioGroup)); end; radioCount := radioCount + 1; aPane := MakeRadioButton(itsWindow, radioGroup, item, enabled, radioCount); itsPanes.Add(CObject(aPane)); radioGroup.AddButton(CDRadioButton(aPane)); if radioCount = 1 then radioGroup.SetStationID(1); end; itemControl: itsPanes.Add(CObject(MakeControl(itsWindow, self, item, enabled))); iconItem: itsPanes.Add(CObject(MakeIcon(itsWindow, self, item, enabled))); picItem: itsPanes.Add(CObject(MakePicture(itsWindow, self, item, enabled))); userItem: itsPanes.Add(CObject(MakeUser(itsWindow, self, item, enabled))); editText: begin aPane := MakeEditText(itsWindow, self, item, enabled); itsPanes.Add(CObject(aPane)); itsTEPanes.Add(CObject(aPane)); end; statText: itsPanes.Add(CObject(MakeStaticText(itsWindow, self, item, enabled))); end; {CASE itemType} {Now advance pointer to next item} if Odd(itemLen) then {Handle odd-length titles/text} itemLen := itemLen + 1; DITLPtr := Ptr(Ord4(DITLPtr) + sizeof(item) - SizeOf(Str255) + itemLen); end; {WITH item DO} end; {FOR index := 0 to nItems} HUnlock(Handle(DITLtmpl)); ActivateNextTE; gBartender.UpdateAllMenus; gBartender.DeleteFromBar(NOTHING); end; { **************************************************** } { Free } {} { **************************************************** } procedure CDlog.Free; begin if itsRadioGroups <> nil then itsRadioGroups.DisposeAll; inherited Free; end; { **************************************************** } { Close } {} { Close is the only way to dismiss the dialog, though it can be called through } { CloseWind or when the application is quitting. When the user presses OK or } { cancel, the Close message should be sent to the Dlog. This method creates } { an urgent chore that sends the Free message to the Dlog. This approach avoids } { trouble caused by Free'ing the object (as a result of CDirector.Close) when } { methods that are still in the call chain depend on the object's existence. } {} { **************************************************** } function CDlog.Close (quitting: boolean): boolean; begin Close := inherited Close(quitting); end; { **************************************************** } { GetDItem } {} { **************************************************** } procedure CDlog.GetDItem (item: integer; var kind: integer; var h: CObject; var r: Rect); begin h := itsPanes.NthItem(item); CPane(h).GetFrame(r); CPane(h).FrameToEnclR(r); kind := 0; end; { **************************************************** } { ActivatePrevTE } {} { Make the previous CDEditText object in the itsTEPanes list the active } { editText pane. } {} { **************************************************** } procedure CDlog.ActivatePrevTE; var numTE: integer; begin numTE := itsTEPanes.GetNumItems; if numTE > 0 then begin if itsActiveTE > 0 then {Deactivate current, if any} CDEditText(itsGopher).Deactivate; itsActiveTE := itsActiveTE - 1; {Go to previous...} if itsActiveTE < 1 then itsActiveTE := numTE; {Or... around to last} itsGopher := CDEditText(itsTEPanes.NthItem(itsActiveTE)); {Activate new} CDEditText(itsGopher).SetSelect(0, 32767); CDEditText(itsGopher).Activate; gGopher := itsGopher; end; {if numTE > 0} end; {ActivatePrevTE} { **************************************************** } { ActivateNextTE } {} { Make the next CDEditText object in the itsTEPanes list the active } { editText pane. } {} { **************************************************** } procedure CDlog.ActivateNextTE; var numTE: integer; begin numTE := itsTEPanes.GetNumItems; if numTE > 0 then begin if itsActiveTE > 0 then {Deactivate current, if any} CDEditText(itsGopher).Deactivate; itsActiveTE := itsActiveTE + 1; {Go to next...} if itsActiveTE > itsTEPanes.GetNumItems then itsActiveTE := 1; {Or... back to first} itsGopher := CDEditText(itsTEPanes.NthItem(itsActiveTE)); {Activate new} CDEditText(itsGopher).SetSelect(0, 32767); CDEditText(itsGopher).Activate; gGopher := itsGopher; end; {if numTE > 0} end; {ActivateNextTE} { **************************************************** } { ActivateThisTE } {} { Make the specified CDEditText object the active editText pane. } {} { **************************************************** } procedure CDlog.ActivateThisTE (tePane: CDEditText); var teIndex: integer; begin teIndex := itsTEPanes.FindIndex(CObject(tePane)); {Get index to specified pane...} if teIndex <> itsActiveTE then begin if itsActiveTE > 0 then {Deactivate current, if any} CDEditText(itsGopher).Deactivate; itsActiveTE := teIndex; {Save pane index} itsGopher := tePane; {Activate it} tePane.SetSelect(0, 32767); tePane.Activate; gGopher := itsGopher; end; {if teIndex <> itsActiveTE} end; {ActivateThisTE} { **************************************************** } { UpdateMenus } {} { Handle commands. } {} { Perform menu management tasks. } { method. } {} { **************************************************** } procedure CDlog.UpdateMenus; begin if itsDocument <> nil then itsDocument.UpdateMenus else inherited UpdateMenus; end; { **************************************************** } { DoCommand } {} { Handle commands. } {} { This method is normally overridden. Make sure to call the inherited } { method. } {} { **************************************************** } procedure CDlog.DoCommand (theCommand: longint); begin case theCommand of cmdOKEquiv: DoButton(1); cmdCancelEquiv: DoButton(2); cmdClose: begin if Close(FALSE) then ; end; otherwise if itsDocument <> nil then itsDocument.DoCommand(theCommand) else inherited DoCommand(theCommand); end; {case} end; {DoCommand} { **************************************************** } { SetEdit } {} { Send the SetEdit message to a CDEditText pane. } { **************************************************** } procedure CDlog.SetEdit ( { Set editing control variables } anItem: integer; { Item number of edit text field } aFilter: integer; { The filter mask } aMaxLength: integer); { The maximum length } var aText: CDEditText; begin aText := CDEditText(itsPanes.NthItem(anItem)); aText.SetEdit(aFilter, aMaxLength); end; { **************************************************** } { GetIText } {} { Get the text for one of the EditText or StaticText panes. } {} { **************************************************** } procedure CDlog.GetIText ( { Get item text } anItem: integer; { Item number of text field } var str: Str255); { The text in a string } var aText: CStaticText; theChars: CharsHandle; theLength: longint; begin str := ''; aText := CStaticText(itsPanes.NthItem(anItem)); if Member(aText, CStaticText) then begin theChars := aText.GetTextHandle; theLength := GetHandleSize(Handle(theChars)); if theLength > 255 then theLength := 255; {$PUSH} {$R-} str[0] := Chr(theLength); {$POP} if theLength > 0 then BlockMove(Ptr(theChars^), @str[1], theLength); end; end; { **************************************************** } { SetIText } {} { Set the text of a CStaticText or CDEditText pane. } {} { **************************************************** } procedure CDlog.SetIText ( { Set item text } anItem: integer; { Item number of text field } str: Str255); { New text for the item } var aText: CStaticText; begin aText := CStaticText(itsPanes.NthItem(anItem)); aText.Prepare; aText.SetTextString(str); end; { **************************************************** } { DoKeyDown } {} { Handle keydowns. Only used with dialogs without editText fields. } {} { **************************************************** } procedure CDlog.DoKeyDown ( { Handle key-down } theChar: char; { Key character } keyCode: Byte; { Key code } macEvent: EventRecord); { Mac event record } const ETX = $03; CR = $0D; ESC = $1B; LKEY = $1C; DKEY = $1F; var cmd: longint; begin cmd := 0; {Check for special characters} if Ord(theChar) in [LKEY..DKEY] then { Intercept arrow keys } cmd := cmdArrowLeft + Ord(theChar) - LKEY { ... to do list movement } else if Ord(theChar) in [ETX, CR] then { Enter and Return = OK } cmd := cmdOkEquiv { Simulate clicking OK } else if Ord(theChar) = ESC then { ESC = CANCEL } cmd := cmdCancelEquiv; { Simulate clicking Cancel } if cmd <> 0 then DoCommand(cmd) else inherited DoKeyDown(theChar, keyCode, macEvent); { Everything else} end; { **************************************************** } { DefaultButton } {} { Simulate clicking a button. Make sure you pass the itemNumber of a button! } {} { **************************************************** } procedure CDlog.DoButton (itemNumber: integer); const hiliteDelay = 8; ON = 1; OFF = 0; var aButton: CDButton; aLong: longint; begin aButton := CDButton(itsPanes.NthItem(itemNumber)); if (aButton <> nil) & Member(aButton, CDButton) & aButton.WantsClicks & (aButton.macControl^^.contrlHilite <> 255) then begin aButton.Hilite(ON); Delay(hiliteDelay, aLong); aButton.Hilite(OFF); aButton.DoGoodClick(0); end; end; { **************************************************** } { GetControlHandle } {} { Get the ControlHandle for the given item. } { **************************************************** } function CDlog.GetControlHandle (itemNumber: integer): ControlHandle; var aControl: CDControl; begin aControl := CDControl(itsPanes.NthItem(itemNumber)); if (aControl <> nil) & Member(aControl, CDControl) then GetControlHandle := aControl.macControl else GetControlHandle := nil; end; { **************************************************** } { MakeButton } {} { **************************************************** } function CDlog.MakeButton (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; enabled: boolean): CPane; var button: CDButton; begin new(button); button.IDButton(anEnclosure, aSupervisor, item); button.SetWantsClicks(enabled); MakeButton := button; end; { **************************************************** } { MakeCheckBox } {} { **************************************************** } function CDlog.MakeCheckBox (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; enabled: boolean): CPane; var check: CDCheckBox; begin new(check); check.IDCheckBox(anEnclosure, aSupervisor, item); check.SetWantsClicks(enabled); MakeCheckBox := check; end; { **************************************************** } { MakeRadioButton } {} { **************************************************** } function CDlog.MakeRadioButton (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; enabled: boolean; anID: integer): CPane; var radio: CDRadioButton; begin new(radio); radio.IDRadioButton(anEnclosure, aSupervisor, item, anID); radio.SetWantsClicks(enabled); MakeRadioButton := radio; end; { **************************************************** } { MakeControl } {} { **************************************************** } function CDlog.MakeControl (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; enabled: boolean): CPane; var control: CDControl; begin new(control); control.IDControl(anEnclosure, aSupervisor, item); control.SetWantsClicks(enabled); MakeControl := control; end; { **************************************************** } { MakeIcon } {} { **************************************************** } function CDlog.MakeIcon (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; enabled: boolean): CPane; var icon: CDIcon; resId: integer; begin new(icon); resID := IntPtr(Ord(@item) + sizeOf(CDDitlItemRec) - SizeOf(Str255))^; {Get resource id} with item.boundsRect do icon.IDIcon(itsWindow, self, right - left, bottom - top, left, top, sizFIXEDSTICKY, sizFIXEDSTICKY, resID); icon.SetWantsClicks(enabled); MakeIcon := icon; end; { **************************************************** } { MakePicture } {} { **************************************************** } function CDlog.MakePicture (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; enabled: boolean): CPane; var picture: CDPicture; resId: integer; begin new(picture); resID := IntPtr(Ord(@item) + sizeOf(CDDitlItemRec) - SizeOf(Str255))^; {Get resource id} with item.boundsRect do picture.IDPicture(itsWindow, self, right - left, bottom - top, left, top, sizFIXEDSTICKY, sizFIXEDSTICKY, resID); picture.SetWantsClicks(enabled); MakePicture := picture; end; { **************************************************** } { MakeUser } {} { **************************************************** } function CDlog.MakeUser (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; enabled: boolean): CPane; var user: CDUser; begin new(user); with item.boundsRect do user.IDUser(itsWindow, self, right - left + 1, bottom - top + 1, left, top, sizFIXEDSTICKY, sizFIXEDSTICKY); user.SetWantsClicks(enabled); MakeUser := user; end; { **************************************************** } { MakeEditText } {} { **************************************************** } function CDlog.MakeEditText (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; enabled: boolean): CPane; var edit: CDEditText; border: CBorder; aStr: Str255; begin new(border); with item.boundsRect do border.IBorder(anEnclosure, aSupervisor, right - left + 2 * BORDER_OFFSET, bottom - top + 2 * BORDER_OFFSET, left - BORDER_OFFSET, top - BORDER_OFFSET, sizFIXEDLEFT, sizFIXEDTOP); border.SetWantsClicks(FALSE); new(edit); with item.boundsRect do edit.IDEditText(anEnclosure, aSupervisor, right - left + 1, bottom - top + 1, left, top, sizFIXEDLEFT, sizFIXEDTOP, -1); edit.SetWantsClicks(enabled); aStr := StringPtr(Ord(@item) + sizeOf(CDDitlItemRec) - SizeOf(str255) - 1)^; edit.SetTextString(aStr); edit.Deactivate; MakeEditText := edit; end; { **************************************************** } { MakeStatitText } {} { **************************************************** } function CDlog.MakeStaticText (anEnclosure: CView; aSupervisor: CBureaucrat; item: CDDitlItemRec; enabled: boolean): CPane; var static: CStaticText; aStr: Str255; begin new(static); with item.boundsRect do static.IStaticText(anEnclosure, aSupervisor, right - left + 1, bottom - top + 1, left, top, sizFIXEDSTICKY, sizFIXEDSTICKY, -1); static.SetWantsClicks(enabled); aStr := StringPtr(Ord(@item) + sizeOf(CDDitlItemRec) - SizeOf(str255) - 1)^; static.SetTextString(aStr); MakeStaticText := static; end; end. {CDlog}