*/
Check out and contribute to CodePedia, the wiki for developers.
*/

View \BUTTON3.PAS

Graphical button and cursor program. Contain source code to a

Submitted By: WEBMASTER
Rating: (Not rated) (Rate It)


{BUTTON3.PAS creates BUTTON3.TPU Unit}
     {From the book "OBJECT ORIENTED PROGRAMMING IN TURBO PASCAL 5.5"}

Unit Button3;

            {=============================================}
            {This version of the unit uses virtual methods}
            {=============================================}

Interface

Type
    STR40 = string[40];

    Point = object
          X,Y,Color : integer;
          Constructor Init;
          Procedure Move(Ptx,Pty : integer);
          Procedure Draw; virtual;
          Procedure Create(Ptx,Pty,C : integer);
          Procedure SetColor(C : integer);
          Procedure SetLoc(Ptx,Pty : integer); virtual;
          Procedure Erase; virtual;
          Function GetColor : integer;
          Function GetX : integer;
          Function GetY : integer;
          end; {object}

    ButtonType = (Rounded,Square,ThreeD);

    Button = object(Point)
           Exist,State,Rotate : boolean;
           FontSize,TypeFace,SizeX,SizeY : integer;
           Style : ButtonType;
           BtnTxt : STR40;
           Constructor Init;
           Procedure Draw; virtual;
           Procedure Create(Ptx,Pty,Width,Height,C : integer; Text : STR40);
           Procedure Erase; virtual;
           Procedure Invert;
           Procedure Move(Ptx,Pty : integer);
           Procedure SetColor(C : integer);
           Procedure SetState(Bstate : boolean);
           Procedure SetLabel(Text : STR40);
           Procedure SetButtonType(WhatType : ButtonType);
           Procedure SetTypeSize(TxtSize : integer);
           Procedure SetTypeFace(TxtFont : integer);
           Function GetWidth : integer;
           Function GetHeight : integer;
           Function GetState  : boolean;
           Function GetTextSize : integer;
           Function GetType : ButtonType;
           Function ButtonHit(MouseX,MouseY : integer) : boolean;
           end; {object}

{=========================================================================}

Implementation

Uses
    Crt,Graph;

Type
    RectOutline = array[1..5] of PointType;

                {========================================}
                {Local procedure used by Button functions}
                {========================================}

Procedure SetOutline(var RectArr : RectOutline; X1,Y1,X2,Y2 : integer);
Begin
     RectArr[1].x := X1;
     RectArr[1].y := Y1;
     RectArr[2].x := X1;
     RectArr[2].y := Y2;
     RectArr[3].x := X2;
     RectArr[3].y := Y2;
     RectArr[4].x := X2;
     RectArr[4].y := Y1;
     RectArr[5].x := X1;
     RectArr[5].y := Y1;
End;

{*************************************************************************}
                 {====================================}
                 {Implementation for object type Point}
                 {====================================}

Constructor Point.Init;
Begin
End;

{*************************************************************************}

Procedure Point.SetLoc;
Begin
     X := Ptx;
     Y := Pty;
End;

{*************************************************************************}

Procedure Point.Draw;
Begin
     PutPixel(X,Y,Color);
End;

{*************************************************************************}

Procedure Point.Create;
Begin
     SetLoc(Ptx,Pty);
     Color := C;
     Draw;
End;

{*************************************************************************}

Procedure Point.Erase;
Var
   Temp : integer;
Begin
     Temp := Color;
     Color := GetBkColor;
     Draw;
     Color := Temp;
End;

{*************************************************************************}

Procedure Point.Move;
Begin
     Erase;
     SetLoc(Ptx,Pty);
     Draw;
End;

{*************************************************************************}

Procedure Point.SetColor;
Begin
     Color := C;
     Draw;
End;

{*************************************************************************}

Function Point.GetColor;
Begin
     GetColor := Color;
End;

{*************************************************************************}

Function Point.GetX;
Begin
     GetX := X;
End;

{*************************************************************************}

Function Point.GetY;
Begin
     GetY := Y;
End;

{*************************************************************************}
               {=====================================}
               {Implementation for object type Button}
               {=====================================}

Constructor Button.Init;
Begin
     Exist := False;
     SetTypeSize(10);
     SetTypeFace(TriplexFont);
End;

{*************************************************************************}

Procedure Button.Draw;
Const
     Radius = 6;        {Radius of corners on rounded buttons}
     Offset = 3;        {Offset for fill                     }
Var
   RectArr : RectOutline;
   AlignX,AlignY,TempSize,TextLen,I,BtnWd,BtnHt,TextDir : integer;
Begin
     SetViewPort(X,Y,X+SizeX,Y+SizeY,ClipOn);
     Graph.SetColor(Color);
     Case Style of
          Square  : begin
                         Graph.Rectangle(0,0,SizeX,SizeY);
                         BtnWd := SizeX - 10;
                         BtnHt := SizeY - 10;
                    end;
          ThreeD  : begin
                         Graph.Rectangle(0,0,SizeX,SizeY);
                         SetOutline(RectArr,1,1,SizeX-1,SizeY-1);
                         SetFillStyle(CloseDotFill,Color);
                         SetLineStyle(UserBitLn,0,NormWidth);
                         FillPoly(SizeOf(RectArr) div
                                  SizeOf(PointType), RectArr);
                         SetLineStyle(SolidLn,0,NormWidth);
                         Graph.Rectangle(2*Radius,2*Radius,
                                         SizeX-2*Radius,SizeY-2*Radius);
                         Line(0,0,2*Radius,2*Radius);
                         Line(0,SizeY,2*Radius,SizeY-2*Radius);
                         Line(SizeX,0,SizeX-2*Radius,2*Radius);
                         Line(SizeX,SizeY,SizeX-2*Radius,SizeY-2*Radius);
                         BtnWd := SizeX-4*Radius;
                         BtnHt := SizeY-4*Radius;
                    end
          else
                    begin
                         Style := Rounded;
                         Graph.Arc(SizeX-Radius,Radius,0,90,Radius);
                         Graph.Arc(Radius,Radius,90,180,Radius);
                         Graph.Arc(Radius,SizeY-Radius,180,270,Radius);
                         Graph.Arc(SizeX-Radius,SizeY-Radius,270,360,Radius);
                         Graph.Line(Radius,0,SizeX-Radius,0);
                         Graph.Line(Radius,SizeY,SizeX-Radius,SizeY);
                         Graph.Line(0,Radius,0,SizeY-Radius);
                         Graph.Line(SizeX,Radius,SizeX,SizeY-Radius);
                         BtnWd := SizeX-2*Radius;
                         BtnHt := SizeY-2*Radius;
                    end;
     end; {of case}

     Case Style of
          Square,
          Rounded : SetOutline(RectArr,Offset,Offset,
                               SizeX-Offset,SizeY-Offset);
          ThreeD  : SetOutline(RectArr,2*Radius+1,2*Radius+1,
                               SizeX-2*Radius-1,SizeY-2*Radius);
     end; {of case{
                              {SHOW STATE}

     if State then
        SetFillStyle(SolidFill,Color)
     else
         SetFillStyle(WideDotFill,Color);
     SetLineStyle(UserBitLn,0,NormWidth);
     FillPoly(SizeOf(RectArr) div SizeOf(PointType),RectArr);
     SetLineStyle(SolidLn,0,NormWidth);

                     {ADJUST FONTS AND STRING TO FIT}
     TempSize := FontSize;
     TextDir  := HorizDir;
     if Rotate then
     begin
          TextDir := VertDir;
          TextLen := BtnWd;
          BtnWd   := BtnHt;
          BtnHt   := TextLen;
     end;
     SetTextStyle(TypeFace,TextDir,TempSize);
     for I := FontSize downto 1 do
         if (TextWidth(BtnTxt) > BtnWd) then
            SetTextStyle(TypeFace,TextDir,I)
         else
         if (TextHeight(BtnTxt) > BtnHt) then
            SetTextStyle(TypeFace,TextDir,I);
     TextLen := Ord(BtnTxt[0]);
     while (TextWidth(Copy(BtnTxt,1,TextLen)) > BtnWd) do
           Dec(TextLen);
     AlignX := SizeX div 2 - 3;
     AlignY := SizeY div 2 - 3;   {Fine tune text position}
     if BtnTxt[TextLen] = ' ' then
        Dec(TextLen);
     if State then
        Graph.SetColor(GetBkColor);

                            {ADD LABEL}
     OutTextXY(AlignX,AlignY,Copy(BtnTxt,1,TextLen));
     if State then
        Graph.SetColor(Color);
     SetViewPort(0,0,GetMaxX,GetMaxY,ClipOn);
End;

{*************************************************************************}

Procedure Button.Create;
Begin
     SetViewPort(0,0,GetMaxX,GetMaxY,ClipOn);
     SetTextJustify(CenterText,CenterText);
     SetLoc(Ptx,Pty);
     if Width < 20 then
        SizeX := 20
     else
         SizeX := Width;
     if Height < 20 then
        SizeY := 20
     else
         SizeY := Height;
     if (SizeY > SizeX) then
        Rotate := True
     else
         Rotate := False;
     Color := C;
     State := False;
     Exist := True;
     BtnTxt := Text;
     Draw;
End;

{*************************************************************************}

Procedure Button.Erase;
Var
   OldColor : integer;
Begin
     if Exist then
     begin
          SetViewPort(X,Y,X+SizeX,Y+SizeY,ClipOn);
          ClearViewPort;
          Exist := False;
     end;
End;

{*************************************************************************}

Procedure Button.Move;
Begin
     Erase;
     SetLoc(Ptx,Pty);
     Draw;
End;

{*************************************************************************}

Procedure Button.SetLabel;
Begin
     BtnTxt := Text;
     Draw;
End;

{*************************************************************************}

Procedure Button.SetColor;
Begin
     Color := C;
     Draw;
End;

{*************************************************************************}

Procedure Button.SetState;
Begin
     if (State <> BState) then
        Invert;
End;

{*************************************************************************}

Procedure Button.SetTypeSize;
Begin
     FontSize := TxtSize;
End;

{*************************************************************************}

Procedure Button.SetTypeFace;
Begin
     TypeFace := TxtFont;
End;

{*************************************************************************}

Procedure Button.SetButtonType;
Begin
     Style := WhatType;
End;

{*************************************************************************}

Procedure Button.Invert;
Begin
     State := not State;
     Draw;
End;

{*************************************************************************}

Function Button.GetWidth;
Begin
     GetWidth := SizeX;
End;

{*************************************************************************}

Function Button.GetHeight;
Begin
     GetHeight := SizeY;
End;

{*************************************************************************}

Function Button.GetState;
Begin
     GetState := State;
End;

{*************************************************************************}

Function Button.GetTextSize;
Begin
     GetTextSize := FontSize;
End;

{*************************************************************************}

Function Button.GetType;
Begin
     GetType := Style;
End;

{*************************************************************************}

Function Button.ButtonHit;
Var
   Result : boolean;
Begin
     Result := False;
     if (MouseX >= X) and (MouseX <= X+SizeX) and
        (MouseY >= Y) and (MouseY <= Y+SizeY) then
                Result := True;
     if Result then
        Invert;
     ButtonHit := Result;
End;

{*************************************************************************}


BEGIN
     {No initialization required}
END.

corner
© 1996-2008 CommunityHeaven LLC. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
North American business development: Nicolai Wadstrom. Publisher: Lars Hagelin.