Mac Mania 2/MacMania 2.toast/Demo's/Tools&Utilities/Programming/MacStarter Pascal 1.0/xWindows definition files/xFigureDecoration.p

Text File | 1992-06-17 | 12.9 KB | 420 lines | [TEXT/PJMM]

unit xFigureDecoration;

{ This units defines several "figure decorations", which are simply static graphical }
{ objects that can be added to xWindows.  Typical uses would be to display  a line }
{ across the window, as in :    new(anXRectangle); }
{                                              anXRectangle.setUp(anXWindow,0,50,-1,2) }
{ which would draw a line two pixels thick across the window, 50 pixels down from }
{ the top.  Note how the use of -1 as the third parameter anchors the right end of the }
{ line to the right side of the widow. }
{      Also defined in this unit is the class xDisplayString, which can display text in }
{ various sizes and fonts.  You can change the string displayed, as well as change its }
{ characteristics. }
{       Finally, a classes for displaying PICTs and ICONs are provided. }

interface

uses
    xWindow;

type

    xFigureDecoration = object(xWindowDecoration)
          { An abstract class defininig the basic behaviour of several different simple }
          { geometric figures.  The subclasses of this class simply override the method }
          { drawIt.   Note that the procedures SetNib and SetPattern do not force a }
          { redrawing of the figure.  You should call them immediately after calling }
          { SetUp.  (If you do want to change the characteristics of an existing figure, }
          { you will have to force a redraw operation yourself.) }
            nib: point;   { the pen size for drawing the figure, by default 1 X 1 pixel. }
            paintPattern: pattern;  { the pattern for filling the figure, by default solid black }
            procedure setUp (win: xWindow;
                                        theLeft, theTop, theWidth, theHeight: integer);
          { Initialize the figure and install it into the xWindow win.  The other parameters }
          { determine the placement and size of the figure.  Read about their meanings in }
          { the description of the method xWindowDecoration.Install, which can be found in }
          { the unit xWindow.p. }
            procedure SetNib (dh, dv: integer);
          { Set the pen size to be dh X dv pixels; this will not affect filled figures. }
            procedure SetPattern (thePattern: pattern);
          { Set the fill pattern to be used for filled figures.  This will only affect filled }
          { figures.  Some predefined constants for use in this procedure are black, gray, }
          { dkGray, ltGray, and white. }
            procedure doDraw;
            override;
          { draws the figure; called by procedure xWindow.doRedraw }
            procedure drawIt;
          { called by doDraw to do the actual drawing }
        end;

    xRectangle = object(xFigureDecoration)
         { A rectangle, frame only; a narrow rectangle makes a horizontal or vertical line }
            procedure drawIt;
            override;
        end;

    xRoundRect = object(xFigureDecoration)
         { A rectangle with rounded corners; frame only }
            procedure drawIt;
            override;
        end;

    xOval = object(xFigureDecoration)
         { An oval that just fits into the enclosing rectangle of the figure; frame only }
            procedure drawIt;
            override;
        end;

    xFilledRectangle = object(xFigureDecoration)
          { A rectangle filled with a pattern (solid black by default) }
            procedure drawIt;
            override;
        end;

    xFilledRoundRect = object(xFigureDecoration)
          { A filled rectangle with rounded cornors }
            procedure drawIt;
            override;
        end;

    xFilledOval = object(xFigureDecoration)
         { a filled oval that just fits into its enclosing rectangle }
            procedure drawIt;
            override;
        end;


    xDisplayString = object(xWindowDecoration)
          { Displays one or more lines of text, is a typeface, font, and size that can }
          { be changed any time you want. }
            theText: string;   { The displayed text }
            fontNum, fontSize: integer;   { current font and font size }
            fontFace: style;   { text style }
            trueWidth, trueHeight: integer;  { The actual size of the displayed text }
            procedure Setup (win: xWindow;
                                        str: string;
                                        theLeft, theTop: integer);
           { Set up the text to be drawn and the place where it is to draw.  win is }
           { the xWindow where the string is to be drawn.  Str specifies the string }
           { to be drawn.  The character "\" is interpreted as a line feed in the text, }
           { allowing you to have multiple line text displays.  (However, there is no }
           { way to actually print out a \.  }
           {     theLeft and theTop determine the position of the upper left corner of the }
           { string.  Note the special interpretation of negative values, as discussed under }
           { the Install procedure of class xWindowDecoration. }
            procedure ChangeString (newStr: string);
           { Change to a different displayed string; forces a redraw. }
            procedure ChangeFont (newFont, newSize: integer);
           { Change the font and/or size, and forces a redraw.  If the newFont is < 0 then }
           { the current font is not changed. If the newSize is <= 0, then the size is not }
           { changed. }
            procedure ChangeStyle (newFace: style);
           { Change the text style (bold, italic, etc), and forces a redraw.  The type }
           { "style" is predefined to be set of (bold,italic,underline,outline,shadow, }
           { condense,extend]).}
            procedure adjustSize;   { not for user; react to change in size of window }
            override;
            procedure doDraw;   { not for user use; draws the string whenever necessary }
            override;
        end;

    xIcon = object(xWindowDecoration)
          { A class for displaying an icon; the icon is loaded from an existing icon }
          { resource. }
            iconHandle: handle;
            procedure SetUp (xWin: xWindow;
                                        iconResourceNum: integer;
                                        theLeft, theTop: integer);
          { Loads an icon resourse, and install it at the specified point in the window. }
          { NOTE: if you resize this decoration, the icon will be drawn in larger or }
          { smaller size, as appropriate (and will probably look bad). }
          {    The iconResourseNum specifes the resource of an existing icon resource. }
          { If the resource is not found, then the icon is simply not installed in the }
          { window. }
          {     theLeft and theTop determine the position of the upper left corner of the }
          { icon.  Note the special interpretation of negative values, as discussed under }
          { the Install procedure of class xWindowDecoration. }
            procedure doDraw;  { not for user; draw the icon. }
            override;
        end;

    xPict = object(xWindowDecoration)
          { A class for displaying a PICT graphic.  The two SetUp procedures allow you }
          { to load a PICT resource from the resource file, or to use a PICT that already }
          { exists. }
          {     Note: If you resize this decoration, the PICT will be scaled to fit the new }
          { drawing rectangle. }
            pic: picHandle;
            procedure SetUp (xWin: xWindow;
                                        thePict: PicHandle;
                                        theLeft, theTop: integer);
          { Installs a PICT to be displayed at the specified location in the given xWindow. }
          {     theLeft and theTop determine the position of the upper left corner of the }
          { pict.  Note the special interpretation of negative values, as discussed under }
          { the Install procedure of class xWindowDecoration. }
            procedure SetUpWithResource (xWin: xWindow;
                                        pictResourceNum: integer;
                                        theLeft, theTop: integer);
          { Like SetUp, but loads a PICT resource to be displayed. }
            procedure doDraw;  { not for user; actually draws PICTS }
            override;
        end;

implementation

procedure xFigureDecoration.setUp (win: xWindow;
                                theLeft, theTop, theWidth, theHeight: integer);
    begin
        inherited init;
        nib.h := 1;
        nib.v := 1;
        paintPattern := black;
        install(win, theLeft, theTop, theWidth, theHeight);
    end;

procedure xFigureDecoration.SetNib (dh, dv: integer);
    begin
        nib.h := dh;
        nib.v := dv;
    end;

procedure xFigureDecoration.SetPattern (thePattern: pattern);
    begin
        paintPattern := thePattern;
    end;

procedure xFigureDecoration.doDraw;
    var
        x1, y1, x2, y2: integer;
        saveNib: point;
        savePat: pattern;
    begin
        saveNib := itsWindow.theWindow^.pnSize;
        PenSize(nib.h, nib.v);
        savePat := itsWindow.theWindow^.pnPat;
        PenPat(paintPattern);
        drawIt;
        PenSize(saveNib.h, saveNib.v);
        PenPat(savePat);
    end;

procedure xFigureDecoration.drawIt;
    begin
    end;

procedure xRectangle.drawIt;
    begin
        FrameRect(drawRect);
    end;

procedure xRoundRect.drawIt;
    begin
        FrameRoundRect(drawRect, 16, 16);
    end;

procedure xOval.drawIt;
    begin
        FrameOval(drawRect);
    end;

procedure xFilledRectangle.drawIt;
    begin
        PaintRect(drawRect);
    end;

procedure xFilledRoundRect.drawIt;
    begin
        PaintRoundRect(drawRect, 16, 16);
    end;

procedure xFilledOval.drawIt;
    begin
        PaintOval(drawRect);
    end;

procedure DoString (d: xDisplayString;
                                var width, height: integer;
                                drawIt: boolean);
    var
        savePort: GrafPTr;
        saveFont: integer;
        saveSize: integer;
        saveFace: style;
        win: windowPtr;
        i, ct: integer;
        info: fontInfo;
        lineHeight: integer;
        str: string;
        w: integer;
    begin
        if (d.itsWindow = nil) | (d.itsWindow.theWindow = nil) then
            EXIT(DoString);
        if length(d.theText) = 0 then begin
                width := 0;
                height := 0;
                EXIT(DoString);
            end;
        GetPort(savePort);
        win := d.itsWindow.theWindow;
        SetPort(win);
        saveFont := win^.txFont;
        saveSize := win^.txSize;
        saveFace := win^.txFace;
        TextFont(d.fontNum);
        TextSize(d.fontSize);
        TextFace(d.fontFace);
        ct := 0;
        i := 1;
        width := 0;
        str := '';
        GetFontInfo(info);
        lineHeight := (info.ascent + info.descent + info.leading);
        while i <= length(d.theText) do begin
                if d.theText[i] = '\' then begin
                        w := StringWidth(str);
                        if w > width then
                            width := w;
                        if drawIt then begin
                                MoveTo(d.drawRect.left + 1, d.drawRect.top + info.ascent + ct * lineHeight);
                                DrawString(str);
                            end;
                        ct := ct + 1;
                        str := '';
                    end
                else
                    str := Concat(str, d.theText[i]);
                i := i + 1;
            end;
        if (str <> '') then begin
                w := StringWidth(str);
                if w > width then
                    width := w;
                if drawIt then begin
                        MoveTo(d.drawRect.left + 1, d.drawRect.top + info.ascent + ct * lineHeight);
                        DrawString(str);
                    end;
                ct := ct + 1;
            end;
        height := ct * lineHeight;
        width := width + 1;
        TextFace(saveFace);
        TextFont(saveFont);
        TextSize(saveSize);
        SetPort(savePort);
    end;

procedure xDisplayString.Setup (win: xWindow;
                                str: string;
                                theLeft, theTop: integer);
    begin
        if (win.theWindow = nil) then
            EXIT(setup);
        theText := str;
        fontNum := systemFont;
        fontSize := 12;
        fontFace := [];
        init;
        Install(win, theLeft, theTop, 1, 1);
        DoString(self, trueWidth, trueHeight, false);
        SetSize(trueWidth, trueHeight);
    end;

procedure xDisplayString.ChangeString (newStr: string);
    begin
        theText := newStr;
        DoString(self, trueWidth, trueHeight, false);
        if trueWidth = width then
            width := width - 1;
        SetSize(trueWidth, trueHeight);
    end;

procedure xDisplayString.ChangeFont (newFont, newSize: integer);
    begin
        if newFont >= 0 then
            fontNum := newFont;
        if newSize > 0 then
            fontSize := newSize;
        DoString(self, trueWidth, trueHeight, false);
        if trueWidth = width then
            width := width - 1;
        SetSize(trueWidth, trueHeight);
    end;

procedure xDisplayString.ChangeStyle (newFace: style);
    begin
        fontFace := newFace;
        DoString(self, trueWidth, trueHeight, false);
        if trueWidth = width then
            width := width - 1;
        SetSize(trueWidth, trueHeight);
    end;

procedure xDisplayString.adjustSize;
    begin
        inherited adjustSize;
        clickRect.right := clickRect.left + trueWidth;
        clickRect.bottom := clickRect.top + trueHeight;
        drawRect := clickRect;
    end;

procedure xDisplayString.doDraw;
    var
        junk1, junk2: integer;
    begin
        DoString(self, junk1, junk2, true);
    end;

procedure xIcon.SetUp (xWin: xWindow;
                                iconResourceNum: integer;
                                theLeft, theTop: integer);
    begin
        iconHandle := GetIcon(iconResourceNum);
        if iconHandle <> nil then begin
                init;
                install(xWin, theLeft, theTop, 32, 32);
            end;
    end;

procedure xIcon.doDraw;
    begin
        if iconHandle <> nil then
            PlotIcon(drawRect, iconHandle);
    end;

procedure xPict.SetUp (xWin: xWindow;
                                thePict: PicHandle;
                                theLeft, theTop: integer);
    var
        w, h: integer;
    begin
        pic := thePict;
        if pic <> nil then begin
                init;
                w := pic^^.picFrame.right - pic^^.picFrame.left;
                h := pic^^.picFrame.bottom - pic^^.picFrame.top;
                install(xWin, theLeft, theTop, w, h);
            end;
    end;

procedure xPict.SetUpWithResource (xWin: xWindow;
                                pictResourceNum: integer;
                                theLeft, theTop: integer);
    var
        w, h: integer;
    begin
        pic := GetPicture(pictResourceNum);
        if pic <> nil then begin
                init;
                w := pic^^.picFrame.right - pic^^.picFrame.left;
                h := pic^^.picFrame.bottom - pic^^.picFrame.top;
                install(xWin, theLeft, theTop, w, h);
            end;
    end;

procedure xPict.doDraw;
    begin
        if pic <> nil then
            DrawPicture(pic, drawRect);
    end;

end.