Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyTriangleCDEF.p

Text File | 1996-06-01 | 3.9 KB | 164 lines | [TEXT/CWIE]

unit MyTriangleCDEF;

interface

    uses
        Controls;

    function TriangleCDEF (variation: integer; theControl: ControlHandle; msg: integer; param: longint): longint;

implementation

    uses
        MyTypes;

    const
        kInactive = 255;        {    part code indicating the control is inactive        }

    function TriangleCDEF (variation: integer; theControl: ControlHandle; msg: integer; param: longint): longint;
        procedure GetRgn (rgn: RgnHandle);
            const
                offset = 2;
                offset2 = 2;
            var
                r: Rect;        {    the Rect to draw the PICT in    }
                pt: Point;
                siz: Point;
                value: integer;
        begin
            r := theControl^^.contrlRect;
            value := theControl^^.contrlValue mod 8;
            pt.h := (r.left + r.right) div 2;
            pt.v := (r.top + r.bottom) div 2;
            if odd(value) then begin
                siz.h := 3 * (r.right - r.left) div 4;
                siz.v := 3 * (r.bottom - r.top) div 4;
            end
            else begin
                siz.h := (r.right - r.left) div 2;
                siz.v := (r.bottom - r.top) div 2;
            end;
            OpenRgn;
            case value of
                0:  begin
                    MoveTo(pt.h, pt.v + offset - siz.v);
                    Line(siz.h, siz.v);
                    Line(-2 * siz.h, 0);
                    Line(siz.h, -siz.v);
                end;
                1:  begin
                    MoveTo(pt.h - offset2 + siz.h div 2, pt.v + offset2 + siz.v div 2);
                    Line(0, -siz.v);
                    Line(-siz.h, 0);
                    Line(siz.h, siz.v);
                end;
                2:  begin
                    MoveTo(pt.h - offset + siz.h, pt.v);
                    Line(-siz.h, siz.v);
                    Line(0, -2 * siz.v);
                    Line(siz.h, siz.v);
                end;
                3:  begin
                    MoveTo(pt.h - offset2 + siz.h div 2, pt.v - offset2 - siz.v div 2);
                    Line(0, siz.v);
                    Line(-siz.h, 0);
                    Line(siz.h, -siz.v);
                end;
                4:  begin
                    MoveTo(pt.h, pt.v - offset + siz.v);
                    Line(siz.h, -siz.v);
                    Line(-2 * siz.h, 0);
                    Line(siz.h, siz.v);
                end;
                5:  begin
                    MoveTo(pt.h + offset2 - siz.h div 2, pt.v - offset2 - siz.v div 2);
                    Line(0, siz.v);
                    Line(siz.h, 0);
                    Line(-siz.h, -siz.v);
                end;
                6:  begin
                    MoveTo(pt.h + offset - siz.h, pt.v);
                    Line(siz.h, siz.v);
                    Line(0, -2 * siz.v);
                    Line(-siz.h, siz.v);
                end;
                7:  begin
                    MoveTo(pt.h + offset2 - siz.h div 2, pt.v + offset2 + siz.v div 2);
                    Line(0, -siz.v);
                    Line(siz.h, 0);
                    Line(-siz.h, siz.v);
                end;
            end;
            CloseRgn(rgn);
        end;

        var
            result: longint;        {    the result to return        }
            hilite: integer;        {    the current control hilite state    }
            rgn: RgnHandle;
            mousePoint: Point;
    begin
        result := 0;

        case msg of
            initCntl:
                ; { We won't get this call anyway }

            drawCntl:  begin    {    Draw the arrow control                }
                if theControl^^.contrlVis <> 0 then begin
                    rgn := NewRgn;
                    GetRgn(rgn);
                    EraseRect(theControl^^.contrlRect);
                    case theControl^^.contrlHilite of
                        kInactive:  begin
                            PenPat(GetQDGlobals^.gray);
                            FrameRgn(rgn);
                            PenPat(GetQDGlobals^.black);
                        end;
                        0, kInUpButtonControlPart:  begin
                            if (theControl^^.contrlValue > 7) = (theControl^^.contrlHilite = kInUpButtonControlPart) then begin
                                FrameRgn(rgn);
                            end
                            else begin
                                FillRgn(rgn, GetQDGlobals^.black);
                            end;
                        end;
                        otherwise
                            ;
                    end;
                    DisposeRgn(rgn);
                end;
            end;

            testCntl:  begin        {    Determine which part of the arrow the mouse is in    }
                mousePoint.v := hiwrd(param);
                mousePoint.h := lowrd(param);

            {    If the mouse Point is in the control and it is active, determine which part the mouse went down in.            }
                if (theControl^^.contrlHilite <> kInactive) then{ & PtInRect(mousePoint, theControl^^.contrlRect) }
                    begin
                    rgn := NewRgn;
                    GetRgn(rgn);
                    if PtInRgn(mousePoint, rgn) then begin
                        result := kInUpButtonControlPart;
                    end;
                    DisposeRgn(rgn);
                end;
            end;

            calcCRgns, calcCntlRgn, calcThumbRgn:  begin
                param := longint(StripAddress(Ptr(param)));        { Mask off the high Byte if necessary }
                GetRgn(RgnHandle(param));
            end;

            dispCntl:
                ;

            otherwise
                ;
        end;

        TriangleCDEF := result;
    end;

end.