{U7BOXER2} METHODS OF TBox; FUNCTION TBox.CREATE(object: TObject; itsHeap: THeap): TBox; BEGIN {$IFC fTrace}BP(11);{$ENDC} SELF := NewObject(itsHeap, THISCLASS); WITH SELF DO BEGIN shapeLRect := zeroLRect; color := colorGray; END; {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} PROCEDURE TBox.Fields(PROCEDURE Field(nameAndType: S255)); BEGIN Field('shapeLRect: LRect'); Field('color: INTEGER'); Field(''); END; {$ENDC} {This draws a particular box} PROCEDURE TBox.Draw; VAR lPat: LPattern; BEGIN {$IFC fTrace}BP(10);{$ENDC} PenNormal; IF LRectIsVisible(SELF.shapeLRect) THEN {this box needs to be drawn} BEGIN {Get a Quickdraw pattern to represent the box's color} CASE SELF.color OF colorWhite: lPat := lPatWhite; colorLtGray: lPat := lPatLtGray; colorGray: lPat := lPatGray; colorDkGray: lPat := lPatDkGray; colorBlack: lPat := lPatBlack; OTHERWISE lPat := lPatWhite; {this case should not happen} END; {Fill the box with the pattern, and draw a frame around it} FillLRect(SELF.shapeLRect, lPat); FrameLRect(SELF.shapeLRect); END; {$IFC fTrace}EP;{$ENDC} END; { Frame a particular box} PROCEDURE TBox.DrawFrame; BEGIN {$IFC fTrace}BP(10);{$ENDC} PenNormal; PenMode(PatXOr); FrameLRect(SELF.shapeLRect); {$IFC fTrace}EP;{$ENDC} END; {This calls the DoToHandle Procedure once for each handle LRect; user of this method must set up the pen pattern and mode before calling} PROCEDURE TBox.PaintHandles; VAR hLRect, shapeLRect: LRect; dh, dv: LONGINT; PROCEDURE MoveHandleAndPaint(hOffset, vOffset: LONGINT); BEGIN OffsetLRect(hLRect, hOffset, vOffset); PaintLRect(hLRect); END; BEGIN {$IFC fTrace}BP(10);{$ENDC} SetLRect(hLRect, -3, -2, 3, 2); shapeLRect := SELF.shapeLRect; WITH shapeLRect DO BEGIN dh := right - left; dv := bottom - top; MoveHandleAndPaint(left, top); {draw top left handle} END; MoveHandleAndPaint(dh, 0); {then top right} MoveHandleAndPaint(0, dv); {then bottom right} MoveHandleAndPaint(-dh, 0); {finally bottom left} {$IFC fTrace}EP;{$ENDC} END; END; METHODS OF TBoxView; FUNCTION TBoxView.CREATE(object: TObject; itsHeap: THeap; itsPanel: TPanel; itsExtent: LRect) : TBoxView; BEGIN {$IFC fTrace}BP(11);{$ENDC} IF object = NIL THEN object := NewObject(itsHeap, THISCLASS); SELF := TBoxView(itsPanel.NewView(object, itsExtent, TPrintManager.CREATE(NIL, itsHeap), stdMargins, TRUE)); {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} PROCEDURE TBoxView.Fields(PROCEDURE Field(nameAndType: S255)); BEGIN TView.Fields(Field); Field('boxList: TList'); END; {$ENDC} {This returns the box containing a certain point} FUNCTION TBoxView.BoxWith(LPt: LPoint): TBox; PROCEDURE FindBox(obj: TObject); VAR box: TBox; BEGIN box := TBox(obj); IF LPtInLRect(LPt, box.shapeLRect) THEN BoxWith := box; {last one found (front one) is returned} END; BEGIN {$IFC fTrace}BP(11);{$ENDC} boxWith := NIL; SELF.EachVirtualPart(FindBox); {$IFC fTrace}EP;{$ENDC} END; {This draws the list of boxes} PROCEDURE TBoxView.Draw; PROCEDURE DrawBox(obj: TObject); VAR box: TBox; BEGIN box := TBox(obj); box.Draw; END; BEGIN {$IFC fTrace}BP(10);{$ENDC} SELF.EachVirtualPart(DrawBox); {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TBoxView.EachActualPart(PROCEDURE DoToObject(filteredObj: TObject)); BEGIN {$IFC fTrace}BP(11);{$ENDC} SELF.boxList.Each(DoToObject); {$IFC fTrace}EP;{$ENDC} END; {This determines which type of selection to create} PROCEDURE TBoxView.MousePress(mouseLPt: LPoint); VAR aSelection: TSelection; panel: TPanel; box: TBox; BEGIN {$IFC fTrace}BP(11);{$ENDC} panel := SELF.panel; panel.Highlight(panel.selection, hOntoOff); {Turn off the old highlighting} box := SELF.BoxWith(mouseLPt); {Find the box the user clicked on} IF box = NIL THEN {Create an instance of TCreateBoxSelection} aSelection := panel.selection.FreedAndReplacedBy( TCreateBoxSelection.CREATE(NIL, SELF.heap, SELF, mouseLPt)) ELSE {Create an instance of TBoxSelection} aSelection := panel.selection.FreedAndReplacedBy( TBoxSelection.CREATE(NIL, SELF.heap, SELF, box, boxSelectionKind, mouseLPt)); panel.Highlight(panel.selection, hOffToOn); {Turn on the highlighting for the newly selected box} self.panel.selection.MarkChanged; {Allow the document to be saved so that any changes made} {can become permanent} {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TBoxView.InvalBox(invalLRect: LRect); BEGIN {$IFC fTrace}BP(10);{$ENDC} InsetLRect(invalLRect, -3, -2); SELF.panel.InvalLRect(invalLRect); {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TBoxView.InitBoxList (itsHeap: THeap); VAR boxList: TList; BEGIN {$IFC fTrace}BP(11);{$ENDC} boxList := TList.CREATE(NIL, itsHeap, 0); SELF.boxList := boxList; {$IFC fTrace}EP;{$ENDC} END; FUNCTION TBoxView.NoSelection: TSelection; BEGIN {$IFC fTrace}BP(11);{$ENDC} NoSelection := TBoxSelection.CREATE(NIL, SELF.Heap, SELF, NIL, nothingKind, zeroLPt); {$IFC fTrace}EP;{$ENDC} END; END; METHODS OF TBoxSelection; FUNCTION TBoxSelection.CREATE(object: TObject; itsHeap: THeap; itsView: TView; itsBox: TBox; itsKind: INTEGER; itsAnchorLPt: LPoint): TBoxSelection; BEGIN {$IFC fTrace}BP(11);{$ENDC} IF object = NIL THEN object := NewObject(itsHeap, THISCLASS); SELF := TBoxSelection(TSelection.CREATE(object, itsHeap, itsView, itsKind, itsAnchorLPt)); SELF.box := itsBox; {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} PROCEDURE TBoxSelection.Fields(PROCEDURE Field(nameAndType: S255)); BEGIN TSelection.Fields(Field); Field('box: TBox'); END; {$ENDC} {This draws the handles on the selected box} PROCEDURE TBoxSelection.Highlight(highTransit: THighTransit); BEGIN {$IFC fTrace}BP(11);{$ENDC} IF SELF.kind <> nothingKind THEN BEGIN thePad.SetPenToHighlight(highTransit); {set the drawing mode according to desired highlighting} SELF.box.PaintHandles; {draw the handles on the box} END; {$IFC fTrace}EP;{$ENDC} END; {This is called when the user moves the mouse after pressing the button} PROCEDURE TBoxSelection.MouseMove(mouseLPt: LPoint); VAR diffLPt: LPoint; boxView: TBoxView; shapeLRect: LRect; BEGIN {$IFC fTrace}BP(11);{$ENDC} boxView := TBoxView(SELF.view); {How far did mouse move?} LPtMinusLPt(mouseLPt, SELF.currLPt, diffLPt); {Move it if delta is nonzero} IF NOT EqualLPt(diffLPt, zeroLPt) THEN BEGIN SELF.currLPt := mouseLPt; shapeLRect := SELF.box.shapeLRect; {Compute old and new positions of box} boxView.InvalBox(shapeLRect); OffsetLRect(shapeLRect, diffLPt.h, diffLPt.v); boxView.InvalBox(shapeLRect); SELF.box.shapeLRect := shapeLRect; END; {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TBoxSelection.MouseRelease; BEGIN {$IFC fTrace}BP(11);{$ENDC} { If the mouse moved then commit any outstanding command } IF NOT EqualLPt(SELF.currLPt, SELF.anchorLPt) THEN SELF.window.CommitLast; {$IFC fTrace}EP;{$ENDC} END; FUNCTION TBoxSelection.NewCommand(cmdNumber: TCmdNumber): TCommand; VAR boxView: TBoxView; heap: THeap; BEGIN {$IFC fTrace}BP(11);{$ENDC} boxView := TBoxView(SELF.view); heap := SELF.Heap; CASE cmdNumber OF uWhite, uLtGray, uGray, uDkGray, uBlack: NewCommand := TRecolorCmd.CREATE(NIL, heap, cmdNumber, boxView, SELF.box, cmdNumber - uWhite + colorWhite); uDuplicate: NewCommand := TDuplicateCmd.CREATE(NIL, heap, cmdNumber, boxView, SELF.box); OTHERWISE NewCommand := SUPERSELF.NewCommand(cmdNumber); END; {$IFC fTrace}EP;{$ENDC} END; FUNCTION TBoxSelection.CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; BEGIN {$IFC fTrace}BP(11);{$ENDC} CASE cmdNumber OF uWhite, uLtGray, uGray, uDkGray, uBlack, uDuplicate: CanDoCommand := SELF.kind <> nothingKind; OTHERWISE CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); END; {$IFC fTrace}EP;{$ENDC} END; END; METHODS OF TCreateBoxSelection; FUNCTION TCreateBoxSelection.CREATE(object: TObject; itsHeap: THeap; itsView: TView; itsAnchorLPt: LPoint): TCreateBoxSelection; VAR box: TBox; BEGIN {$IFC fTrace}BP(11);{$ENDC} IF object = NIL THEN object := NewObject(itsHeap, THISCLASS); SELF := TCreateBoxSelection(TSelection.CREATE(object, itsHeap, itsView, createBoxSelectionKind, itsAnchorLPt)); box := TBox.CREATE(NIL, SELF.heap); SELF.box := box; {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} PROCEDURE TCreateBoxSelection.Fields(PROCEDURE Field(nameAndType: S255)); BEGIN TSelection.Fields(Field); Field('box: TBox'); END; {$ENDC} {This is called when the user moves the mouse after pressing the button} PROCEDURE TCreateBoxSelection.MouseMove(mouseLPt: LPoint); VAR maxBoxLRect: LRect; diffLPt: LPoint; boxView: TBoxView; box: TBox; PROCEDURE DrawTheFrame; BEGIN box.DrawFrame; END; BEGIN {$IFC fTrace}BP(11);{$ENDC} boxView := TBoxView(SELF.view); box := SELF.box; { In Boxer it is possible to draw a box greater than allowed by a 16 bit rectangle. These three lines force the rectangle to within 16 bits. } {$H-} WITH SELF.anchorLPt DO SetLRect(maxBoxLRect, h+10-MAXINT, v+10-MAXINT, h+MAXINT-10, v+MAXINT-10); {$H+} LRectHaveLPt(maxBoxLRect, mouseLPt); LPtMinusLPt(mouseLPt, SELF.currLPt, diffLPt); IF NOT EqualLPt(diffLPt, zeroLPt) THEN BEGIN SELF.currLPt := mouseLPt; boxView.panel.OnAllPadsDo(DrawTheFrame); WITH box DO BEGIN shapeLRect.topLeft := SELF.anchorLPt; shapeLRect.botRight := mouseLPt; END; {$H-} RectifyLRect(box.shapeLRect); {$H+} boxView.panel.OnAllPadsDo(DrawTheFrame); END; {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TCreateBoxSelection.MouseRelease; VAR thisBox: TBox; boxView: TBoxView; drawnLRect: LRect; aSelection: TSelection; panel: TPanel; PROCEDURE DrawTheFrame; BEGIN thisBox.DrawFrame; END; BEGIN {$IFC fTrace}BP(11);{$ENDC} boxView := TBoxView(SELF.view); panel := boxView.panel; thisBox := SELF.box; panel.OnAllPadsDo(DrawTheFrame); drawnLRect := thisBox.shapeLRect; { Independant of whether we threw the boxed away or not we must create an instance of TBoxSelection to replace the now useless instance of TCreateBoxSelection using the kind set above. } aSelection := SELF.FreedAndReplaceby( TBoxSelection.CREATE(NIL, SELF.heap, boxView, thisBox, boxSelectionKind, drawnLRect.topleft)); boxView.InvalBox(drawnLRect); {If the box is not big enough then throw it away, otherwise put it in the list} IF (drawnLRect.right - drawnLRect.left <=4) OR (drawnLRect.bottom - drawnLRect.top <=4) THEN BEGIN aSelection.kind := nothingKind; thisBox.Free; END ELSE BEGIN { Commit any outstanding command } SELF.window.CommitLast; boxView.boxList.InsLast(thisBox); END; {$IFC fTrace}EP;{$ENDC} END; END; METHODS OF TRecolorCmd; FUNCTION TRecolorCmd.CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; itsView: TBoxView; itsBox: TBox; itsColor: TColor): TRecolorCmd; BEGIN {$IFC fTrace}BP(10);{$ENDC} IF object = NIL THEN object := NewObject(itsHeap, THISCLASS); SELF := TRecolorCmd(TCommand.CREATE(object, itsHeap, itsCmdNumber, itsView, TRUE, revealAll)); SELF.color := itsColor; SELF.box := itsBox; {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} PROCEDURE TRecolorCmd.Fields(PROCEDURE Field(nameAndType: S255)); BEGIN TCommand.Fields(Field); Field('Color: INTEGER'); Field('box: TBox'); END; {$ENDC} PROCEDURE TRecolorCmd.Commit; BEGIN {$IFC fTrace}BP(12);{$ENDC} SELF.box.color := SELF.color; {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TRecolorCmd.Perform(cmdPhase: TCmdPhase); VAR boxView: TBoxView; tempColor: TColor; BEGIN {$IFC fTrace}BP(12);{$ENDC} boxView := TBoxView(SELF.image); boxView.InvalBox(SELF.box.shapeLRect); self.image.view.panel.selection.MarkChanged; {allow this document to be saved} {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TRecolorCmd.FilterAndDo(actualObj: TObject; PROCEDURE DoToObject(filteredObj: TObject)); VAR saveColor: TColor; box: TBox; BEGIN {$IFC fTrace}BP(12);{$ENDC} box := TBox(actualObj); IF box = SELF.box THEN BEGIN saveColor := box.color; box.color := SELF.Color; DoToObject(box); box.color := saveColor; END ELSE DoToObject(box); {$IFC fTrace}EP;{$ENDC} END; END; METHODS OF TDuplicateCmd; FUNCTION TDuplicateCmd.CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; itsView: TBoxView; itsBox: TBox): TDuplicateCmd; PROCEDURE CloneBox(filteredObj: TObject); VAR box: TBox; BEGIN box := TBox(filteredObj.Clone(itsHeap)); SELF.newBox := box; END; BEGIN {$IFC fTrace}BP(10);{$ENDC} IF object = NIL THEN object := NewObject(itsHeap, THISCLASS); SELF := TDuplicateCmd(TCommand.CREATE(object, itsHeap, itsCmdNumber, itsView, TRUE, revealAll)); TBoxView(SELF.image).FilterAndDo(itsbox, CloneBox); SELF.oldBox := itsBox; {$H-} OffSetLRect(SELF.newBox.shapeLRect, 20, 20); {$H+} {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TDuplicateCmd.Free; BEGIN {$IFC fTrace}BP(10);{$ENDC} Free(SELF.newBox); SELF.FreeObject; {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} PROCEDURE TDuplicateCmd.Fields(PROCEDURE Field(nameAndType: S255)); BEGIN TCommand.Fields(Field); Field('oldBox: TBox'); Field('newBox: TBox'); END; {$ENDC} PROCEDURE TDuplicateCmd.Commit; VAR boxView: TBoxView; BEGIN {$IFC fTrace}BP(12);{$ENDC} boxView := TBoxView(SELF.image); boxView.boxList.InsLast(SELF.newBox); SELF.newBox := NIL; {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TDuplicateCmd.Perform(cmdPhase: TCmdPhase); VAR boxView: TBoxView; box: TBox; thisSelection: TBoxSelection; BEGIN {$IFC fTrace}BP(12);{$ENDC} boxView := TBoxView(SELF.image); thisSelection := TBoxSelection(boxView.panel.selection); {------------------------------------------------------------------------------------------- The current selection is unhighlighted before performing the command as the result of the following command fields set by TCommand.CREATE: unHiliteBefore[doPhase..redoPhase] <- TRUE The resulting selection is highlighted after performing the command as the result of the following command fields set by TCommand.CREATE: hiLiteAfter [doPhase..redoPhase] <- TRUE -------------------------------------------------------------------------------------------} WITH thisSelection DO CASE cmdPhase OF doPhase, redoPhase: box := SELF.newBox; undoPhase: box := SELF.oldBox; END {CASE}; boxView.InvalBox(SELF.newBox.shapeLRect); self.image.view.panel.selection.MarkChanged; {allow this document to be saved} {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TDuplicateCmd.EachVirtualPart(PROCEDURE DoToObject(filteredObj: TObject)); BEGIN {$IFC fTrace}BP(12);{$ENDC} TBoxView(SELF.image).EachActualPart(DoToObject); DoToObject(SELF.newBox); {$IFC fTrace}EP;{$ENDC} END; END; METHODS OF TClearAllCmd; FUNCTION TClearAllCmd.CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; itsView: TBoxView): TClearAllCmd; BEGIN {$IFC fTrace}BP(10);{$ENDC} IF object = NIL THEN object := NewObject(itsHeap, THISCLASS); SELF := TClearAllCmd(TCommand.CREATE(object, itsHeap, itsCmdNumber, itsView, TRUE, revealNone)); SELF.kind := SELF.image.view.panel.selection.kind; {$IFC fTrace}EP;{$ENDC} END; {$IFC fDebugMethods} PROCEDURE TClearAllCmd.Fields(PROCEDURE Field(nameAndType: S255)); BEGIN TCommand.Fields(Field); Field('kind: INTEGER'); END; {$ENDC} PROCEDURE TClearAllCmd.Commit; BEGIN {$IFC fTrace}BP(12);{$ENDC} TBoxView(SELF.image).boxList.DelAll(TRUE); {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TClearAllCmd.Perform(cmdPhase: TCmdPhase); VAR thisSelection: TSelection; boxView: TBoxView; BEGIN {$IFC fTrace}BP(12);{$ENDC} boxView := TBoxView(SELF.image); thisSelection := boxView.panel.selection; WITH thisSelection DO CASE cmdPhase OF doPhase, redoPhase: kind := nothingKind; undoPhase: kind := SELF.kind; END; { Invalidate the whole panel } boxView.panel.Invalidate; self.image.view.panel.selection.MarkChanged; {allow this document to be saved} {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TClearAllCmd.EachVirtualPart(PROCEDURE DoToObject(filteredObj: TObject)); BEGIN {$IFC fTrace}BP(12);{$ENDC} {$IFC fTrace}EP;{$ENDC} END; END; METHODS OF TBoxProcess; FUNCTION TBoxProcess.CREATE: TBoxProcess; BEGIN {$IFC fTrace}BP(11);{$ENDC} SELF := TBoxProcess(TProcess.CREATE(NewObject(mainHeap, THISCLASS), mainHeap)); {$IFC fTrace}EP;{$ENDC} END; FUNCTION TBoxProcess.NewDocManager(volumePrefix: TFilePath; openAsTool: BOOLEAN): TDocManager; BEGIN {$IFC fTrace}BP(11);{$ENDC} NewDocManager := TBoxDocManager.CREATE(NIL, mainHeap, volumePrefix); {$IFC fTrace}EP;{$ENDC} END; END; METHODS OF TBoxDocManager; FUNCTION TBoxDocManager.CREATE(object: TObject; itsHeap: THeap; itsPathPrefix: TFilePath) : TBoxDocManager; BEGIN {$IFC fTrace}BP(11);{$ENDC} IF object = NIL THEN object := NewObject(itsHeap, THISCLASS); SELF := TBoxDocManager(TDocManager.CREATE(object, itsHeap, itsPathPrefix)); {$IFC fTrace}EP;{$ENDC} END; FUNCTION TBoxDocManager.NewWindow(heap: THeap; wmgrID: TWindowID):TWindow; BEGIN {$IFC fTrace}BP(11);{$ENDC} NewWindow := TBoxWindow.CREATE(NIL, heap, wmgrID); {$IFC fTrace}EP;{$ENDC} END; END; METHODS OF TBoxWindow; FUNCTION TBoxWindow.CREATE(object: TObject; itsHeap: THeap; itsWmgrID: TWindowID): TBoxWindow; BEGIN {$IFC fTrace}BP(10);{$ENDC} IF object = NIL THEN object := NewObject(itsHeap, THISCLASS); SELF := TBoxWindow(TWindow.CREATE(object, itsHeap, itsWmgrID, TRUE)); {$IFC fTrace}EP;{$ENDC} END; PROCEDURE TBoxWindow.BlankStationery; VAR viewLRect: LRect; panel: TPanel; boxView: TBoxView; aSelection: TSelection; BEGIN {$IFC fTrace}BP(10);{$ENDC} panel := TPanel.CREATE(NIL, SELF.Heap, SELF, 0, 0, [aScroll, aSplit], [aScroll, aSplit]); SetLRect(viewLRect, 0, 0, 5000, 3000); boxView := TBoxView.CREATE(NIL, SELF.Heap, panel, viewLRect); boxView.InitBoxList(SELF.Heap); {$IFC fTrace}EP;{$ENDC} END; FUNCTION TBoxWindow.NewCommand(cmdNumber: TCmdNumber): TCommand; BEGIN {$IFC fTrace}BP(11);{$ENDC} CASE cmdNumber OF uClearAll: NewCommand := TClearAllCmd.CREATE(NIL, SELF.heap, cmdNumber, TBoxView(SELF.selectPanel.view)); OTHERWISE NewCommand := SUPERSELF.NewCommand(cmdNumber); END; {$IFC fTrace}EP;{$ENDC} END; FUNCTION TBoxWindow.CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; BEGIN {$IFC fTrace}BP(11);{$ENDC} CASE cmdNumber OF uClearAll: CanDoCommand := TRUE; OTHERWISE CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); END; {$IFC fTrace}EP;{$ENDC} END; END;