|
Volume Number: | 7 | |
Issue Number: | 11 | |
Column Tag: | Pascal Methods |
Related Info: Dialog Manager TextEdit
Posing Dialogs in MacApp
By James Plamondon, San Mateo, CA
Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks.
Posing the Question
So you want to pose a dialog. You’ve done it a million times before: create the dialog, initialize it, pose it, and see if it was cancelled; if not, get the data from the dialog and do something with it. It’s all pretty formulaic -- so why not encapsulate the process in a class?
TPoseDialogCmd does just that. A subclass of TCommand, it handles the display of a dialog, in the steps described above. Actually, it is an abstract class; it has two subclasses, TMacAppDialogCmd and TToolboxDialogCmd, that implement the methods laid out in TPoseDialogCmd. TMacAppDialogCmd displays dialogs that are built of MacApp views; TToolboxDialogCmd displays dialogs that are built using the Toolbox Dialog manager. This article will focus on TMacAppDialogCmd.
First, let’s illustrate the use of the TMacAppDialogCmd. I’ve modified the MacApp sample program DemoText to add a “character” dialog, which allows the user to specify, for a given text selection, its font, style, size, justification, etc.. This dialog is described by the class TCharDialogView, in the unit UCharacterDialog. UCharacterDialog also contains the description of the class TCharacterDialogCmd, a subclass of TMacAppDialogCmd that knows about the Character dialog. TCharacterDialogCmd doesn’t know anything about the DemoText application’s data structures, though, so it is subclassed in UTEDocument to produce TTECharDialogCmd. TTECharDialogCmd knows about TTEDocuments and TTEViews, so it knows how to access and change the text style and alignment of the current selection.
When the user selects the “Character ” menu item, TTEDocument.DoMenuCommand() is called. In its local DoCharacter() routine, a TTECharDialogCmd is created and initialized with the text style and alignment of the current selection. The command is returned as the function result of TTEDocument.DoMenuCommand(), and is eventually posted to the application’s command queue. The command is subsequently picked up by PollEvent(), and its DoIt() method is called. TPoseDialogCmd’s implementation is executed. Here it is:
{1} PROCEDURE TPoseDialogCmd.DoIt; OVERRIDE; VAR theCommand:TCommand; BEGIN InitTheDialog; PoseTheDialog; { create the resulting command } IF fCancelled THEN theCommand := NIL ELSE theCommand := CreateTheCommand; { post the resulting command } IF (theCommand <> NIL) THEN gTarget.PostCommand(theCommand); { clean up } DropTheDialog; END; { DoIt }
Figure 1: Character Dialog
InitTheDialog() is overridden in TCharacterDialogCmd, which knows about the TCharcterDialogView class (since both are defined in the same unit), as follows:
{2} PROCEDURE TCharacterDialogCmd.InitTheDialog; OVERRIDE; VAR theTextStyle: TextStyle; BEGIN { localize to avoid unsafe field use } theTextStyle := fTextStyle; { initialize the dialog to act on the command’s TextStyle and alignment } TCharDialogView(fTheDialog).SetDialogInfo(theTextStyle, fAlignment, kRedraw); { make sure the ‘size’ field is the current edit text item } fTheDialog.SelectEditText(‘size’, TRUE); { TRUE = DO select the text } END; { InitTheDialog }
The dialog’s class and class of the command that show the dialog must know about and rely on each other, as the typecast in the second statement shows. The command class has to assume that the dialog is of the intended class. If it’s not, you’re going to get a very unpleasant run-time error.
The method PoseTheDialog(), inherited from TMacAppDialogCmd, follows naturally enough:
{3} PROCEDURE TMacAppDialogCmd.PoseTheDialog; { Actually poses the dialog. } VAR dismisser: IDType; BEGIN { pose the dialog } fTheWindow.Select;{ bring the window to the front before showing it } dismisser := fTheDialog.PoseModally; { take note of the user’s response } SetDismisser(dismisser); SetCancelled(dismisser = fTheDialog.fCancelItem); END; { PoseTheDialog }
It just brings the window to the front, poses it with PoseModally(), and sets the appropriate fields to indicate the manner in which the dialog was dismissed.
The only other routine that needs to be overridden is TPoseDialogCmd’s CreateTheCommand(), which is overridden in TTECharDialogCmd as follows:
{4} FUNCTION TTECharDialogCmd.CreateTheCommand : TCommand; OVERRIDE; VAR oldTextStyle: TextStyle; newTextStyle: TextStyle; newAlign:INTEGER; aCmd: TTEStyleAndAlignCmd; BEGIN oldTextStyle := fTextStyle; { localize } { get the current TextEdit and alignment states from the Character Dialog } TCharDialogView(fTheDialog).GetDialogInfo (newTextStyle, newAlign); IF SameTextStyle(oldTextStyle, newTextStyle) & (fAlignment = newAlign) THEN CreateTheCommand := NIL { no change } ELSE IF (fAlignment = newAlign) THEN BEGIN CreateTheCommand := TTEView(fView).DoMakeStyleCommand( newTextStyle, cCharacter, doAllAndAlign); END ELSE { alignment changed; text style may have, too } BEGIN New(aCmd); FailNIL(aCmd); aCmd.ITEStyleAndAlignCmd(TTEView(fView), newTextStyle, fCmdNumber, doAllAndAlign, newAlign); CreateTheCommand := aCmd; END; { else } END; { CreateTheCommand }
This method’s implementation shows why TTECharDialogCmd had to be aware of DemoText’s application-specific data structures: how else would it know that its fView field referred to a TTEView, which contained the style to be altered?
TTEView’s DoMakeStyleCommand() method returns a TTEStyleCommand. This class can’t handle changes to the text’s alignment (also known as “justification”). DemoText has a TJustCommand for changing text alignment. I needed a combination of the two: a single command that would change both the style and the alignment of the selected text. I produced such a command, TTEStyleAndAlignCmd, by subclassing TTEStyleCommand and pasting in code that I copied from DemoText’s TJustCommand. (That’s one way to re-use code!) CreateTheCommand(), above, returns NIL, a TTEStyleCommand, or a TTEStyleAndAlignCmd as appropriate. It could be modified slightly to return a TJustCommand when only the alignment of the text has changed (left as an exercise for the reader).
The command returned by CreateTheCommand() is posted in TPoseDialogCmd.DoIt(). It will be picked up by PollEvent() and executed in the normal manner. If the user cancelled the dialog, no command gets posted, so nothing is changed.
Caching Dialog-Posing Commands
MacApp 2.0 allows recurring commands to remain in the command queue until they are ready to execute. A clever programmer might use this feature to cache the dialog-posing commands. One would need to write a routine that searched the command queue for an idle command with a given command number. If one were found, its fReadyToExecute field would be set to TRUE, and its data (text style and alignment, in the example above) would be initialized. The next pass through PollEvent() would pick it up and execute it by calling its DoIt() method, which initializes and displays its dialog. Caching these commands also caches their dialogs, considerably reducing the time required to display them (after they’ve been built the first time).
Of course, caching dialogs can use up a lot of memory, so you’ve got to be able to purge the caches when necessary (for example, in an override of TApplication.SpaceIsLow()). This can be done easily, by traversing the command queue and purging all of the idle TPoseDialogCmd commands. This requires a Member() call, which offends the delicate sensibilities of a lot of people.
Adding a pair of simple functions to TCommand would solve this problem: CanPurgeCommand() would return true if the command could be purged, and false otherwise; PurgeCommand() would purge it, returning TRUE if it were freed by its implementation. TCommand’s implementation could return FALSE and TRUE respectively, doing nothing else. TMacAppDialogCommand could then override these methods to “do the right thing” for cached dialog posers.
One other gotcha you’ll encounter if you try to implement this scheme is related to document references maintained by the cached command and its dialog’s views. A command is built to pose a dialog to affect a given document. The command is cached after execution. The user then issues the same command on a different document. Both the command’s fChangedDocument reference and the fDocument fields of all of its dialog’s views are wrong -- the reference the original document, not the new one.
This is also easy to fix, by adding yet another method to TCommand: a routine to set the command’s document reference to a given value. This can be overridden in the dialog posing commands to call CreateTheDialog(), which will rebuild the dialog if its document doesn’t match the command’s.
These changes were not made to the example program because they would have required significant changes to MacApp. They are left as an exercise for the reader.
TView.PostRes()
Many views need to maintain references to some of their subviews. For example, the Character dialog contains a number of these references. When is a good time to initialize these references? IRes() is out -- the subviews doesn’t exist when it is called. Many MacApp programmers initialize such references in Open() -- but that means that they can’t do anything to the dialog before it is opened.
About a year ago, I proposed that a PostRes() method be added to TView, to solve just this problem. It would conduct a post-order traversal of the subview hierarchy, calling PostRes() on each view it encountered. Thus, by the time the dialog’s PostRes() method were called, all of its subviews would exist, and their own subview references would have been initialized. The proposed routine would not be a solution to the much more general problem of making objects (and the references between them) persistent, but it was not intended to be; it was just for initializing subview references.
Subsequently, John MacVeigh implemented the routine, and changed TEvtHandler.DoCreateViews() to support it. His implementation works like a champ. It is long and, it is on the source disk. The modified DemoText example program uses PostRes(), so you won’t be able to compile it unless you add it to your copy of MacApp. The example program is also supplied as a compiled application, though, so you don’t have to compile it yourself to run it.
As best I can determine, Apple has no plans to implement PostRes(). They seem to be waiting to implement a universal solution to the persistent object problem. I’d be happy to use such a solution, but in the meantime, I find PostRes() to be invaluable.
Circular Reference Problem
One of Pascal’s worst shortcomings is in its handling of separate compilation. This is really no surprise, since it was not designed with separate compilation in mind, as was C. MPW Pascal has been extended on a number of occasions, and in a number of ways, to overcome this problem. In MPW 3.2, a pretty good solution has been reached.
MPW 3.2 Pascal supports two features that help solve the Circular Reference Problem: external type declarations and USES clauses in the implementation portion of a unit. Using these features, one can get around the problem, if one follows these simple rules:
• If you inherit from a class, your INTERFACE must USE the unit in which it is defined.
• Otherwise, if you use a class or type in the INTERFACE of your unit, you can declare it to be EXTERNAL, as follows:
TClass = OBJECT; EXTERNAL;
• If you declare a type to be EXTERNAL in the INTERFACE portion of your unit, your IMPLEMENTATION must USE the unit in which it is defined.
• Whenever you USE a unit, you must also USE all units that it USES in its INTERFACE.
The last of these rules is the most bothersome, because it clutters up the USES clause with a lot of seemingly irrelevant junk. Perhaps MPW 3.3 will solve that one, too!
These rules are followed in the modified DemoText example program, for those units which have been added to the original MacApp version. (I left the rest of the program alone, as much as possible, including its USES clauses.)
TValueRadio, TValueCheckbox, TSetCluster, and TValueRadioCluster
When I use a cluster of checkboxes, it’s usually because I’m defining a Pascal set type. When I’m using a cluster of radio buttons, it’s usually because I’m selecting one value from a set of possible values. Either way, it would be nice to have a class do the dirty work for me.
I wrote a suite of classes to do just that. TValueCheckBox and TValueRadio associate a number with a control; TSetCluster handles a cluster of TValueCheckboxes; TValueRadioCluster handles a cluster of TValueRadios. All are used in the Character dialog.
View Type Extensions
In order to associate a number with a TValueCheckbox or a TValueRadio in its defining resource, I extended the ‘view’ resource type definition. The ability to do this is built into MacApp 2.0. One simply writes a file containing additional cases for the ‘view’ resource definition, and adds the file pathname to the {OtherViewTypesSrc} definition in your MAMake file. A dependency must also be added to the MAMake file to keep everything in sync.
A Real Poser
If it’s that darn easy, why isn’t everybody using TPoseDialogCmds? Well, maybe after this article, they will be!
Acknowledgments
This article would not have been possible without the support of Steve Starr, Marian Cauwet, or Ed Lauing, who have made Power Up Software such a great place to work, or my family, who have made my home such a great place to live. To the former, I give my thanks and respect; to the latter, my love.
Listing: PostRes() {---------------------------------------------------------} Add to UMacApp.p: PROCEDURE TView.PostRes; { Called on each view created by DoCreateViews(), in a post-order traversal, view creation is completed. } {--------------------------------------------------------} {--------------------------------------------------------} Change in UMacApp.TEvtHandler.p (thanks to John MacVeigh): {--------------------------------------------------------} FUNCTION TEvtHandler.DoCreateViews(itsDocument: TDocument; parentView: TView; itsRsrcID: INTEGER; subviewOffset: VPoint): TView; Var TopView: TView; {--------------------------------------------------------} PROCEDURE CallPostRes (aView: TView); {perform a (rather convoluted) post-order traversal of the subview lists, such that a view's subviews will all have PostRes called before the view itself is PosRes'd.} Var Unused: ArrayIndex; Function DummyTest (item: TView): Boolean; Begin CallPostRes (Item); DummyTest := False End; Begin If aView.fSubViews <> Nil Then If aView.fSubViews.IterateTil (DummyTest, kIterateBackward, Unused) <> Nil Then; aView.PostRes End; {CallPostRes} {--------------------------------------------------------} { JLP: "ReallyDoCreateViews" is original (MacApp 2.0 Final) DoCreateViews() } {--------------------------------------------------------} Function ReallyDoCreateViews(itsDocument: TDocument; parentView: TView; itsRsrcID: INTEGER; subviewOffset: VPoint): TView; VAR i:INTEGER; numViews:INTEGER; aView: TView; viewResource: ViewRsrcHndl; theViewInfo: ViewTemplatePtr; lastParentID: IDType; lastParent: TView; lastRoot:TView; firstView: TView; fi: FailInfo; PROCEDURE HdlDoCreateViews(error: OSErr; message: LONGINT); BEGIN IF viewResource <> NIL THEN { Don't constipate the heap } HUnLock(Handle(viewResource)); FreeIfObject(firstView); firstView := NIL; END; {$IFC qDebug} PROCEDURE ReportTemplate; BEGIN WITH theViewInfo^ DO BEGIN WrLblSig('signature', itsSignature); WriteLn; WrLblSig('itsParentID', itsParentID); WrLblSig(', thisViewID', thisViewID); WriteLn; WrLblVPt('itsLocation', itsLocation); WrLblVPt(', itsSize', itsSize); Write('itsHSizeDet = ', ord(itsHSizeDet): 3); WriteLn(', itsVSizeDet = ', ord(itsVSizeDet): 3); WrLblBoolean(', isEnabled ', isEnabled); WriteLn; WriteLn('---------- end of view ----------'); END; END; {$ENDC} BEGIN firstView := NIL; { Assume the worst. } viewResource := ViewRsrcHndl(GetResource('view', itsRsrcID)); IF viewResource = NIL THEN BEGIN {$IFC qDebug} ProgramBreak(ConcatNumber('Unable to find ‘view’ resource #', itsRsrcID)); {$ENDC} FailNilResource(viewResource); END; LockHandleHigh(Handle(viewResource)); CatchFailures(fi, HdlDoCreateViews); numViews := viewResource^^.numViews; theViewInfo := @viewResource^^.theViews; lastParentID := kNoIdentifier; aView := parentView; lastRoot := parentView; FOR i := 1 TO numViews DO WITH theViewInfo^ DO BEGIN {$IFC qDebug} IF gIntenseDebugging THEN ReportTemplate; {$ENDC} IF LONGINT(itsParentID) = LONGINT(kNoIdentifier) THEN lastParent := parentView ELSE IF LONGINT(itsParentID) <> LONGINT(lastParentID) THEN BEGIN lastParent := aView; { Begin with last view created or parentView } WHILE (lastParent <> NIL) & (lastParent.fIdentifier <> itsParentID) DO lastParent := lastParent.fSuperView; IF (lastParent = NIL) & (lastRoot <> NIL) THEN IF aView <> NIL THEN lastParent := aView.FindSubView(itsParentID) ELSE lastParent := lastRoot.FindSubView(itsParentID); {$IFC qDebug} IF lastParent = NIL THEN ProgramBreak('Unable to find parent view for template'); {$ENDC} END; lastParentID := itsParentID; IF LONGINT(itsSignature) = LONGINT('incl') THEN BEGIN aView := ReallyDoCreateViews(itsDocument, lastParent, includeRsrcID, gZeroVPt); OffsetPtr(theViewInfo, SIZEOF(ViewTemplate) - SIZEOF(Str255) + SIZEOF(INTEGER)); END ELSE IF LONGINT(itsSignature) = LONGINT('inc@') THEN BEGIN aView := ReallyDoCreateViews(itsDocument, lastParent, includeRsrcID, itsSubViewOffset); OffsetPtr(theViewInfo, SIZEOF(ViewTemplate) - SIZEOF(Str255) + SIZEOF(INTEGER) + SIZEOF(VPoint)); END ELSE aView := CreateAView(itsDocument, lastParent, Ptr(theViewInfo)); IF aView = NIL THEN LEAVE; IF ((subviewOffset.h <> 0) | (subviewOffset.v <> 0)) & (aView.fSuperView = parentView) & (parentView <> NIL) THEN aView.Locate(aView.fLocation.h + subviewOffset.h, aView.fLocation.v + subviewOffset.v, kDontInvalidate); IF i = 1 THEN BEGIN firstView := aView; IF Member(aView, TWindow) & (parentView = NIL) THEN parentView := aView; END; IF (lastRoot = NIL) & (aView <> NIL) & (aView.fSuperView = NIL) THEN lastRoot := aView; END; HUnLock(Handle(viewResource)); Success(fi); ReallyDoCreateViews := firstView {*** what DoCreateViews used to return} End; {ReallyDoCreateViews} Begin {DoCreateViews} If fNextHandler <> Nil Then DoCreateViews := fNextHandler.DoCreateViews (itsDocument, parentView, itsRsrcID, subviewOffset) Else Begin TopView := ReallyDoCreateViews (itsDocument, parentView, itsRsrcID, subviewOffset); If TopView <> Nil Then Begin CallPostRes (TopView); TopView.AdjustSize; { Make sure size gets adjusted by the size determiners } End; DoCreateViews := TopView End End; {DoCreateViews}
Listing: UCharacterDialog.inc1.p {********************************************************* UCharacterDialog.inc1.p *********************************************************} USES { • Implementation use } Fonts, Packages, Picker,{ TColorDialogCmd } Resources, ToolUtils; { TColorDialogCmd } TYPE FondHandle = ^FondPointer; FondPointer = ^FondRecord; FondRecord = RECORD familyStuff: FamRec; noOfFonts: INTEGER; fontStuff: ARRAY [0..1000] OF RECORD size: INTEGER; style: INTEGER; resID: INTEGER; END; END; {########################################################## Unit Initialization ###########################################################} {--------------------------------------------------------------------------------------------------------------------} {$S AInit} PROCEDURE InitUCharacterDialog; VAR dummy: BOOLEAN; BEGIN IF gDeadStripSuppression THEN BEGIN { list the views instantiated via resource templates below } dummy := Member(TObject(NIL), TCharDialogView); dummy := Member(TObject(NIL), TFaceCluster); dummy := Member(TObject(NIL), TFontListView); dummy := Member(TObject(NIL), TJustifyCluster); dummy := Member(TObject(NIL), TSampleText); dummy := Member(TObject(NIL), TSetCluster); dummy := Member(TObject(NIL), TSizeCluster); dummy := Member(TObject(NIL), TSizeListView); dummy := Member(TObject(NIL), TSizeText); dummy := Member(TObject(NIL), TSpaceCluster); dummy := Member(TObject(NIL), TStyleCluster); dummy := Member(TObject(NIL), TValueCheckBox); dummy := Member(TObject(NIL), TValueRadio); dummy := Member(TObject(NIL), TValueRadioCluster); END; { if gDeadStripSuppression } END; { InitUCharacterDialog } {######################################################### Utility Routines ##########################################################} {----------------------------------------------------------------------------------------------------------------} {$ AUtil} FUNCTION SameRGBColor(color1, color2: RGBColor): BOOLEAN; BEGIN SameRGBColor := (color1.red = color2.red) & (color1.green = color2.green) & (color1.blue = color2.blue); END; { SameRGBColor } {----------------------------------------------------------------------------------------------------------------} {$ AUtil} FUNCTION SameTextStyle(style1, style2: TextStyle): BOOLEAN; BEGIN SameTextStyle := (style1.tsFont = style2.tsFont) & (style1.tsFace = style2.tsFace) & (style1.tsSize = style2.tsSize) & SameRGBColor(style1.tsColor, style2.tsColor); END; { SameTextStyle } {----------------------------------------------------------------------------------------------------------------} {$ AUtil} { AffectTextStyle(): Uses the given source TextStyle to modify the given target TextStyle according to the given mode, in a manner similar to that used in TTEView.SetOneStyle(). Note that "mode" may include flags for setting the alignment, as defined above; if present, they are ignored. } PROCEDURE AffectTextStyle( theMode:INTEGER; VAR source: TextStyle; { not changed } VAR target: TextStyle); BEGIN IF (theMode IN [doAll, doAllAndAlign]) THEN target := source{ ignore alignment } ELSE BEGIN IF BAND(theMode, doFont) <> 0 THEN target.tsFont := source.tsFont; IF BAND(theMode, doPlusFace) <> 0 THEN target.tsFace := target.tsFace + source.tsFace ELSE IF BAND(theMode, doMinusFace) <> 0 THEN target.tsFace := target.tsFace - source.tsFace ELSE IF BAND(theMode, doFace) <> 0 THEN target.tsFace := source.tsFace; IF BAND(theMode, doColor) <> 0 THEN target.tsColor := source.tsColor; IF BAND(theMode, addSize) <> 0 THEN target.tsSize := target.tsSize + source.tsSize ELSE IF BAND(theMode, doSize) <> 0 THEN target.tsSize := source.tsSize; { make sure that condense & extend are never on together } IF (theMode IN [doAll, doAllAndAlign, doPlusFace, doFace]) & (target.tsFace * [condense, extend] = [condense, extend]) THEN target.tsFace := target.tsFace - [condense, extend]; END; END; { AffectTextStyle } {----------------------------------------------------------------------------------------------------------------} {$ AUtil} { AffectTextAlignment(): Uses the given source alignment to modify the given target alignment according to the given mode, in a manner similar to that used in TTEView.SetOneStyle(). Note that "mode" may include flags for setting the alignment, as defined above. } PROCEDURE AffectTextAlignment( theMode:INTEGER; source: INTEGER; VARtarget:INTEGER); BEGIN IF (theMode = doAllAndAlign) | (BAND(theMode, doAlign) <> 0) THEN target := source; {! GetActualJustification(source) ??? } END; { AffectTextAlignment } {----------------------------------------------------------------------------------------------------------------} {$ AUtil} { AffectTextStyleAndAlign(): Uses the given source TextStyle and alignment to modify the given target TextStyle and alignment according to the given mode, in a manner similar to that used in TTEView.SetOneStyle(). Note that "mode" may include flags for setting the alignment, as defined above. } PROCEDURE AffectTextStyleAndAlign( theMode: INTEGER; VAR sourceTS: TextStyle; { not changed } sourceAlign: INTEGER; VAR targetTS: TextStyle; VAR targetAlign: INTEGER); BEGIN AffectTextStyle(theMode, sourceTS, targetTS); AffectTextAlignment(theMode, sourceAlign, targetAlign); END; { AffectTextStyleAndAlign } {############################################################################### TCharDialogView ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S AOpen} { PostRes(): Initialize the dialog's subview references. } PROCEDURE TCharDialogView.PostRes; OVERRIDE; VAR aView: TView; BEGIN INHERITED PostRes; aView := FindSubView('sclu'); FailNil(aView); fSizeCluster := TSizeCluster(aView); aView := FindSubView('just'); FailNil(aView); fJustCluster := TJustifyCluster(aView); aView := FindSubView('flst'); FailNil(aView); fFontListView := TFontListView(aView); aView := FindSubView('samp'); FailNil(aView); fSampleText := TSampleText(aView); aView := FindSubView('face'); FailNil(aView); fFaceCluster := TFaceCluster(aView); END; { PostRes } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} { SetDialogInfo(): Initializes the dialog to reflect the given TextStyle record and alignment value. } PROCEDURE TCharDialogView.SetDialogInfo( theStyle:TextStyle; alignment: INTEGER; redraw: BOOLEAN); BEGIN WITH theStyle DO BEGIN SetTextFont(tsFont, redraw); SetTextSize(tsSize, redraw); SetTextFace(tsFace, redraw); SetTextColor(tsColor, redraw); END; SetTextJust(alignment, redraw); END; { SetDialogInfo } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} { GetDialogInfo(): Returns the dialog's current TextStyle record and alignment value. } PROCEDURE TCharDialogView.GetDialogInfo( VAR theStyle: TextStyle; VAR alignment: INTEGER); BEGIN fSampleText.GetTextInfo(theStyle, alignment); END; { GetDialogInfo } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TCharDialogView.SetTextFont(theFont: INTEGER; redraw:BOOLEAN); BEGIN { the call below is redundant, if in response to DoChoice(mFontChanged) } fFontListView.SetTextFont(theFont,redraw); { always necessary } fSizeCluster.SetTextFont(theFont, redraw); fSampleText.SetTextFont(theFont, redraw); END; {SetTextFont} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TCharDialogView.SetTextSize( theSize: INTEGER; redraw:BOOLEAN); BEGIN fSizeCluster.SetTextSize(theSize,redraw); fSampleText.SetTextSize(theSize,redraw); END; {SetTextSize} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TCharDialogView.SetTextFace( theFace: Style; redraw:BOOLEAN); BEGIN fSampleText.SetTextFace(theFace,redraw); fFaceCluster.SetTextFace(theFace,redraw); END; {SetTextFace} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TCharDialogView.SetTextColor(theColor: RGBColor; redraw:BOOLEAN); BEGIN fSampleText.SetTextColor(theColor, redraw); END; {SetTextColor} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TCharDialogView.SetTextJust(alignment: INTEGER; redraw:BOOLEAN); BEGIN fSampleText.SetTextJust(alignment, redraw); fJustCluster.SetTextJust(alignment, redraw); END; { SetTextJust } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TCharDialogView.DoChoice(origView: TView; itsChoice: INTEGER); OVERRIDE; BEGIN CASE itsChoice OF mFontChanged: BEGIN SetTextFont(fFontListView.GetTextFont,kRedraw); END; mFontSizeChanged: BEGIN SetTextSize(fSizeCluster.GetTextSize,kRedraw); END; OTHERWISE INHERITED DoChoice(origView, itsChoice); END; { case } END; { DoChoice } {############################################################################### TValueCheckBox ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} PROCEDURE TValueCheckBox.IRes( itsDocument: TDocument; itsSuperView: TView; VAR itsParams: Ptr); OVERRIDE; BEGIN INHERITED IRes(itsDocument, itsSuperView, itsParams); WITH ValueCheckBoxTemplatePtr(itsParams)^ DO BEGIN fNumber := number; END; OffsetPtr(itsParams, SIZEOF(ValueCheckBoxTemplate)); END; { IRes } {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} PROCEDURE TValueCheckBox.SetNumber( number: INTEGER); BEGIN fNumber := number; END; { SetNumber } {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} FUNCTION TValueCheckBox.GetNumber :INTEGER; BEGIN GetNumber := fNumber; END; { GetNumber } {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TValueCheckBox.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; BEGIN DoToField('TValueCheckBox', NIL, bClass); DoToField('fNumber', @fNumber, bInteger); INHERITED Fields(DoToField); END; { Fields } {$ENDC qDebug} {############################################################################### TValueRadio ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} PROCEDURE TValueRadio.IRes( itsDocument: TDocument; itsSuperView: TView; VAR itsParams: Ptr); OVERRIDE; BEGIN INHERITED IRes(itsDocument, itsSuperView, itsParams); WITH ValueRadioTemplatePtr(itsParams)^ DO BEGIN fNumber := number; END; OffsetPtr(itsParams, SIZEOF(ValueRadioTemplate)); END; { IRes } {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} PROCEDURE TValueRadio.SetNumber(number:INTEGER); BEGIN fNumber := number; END; { SetNumber } {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} FUNCTION TValueRadio.GetNumber:INTEGER; BEGIN GetNumber := fNumber; END; { GetNumber } {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TValueRadio.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; BEGIN DoToField('TValueRadio', NIL, bClass); DoToField('fNumber', @fNumber, bInteger); INHERITED Fields(DoToField); END; { Fields } {$ENDC qDebug} {############################################################################### TSetCluster ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} { IRes(): Sets fSet to []. } PROCEDURE TSetCluster.IRes( itsDocument: TDocument; itsSuperView: TView; VAR itsParams: Ptr); OVERRIDE; BEGIN INHERITED IRes(itsDocument, itsSuperView, itsParams); fSet := []; END; { IRes } {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} PROCEDURE TSetCluster.SetTheSet(theSet:ValueSet; redraw:BOOLEAN); {----------------------------------------------------------------------------------------------------------------} PROCEDURE SetOrClearSubview(aView: TView); VAR number:INTEGER; inNewState:BOOLEAN; BEGIN IF Member(aView, TValueCheckbox) THEN BEGIN number := TValueCheckbox(aView).GetNumber; IF (theSet = []) & (number = kEmptySet) THEN TValueCheckbox(aView).SetState(TRUE, redraw) ELSE BEGIN inNewState := (number IN theSet); IF (TValueCheckbox(aView).IsOn <> inNewState) THEN TValueCheckbox(aView).SetState(inNewState, redraw); END; { else } END; { if is TValueCheckbox } END; { SetOrClearSubview } {----------------------------------------------------------------------------------------------------------------} BEGIN { SetTheSet } IF (theSet <> fSet) THEN BEGIN fSet := theSet; EachSubview(SetOrClearSubview); END; END; { SetTheSet } {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} FUNCTION TSetCluster.GetTheSet : ValueSet; BEGIN GetTheSet := fSet; END; { GetTheSet } {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} PROCEDURE TSetCluster.DoCheckBoxHit( VAR origView: TView; VAR itsChoice: INTEGER); VAR number:INTEGER; BEGIN { modify the set value as necessary } IF Member(origView, TValueCheckBox) THEN BEGIN number := TValueCheckBox(origView).GetNumber; IF (kMinValue <= number) & (number <= kMaxValue) THEN BEGIN IF (TValueCheckBox(origView).IsOn) THEN SetTheSet(fSet + [number], kRedraw) ELSE SetTheSet(fSet - [number], kRedraw); END { if in range } ELSE IF (number = kEmptySet) THEN SetTheSet([], kRedraw) ELSE BEGIN {$IFC qDebug} (* write( 'In TSetCluster.DoChoice(), number is out of range: '); writeln('(', kMinValue:1, ' <= ', number:1, ') & (', number:1, ' <= ', kMaxValue:1, ')'); *) {$ENDC qDebug} END; { out of range } END; { if is member } END; { DoCheckBoxHit } {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} PROCEDURE TSetCluster.DoRadioHit(VAR origView: TView; VAR itsChoice: INTEGER); VAR number:INTEGER; BEGIN IF (Member(origView, TValueRadio)) THEN BEGIN number := TValueRadio(origView).GetNumber; IF (kMinValue <= number) & (number <= kMaxValue) THEN SetTheSet([number], kRedraw) ELSE IF (number = kEmptySet) THEN SetTheSet([], kRedraw) ELSE BEGIN {$IFC qDebug} write( 'In TSetCluster.DoChoice(), number is out of range: '); writeln('(', kMinValue:1, ' <= ', number:1, ') & (', number:1, ' <= ', kMaxValue:1, ')'); {$ENDC qDebug} END; { out of range } END; { if is member } END; { DoRadioHit } {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} PROCEDURE TSetCluster.DoChoice(origView: TView; itsChoice: INTEGER); OVERRIDE; VAR callDoChoice: BOOLEAN; BEGIN IF (origView.fSuperView = SELF) { Only worry about it if it's our subview! } THEN BEGIN CASE itsChoice OF mCheckBoxHit: DoCheckBoxHit(origView, itsChoice); mRadioHit: DoRadioHit(origView, itsChoice); OTHERWISE;{ nothing special } END; { case } END; { our subView } INHERITED DoChoice(origView, itsChoice); END; { DoChoice } {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TSetCluster.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;fieldType: INTEGER)); OVERRIDE; VAR i:ValueRange; iStr: Str255; isInSet: BOOLEAN; BEGIN DoToField('TSetCluster', NIL, bClass); DoToField('fSet', @fSet, bHexLongint);{ because it contains only 31 members } FOR i := kMinValue to kMaxValue DO BEGIN isInSet := i IN fSet; NumToString(LONGINT(i), iStr); DoToField(Concat(' ', iStr), @isInSet, bBoolean); END; INHERITED Fields(DoToField); END; { Fields } {$ENDC qDebug} {############################################################################### TValueRadioCluster ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} FUNCTION TValueRadioCluster.GetNumber:INTEGER; VAR Valueradio:TValueRadio; {----------------------------------------------------------------------------------------------------------------} FUNCTION IsSelectedValueRadio(aView: TView): BOOLEAN; BEGIN IsSelectedValueRadio := Member(aView, TValueRadio) & TValueRadio(aView).IsOn; END; { IsSelectedValueRadio } {----------------------------------------------------------------------------------------------------------------} BEGIN { GetNumber } Valueradio := TValueRadio(FirstSubViewThat(IsSelectedValueRadio)); IF (Valueradio = NIL) THEN GetNumber := kBadValue ELSE GetNumber := Valueradio.GetNumber; END; { GetNumber } {----------------------------------------------------------------------------------------------------------------} {$S AUtilities} PROCEDURE TValueRadioCluster.SetNumber(number :INTEGER; redraw:BOOLEAN); {----------------------------------------------------------------------------------------------------------------} PROCEDURE SetOrClearSubview(aView: TView); BEGIN IF Member(aView, TValueRadio) THEN TValueRadio(aView).SetState((TValueRadio(aView).GetNumber = number), redraw); END; { SetOrClearSubview } {----------------------------------------------------------------------------------------------------------------} BEGIN { SetNumber } EachSubview(SetOrClearSubview); END; { SetNumber } {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TValueRadioCluster.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; VAR number:INTEGER; BEGIN DoToField('TValueRadioCluster', NIL, bClass); number := GetNumber; DoToField('current number', @number, bInteger); INHERITED Fields(DoToField); END; { Fields } {$ENDC qDebug} {############################################################################### TSampleText ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S AOpen} { PostRes(): Initialize the dialog's subview references. } PROCEDURE TSampleText.PostRes; OVERRIDE; BEGIN ChangeWrap(TRUE,{ DO wrap text } kDontRedraw);{ DON'T redraw } END; { PostRes } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSampleText.GetTextInfo( VAR theStyle: TextStyle; VAR alignment: INTEGER); BEGIN theStyle := fTextStyle; alignment := fJust; END; { GetTextInfo } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSampleText.GetTextStyle(VAR theStyle: TextStyle); BEGIN theStyle := fTextStyle; END; { GetTextStyle } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSampleText.SetTextStyle(mode: INTEGER; theTextStyle: TextStyle; redraw: BOOLEAN); VAR localTextStyle: TextStyle; ctlRect: Rect; BEGIN localTextStyle := fTextStyle;{ a TStaticText field } AffectTextStyle(mode, theTextStyle, localTextStyle); InstallTextStyle(localTextStyle, kDontRedraw); { a TControl method } IF redraw THEN BEGIN ControlArea(ctlRect); InvalidRect(ctlRect); END; END; { SetTextStyle } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSampleText.SetTextFont(theFont: INTEGER; redraw:BOOLEAN); VAR aTextStyle:TextStyle; BEGIN GetTextStyle(aTextStyle); IF (theFont <> aTextStyle.tsFont) THEN BEGIN aTextStyle.tsFont := theFont; SetTextStyle(doFont,aTextStyle,redraw); END; END; {SetTextFont} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSampleText.SetTextSize(theSize: INTEGER; redraw:BOOLEAN); VAR aTextStyle:TextStyle; BEGIN GetTextStyle(aTextStyle); IF (aTextStyle.tsSize <> theSize) THEN BEGIN aTextStyle.tsSize := theSize; SetTextStyle(doSize,aTextStyle,redraw) END; END; {SetTextSize} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSampleText.SetTextFace(theFace: Style; redraw:BOOLEAN); VAR aTextStyle:TextStyle; BEGIN GetTextStyle(aTextStyle); IF (aTextStyle.tsFace <> theFace) THEN BEGIN aTextStyle.tsFace := theFace; SetTextStyle(doFace,aTextStyle,redraw); END; END; {SetTextFace} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSampleText.SetTextColor(theColor: RGBColor; redraw:BOOLEAN); VAR aTextStyle:TextStyle; BEGIN GetTextStyle(aTextStyle); IF (NOT SameRGBColor(aTextStyle.tsColor, theColor)) { UProtoUtilities } THEN BEGIN aTextStyle.tsColor := theColor; SetTextStyle(doColor,aTextStyle,redraw); END; END; { SetTextColor } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSampleText.SetTextJust(alignment: INTEGER; redraw:BOOLEAN); BEGIN IF (fJust <> alignment) THEN SetJustification(alignment, redraw); END; { SetTextJust } {############################################################################### TJustifyCluster ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S AOpen} { PostRes(): Initialize the dialog's subview references. } PROCEDURE TJustifyCluster.PostRes; OVERRIDE; VAR aView: TView; BEGIN INHERITED PostRes; aView := GetDialogView.FindSubView('samp'); FailNil(aView); fSampleText := TSampleText(aView); END; { PostRes } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TJustifyCluster.DoChoice(origView: TView; itsChoice: INTEGER); BEGIN INHERITED DoChoice(origView,itsChoice); IF (itsChoice = mRadioHit) & (TRadio(origView).IsOn) THEN fSampleText.SetTextJust(GetNumber,kRedraw) END; { DoChoice } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TJustifyCluster.SetTextJust(alignment: INTEGER; redraw:BOOLEAN); BEGIN IF (GetNumber <> alignment) THEN SetNumber(alignment, redraw); END; { SetTextJust } {############################################################################### TStyleCluster ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TStyleCluster.SetTextFace(theFace: Style; redraw:BOOLEAN); VAR theSet:ValueSet;{ see UProtoControls.p } aStyleItem:StyleItem; { see IM v1 p201 } BEGIN IF (GetTextFace <> theFace) THEN BEGIN { convert Style to ValueSet } theSet := []; IF (theFace <> []) THEN BEGIN FOR aStyleItem := bold TO shadow DO { ignore condense and extend } BEGIN IF (aStyleItem IN theFace) THEN theSet := theSet + [ord(aStyleItem)]; END; { for } END; { if } SetTheSet(theSet, redraw); END; END; { SetTextFace } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} FUNCTION TStyleCluster.GetTextFace : Style; VAR aStyleItem:StyleItem; result:Style; BEGIN result := []; IF (fSet <> []) THEN BEGIN FOR aStyleItem := bold TO shadow DO BEGIN IF (ord(aStyleItem) IN fSet) THEN result := result + [aStyleItem]; END; { for } END; { if } GetTextFace := result; END; { GetTextFace } {############################################################################### TSpaceCluster ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSpaceCluster.SetTextFace(theFace: Style; redraw:BOOLEAN); VAR theNumber: INTEGER; BEGIN IF (GetTextFace <> theFace) THEN BEGIN { convert Style to INTEGER } IF (condense IN theFace) THEN theNumber := ord(condense) ELSE IF (extend IN theFace) THEN theNumber := ord(extend) ELSE theNumber := kNormalSpacing; SetNumber(theNumber, redraw); END; END; { SetTextFace } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} FUNCTION TSpaceCluster.GetTextFace : Style; VAR theNumber: INTEGER; BEGIN theNumber := GetNumber; IF (theNumber = ord(condense)) THEN GetTextFace := [condense] ELSE IF (theNumber = ord(extend)) THEN GetTextFace := [extend] ELSE GetTextFace := []; END; { GetTextFace } {############################################################################### TFaceCluster ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S AOpen} { PostRes(): Initialize the dialog's subview references. } PROCEDURE TFaceCluster.PostRes; OVERRIDE; VAR aView: TView; BEGIN INHERITED PostRes; aView := FindSubView('styl'); FailNil(aView); fStyleCluster := TStyleCluster(aView); aView := FindSubView('spac'); FailNil(aView); fSpaceCluster := TSpaceCluster(aView); aView := GetDialogView.FindSubView('samp'); FailNil(aView); fSampleText := TSampleText(aView); END; { PostRes } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TFaceCluster.DoChoice(origView: TView; itsChoice: INTEGER); BEGIN IF (itsChoice IN [mCheckBoxHit, mRadioHit]) THEN fSampleText.SetTextFace(GetTextFace, kRedraw); INHERITED DoChoice(origView, itsChoice); END; { DoChoice } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TFaceCluster.SetTextFace(theFace: Style; redraw:BOOLEAN); BEGIN IF (GetTextFace <> theFace) THEN BEGIN fStyleCluster.SetTextFace(theFace, redraw); fSpaceCluster.SetTextFace(theFace, redraw); END; END; { SetTextFace } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} FUNCTION TFaceCluster.GetTextFace : Style; BEGIN GetTextFace := fStyleCluster.GetTextFace + fSpaceCluster.GetTextFace; END; { GetTextFace } {############################################################################### TFontListView ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S AOpen} { PostRes(): Calls InitFontList(). } PROCEDURE TFontListView.PostRes; OVERRIDE; BEGIN INHERITED PostRes; { build the font list } InitFontList; {$IFC qDebug} Assertion((fNumOfRows >= 1), AtStr('(fNumOfRows >= 1)')); {$ENDC qDebug} { select the first item } SetSelectionRect(1, 1, 1, 1, kDontExtend, kHighlight, kSelect); END; { PostRes } {----------------------------------------------------------------------------------------------------------------} {$S AOpen} PROCEDURE TFontListView.InitFontList; VAR pFondIDs:FontListPtr; i:INTEGER; noOfFonds: INTEGER; aString: Str255; {----------------------------------------------------------------------------------------------------------------}} FUNCTION FondAfter(VAR fontName: Str255): INTEGER; { Find the FOND whose name follows fontName alphabetically, and return its id and name } VAR theFondResource:Handle; lastID:INTEGER; thisID:INTEGER; itsType: ResType; index: INTEGER; foundFOND: BOOLEAN; lastName:Str255; thisName:Str255; BEGIN lastID := 0; foundFOND := FALSE; lastName := '~~~~~~~~'; FOR index := 1 to noOfFonds DO BEGIN theFondResource := GetIndResource('FOND', index); GetResInfo(theFondResource, thisID, itsType, thisName); IF (thisName > fontName) & (thisName < lastName) THEN BEGIN lastID := thisID; CopyStr255(thisName, @lastName); foundFOND := TRUE; END; END; IF foundFOND THEN CopyStr255(lastName, @fontName) ELSE { Skip duplicate FOND names } fontName := ''; FondAfter := lastID; END; { FondAfter } {----------------------------------------------------------------------------------------------------------------} BEGIN { InitFontList } fFontList := NIL; noOfFonds := CountResources('FOND'); IF noOfFonds > kMaxFonds THEN noOfFonds := kMaxFonds; pFondIDs := FontListPtr(NewPermPtr(noOfFonds * sizeof(INTEGER))); FailNIL(pFondIDs); aString := ' '; FOR i := 1 TO noOfFonds DO BEGIN { put each FOND's id in the list } pFondIDs^[i] := FondAfter(aString); { in alphabetical order } IF length(aString) = 0 THEN { we finished early } BEGIN noOfFonds := i-1; LEAVE; END; END; fFontList := pFondIDs; InsItemLast(noOfFonds) END; { InitFontList } {----------------------------------------------------------------------------------------------------------------} {$S AClose} PROCEDURE TFontListView.Free; OVERRIDE; BEGIN Ptr(fFontList) := DisposeIfPtr(fFontList); INHERITED Free; END; {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TFontListView.GetItemText(anItem: INTEGER; VAR aString: Str255); OVERRIDE; VAR theFondResource:Handle; itsID: INTEGER; itsType: ResType; BEGIN theFondResource := GetResource('FOND', fFontList^[anItem]); GetResInfo(theFondResource, itsID, itsType, aString); END; {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TFontListView.SetTextFont(theFont: INTEGER; redraw:BOOLEAN); VAR item: INTEGER; BEGIN IF (GetTextFont <> theFont) THEN BEGIN item := fNumOfRows; { find the list item that is displaying theFont } WHILE (item >= 1) & (fFontList^[item] <> theFont) DO BEGIN item := item - 1; END; IF (fFontList^[item] = theFont) { found it } THEN BEGIN SelectItem(item, kDontExtend, kHighlight, kSelect); END ELSE BEGIN SetEmptySelection(kHighlight); {$IFC qDebug} ProgramBreak('In TFontListView.SetTextFont(), a missing font was set (bad!).'); {$ENDC qDebug} END; END; END; { SetTextFont } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} FUNCTION TFontListView.GetTextFont :INTEGER; VAR aString: Str255; aFontNumber: INTEGER; BEGIN GetItemText(LastSelectedItem,aString); GetFNum(aString,aFontNumber); GetTextFont := aFontNumber; END; {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TFontListView.SelectItem(anItem: INTEGER; extendSelection, highlight, select: BOOLEAN); OVERRIDE; BEGIN INHERITED SelectItem(anItem, extendSelection, highlight, select); IF select THEN DoChoice(SELF,mFontChanged) END; {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TFontListView.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; BEGIN DoToField('TFontListView', NIL, bClass); DoToField('fFontList', @fFontList, bPointer); INHERITED Fields(DoToField); END; {$ENDC qInspector} {############################################################################### TSizeListView ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} FUNCTION TSizeListView.GetItemSize(anItem: INTEGER) :INTEGER; VAR i:INTEGER; noOfSizes: INTEGER; theFond: FondHandle; BEGIN theFond := FondHandle(GetResource('FOND', fFondID)); noOfSizes := 0; FOR i := 0 TO theFond^^.noOfFonts DO BEGIN IF theFond^^.fontStuff[i].style = 0 THEN noOfSizes := noOfSizes + 1; IF noOfSizes = anItem THEN BEGIN GetItemSize := theFond^^.fontStuff[i].size; EXIT(GetItemSize); END; END; GetItemSize := 0; END; {GetItemSize} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} FUNCTION TSizeListView.FindSizeItem(theSize: INTEGER) :INTEGER; VAR i:INTEGER; BEGIN FOR i := 1 TO fNumOfRows DO BEGIN IF theSize=GetItemSize(i) THEN BEGIN FindSizeItem := i; EXIT(FindSizeItem) END; END; { for } FindSizeItem := 0; END; {FindSizeItem} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} FUNCTION TSizeListView.GetTextSize :INTEGER; BEGIN GetTextSize := GetItemSize(LastSelectedItem) END; {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSizeListView.SetTextSize(theSize: INTEGER; redraw:BOOLEAN); VAR anItem:INTEGER; BEGIN IF (GetTextSize <> theSize) THEN BEGIN anItem := FindSizeItem(theSize); IF anItem <> 0 THEN INHERITED SelectItem(anItem, kDontExtend, kHighlight, kSelect); END; END; {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSizeListView.GetItemText(anItem: INTEGER; VAR aString: Str255); OVERRIDE; BEGIN NumToString(GetItemSize(anItem), aString); END; {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSizeListView.SetNumberOfItems(aNumber: INTEGER); BEGIN IF fNumOfRows > aNumber THEN DelItemFirst(fNumOfRows - aNumber) ELSE IF fNumOfRows < aNumber THEN InsItemFirst(aNumber - fNumOfRows); END; {----------------------------------------------------------------------------------------------------------------} {$S AOpen} PROCEDURE TSizeListView.InstallFontFamily( theFondID: INTEGER); VAR theFond: FondHandle; noOfSizes: INTEGER; i:INTEGER; BEGIN theFond := FondHandle(GetResource('FOND', theFondID)); noOfSizes := 0; FOR i := 0 TO theFond^^.noOfFonts DO BEGIN IF theFond^^.fontStuff[i].style = 0 THEN noOfSizes := noOfSizes + 1; END; { for } fFondID := theFondID; SetNumberOfItems(noOfSizes); ForceRedraw; END; {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSizeListView.SelectItem(anItem: INTEGER; extendSelection: BOOLEAN; highlight: BOOLEAN; select: BOOLEAN); BEGIN { if anItem is 0, row 1 is selected } INHERITED SelectItem(anItem, extendSelection, highlight, select); IF select & (anItem <> 0) THEN DoChoice(SELF, mListFontSizeChanged); END; {----------------------------------------------------------------------------------------------------------------} {$S AFields} PROCEDURE TSizeListView.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; BEGIN DoToField('TSizeListView', NIL, bClass); DoToField('fFondID', @fFondID, bInteger); INHERITED Fields(DoToField); END; {############################################################################### TSizeText ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} FUNCTION TSizeText.GetTextSize :INTEGER; BEGIN GetTextSize := GetValue END; {GetTextSize} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSizeText.SetTextSize(theSize: INTEGER; redraw:BOOLEAN); BEGIN SetValue(theSize,redraw); TDialogView(GetDialogView).DoSelectEditText(SELF, TRUE) END; {SetTextSize} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} FUNCTION TSizeText.Validate: LONGINT; OVERRIDE; VAR result:LONGINT; BEGIN result := INHERITED Validate; IF (result = kValidValue) THEN DoChoice(SELF, mTextFontSizeChanged); Validate := result; END; {############################################################################### TSizeCluster ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S AOpen} { PostRes(): Initialize the dialog's subview references. } PROCEDURE TSizeCluster.PostRes; OVERRIDE; VAR aView: TView; BEGIN INHERITED PostRes; aView := GetDialogView.FindSubView('size'); FailNil(aView); fSizeText := TSizeText(aView); aView := FindSubView('slst'); FailNil(aView); fSizeListView := TSizeListView(aView); END; { PostRes } {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} FUNCTION TSizeCluster.GetTextSize :INTEGER; BEGIN GetTextSize := fSizeText.GetTextSize END; {GetTextSize} {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSizeCluster.SetTextSize(theSize: INTEGER; redraw:BOOLEAN); BEGIN fSizeText.SetTextSize(theSize,redraw); fSizeListView.SetTextSize(theSize,redraw) END; {----------------------------------------------------------------------------------------------------------------} {$S ACharDlg} PROCEDURE TSizeCluster.SetTextFont(theFont: INTEGER; redraw:BOOLEAN); BEGIN fSizeListView.InstallFontFamily(theFont); fSizeListView.SetTextSize(GetTextSize,redraw) END; {----------------------------------------------------------------------------------------------------------------}} {$S ACharDlg} PROCEDURE TSizeCluster.DoChoice(origView: TView; itsChoice: INTEGER); BEGIN CASE itsChoice OF mTextFontSizeChanged: BEGIN {$IFC qDebug} Assertion(Member(origView, TSizeText), AtStr('Member(origView, TSizeText)')); {$ENDC qDebug} fSizeListView.SetTextSize(TSizeText(origView).GetTextSize, kRedraw); INHERITED DoChoice(origView, mFontSizeChanged); END; { mTextFontSizeChanged } mListFontSizeChanged: BEGIN {$IFC qDebug} Assertion(Member(origView, TSizeListView), AtStr('Member(origView, TSizeListView)')); {$ENDC qDebug} fSizeText.SetTextSize(TSizeListView(origView).GetTextSize, kRedraw); INHERITED DoChoice(origView, mFontSizeChanged); END; { mListFontSizeChanged } mFontSizeChanged: BEGIN {$IFC qDebug} ProgramBreak('In TSizeCluster.DoChoice(), unexpected ''mFontSizeChanged'' recieved.'); {$ENDC qDebug} INHERITED DoChoice(origView, itsChoice); END; { mListFontSizeChanged } OTHERWISE INHERITED DoChoice(origView, itsChoice); END; {CASE} END; {DoChoice} {############################################################################### TCharacterDialogCmd ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S ASelCommand} PROCEDURE TCharacterDialogCmd.ICharacterDialogCmd( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller; itsTextStyle: TextStyle; itsAlignment: INTEGER); BEGIN IMacAppDialogCmd( itsCmdNumber, itsDocument, itsView, itsScroller, itsCmdNumber, { a handy convention: 'view' rsrc ID <=> CmdNumber } 'DLOG'); fTextStyle := itsTextStyle; fAlignment := itsAlignment; END; { ICharacterDialogCmd } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} { InitTheDialog(): Initializes the dialog to reflect the command's TextStyle and alignment values. } PROCEDURE TCharacterDialogCmd.InitTheDialog; OVERRIDE; VAR theTextStyle: TextStyle; BEGIN { localize to avoid unsafe field use } theTextStyle := fTextStyle; { initialize the dialog to act on the command's TextStyle and alignment } TCharDialogView(fTheDialog).SetDialogInfo(theTextStyle, fAlignment, kRedraw); { make sure the 'size' field is the current edit text item } fTheDialog.SelectEditText('size', TRUE); { TRUE = DO select the text } END; { InitTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TCharacterDialogCmd.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; BEGIN DoToField('TCharacterDialogCmd', NIL, bClass); {$Push} {$H-} TextStyleFields('fTextStyle', fTextStyle, DoToField); {$Pop} DoToField('fAlignment', @fAlignment, bInteger); INHERITED Fields(DoToField); END; { Fields } {$ENDC qDebug} {############################################################################### TColorDialogCmd ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S ASelCommand} PROCEDURE TColorDialogCmd.IColorDialogCmd( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller; itsInitialColor:RGBColor; itsPromptID: INTEGER); BEGIN IToolboxDialogCmd( itsCmdNumber, itsDocument, itsView, itsScroller, -1, { this value wil be ignored } [], { this value wil be ignored } NIL); { this value wil be ignored } fInitialColor := itsInitialColor; fResultColor := itsInitialColor; fPromptID := itsPromptID; END; { IColorDialogCmd } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TColorDialogCmd.PoseTheDialog; OVERRIDE; VAR pickerPrompt: StringHandle; cancelled: BOOLEAN; initialColor: RGBColor; resultColor: RGBColor; BEGIN pickerPrompt := GetString(fPromptID); FailNil(pickerPrompt); { localize -- That Amazing Moving Memory! } initialColor := fInitialColor; cancelled := NOT GetColor(gZeroPt, pickerPrompt^^, initialColor, resultColor); fResultColor := resultColor; SetCancelled(cancelled); IF cancelled THEN SetDismisser(cancel) ELSE SetDismisser(ok); END; { PoseTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TColorDialogCmd.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; BEGIN DoToField('TColorDialogCmd', NIL, bClass); DoToField('fInitialColor', @fInitialColor, bRGBColor); DoToField('fResultColor', @fResultColor, bRGBColor); INHERITED Fields(DoToField); END; { Fields } {$ENDC qDebug} {----------------------------------------------------------------------------------------------------------------}
Continued in next frame | ||
Volume Number: | 7 | |
Issue Number: | 11 | |
Column Tag: | Pascal Methods |
Related Info: Dialog Manager TextEdit
Posing Dialogs in MacApp (code)
Listing: UCharacterDialog.p {************************************************************************************ UCharacterDialog.p ************************************************************************************} UNIT UCharacterDialog; INTERFACE USES { • MacApp } UMacApp, { • Building Blocks } UGridView, UTEView, UDialog, UMenuItemCommand; CONST kMaxFonds = 100; { Max number of FONDs the FontList holds } kNormalSpacing = 0; { values for TSpaceCluster } { keystroke (UKeywordDialog) } { TextStyle mode constants -- see IM v5 p269 (TESetStyle()) } doAlign = 64; { modify alignment } doPlusFace = 128; { add face to existing face } doMinusFace = 256; { subtract face from existing face } doAllAndAlign = doAll + doAlign; { doAll, and align too } { DoChoice() message numbers } mFontChanged = 101; { Character Dialog } mFontSizeChanged= 102; mFontFaceChanged= 103; mTextJustChanged= 104; mTextFontSizeChanged= 105; mListFontSizeChanged= 106; mSpacingChanged = 107; {########################################################################### Unit Initialization ###########################################################################} PROCEDURE InitUCharacterDialog; {########################################################################### Utility Routines ###########################################################################} FUNCTION SameRGBColor(color1, color2: RGBColor): BOOLEAN; FUNCTION SameTextStyle(style1, style2: TextStyle): BOOLEAN; { AffectTextStyle(): Uses the given source TextStyle to modify the given target TextStyle according to the given mode, in a manner similar to that used in TTEView.SetOneStyle(). Note that "mode" may include flags for setting the alignment, as defined above; if present, they are ignored. } PROCEDURE AffectTextStyle(theMode: INTEGER; VAR source: TextStyle; { not changed } VAR target: TextStyle); { AffectTextAlignment(): Uses the given source alignment to modify the given target alignment according to the given mode, in a manner similar to that used in TTEView.SetOneStyle(). Note that "mode" may include flags for setting the alignment, as defined above. } PROCEDURE AffectTextAlignment(theMode: INTEGER; source: INTEGER; VARtarget: INTEGER); { AffectTextStyleAndAlign(): Uses the given source TextStyle and alignment to modify the given target TextStyle and alignment according to the given mode, in a manner similar to that used in TTEView.SetOneStyle(). Note that "mode" may include flags for setting the alignment, as defined above. } PROCEDURE AffectTextStyleAndAlign(theMode: INTEGER; VAR sourceTS: TextStyle; { not changed } sourceAlign: INTEGER; VAR targetTS: TextStyle; VAR targetAlign: INTEGER); TYPE FontList = ARRAY [1..kMaxFonds] OF INTEGER; { FOND resource IDs } FontListPtr = ^FontList; {############################################################################### TCharDialogView This dialog accepts a TextStyle and an alignment, allows the user to edit them, and allows access to the result. ###############################################################################} TCharDialogView = OBJECT (TDialogView) fSampleText: TSampleText; fFontListView: TFontListView; fSizeCluster: TSizeCluster; fJustCluster: TJustifyCluster; fFaceCluster: TFaceCluster; { PostRes(): Initialize the dialog's subview references. } PROCEDURE TCharDialogView.PostRes; OVERRIDE; { SetDialogInfo(): Initializes the dialog to reflect the given TextStyle record and alignment value. } PROCEDURE TCharDialogView.SetDialogInfo( theStyle:TextStyle; alignment: INTEGER; redraw: BOOLEAN); { GetDialogInfo(): Returns the dialog's current TextStyle record and alignment value. } PROCEDURE TCharDialogView.GetDialogInfo( VAR theStyle: TextStyle; VAR alignment: INTEGER); PROCEDURE TCharDialogView.SetTextFont( theFont: INTEGER; redraw: BOOLEAN); PROCEDURE TCharDialogView.SetTextSize( theSize: INTEGER; redraw: BOOLEAN); PROCEDURE TCharDialogView.SetTextFace( theFace: Style; redraw: BOOLEAN); PROCEDURE TCharDialogView.SetTextColor( theColor: RGBColor; redraw: BOOLEAN); PROCEDURE TCharDialogView.SetTextJust( alignment: INTEGER; redraw: BOOLEAN); PROCEDURE TCharDialogView.DoChoice( origView: TView; itsChoice: INTEGER); OVERRIDE; END; { TCharDialogView } {############################################################################### TSampleText TCharDialogView doesn't need an fTextStyle or an fAlignment field, because TSampleText has them. ###############################################################################} TSampleText= OBJECT (TStaticText) { PostRes(): Turn on fAutoWrap (FALSE by default in MacApp 2.0). } PROCEDURE TSampleText.PostRes; OVERRIDE; PROCEDURE TSampleText.GetTextInfo( VAR theStyle: TextStyle; VAR alignment: INTEGER); PROCEDURE TSampleText.GetTextStyle( VAR theStyle: TextStyle); PROCEDURE TSampleText.SetTextStyle( mode: INTEGER; { IM v5 p269 } theTextStyle: TextStyle; redraw: BOOLEAN); PROCEDURE TSampleText.SetTextFont( theFont: INTEGER; redraw: BOOLEAN); PROCEDURE TSampleText.SetTextSize( theSize: INTEGER; redraw: BOOLEAN); PROCEDURE TSampleText.SetTextFace( theFace: Style; redraw: BOOLEAN); PROCEDURE TSampleText.SetTextColor( theColor: RGBColor; redraw: BOOLEAN); PROCEDURE TSampleText.SetTextJust( alignment: INTEGER; redraw: BOOLEAN); END; { TSampleText } {############################################################################### TValueCheckBox A TValueCheckBox is just like a normal checkbox, except that it has one additional field: fNumber. This value is read in from the view's view resource, and can be accessed via access functions. It is used when the control is placed in a TSetCluster. ###############################################################################} ValueCheckBoxTemplatePtr = ^ValueCheckBoxTemplate; ValueCheckBoxTemplate = RECORD number:INTEGER; END; { ValueCheckBoxTemplate } TValueCheckBox = OBJECT(TCheckBox) fNumber: INTEGER; PROCEDURE TValueCheckBox.IRes( itsDocument: TDocument; itsSuperView:TView; VAR itsParams: Ptr); OVERRIDE; PROCEDURE TValueCheckBox.SetNumber(number: INTEGER); FUNCTION TValueCheckBox.GetNumber :INTEGER; { debugger stuff } {$IFC qInspector} PROCEDURE TValueCheckBox.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; { TValueCheckBox } {############################################################################### TValueRadio A TValueRadio is just like a normal radio button, except that it has one additional field: fNumber. This value is read in from the view's view resource, and can be accessed via access functions. It is used when the control is placed in a TSetCluster. This class is actually a minor variation on TValueCheckbox. ###############################################################################} ValueRadioTemplatePtr = ^ValueRadioTemplate; ValueRadioTemplate= RECORD number:INTEGER; END; { ValueRadioTemplate } TValueRadio = OBJECT(TRadio) fNumber: INTEGER; PROCEDURE TValueRadio.IRes( itsDocument: TDocument; itsSuperView: TView; VAR itsParams: Ptr); OVERRIDE; PROCEDURE TValueRadio.SetNumber( number: INTEGER); FUNCTION TValueRadio.GetNumber :INTEGER; { debugger stuff } {$IFC qInspector} PROCEDURE TValueRadio.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; { TValueRadio } {############################################################################### TSetCluster This class is used to manipulate a group of radio buttons and/or checkbixes that, together, define a set of possible values. For example, one could easily imagine a group of seven checkboxes, each repreenting a day of the week. This class can be used to combine the values of that group of checkboxes into a set. It is assumed that the checkboxes and/or radio buttons which are the subviews of this class of clusters will be of class TValueCheckBox and TValueRadio, respectively (see above). This class is implemented to act on a small set -- no more than 31 possible values. That is because that's enough for a lot of uses, and beacuse its the biggest set for which there are no performance penalties (see MPW 3.0 Pascal manual, p.4-18: Set Types). Note: This implementation could be improved by adding two additional fields: fMinValue and fMaxValue. These values could be used for boundary checks in DoChoice(), instead of kMinValue and kMaxValue. Also note that fSet is not initialized during PostRes(), so that it can be set with a call to SetTheSet() without redundancy. However, the set is initialized to the empty set ([]) during IRes(), to ensure stability. ###############################################################################} CONST kMinValue= 0; kMaxValue= 30; kBadValue= -32768; kEmptySet= -1; TYPE ValueRange = kMinValue..kMaxValue; ValueSet = SET OF ValueRange; TSetCluster = OBJECT(TCluster) fSet: ValueSet;{ the current set } { IRes(): Sets fSet to []. } PROCEDURE TSetCluster.IRes( itsDocument: TDocument; itsSuperView:TView; VAR itsParams: Ptr); OVERRIDE; PROCEDURE TSetCluster.SetTheSet( theSet: ValueSet; redraw: BOOLEAN); FUNCTION TSetCluster.GetTheSet : ValueSet; { DoCheckBoxHit(): Handles mCheckBoxHit messages. Can alter the values of origView and itsChoice. } PROCEDURE TSetCluster.DoCheckBoxHit( VAR origView: TView; VARitsChoice: INTEGER); { DoRadioHit(): Handles mRadioHit messages. Can alter the values of origView and itsChoice. } PROCEDURE TSetCluster.DoRadioHit( VAR origView: TView; VARitsChoice: INTEGER); { DoChoice(): maintains fSet. } PROCEDURE TSetCluster.DoChoice( origView: TView; itsChoice: INTEGER); OVERRIDE; { debugger stuff } {$IFC qInspector} PROCEDURE TSetCluster.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; { TSetCluster } {############################################################################### TValueRadioCluster This class is, in most respects, just like a regular cluster. Its special function is that, if it contains a bunch of TValueRadio controls, it can find the 'number' of the currently-selected TValueRadio control. ###############################################################################} TValueRadioCluster = OBJECT(TCluster) PROCEDURE TValueRadioCluster.SetNumber( number: INTEGER; redraw: BOOLEAN); FUNCTION TValueRadioCluster.GetNumber :INTEGER; { debugger stuff } {$IFC qInspector} PROCEDURE TValueRadioCluster.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; { TValueRadioCluster } {############################################################################### TJustifyCluster ###############################################################################} TJustifyCluster = OBJECT (TValueRadioCluster) fSampleText: TSampleText; { PostRes(): Initialize the dialog's subview references. } PROCEDURE TJustifyCluster.PostRes; OVERRIDE; PROCEDURE TJustifyCluster.DoChoice( origView: TView; itsChoice: INTEGER); OVERRIDE; PROCEDURE TJustifyCluster.SetTextJust( alignment: INTEGER; redraw: BOOLEAN); END; { TJustifyCluster } {############################################################################### TStyleCluster This class provides an interface between the TFaceCluster class, which wants to manipulate QuickDraw styles, and TSetCluster, which wants to manipulate ValueSets (see IM v1 p201). ###############################################################################} TStyleCluster = OBJECT (TSetCluster) PROCEDURE TStyleCluster.SetTextFace( theFace: Style; redraw: BOOLEAN); FUNCTION TStyleCluster.GetTextFace : Style; END; {############################################################################### TSpaceCluster This class provides an interface between the TFaceCluster class, which wants to manipulate QuickDraw styles, and TValueRadioCluster, which wants to manipulate only single integers. ###############################################################################} TSpaceCluster = OBJECT (TValueRadioCluster) PROCEDURE TSpaceCluster.SetTextFace( theFace: Style; redraw: BOOLEAN); FUNCTION TSpaceCluster.GetTextFace : Style; END; { TSpaceCluster } {############################################################################### TFaceCluster This implementation relies on these facts being true: • all of the controls in the TStyleCluster are checkboxes • all of the controls in the TSpaceCluster are radio buttons • the TFaceCluster contains no other controls With these things being true, we know that whenever the TFaceCluster's DoChoice() method gets told about a mCheckBoxHit, we know it happened in the style cluster. Likewise, if it gets a mRadioHit message, we know it happened in the TSpaceCluster. ###############################################################################} TFaceCluster = OBJECT (TCluster) fStyleCluster: TStyleCluster; fSpaceCluster: TSpaceCluster; fSampleText: TSampleText; { PostRes(): Initialize the dialog's subview references. } PROCEDURE TFaceCluster.PostRes; OVERRIDE; PROCEDURE TFaceCluster.SetTextFace( theFace: Style; redraw: BOOLEAN); FUNCTION TFaceCluster.GetTextFace : Style; { DoChoice(): Handles all manipulations of the style and spacing clusters, which are subviews of SELF. } PROCEDURE TFaceCluster.DoChoice( origView: TView; itsChoice: INTEGER); OVERRIDE; END; {############################################################################### TFontListView ###############################################################################} TFontListView = OBJECT (TTextListView) fFontList: FontListPtr; { font resource ids } { PostRes(): Calls InitFontList(). } PROCEDURE TFontListView.PostRes; OVERRIDE; PROCEDURE TFontListView.InitFontList; PROCEDURE TFontListView.Free; OVERRIDE; PROCEDURE TFontListView.GetItemText( anItem: INTEGER; VAR aString: Str255); OVERRIDE; PROCEDURE TFontListView.SelectItem( anItem: INTEGER; extendSelection, highlight, select: BOOLEAN); OVERRIDE; FUNCTION TFontListView.GetTextFont :INTEGER; PROCEDURE TFontListView.SetTextFont( theFont: INTEGER; redraw:BOOLEAN); {$IFC qInspector} PROCEDURE TFontListView.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; {############################################################################### TSizeListView ###############################################################################} TSizeListView = OBJECT (TTextListView) fFondID: INTEGER; FUNCTION TSizeListView.GetItemSize(anItem: INTEGER) :INTEGER; FUNCTION TSizeListView.FindSizeItem(theSize: INTEGER) :INTEGER; FUNCTION TSizeListView.GetTextSize :INTEGER; PROCEDURE TSizeListView.SetTextSize( theSize: INTEGER; redraw: BOOLEAN); PROCEDURE TSizeListView.GetItemText( anItem: INTEGER; VAR aString: Str255); OVERRIDE; PROCEDURE TSizeListView.SetNumberOfItems( aNumber: INTEGER); PROCEDURE TSizeListView.InstallFontFamily( theFondID: INTEGER); PROCEDURE TSizeListView.SelectItem(anItem: INTEGER; extendSelection: BOOLEAN; highlight: BOOLEAN; select: BOOLEAN); OVERRIDE; PROCEDURE TSizeListView.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; END; {############################################################################### TSizeText ###############################################################################} TSizeText= OBJECT (TNumberText) FUNCTION TSizeText.GetTextSize :INTEGER; PROCEDURE TSizeText.SetTextSize( theSize: INTEGER; redraw: BOOLEAN); FUNCTION TSizeText.Validate: LONGINT; OVERRIDE; END; {############################################################################### TSizeCluster ###############################################################################} TSizeCluster = OBJECT (TCluster) fSizeText: TSizeText; fSizeListView: TSizeListView; { PostRes(): Initialize the dialog's subview references. } PROCEDURE TSizeCluster.PostRes; OVERRIDE; FUNCTION TSizeCluster.GetTextSize :INTEGER; PROCEDURE TSizeCluster.SetTextSize(theSize: INTEGER; redraw:BOOLEAN); PROCEDURE TSizeCluster.SetTextFont( theFont: INTEGER; redraw: BOOLEAN); PROCEDURE TSizeCluster.DoChoice( origView: TView; itsChoice: INTEGER); OVERRIDE; END; {########################################################################### TCharacterDialogCmd This command displays the Character dialog. It is a subclass of TMacAppDialogCmd, which is defined in UMenuItemCommand. ###########################################################################} TCharacterDialogCmd = OBJECT(TMacAppDialogCmd) fTextStyle:TextStyle; fAlignment:INTEGER; PROCEDURE TCharacterDialogCmd.ICharacterDialogCmd( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller; itsTextStyle: TextStyle; itsAlignment: INTEGER); { InitTheDialog(): Initializes the dialog to reflect the command's TextStyle and alignment values (which were set in an override of InitMenuItemCommand()). } PROCEDURE TCharacterDialogCmd.InitTheDialog; OVERRIDE; {$IFC qInspector} PROCEDURE TCharacterDialogCmd.Fields( PROCEDURE DoToField( fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; { TCharacterDialogCmd } {########################################################################### TColorDialogCmd This command displays the Color Picker dialog. ###########################################################################} TColorDialogCmd = OBJECT(TToolboxDialogCmd) fInitialColor: RGBColor; fResultColor: RGBColor; fPromptID: INTEGER; PROCEDURE TColorDialogCmd.IColorDialogCmd( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller; itsInitialColor:RGBColor; itsPromptID: INTEGER); { PoseTheDialog(): Calls the Color Picker Package routine GetColor(), which builds its own dialog, using its own filter, dismissers, etc. } PROCEDURE TColorDialogCmd.PoseTheDialog; OVERRIDE; {$IFC qInspector} PROCEDURE TColorDialogCmd.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; { TColorDialogCmd } IMPLEMENTATION {$I UCharacterDialog.inc1.p} END.
Listing: UMenuItemCommand.inc1.p {******************************************************************************* UMenuItemCommand.inc1.p *******************************************************************************} USES { • Implementation Use } Resources, Script, Dialogs;{ TToolboxDialogCmd } {############################################################################### TMenuItemCommand This is an abstract class, from which all commands created by DoMenuCommand() should (must?) descend. ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMenuItemCommand.IMenuItemCommand( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller); VAR menuNumber:INTEGER; itemNumber:INTEGER; BEGIN ICommand(itsCmdNumber, itsDocument, itsView, itsScroller); CmdToMenuItem(itsCmdNumber, menuNumber, itemNumber); SetMenuNumber(menuNumber); SetItemNumber(itemNumber); END; { IMenuItemCommand } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMenuItemCommand.SetMenuNumber( menuNumber: INTEGER); BEGIN fMenuNumber := menuNumber; END; { SetMenuNumber } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMenuItemCommand.SetItemNumber( itemNumber:INTEGER); BEGIN fItemNumber := itemNumber; END; { SetItemNumber } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TMenuItemCommand.GetMenuNumber : INTEGER; BEGIN GetMenuNumber := fMenuNumber; END; { GetMenuNumber } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TMenuItemCommand.GetItemNumber : INTEGER; BEGIN GetItemNumber := fItemNumber; END; { GetItemNumber } {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TMenuItemCommand.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; BEGIN DoToField('TMenuItemCommand', NIL, bClass); DoToField('fMenuNumber', @fMenuNumber, bInteger); DoToField('fItemNumber', @fItemNumber, bInteger); INHERITED Fields(DoToField); END; { Fields } {$ENDC qDebug} {############################################################################### TPoseDialogCmd This is an abstract class, from which all commands which are intended to display dialogs should descend. It has two main subclasses: TMacAppDialogCmd and TToolboxDialogCmd. TMacAppDialogCmd poses a MacApp dialog, while TToolboxDialogCmd poses a Toolbox dialog. ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TPoseDialogCmd.IPoseDialogCmd( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller); BEGIN { 1: Calling parent class' initialization method } IMenuItemCommand( itsCmdNumber, itsDocument, itsView, itsScroller); { 2: 'overriding' parent class' default initializations } { this command doesn't change the document; the command it creates does } fCanUndo := FALSE; { when FALSE, object is freed after DoIt() } { if fFreeOnCompletion is TRUE (the default) } fCausesChange := FALSE; { when FALSE, doesn't mark document as changed } { 3: Performing local initialization } SetCancelled(FALSE); END; { IPoseDialogCmd } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TPoseDialogCmd.SetCancelled(cancelled: BOOLEAN); BEGIN fCancelled := cancelled; END; { SetCancelled } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TPoseDialogCmd.GetCancelled : BOOLEAN; BEGIN GetCancelled := fCancelled; END; { GetCancelled } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TPoseDialogCmd.CreateTheDialog; { This routine creates the dialog to be posed, and assigns a reference to it to an instance variable (which is added in TMacAppDialogCmd and TToolboxDialogCmd). } BEGIN { does nothing; implemented in TMacAppDialogCmd and TToolboxDialogCmd } END; { CreateTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TPoseDialogCmd.InitTheDialog; { This routine initializes the dialog to be posed. } BEGIN { does nothing } END; { InitTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TPoseDialogCmd.CreateTheCommand : TCommand; { This routine creates the command that is to be posted as a result of having the user accept the dialog. } BEGIN CreateTheCommand := NIL; END; { CreateTheCommand } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TPoseDialogCmd.PoseTheDialog; { Actually poses the dialog. } BEGIN { does nothing; implemented in TMacAppDialogCmd and TToolboxDialogCmd } END; { PoseTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TPoseDialogCmd.DropTheDialog; { Cleans up after exiting the dialog. } BEGIN { does nothing; implemented in TMacAppDialogCmd and TToolboxDialogCmd } END; { DropTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TPoseDialogCmd.DoIt; OVERRIDE; { This routine calls InitTheDialog() to initialize the dialog associated with this command, PoseTheDialog() to pose it, and if it is accepted by the user, CreateTheCommand() to create the command that is to be posted as a result. The resulting command is then posted with PostCommand(). } VAR theCommand:TCommand; BEGIN { initialize the dialog as needed } InitTheDialog; { pose it } PoseTheDialog; { create the resulting command } IF fCancelled THEN theCommand := NIL { the user cancelled the dialog } ELSE theCommand := CreateTheCommand; { the user accepted the dialog } { post the resulting command } IF (theCommand <> NIL) THEN gTarget.PostCommand(theCommand); { clean up } DropTheDialog; END; { DoIt } {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TPoseDialogCmd.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; BEGIN DoToField('TPoseDialogCmd', NIL, bClass); DoToField('fCancelled', @fCancelled, bBoolean); INHERITED Fields(DoToField); END; { Fields } {$ENDC qDebug} {############################################################################### TMacAppDialogCmd This is an abstract class, from which all command which are intended to display dialogs should descend. ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMacAppDialogCmd.IMacAppDialogCmd( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller; itsDialogWindResID: INTEGER; itsDialogViewSig: IDType); BEGIN { 1: Calling parent class' initialization method } IPoseDialogCmd( itsCmdNumber, itsDocument, itsView, itsScroller); { 2: 'overriding' parent class' default initializations } { none } { 3: Performing local initialization } SetDialogWindResID(itsDialogWindResID); SetDialogViewSig(itsDialogViewSig); fTheDialog := NIL; { for now } fTheWindow := NIL; { for now } { initialize fTheDialog and fTheWindow } CreateTheDialog; END; { IMacAppDialogCmd } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMacAppDialogCmd.Free; VAR whereItsAt:INTEGER; BEGIN IF (fTheWindow <> NIL) THEN BEGIN IF fTheWindow.fFreeOnClosing THEN fTheWindow.Close ELSE BEGIN fTheWindow.Close; fTheWindow.Free; END; { else } fTheWindow := NIL; fTheDialog := NIL; END; { then } (* { needed for recurring commands -- not yet implemented !!! } whereItsAt := gApplication.fCommandQueue.GetSameItemNo(SELF); IF (whereItsAt <> kEmptyIndex) THEN gApplication.fCommandQueue.AtDelete(whereItsAt); *) INHERITED Free; END; { Free } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMacAppDialogCmd.SetDialogWindResID( dialogWindResID:INTEGER); BEGIN fDialogWindResID := dialogWindResID; END; { SetDialogWindResID } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMacAppDialogCmd.SetDialogViewSig( dialogViewSig: IDType); BEGIN fDialogViewSig := dialogViewSig; END; { SetDialogViewSig } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMacAppDialogCmd.SetTheDialog( theDialog: TDialogView); BEGIN fTheDialog := theDialog; END; { SetTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMacAppDialogCmd.SetTheWindow(theWindow: TWindow); BEGIN fTheWindow := theWindow; END; { SetTheWindow } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMacAppDialogCmd.SetDismisser( dismisser: IDType); BEGIN fDismisser := dismisser; END; { SetDismisser } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TMacAppDialogCmd.GetDialogWindResID : INTEGER; BEGIN GetDialogWindResID := fDialogWindResID; END; { GetDialogWindResID } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TMacAppDialogCmd.GetDialogViewSig : IDType; BEGIN GetDialogViewSig := fDialogViewSig; END; { GetDialogViewSig } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TMacAppDialogCmd.GetTheDialog : TDialogView; BEGIN GetTheDialog := fTheDialog; END; { GetTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TMacAppDialogCmd.GetTheWindow : TWindow; BEGIN GetTheWindow := fTheWindow; END; { GetTheWindow } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TMacAppDialogCmd.GetDismisser : IDType; BEGIN GetDismisser := fDismisser; END; { GetDismisser } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMacAppDialogCmd.CreateTheDialog; OVERRIDE; { This routine creates the dialog to be posed, assigns it to fTheDialog, and assigns a reference to the window containing the dialog to fTheWindow. } VAR theWindow: TWindow; theDialog: TDialogView; diffDoc: BOOLEAN; BEGIN theWindow := GetTheWindow; IF (theWindow = NIL) THEN theWindow := NewTemplateWindow(fDialogWindResID, fChangedDocument) ELSE BEGIN IF (theWindow.fDocument <> fChangedDocument) THEN theWindow.Free; theWindow := NewTemplateWindow(fDialogWindResID, fChangedDocument); END; { else } FailNil(theWindow); theDialog := TDialogView(theWindow.FindSubView(fDialogViewSig)); FailNil(theDialog); SetTheWindow(theWindow); SetTheDialog(theDialog); END; { CreateTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMacAppDialogCmd.PoseTheDialog; { Actually poses the dialog. } VAR dismisser: IDType; BEGIN { pose the dialog } fTheWindow.Select;{ bring the window to the front before showing it } dismisser := fTheDialog.PoseModally; { take note of the user's response } SetDismisser(dismisser); SetCancelled(dismisser = fTheDialog.fCancelItem); END; { PoseTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TMacAppDialogCmd.DropTheDialog; { Cleans up after exiting the dialog. } VAR freeOnClosing: BOOLEAN; BEGIN freeOnClosing := fTheWindow.fFreeOnClosing; fTheWindow.Close; IF (freeOnClosing) THEN BEGIN SetTheDialog(NIL); SetTheWindow(NIL); END; { then } END; { DropTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TMacAppDialogCmd.Fields( PROCEDURE DoToField( fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; BEGIN DoToField('TMacAppDialogCmd', NIL, bClass); DoToField('fDialogWindResID', @fDialogWindResID, bInteger); DoToField('fDialogViewSig', @fDialogViewSig, bIDType); DoToField('fTheDialog', @fTheDialog, bObject); DoToField('fTheWindow', @fTheWindow, bObject); DoToField('fDismisser', @fDismisser, bIDType); INHERITED Fields(DoToField); END; { Fields } {$ENDC qDebug} {############################################################################### TToolboxDialogCmd Commands of this class display a Toolbox modal dialog, posting a command when and if the dialog is accepted by the user. It is intended to be an abstract class. Each dialog should have a command class that poses it. Such classes can be quite small -- overrides of Fields(), InitMenuItemCommand(), CreateTheCommand(), and a new IClassName() routine -- or quite complex, but most will be small. ###############################################################################} {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TToolboxDialogCmd.IToolboxDialogCmd( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller; itsDialogResID: INTEGER; itsDismisserSet: ItemSet; itsFilter: ProcPtr); BEGIN { 1: Calling parent class' initialization method } IPoseDialogCmd( itsCmdNumber, itsDocument, itsView, itsScroller); { 2: 'overriding' parent class' default initializations } { none } { 3: Performing local initialization } SetDialogResID(itsDialogResID); SetTheDialog(NIL); SetDismisser(-1); SetDismisserSet(itsDismisserSet); SetFilter(itsFilter); CreateTheDialog; END; { IToolboxDialogCmd } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TToolboxDialogCmd.SetDialogResID( dialogResID: INTEGER); BEGIN fDialogResID := dialogResID; END; { SetDialogResID } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TToolboxDialogCmd.SetTheDialog( theDialog: DialogPtr); BEGIN fTheDialog := theDialog; END; { SetTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TToolboxDialogCmd.SetDismisser(dismisser: INTEGER); BEGIN fDismisser := dismisser; END; { SetDismisser } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TToolboxDialogCmd.SetDismisserSet( dismisserSet: ItemSet); BEGIN fDismisserSet := dismisserSet; END; { SetDismisserSet } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TToolboxDialogCmd.SetFilter(filter: ProcPtr); BEGIN fFilter := filter; END; { SetFilter } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TToolboxDialogCmd.GetDialogResID : INTEGER; BEGIN GetDialogResID := fDialogResID; END; { GetDialogResID } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TToolboxDialogCmd.GetTheDialog : DialogPtr; BEGIN GetTheDialog := fTheDialog; END; { GetTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TToolboxDialogCmd.GetDismisser : INTEGER; BEGIN GetDismisser := fDismisser; END; { GetDismisser } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TToolboxDialogCmd.GetDismisserSet : ItemSet; BEGIN GetDismisserSet := fDismisserSet; END; { GetDismisserSet } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} FUNCTION TToolboxDialogCmd.GetFilter : ProcPtr; BEGIN GetFilter := fFilter; END; { GetFilter } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TToolboxDialogCmd.CreateTheDialog; OVERRIDE; { This routine creates the dialog to be posed, assigns it to fTheDialog. } BEGIN fTheDialog := GetNewCenteredDialog(fDialogResID, NIL, WindowPtr(-1)); END; { CreateTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TToolboxDialogCmd.PostProcess( VAR itemHit: INTEGER); { This routine is called after ModalDialog() in the REPEAT loop of PoseTheDialog(), to give the class a shot at post-processing events. } BEGIN { does nothing } END; { PostProcess } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TToolboxDialogCmd.PoseTheDialog; { Actually poses the dialog. } VAR itemHit: INTEGER; BEGIN { pose the dialog } REPEAT ModalDialog(fFilter, itemHit); PostProcess(itemHit); UNTIL (itemHit IN fDismisserSet); { take note of the user's response } SetDismisser(itemHit); SetCancelled((itemHit = cancel)); END; { PoseTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S ADoCommand} PROCEDURE TToolboxDialogCmd.DropTheDialog; BEGIN DisposDialog(fTheDialog); SetTheDialog(NIL);{ paranoia } END; { DropTheDialog } {----------------------------------------------------------------------------------------------------------------} {$S AFields} {$IFC qInspector} PROCEDURE TToolboxDialogCmd.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; BEGIN DoToField('TToolboxDialogCmd', NIL, bClass); DoToField('fDialogResID', @fDialogResID, bInteger); DoToField('fTheDialog', @fTheDialog, bGrafPtr); DoToField('fDismisser', @fDismisser, bInteger); DoToField('fDismisserSet', @fDismisser, bHexLongint); DoToField('fFilter', @fFilter, bHexLongint); INHERITED Fields(DoToField); END; { Fields } {$ENDC qDebug} {----------------------------------------------------------------------------------------------------------------}
Listing: UMenuItemCommand.p {******************************************************************************* UMenuItemCommand.p *******************************************************************************} UNIT UMenuItemCommand; INTERFACE USES { • MacApp } UMacApp, { • Building Blocks } UDialog; CONST kIgnoreDismisser= ';-) ';{ a smiley face! (anything will do) } kNotAMacAppDialog = '!!!!';{ command displays a Toolbox dialog } kInvalidRsrcID = -32768;{ command displays a Toolbox dialog } TYPE {########################################################################### TMenuItemCommand This is an abstract class, from which all commands created by DoMenuCommand() should (must?) descend. ###########################################################################} TMenuItemCommand= OBJECT(TCommand) fMenuNumber: INTEGER; fItemNumber: INTEGER; PROCEDURE TMenuItemCommand.IMenuItemCommand( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller); PROCEDURE TMenuItemCommand.SetMenuNumber( menuNumber:INTEGER); PROCEDURE TMenuItemCommand.SetItemNumber( itemNumber:INTEGER); FUNCTION TMenuItemCommand.GetMenuNumber : INTEGER; FUNCTION TMenuItemCommand.GetItemNumber : INTEGER; {$IFC qInspector} PROCEDURE TMenuItemCommand.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; { TMenuItemCommand } {########################################################################### TPoseDialogCmd This is an abstract class, from which all commands which are intended to display dialogs should descend. It has two main subclasses: TMacAppDialogCmd and TToolboxDialogCmd. TMacAppDialogCmd poses a MacApp dialog, while TToolboxDialogCmd poses a Toolbox dialog. ###########################################################################} TPoseDialogCmd = OBJECT(TMenuItemCommand) fCancelled:BOOLEAN; PROCEDURE TPoseDialogCmd.IPoseDialogCmd( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller); PROCEDURE TPoseDialogCmd.SetCancelled( cancelled: BOOLEAN); FUNCTION TPoseDialogCmd.GetCancelled : BOOLEAN; PROCEDURE TPoseDialogCmd.CreateTheDialog; { This routine creates the dialog to be posed, and assigns a reference to it to an instance variable (which is added in TMacAppDialogCmd and TToolboxDialogCmd). } PROCEDURE TPoseDialogCmd.InitTheDialog; { This routine initializes the dialog to be posed. } FUNCTION TPoseDialogCmd.CreateTheCommand : TCommand; { This routine creates the command that is to be posted as a result of having the user accept the dialog. } PROCEDURE TPoseDialogCmd.PoseTheDialog; { Actually poses the dialog. } PROCEDURE TPoseDialogCmd.DropTheDialog; { Cleans up after exiting the dialog. } PROCEDURE TPoseDialogCmd.DoIt; OVERRIDE; { This routine calls CreateTheDialog() to create the dialog associated with this command, InitTheDialog() to initialize it, PoseTheDialog() to pose it, and if it is accepted by the user, CreateTheCommand() to create the command that is to be posted as a result. The resulting command is then posted with PostCommand(). } {$IFC qInspector} PROCEDURE TPoseDialogCmd.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; { TPoseDialogCmd } {########################################################################### TMacAppDialogCmd Commands of this class display a MacApp modal dialog, posting a command when and if the dialog is accepted by the user. It is intended to be an abstract class. Each dialog should have a command class that poses it. Such classes can be quite small -- overrides of Fields(), InitMenuItemCommand(), and a new IClassName() routine -- or quite complex, but most will be small. ###########################################################################} TMacAppDialogCmd= OBJECT(TPoseDialogCmd) fDialogWindResID: INTEGER; { resID of the dialog's window's 'view' } fDialogViewSig: IDType; { signature of the dialog view } fTheDialog:TDialogView; { the dialog to be posed } fTheWindow:TWindow; { the window containing the dialog } fDismisser:IDType;{ the dialog's dismisser } PROCEDURE TMacAppDialogCmd.IMacAppDialogCmd( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller; itsDialogWindResID: INTEGER; itsDialogViewSig: IDType); PROCEDURE TMacAppDialogCmd.Free; OVERRIDE; PROCEDURE TMacAppDialogCmd.SetDialogWindResID( dialogWindResID:INTEGER); PROCEDURE TMacAppDialogCmd.SetDialogViewSig( dialogViewSig: IDType); PROCEDURE TMacAppDialogCmd.SetTheDialog( theDialog: TDialogView); PROCEDURE TMacAppDialogCmd.SetTheWindow( theWindow: TWindow); PROCEDURE TMacAppDialogCmd.SetDismisser( dismisser: IDType); FUNCTION TMacAppDialogCmd.GetDialogWindResID : INTEGER; FUNCTION TMacAppDialogCmd.GetDialogViewSig : IDType; FUNCTION TMacAppDialogCmd.GetTheDialog : TDialogView; FUNCTION TMacAppDialogCmd.GetTheWindow : TWindow; FUNCTION TMacAppDialogCmd.GetDismisser : IDType; PROCEDURE TMacAppDialogCmd.CreateTheDialog; OVERRIDE; { This routine creates the dialog to be posed, assigns it to fTheDialog, and assigns a reference to the window containing the dialog to fTheWindow. } PROCEDURE TMacAppDialogCmd.PoseTheDialog; OVERRIDE; { Actually poses the dialog. } PROCEDURE TMacAppDialogCmd.DropTheDialog; OVERRIDE; { Cleans up after exiting the dialog. } {$IFC qInspector} PROCEDURE TMacAppDialogCmd.Fields( PROCEDURE DoToField( fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; { TMacAppDialogCmd } {########################################################################### TToolboxDialogCmd Commands of this class display a Toolbox modal dialog, posting a command when and if the dialog is accepted by the user. It is intended to be an abstract class. Each dialog should have a command class that poses it. Such classes can be quite small -- overrides of Fields(), InitMenuItemCommand(), CreateTheCommand(), and a new IClassName() routine -- or quite complex, but most will be small. ###########################################################################} itemRange = 1..30; { only items 1..30 may be dismissers } ItemSet = SET OF ItemRange;{ set of items that can dismiss the dialog } TToolboxDialogCmd = OBJECT(TPoseDialogCmd) fDialogResID: INTEGER; { resID of the dialog's 'DLOG' resource } fTheDialog: DialogPtr; { pointer to dialog to be posed } fDismisser: INTEGER;{ item that dismissed the dialog } fDismisserSet: ItemSet; { items that can dismiss dialog } fFilter: ProcPtr; { filter passed to ModalDialog() } PROCEDURE TToolboxDialogCmd.IToolboxDialogCmd( itsCmdNumber: CmdNumber; itsDocument: TDocument; itsView: TView; itsScroller: TScroller; itsDialogResID: INTEGER; itsDismisserSet:ItemSet; itsFilter: ProcPtr); PROCEDURE TToolboxDialogCmd.SetDialogResID( dialogResID: INTEGER); PROCEDURE TToolboxDialogCmd.SetTheDialog( theDialog: DialogPtr); PROCEDURE TToolboxDialogCmd.SetDismisser( dismisser: INTEGER); PROCEDURE TToolboxDialogCmd.SetDismisserSet( dismisserSEt: ItemSet); PROCEDURE TToolboxDialogCmd.SetFilter(filter: ProcPtr); FUNCTION TToolboxDialogCmd.GetDialogResID : INTEGER; FUNCTION TToolboxDialogCmd.GetTheDialog : DialogPtr; FUNCTION TToolboxDialogCmd.GetDismisser : INTEGER; FUNCTION TToolboxDialogCmd.GetDismisserSet : ItemSet; FUNCTION TToolboxDialogCmd.GetFilter : ProcPtr; PROCEDURE TToolboxDialogCmd.CreateTheDialog; OVERRIDE; { This routine creates the dialog to be posed, assigns it to fTheDialog. } PROCEDURE TToolboxDialogCmd.PostProcess( VAR itemHit: INTEGER); { This routine is called after ModalDialog() in the REPEAT loop of PoseTheDialog(), to give the class a shot at post-processing events. } PROCEDURE TToolboxDialogCmd.PoseTheDialog; OVERRIDE; PROCEDURE TToolboxDialogCmd.DropTheDialog; OVERRIDE; {$IFC qInspector} PROCEDURE TToolboxDialogCmd.Fields( PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER)); OVERRIDE; {$ENDC qInspector} END; { TToolboxDialogCmd } {----------------------------------------------------------------------------------------------------------------} IMPLEMENTATION {$I UMenuItemCommand.inc1.p} END. { UMenuItemCommand.p }
Listing: UCharacterDialog.r #include "Types.r" #include "MacAppTypes.r" #include "ViewTypes.r" /* Command number */ #define cCharacter 1503 /* see DemoText.r */ // see IM v1 p387 #define teJustLeft 0 #define teJustCenter 1 #define teJustRight -1 // see IM v1 p210 (p152 is WRONG) #define boldBit 0 #define italicBit1 #define underlineBit 2 #define outlineBit 3 #define shadowBit4 #define condenseBit 5 #define extendBit6 #define kEmptySet -1 #define kNormalSpacing 0 // strings for sample text #define kSampleTextString 32700 // why not? it's a good number! /************************************************************ The following resources define the application's Character dialog. **********************************************/ resource 'view' (cCharacter, "cCharacter", purgeable) { { root, 'wind', {50, 40}, {230, 465}, sizeVariable, sizeVariable, shown, enabled, Window {"TWindow", dBoxProc, noGoAwayBox, notResizable, modal, ignoreFirstClick, dontFreeOnClosing, disposeOnFree, doesntCloseDocument, dontOpenWithDocument, dontAdaptToScreen, dontStagger, dontForceOnScreen, center, 'size', "<<<>>>"}, 'wind', 'DLOG', {0, 0}, {230, 465}, sizeVariable, sizeVariable, shown, enabled, DialogView {"TCharDialogView", 'ok ', 'cncl'}, 'DLOG', 'sclu', {3, 155}, {132, 53}, sizeFixed, sizeFixed, shown, disabled, Cluster {"TSizeCluster", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, ""}, 'sclu', 'size', {107, 5}, {20, 35}, sizeFixed, sizeFixed, shown, enabled, NumberText {"TSizeText", adnFrame, {1, 1}, sizeable, notDimmed, notHilited, doesntDismiss, {3, 3, 3, 3}, systemFont, justSystem, "12", 3, arrowsAndBackspace, 12, 1, 127}, 'sclu', 'VW28', {17, 5}, {80, 45}, sizeVariable, sizeVariable, shown, disabled, Control {"TControl", adnFrame, {1, 1}, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont}, 'VW28', 'VW30', {1, 1}, {78, 28}, sizeRelSuperView, sizeRelSuperView, shown, disabled, Scroller {"TScroller", VertScrollBar, noHorzScrollBar, 256, 256, 16, 16, noVertConstrain, noHorzConstrain, noInset}, 'VW30', 'slst', {0, 0}, {0, 28}, sizeVariable, sizeFixed, shown, enabled, TextListView {"TSizeListView", 0, 1, 0, 28, 0, 2, dontAdornRows, dontAdornCols, singleSelection, systemFont}, 'DLOG', 'just', {5, 325}, {65, 130}, sizeFixed, sizeFixed, shown, disabled, Cluster {"TJustifyCluster", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, "Justify:"}, 'just', 'Left', {15, 15}, {15, 50}, sizeFixed, sizeFixed, shown, enabled, ValueRadio {"TValueRadio", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, on, "Left", teJustLeft}, 'just', 'Cntr', {30, 15}, {15, 65}, sizeFixed, sizeFixed, shown, enabled, ValueRadio {"TValueRadio", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, off, "Center", teJustCenter}, 'just', 'Rght', {45, 15}, {15, 55}, sizeFixed, sizeFixed, shown, enabled, ValueRadio {"TValueRadio", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, off, "Right", teJustRight}, 'DLOG', 'VW09', {145, 10}, {15, 55}, sizeFixed, sizeFixed, shown, disabled, StaticText {"TStaticText", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, justSystem, "Sample:"}, 'DLOG', 'VW22', {140, 10}, {1, 445}, sizeVariable, sizeVariable, shown, disabled, Control {"TControl", 0b1, {1, 1}, sizeable, dimmed, notHilited, doesntDismiss, noInset, systemFont}, 'DLOG', 'VW23', {200, 295}, {22, 72}, sizeFixed, sizeFixed, shown, enabled, Button {"TButton", noAdornment, sizeable, notDimmed, notHilited, dismisses, noInset, systemFont, "Cancel"}, 'DLOG', 'VW24', {195, 375}, {30, 80}, sizeFixed, sizeFixed, shown, enabled, Button {"TButton", adnRRect, {3, 3}, sizeable, notDimmed, notHilited, dismisses, {4, 4, 4, 4}, systemFont, "OK"}, 'DLOG', 'VW25', {20, 10}, {114, 140}, sizeVariable, sizeVariable, shown, disabled, Control {"TControl", adnFrame, {1, 1}, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont}, 'VW25', 'VW27', {1, 1}, {112, 123}, sizeRelSuperView, sizeRelSuperView, shown, disabled, Scroller {"TScroller", VertScrollBar, HorzScrollBar, 256, 256, 16, 16, noVertConstrain, noHorzConstrain, noInset}, 'VW27', 'flst', {0, 0}, {0, 123}, sizeVariable, sizeFixed, shown, enabled, TextListView {"TFontListView", 0, 1, 0, 123, 0, 2, dontAdornRows, dontAdornCols, singleSelection, systemFont}, 'DLOG', 'VW26', {5, 10}, {15, 30}, sizeFixed, sizeFixed, shown, disabled, StaticText {"TStaticText", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, justSystem, "Font"}, 'DLOG', 'VW29', {5, 160}, {15, 30}, sizeFixed, sizeFixed, shown, disabled, StaticText {"TStaticText", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, justSystem, "Size"}, 'DLOG', 'samp', {145, 65}, {45, 390}, sizeFixed, sizeFixed, shown, disabled, StaticText { "TSampleText", adnFrame, {1, 1}, notSizeable, notDimmed, notHilited, doesntDismiss, {3, 3, 3, 3}, plain, 0, {0x0, 0x0, 0x0}, "A", justSystem, "The quick brown fox jumped over the lazy dog."}, 'DLOG', 'face', {5, 210}, {130, 245}, sizeFixed, sizeFixed, shown, disabled, Cluster {"TFaceCluster", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, ""}, 'face', 'styl', {0, 0}, {110, 110}, sizeFixed, sizeFixed, shown, disabled, Cluster {"TStyleCluster", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, "Style:"}, 'styl', 'pln*', {15, 15}, {15, 55}, sizeFixed, sizeFixed, shown, enabled, ValueCheckBox {"TValueCheckBox", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, on, "Plain", kEmptySet}, 'styl', 'bld0', {30, 15}, {15, 50}, sizeFixed, sizeFixed, shown, enabled, ValueCheckBox {"TValueCheckBox", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, off, "Bold", boldBit}, 'styl', 'Itl1', {45, 15}, {15, 55}, sizeFixed, sizeFixed, shown, enabled, ValueCheckBox {"TValueCheckBox", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, off, "Italic", italicBit}, 'styl', 'und2', {60, 15}, {15, 80}, sizeFixed, sizeFixed, shown, enabled, ValueCheckBox {"TValueCheckBox", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, off, "Underline", underlineBit}, 'styl', 'out3', {75, 15}, {15, 65}, sizeFixed, sizeFixed, shown, enabled, ValueCheckBox {"TValueCheckBox", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, off, "Outline", outlineBit}, 'styl', 'shd4', {90, 15}, {15, 70}, sizeFixed, sizeFixed, shown, enabled, ValueCheckBox {"TValueCheckBox", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, off, "Shadow", shadowBit}, 'face', 'spac', {65, 115}, {65, 130}, sizeFixed, sizeFixed, shown, disabled, Cluster {"TSpaceCluster", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, "Spacing:"}, 'spac', 'Norm', {15, 15}, {15, 75}, sizeFixed, sizeFixed, shown, enabled, ValueRadio {"TValueRadio", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, on, "Normal", kNormalSpacing}, 'spac', 'Comp', {30, 15}, {15, 100}, sizeFixed, sizeFixed, shown, enabled, ValueRadio {"TValueRadio", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, off, "Condensed", condenseBit}, 'spac', 'Expd', {45, 15}, {15, 80}, sizeFixed, sizeFixed, shown, enabled, ValueRadio {"TValueRadio", noAdornment, sizeable, notDimmed, notHilited, doesntDismiss, noInset, systemFont, off, "Extended", extendBit} } }; resource 'STR#' (kSampleTextString, #if qNames "kSampleTextString", #endif purgeable) { { "The quick brown fox jumped over the lazy dog."; "Pack my box with five dozen liquor jugs."; } }; // kSampleTextString
Listing: UCharacterDialog.types.r /* UCharacterDialog.types.r * * This file contains a few extensions to the original view resource types. It is included in MPW:MacApp:Interfaces:RIncludes:ViewTypes.r by compiler directive. * * In both the ValueCheckBox and the ValueRadio, the only change is to the template signature (of course) and the addition of a new field. The new field, an integer, will contain a value specified in the resource. It is intended that this value be used when the control is a sub-view of a TSetCluster. Then, when the control is clicked 'on', the control's set-value will be added to the set of values maintained by the cluster. Likewise, when the control is clicked 'off', the control's set-value will be removed from the cluster's set of values. These set changes will be performed by the cluster's DoChoice() method. */ //-------------------------------------------------------------------------------------------------------------- case ValueCheckBox: key literal longint = 'chk_'; // Template signature pstring; // Class name align word; TCONTROLDATA; TCHECKBOXDATA; integer; // the 'set value' case ValueRadio: key literal longint = 'rad_'; // Template signature pstring; // Class name align word; TCONTROLDATA; TRADIODATA; integer; // the 'set value'
- SPREAD THE WORD:
- Slashdot
- Digg
- Del.icio.us
- Newsvine