Carousel Volume 2 #1/carousel.iso/mactosh/hc/barbutto.sit/BarButton/card_5475.txt

Text File | 1987-11-23 | 38KB | 1,415 lines

-- card: 5475 from stack: in
-- bmap block id: 0
-- flags: 0000
-- background id: 5228
-- name: Card 6


-- part 3 (field)
-- low flags: 00
-- high flags: 2007
-- rect: left=19 top=75 right=293 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name:


-- part 5 (field)
-- low flags: 00
-- high flags: 0000
-- rect: left=19 top=37 right=76 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 3
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name:


-- part 6 (button)
-- low flags: 00
-- high flags: 2000
-- rect: left=119 top=313 right=342 bottom=152
-- title width / last selected line: 0
-- icon id / first selected line: 26425 / 26425
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: New Button
----- HyperTalk script -----
on mouseUp
  go next card
end mouseUp

on mousedown
  if the optionkey is down then put script of me into bkgnd field lowerpane
end mousedown


-- part contents for background part 1
----- text -----
VESTIGIAL CARD: This is the complete text of the Lightspeed Pascal source of the BarButton XCMD.  If you want to recompile with modifications, be sure the files DA PasLib and MacTraps are in the Project, and Build and Save As a Code resource of type 'XCMD'.  Then ResEdit the XCMD into your stack.
This XCMD was written more as an experiment than anything else.
If you would like your own custom version, and don't feel like writing it yourself, give me a call.  There are many simple tasks that Hypercard cannot do well, or quickly, or at all.  But XCMD's and XFCN's can avoid most of these deficencies.

Infosynthesis
2960 Ferry Street
Eugene, OR 97405
[phone]
{BarButton adjusts the size of the bar contained within rect passed in "It", and using the }
{options in the first 4 parameters.}
UNIT Main;

INTERFACE

USES
HyperXCMD;


-- part contents for background part 2
----- text -----


{BarButton adjusts the size of the bar contained within rect in first 4}
{parameters.}
UNIT Main;

INTERFACE

USES
HyperXCMD;

PROCEDURE Main (ParamPtr : XCmdPtr);

IMPLEMENTATION

{-------------------------------------------------------------------------------}
PROCEDURE BarButton (ParamPtr : XCmdPtr);
FORWARD;

PROCEDURE Main;
BEGIN
BarButton(ParamPtr);
END;

PROCEDURE BarButton;

CONST
leftToRight = 1;
rightToLeft = 2;
bottomToTop = 3;
topToBottom = 4;

VAR
str : Str255;
ButtonRect, DrawRect, BlankRect, ViewRect, TextRect : rect;
InRect, newLoc, dummy, ShowValue, SuppressDisplay : boolean;
spot, oldspot, TextPoint : point;
direction, maximumValue, minimumValue, CurrentValue, InitialValue : integer;
theInfo : FontInfo;
TextHeight, TextWidth, ButtonHeight, ButtonWidth : integer;
proportion : real;

{-------------------------------------------------------------------------------}
PROCEDURE DoJsr (addr : ProcPtr);
INLINE
$205F, $4E90;
{ Jump subroutine to a procedure.   Pop address into A0, JSR (A0) }

{-------------------------------------------------------------------------------}
PROCEDURE ZeroToPas (zeroStr : Ptr;
VAR pasStr : Str255);
{Fill the Pascal string with the contents of the zero-terminated}
{   string.  You create the Pascal string and pass it in as a VAR }
{   parameter.  Useful for converting the arguments of any XCMD to }
{   Pascal strings.}
BEGIN
WITH paramPtr^ DO
BEGIN
inArgs[1] := ORD(zeroStr);
inArgs[2] := ORD(@pasStr);
request := xreqZeroToPas;
DoJsr(entryPoint);
END;
END;

{-------------------------------------------------------------------------------}
FUNCTION StrToNum (str : Str31) : LongInt;
{  Convert a string of ASCII decimal digits to a signed long integer.}
{   Negative sign is allowed.  }
BEGIN
WITH paramPtr^ DO
BEGIN
inArgs[1] := ORD(@str);
request := xreqStrToNum;
DoJsr(entryPoint);
StrToNum := outArgs[1];
END;
END;

{-------------------------------------------------------------------------------}
FUNCTION PasToZero (str : Str255) : Handle;
{  Convert a Pascal string to a zero-terminated string.  Returns a handle}
{   to a new zero-terminated string.  The caller must dispose the handle. }
BEGIN
WITH paramPtr^ DO
BEGIN
inArgs[1] := ORD(@str);
request := xreqPasToZero;
DoJsr(entryPoint);
PasToZero := Handle(outArgs[1]);
END;
END;

{-------------------------------------------------------------------------------}
FUNCTION EvalExpr (expr : Str255) : Handle;
{  Evaluate a HyperCard expression and return the answer.  The answer is}
{   a handle to a zero-terminated string. }
BEGIN
WITH paramPtr^ DO
BEGIN
inArgs[1] := ORD(@expr);
request := xreqEvalExpr;
DoJsr(entryPoint);
EvalExpr := Handle(outArgs[1]);
END;
END;

{-------------------------------------------------------------------------------}
FUNCTION NumToStr (num : LongInt) : Str31;
{  Convert a signed long integer to a Pascal string.  }
VAR
str : Str31;
BEGIN
WITH paramPtr^ DO
BEGIN
inArgs[1] := num;
inArgs[2] := ORD(@str);
request := xreqNumToStr;
DoJsr(entryPoint);
NumToStr := str;
END;
END;

{-------------------------------------------------------------------------------}
FUNCTION IntExpr (theString : str255) : integer;
TYPE
Ptr31 = ^str31;
Hand31 = ^Ptr31;

VAR
tempHand : handle;
ShortStr : str31;
ShortPtr : Ptr31;
ShortHand : Hand31;
NumLong : longint;
LongStr : str255;

BEGIN
tempHand := EvalExpr(theString);
ZeroToPas(tempHand^, LongStr);
ShortStr := LongStr;
NumLong := StrToNum(ShortStr);
IntExpr := loword(NumLong);
DisposHandle(tempHand);
END;

{-------------------------------------------------------------------------------}
FUNCTION DePad (str : str255) : str255;
VAR
c : integer;

BEGIN
FOR c := length(str) DOWNTO 1 DO
IF ord(str[c]) = 32 THEN
Delete(str, c, 1);
DePad := str;
END;

{-------------------------------------------------------------------------------}
PROCEDURE DisplayValue;
BEGIN
IF ShowValue THEN
BEGIN
TextFont(systemfont);{Chicago}
TextSize(12);
str := Depad(StringOf(CurrentValue));
CASE direction OF
leftToRight, rightToLeft :
MoveTo(TextPoint.h, TextPoint.v);
bottomToTop, topToBottom :
MoveTo(TextPoint.h - StringWidth(str) DIV 2, TextPoint.v);
END;
EraseRect(TextRect);
DrawString(str);
END;
END;{DisplayValue}

{-------------------------------------------------------------------------------}
PROCEDURE ComputeValue;

BEGIN
WITH ViewRect DO
CASE direction OF
leftToRight :
proportion := (oldspot.h - left) * 1.0 / (right - left);
rightToLeft :
proportion := (right - oldspot.h) * 1.0 / (right - left);
bottomToTop :
proportion := (bottom - oldspot.v) * 1.0 / (bottom - top);
topToBottom :
proportion := (oldspot.v - top) * 1.0 / (bottom - top);
END;

IF proportion < 0 THEN
proportion := 0;
IF proportion > 1.0 THEN
proportion := 1.0;

CurrentValue := round(proportion * (maximumValue - minimumValue) + minimumValue);
DisplayValue;
END;{ComputeValue}

{-------------------------------------------------------------------------------}
BEGIN
ButtonRect.left := IntExpr('item 1 of It');
ButtonRect.top := IntExpr('item 2 of It');
ButtonRect.right := IntExpr('item 3 of It');
ButtonRect.bottom := IntExpr('item 4 of It');
ButtonHeight := ButtonRect.bottom - ButtonRect.top;
ButtonWidth := ButtonRect.right - ButtonRect.left;

ViewRect := ButtonRect;
InsetRect(ViewRect, 1, 1);
DrawRect := ViewRect;
BlankRect := DrawRect;

WITH ButtonRect DO
IF right - left > bottom - top THEN
direction := leftToRight
ELSE
direction := bottomToTop;
maximumValue := 100;
minimumValue := 0;
ShowValue := FALSE;
SuppressDisplay := FALSE;
InitialValue := -32767;{Hopefully no one will actually use that value!}

WITH ParamPtr^ DO
BEGIN
IF paramCount > 0 THEN
BEGIN
ZeroToPas(params[1]^, str);
direction := StrToNum(str);
IF (direction >= -4) AND (direction <= -1) THEN
BEGIN
SuppressDisplay := TRUE;
direction := -direction;
END;
IF (direction < 1) OR (direction > 4) THEN
direction := leftToRight;
IF paramCount > 1 THEN
BEGIN
ZeroToPas(params[2]^, str);
maximumValue := StrToNum(str);
ShowValue := TRUE;
IF paramCount > 2 THEN
BEGIN
ZeroToPas(params[3]^, str);
minimumValue := StrToNum(str);
IF minimumValue >= maximumValue THEN
minimumValue := maximumValue + 10;
IF paramCount > 3 THEN
BEGIN
ZeroToPas(params[4]^, str);
InitialValue := StrToNum(str);
END;{end of reading initial value}
END;{end of reading third parameter}
END;{end of reading second parameter}
END;{end of reading first parameter}
END;{with ParamPtr^}
IF SuppressDisplay THEN
ShowValue := FALSE;

IF InitialValue = -32767 THEN
GetMouse(spot){Get current loc of mouse}
ELSE
BEGIN{force initial value of bar without mousedown}
proportion := (InitialValue - minimumValue) * 1.0 / (maximumValue - minimumValue);
IF proportion < 0 THEN
proportion := 0;
IF proportion > 1.0 THEN
proportion := 1.0;
CASE direction OF
leftToRight :
spot.h := round(DrawRect.left + proportion * ButtonWidth);
rightToLeft :
spot.h := round(DrawRect.right - proportion * ButtonWidth);
bottomToTop :
spot.v := round(DrawRect.bottom - proportion * ButtonHeight);
topToBottom :
spot.v := round(DrawRect.top + proportion * ButtonHeight);
END;{end of case direction}
END;{end of forcing initial value}

CASE direction OF
leftToRight :
BEGIN
DrawRect.right := spot.h;
BlankRect.left := spot.h;
END;
rightToLeft :
BEGIN
DrawRect.left := spot.h;
BlankRect.right := spot.h;
END;
bottomToTop :
BEGIN
DrawRect.top := spot.v;
BlankRect.bottom := spot.v;
END;
topToBottom :
BEGIN
DrawRect.bottom := spot.v;
BlankRect.top := spot.v;
END;
END;{end of case direction}

IF ShowValue THEN{Set up stuff for ShowValue}
BEGIN
IF StringWidth(DePad(StringOf(maximumValue))) >= StringWidth(DePad(StringOf(minimumValue))) THEN
TextWidth := StringWidth(DePad(StringOf(maximumValue)))
ELSE
TextWidth := StringWidth(DePad(StringOf(minimumValue)));

GetFontInfo(theInfo);
TextHeight := theInfo.ascent;{numbers don't have descenders}

CASE direction OF
leftToRight, rightToLeft :
BEGIN
TextRect.top := ButtonRect.top + ButtonHeight DIV 2 - TextHeight DIV 2 - TextHeight DIV 4;
TextRect.left := ButtonRect.right + 1;
TextPoint.h := TextRect.left + TextHeight DIV 4;
TextRect.bottom := TextRect.top + TextHeight + TextHeight DIV 2;
TextPoint.v := TextRect.bottom - TextHeight DIV 4;
END;
bottomToTop, topToBottom :
BEGIN
TextRect.top := ButtonRect.bottom + 2;
TextPoint.h := ButtonRect.left + ButtonWidth DIV 2;
TextRect.left := TextPoint.h - TextWidth DIV 2 - TextHeight DIV 4;
TextRect.bottom := TextRect.top + TextHeight + TextHeight DIV 2 - 4;
TextPoint.v := TextRect.bottom - TextHeight DIV 4;
END;
END;
TextRect.right := TextRect.left + TextWidth + TextHeight DIV 2;
END;{end setting up ShowValue stuff}

oldspot := spot;
dummy := SectRect(ViewRect, DrawRect, DrawRect);
PaintRect(DrawRect);
dummy := SectRect(ViewRect, BlankRect, BlankRect);
EraseRect(BlankRect);
DrawRect := ViewRect;{now will be used for the redrawing}
InsetRect(ButtonRect, -10, -10);
IF InitialValue > -32767 THEN
BEGIN{Display forced starting value}
CurrentValue := InitialValue;
DisplayValue;
END
ELSE
BEGIN
ComputeValue;{Display first real value if requested}
REPEAT
GetMouse(spot);
InRect := PtInRect(spot, ButtonRect) AND Button;
IF InRect THEN
BEGIN
newLoc := TRUE;{guilty unless proven innocent}
CASE direction OF

leftToRight, rightToLeft :
BEGIN
IF spot.h = oldspot.h THEN{no horizontal movement; don't redraw at all}
newLoc := FALSE
ELSE
BEGIN
IF spot.h > oldspot.h THEN{moving right}
BEGIN
DrawRect.right := spot.h;
DrawRect.left := oldspot.h;
END
ELSE{moving left}
BEGIN
DrawRect.left := spot.h;
DrawRect.right := oldspot.h;
END;
END;{end new horizontal loc}
DrawRect.top := ViewRect.top;{restore top and bottom in case SectRect wiped them out with empty rect}
DrawRect.bottom := ViewRect.bottom;
END;{end horizontal case}

bottomToTop, topToBottom :
BEGIN
IF spot.v = oldspot.v THEN{no vertical movement; don't redraw at all}
newLoc := FALSE
ELSE
BEGIN
IF spot.v > oldspot.v THEN{moving down}
BEGIN
DrawRect.bottom := spot.v;
DrawRect.top := oldspot.v;
END
ELSE{moving up}
BEGIN
DrawRect.top := spot.v;
DrawRect.bottom := oldspot.v;
END;
END;{end new vertical loc}
DrawRect.left := ViewRect.left;{restore left and right in case SectRect wiped them out with empty rect}
DrawRect.right := ViewRect.right;
END;{end vertical case}
END;{case block}

dummy := SectRect(ViewRect, DrawRect, DrawRect);
IF newLoc THEN{Redraw if necessary}
BEGIN
InvertRect(DrawRect);
IF ShowValue THEN
ComputeValue;{Display current value if requested}
END;
oldspot := spot;{today becomes yesterday}
END;{end InRect}

UNTIL NOT Button;{loop until mouseUp}
ComputeValue;{Put result in "the Result" even if they don't want it displayed}
END;{end of event loop for real values}

str := NumToStr(CurrentValue);
paramPtr^.returnValue := PasToZero(str);
END;{end BarButton}

END.

-- part contents for card part 2
----- text -----







sdsdfsdfsdsfsdf

-- part contents for background part 5
----- text -----
This XCMD was written more as an experiment than anything else.
If you would like your own custom version, and don't feel like writing it yourself, give me a call.  There are many simple tasks that Hypercard cannot do well, or quickly, or at all.  But XCMD's and XFCN's can avoid most of these deficencies.

Infosynthesis
2960 Ferry Street
Eugene, OR 97405
[phone]
{BarButton adjusts the size of the bar contained within rect passed in "It", and using the }
{options in the first 4 parameters.}
UNIT Main;

INTERFACE

USES
HyperXCMD;

PROCEDURE Main (ParamPtr : XCmdPtr);

IMPLEMENTATION

{-------------------------------------------------------------------------------}
PROCEDURE BarButton (ParamPtr : XCmdPtr);
FORWARD;

PROCEDURE Main;
BEGIN
BarButton(ParamPtr);
END;

PROCEDURE BarButton;

CONST
leftToRight = 1;
rightToLeft = 2;
bottomToTop = 3;
topToBottom = 4;

VAR
str : Str255;
ButtonRect, DrawRect, BlankRect, ViewRect, TextRect : rect;
InRect, newLoc, dummy, ShowValue, SuppressDisplay : boolean;
spot, oldspot, TextPoint : point;
direction, maximumValue, minimumValue, CurrentValue, InitialValue : integer;
theInfo : FontInfo;
TextHeight, TextWidth, ButtonHeight, ButtonWidth : integer;
proportion : real;

{-------------------------------------------------------------------------------}
PROCEDURE DoJsr (addr : ProcPtr);
INLINE
$205F, $4E90;
{ Jump subroutine to a procedure.   Pop address into A0, JSR (A0) }

{-------------------------------------------------------------------------------}
PROCEDURE ZeroToPas (zeroStr : Ptr;
VAR pasStr : Str255);
{Fill the Pascal string with the contents of the zero-terminated}
{   string.  You create the Pascal string and pass it in as a VAR }
{   parameter.  Useful for converting the arguments of any XCMD to }
{   Pascal strings.}
BEGIN
WITH paramPtr^ DO
BEGIN
inArgs[1] := ORD(zeroStr);
inArgs[2] := ORD(@pasStr);
request := xreqZeroToPas;
DoJsr(entryPoint);
END;
END;

{-------------------------------------------------------------------------------}
FUNCTION StrToNum (str : Str31) : LongInt;
{  Convert a string of ASCII decimal digits to a signed long integer.}
{   Negative sign is allowed.  }
BEGIN
WITH paramPtr^ DO
BEGIN
inArgs[1] := ORD(@str);
request := xreqStrToNum;
DoJsr(entryPoint);
StrToNum := outArgs[1];
END;
END;

{-------------------------------------------------------------------------------}
FUNCTION PasToZero (str : Str255) : Handle;
{  Convert a Pascal string to a zero-terminated string.  Returns a handle}
{   to a new zero-terminated string.  The caller must dispose the handle. }
BEGIN
WITH paramPtr^ DO
BEGIN
inArgs[1] := ORD(@str);
request := xreqPasToZero;
DoJsr(entryPoint);
PasToZero := Handle(outArgs[1]);
END;
END;

{-------------------------------------------------------------------------------}
FUNCTION EvalExpr (expr : Str255) : Handle;
{  Evaluate a HyperCard expression and return the answer.  The answer is}
{   a handle to a zero-terminated string. }
BEGIN
WITH paramPtr^ DO
BEGIN
inArgs[1] := ORD(@expr);
request := xreqEvalExpr;
DoJsr(entryPoint);
EvalExpr := Handle(outArgs[1]);
END;
END;

{-------------------------------------------------------------------------------}
FUNCTION NumToStr (num : LongInt) : Str31;
{  Convert a signed long integer to a Pascal string.  }
VAR
str : Str31;
BEGIN
WITH paramPtr^ DO
BEGIN
inArgs[1] := num;
inArgs[2] := ORD(@str);
request := xreqNumToStr;
DoJsr(entryPoint);
NumToStr := str;
END;
END;

{-------------------------------------------------------------------------------}
FUNCTION IntExpr (theString : str255) : integer;
TYPE
Ptr31 = ^str31;
Hand31 = ^Ptr31;

VAR
tempHand : handle;
ShortStr : str31;
ShortPtr : Ptr31;
ShortHand : Hand31;
NumLong : longint;
LongStr : str255;

BEGIN
tempHand := EvalExpr(theString);
ZeroToPas(tempHand^, LongStr);
ShortStr := LongStr;
NumLong := StrToNum(ShortStr);
IntExpr := loword(NumLong);
DisposHandle(tempHand);
END;

{-------------------------------------------------------------------------------}
FUNCTION DePad (str : str255) : str255;
VAR
c : integer;

BEGIN
FOR c := length(str) DOWNTO 1 DO
IF ord(str[c]) = 32 THEN
Delete(str, c, 1);
DePad := str;
END;

{-------------------------------------------------------------------------------}
PROCEDURE DisplayValue;
BEGIN
IF ShowValue THEN
BEGIN
TextFont(systemfont);{Chicago}
TextSize(12);
str := Depad(StringOf(CurrentValue));
CASE direction OF
leftToRight, rightToLeft :
MoveTo(TextPoint.h, TextPoint.v);
bottomToTop, topToBottom :
MoveTo(TextPoint.h - StringWidth(str) DIV 2, TextPoint.v);
END;
EraseRect(TextRect);
DrawString(str);
END;
END;{DisplayValue}

{-------------------------------------------------------------------------------}
PROCEDURE ComputeValue;

BEGIN
WITH ViewRect DO
CASE direction OF
leftToRight :
proportion := (oldspot.h - left) * 1.0 / (right - left);
rightToLeft :
proportion := (right - oldspot.h) * 1.0 / (right - left);
bottomToTop :
proportion := (bottom - oldspot.v) * 1.0 / (bottom - top);
topToBottom :
proportion := (oldspot.v - top) * 1.0 / (bottom - top);
END;

IF proportion < 0 THEN
proportion := 0;
IF proportion > 1.0 THEN
proportion := 1.0;

CurrentValue := round(proportion * (maximumValue - minimumValue) + minimumValue);
DisplayValue;
END;{ComputeValue}

{-------------------------------------------------------------------------------}
BEGIN
ButtonRect.left := IntExpr('item 1 of It');
ButtonRect.top := IntExpr('item 2 of It');
ButtonRect.right := IntExpr('item 3 of It');
ButtonRect.bottom := IntExpr('item 4 of It');
ButtonHeight := ButtonRect.bottom - ButtonRect.top;
ButtonWidth := ButtonRect.right - ButtonRect.left;

ViewRect := ButtonRect;
InsetRect(ViewRect, 1, 1);
DrawRect := ViewRect;
BlankRect := DrawRect;

WITH ButtonRect DO
IF right - left > bottom - top THEN
direction := leftToRight
ELSE
direction := bottomToTop;
maximumValue := 100;
minimumValue := 0;
ShowValue := FALSE;
SuppressDisplay := FALSE;
InitialValue := -32767;{Hopefully no one will actually use that value!}

WITH ParamPtr^ DO
BEGIN
IF paramCount > 0 THEN
BEGIN
ZeroToPas(params[1]^, str);
direction := StrToNum(str);
IF (direction >= -4) AND (direction <= -1) THEN
BEGIN
SuppressDisplay := TRUE;
direction := -direction;
END;
IF (direction < 1) OR (direction > 4) THEN
direction := leftToRight;
IF paramCount > 1 THEN
BEGIN
ZeroToPas(params[2]^, str);
maximumValue := StrToNum(str);
ShowValue := TRUE;
IF paramCount > 2 THEN
BEGIN
ZeroToPas(params[3]^, str);
minimumValue := StrToNum(str);
IF minimumValue >= maximumValue THEN
minimumValue := maximumValue + 10;
IF paramCount > 3 THEN
BEGIN
ZeroToPas(params[4]^, str);
InitialValue := StrToNum(str);
END;{end of reading initial value}
END;{end of reading third parameter}
END;{end of reading second parameter}
END;{end of reading first parameter}
END;{with ParamPtr^}
IF SuppressDisplay THEN
ShowValue := FALSE;

IF InitialValue = -32767 THEN
GetMouse(spot){Get current loc of mouse}
ELSE
BEGIN{force initial value of bar without mousedown}
proportion := (InitialValue - minimumValue) * 1.0 / (maximumValue - minimumValue);
IF proportion < 0 THEN
proportion := 0;
IF proportion > 1.0 THEN
proportion := 1.0;
CASE direction OF
leftToRight :
spot.h := round(DrawRect.left + proportion * ButtonWidth);
rightToLeft :
spot.h := round(DrawRect.right - proportion * ButtonWidth);
bottomToTop :
spot.v := round(DrawRect.bottom - proportion * ButtonHeight);
topToBottom :
spot.v := round(DrawRect.top + proportion * ButtonHeight);
END;{end of case direction}
END;{end of forcing initial value}

CASE direction OF
leftToRight :
BEGIN
DrawRect.right := spot.h;
BlankRect.left := spot.h;
END;
rightToLeft :
BEGIN
DrawRect.left := spot.h;
BlankRect.right := spot.h;
END;
bottomToTop :
BEGIN
DrawRect.top := spot.v;
BlankRect.bottom := spot.v;
END;
topToBottom :
BEGIN
DrawRect.bottom := spot.v;
BlankRect.top := spot.v;
END;
END;{end of case direction}

IF ShowValue THEN{Set up stuff for ShowValue}
BEGIN
IF StringWidth(DePad(StringOf(maximumValue))) >= StringWidth(DePad(StringOf(minimumValue))) THEN
TextWidth := StringWidth(DePad(StringOf(maximumValue)))
ELSE
TextWidth := StringWidth(DePad(StringOf(minimumValue)));

GetFontInfo(theInfo);
TextHeight := theInfo.ascent;{numbers don't have descenders}

CASE direction OF
leftToRight, rightToLeft :
BEGIN
TextRect.top := ButtonRect.top + ButtonHeight DIV 2 - TextHeight DIV 2 - TextHeight DIV 4;
TextRect.left := ButtonRect.right + 1;
TextPoint.h := TextRect.left + TextHeight DIV 4;
TextRect.bottom := TextRect.top + TextHeight + TextHeight DIV 2;
TextPoint.v := TextRect.bottom - TextHeight DIV 4;
END;
bottomToTop, topToBottom :
BEGIN
TextRect.top := ButtonRect.bottom + 2;
TextPoint.h := ButtonRect.left + ButtonWidth DIV 2;
TextRect.left := TextPoint.h - TextWidth DIV 2 - TextHeight DIV 4;
TextRect.bottom := TextRect.top + TextHeight + TextHeight DIV 2 - 4;
TextPoint.v := TextRect.bottom - TextHeight DIV 4;
END;
END;
TextRect.right := TextRect.left + TextWidth + TextHeight DIV 2;
END;{end setting up ShowValue stuff}

oldspot := spot;
dummy := SectRect(ViewRect, DrawRect, DrawRect);
PaintRect(DrawRect);
dummy := SectRect(ViewRect, BlankRect, BlankRect);
EraseRect(BlankRect);
DrawRect := ViewRect;{now will be used for the redrawing}
InsetRect(ButtonRect, -10, -10);
IF InitialValue > -32767 THEN
BEGIN{Display forced starting value}
CurrentValue := InitialValue;
DisplayValue;
END
ELSE
BEGIN
ComputeValue;{Display first real value if requested}
REPEAT
GetMouse(spot);
InRect := PtInRect(spot, ButtonRect) AND Button;
IF InRect THEN
BEGIN
newLoc := TRUE;{guilty unless proven innocent}
CASE direction OF

leftToRight, rightToLeft :
BEGIN
IF spot.h = oldspot.h THEN{no horizontal movement; don't redraw at all}
newLoc := FALSE
ELSE
BEGIN
IF spot.h > oldspot.h THEN{moving right}
BEGIN
DrawRect.right := spot.h;
DrawRect.left := oldspot.h;
END
ELSE{moving left}
BEGIN
DrawRect.left := spot.h;
DrawRect.right := oldspot.h;
END;
END;{end new horizontal loc}
DrawRect.top := ViewRect.top;{restore top and bottom in case SectRect wiped them out with empty rect}
DrawRect.bottom := ViewRect.bottom;
END;{end horizontal case}

bottomToTop, topToBottom :
BEGIN
IF spot.v = oldspot.v THEN{no vertical movement; don't redraw at all}
newLoc := FALSE
ELSE
BEGIN
IF spot.v > oldspot.v THEN{moving down}
BEGIN
DrawRect.bottom := spot.v;
DrawRect.top := oldspot.v;
END
ELSE{moving up}
BEGIN
DrawRect.top := spot.v;
DrawRect.bottom := oldspot.v;
END;
END;{end new vertical loc}
DrawRect.left := ViewRect.left;{restore left and right in case SectRect wiped them out with empty rect}
DrawRect.right := ViewRect.right;
END;{end vertical case}
END;{case block}

dummy := SectRect(ViewRect, DrawRect, DrawRect);
IF newLoc THEN{Redraw if necessary}
BEGIN
InvertRect(DrawRect);
IF ShowValue THEN
ComputeValue;{Display current value if requested}
END;
oldspot := spot;{today becomes yesterday}
END;{end InRect}

UNTIL NOT Button;{loop until mouseUp}
ComputeValue;{Put result in "the Result" even if they don't want it displayed}
END;{end of event loop for real values}

str := NumToStr(CurrentValue);
paramPtr^.returnValue := PasToZero(str);
END;{end BarButton}

END.

-- part contents for card part 3
----- text -----
{BarButton adjusts the size of the bar contained in rect in variable "It",}
{and according to options in first 4 parameters.}

unit Main;

interface
 type
  XCmdPtr = ^XCmdBlock;
  XCmdBlock = record
    paramCount : INTEGER;
    params : array[1..16] of Handle;
    returnValue : Handle;
    passFlag : BOOLEAN;

    entryPoint : ProcPtr;    { to call back to HyperCard }
    request : INTEGER;
    result : INTEGER;
    inArgs : array[1..8] of LongInt;
    outArgs : array[1..4] of LongInt;
   end;

 procedure Main (ParamPtr : XCmdPtr);


implementation

{-------------------------------------------------------------------------------}
 procedure BarButton (ParamPtr : XCmdPtr);
 FORWARD;

 procedure Main;
 begin
  BarButton(ParamPtr);
 end;

 procedure BarButton;

  const
 { request codes for sending commands back to Hypercard}
   xreqEvalExpr = 2;
   xreqPasToZero = 7;
   xreqZeroToPas = 8;
   xreqStrToNum = 10;
   xreqNumToStr = 14;

{ four directions for the bar, as specified in first parameter }
   leftToRight = 1;
   rightToLeft = 2;
   bottomToTop = 3;
   topToBottom = 4;

  type
   Str19 = string[19];
   Str31 = string[31];

  var
   str : Str255;
   ButtonRect, DrawRect, BlankRect, ViewRect, TextRect : rect;
   InRect, newLoc, dummy, ShowValue, SuppressDisplay : boolean;
   spot, oldspot, TextPoint : point;
   direction, maximumValue, minimumValue, CurrentValue, InitialValue : integer;
   theInfo : FontInfo;
   TextHeight, TextWidth, ButtonHeight, ButtonWidth : integer;
   proportion : real;

{-------------------------------------------------------------------------------}
{ Jump subroutine to a procedure.   Pop address into A0, JSR (A0) }
  procedure DoJsr (addr : ProcPtr);
  inline
   $205F, $4E90;

{-------------------------------------------------------------------------------}
{Fill the Pascal string with the contents of the zero-terminated}
{   string.  You create the Pascal string and pass it in as a VAR }
{   parameter.  Useful for converting the arguments of any XCMD to }
{   Pascal strings.}

  procedure ZeroToPas (zeroStr : Ptr;
     var pasStr : Str255);
  begin
   with paramPtr^ do
    begin
     inArgs[1] := ORD(zeroStr);
     inArgs[2] := ORD(@pasStr);
     request := xreqZeroToPas;
     DoJsr(entryPoint);
    end;
  end;

{-------------------------------------------------------------------------------}
{  Convert a string of ASCII decimal digits to a signed long integer.}
{   Negative sign is allowed.  }

  function StrToNum (str : Str31) : LongInt;
  begin
   with paramPtr^ do
    begin
     inArgs[1] := ORD(@str);
     request := xreqStrToNum;
     DoJsr(entryPoint);
     StrToNum := outArgs[1];
    end;
  end;

{-------------------------------------------------------------------------------}
{  Convert a Pascal string to a zero-terminated string.  Returns a handle}
{   to a new zero-terminated string.  The caller must dispose the handle. }

  function PasToZero (str : Str255) : Handle;
  begin
   with paramPtr^ do
    begin
     inArgs[1] := ORD(@str);
     request := xreqPasToZero;
     DoJsr(entryPoint);
     PasToZero := Handle(outArgs[1]);
    end;
  end;

{-------------------------------------------------------------------------------}
{  Evaluate a HyperCard expression and return the answer.  The answer is}
{   a handle to a zero-terminated string. }

  function EvalExpr (expr : Str255) : Handle;
  begin
   with paramPtr^ do
    begin
     inArgs[1] := ORD(@expr);
     request := xreqEvalExpr;
     DoJsr(entryPoint);
     EvalExpr := Handle(outArgs[1]);
    end;
  end;

{-------------------------------------------------------------------------------}
{  Convert a signed long integer to a Pascal string.  }

  function NumToStr (num : LongInt) : Str31;
   var
    str : Str31;
  begin
   with paramPtr^ do
    begin
     inArgs[1] := num;
     inArgs[2] := ORD(@str);
     request := xreqNumToStr;
     DoJsr(entryPoint);
     NumToStr := str;
    end;
  end;

{-------------------------------------------------------------------------------}
{ Convert parameter string to 2-byte integer }

  function IntExpr (theString : str255) : integer;
   type
    Ptr31 = ^str31;
    Hand31 = ^Ptr31;

   var
    tempHand : handle;
    ShortStr : str31;
    NumLong : longint;
    LongStr : str255;

  begin
   tempHand := EvalExpr(theString);
   ZeroToPas(tempHand^, LongStr);
   ShortStr := LongStr;
   NumLong := StrToNum(ShortStr);
   IntExpr := loword(NumLong);
   DisposHandle(tempHand);
  end;

{-------------------------------------------------------------------------------}
{Remove spaces from string returned by Pascal's StringOf function}

  function DePad (str : str255) : str255;
   var
    c : integer;

  begin
   for c := length(str) downto 1 do
    if ord(str[c]) = 32 then
     Delete(str, c, 1);
   DePad := str;
  end;

{-------------------------------------------------------------------------------}
{Display the integer value of the bar within TextRect}

  procedure DisplayValue;
  begin
   if ShowValue then
    begin
     TextFont(systemfont);{Chicago}
     TextSize(12);
     str := Depad(StringOf(CurrentValue));
     case direction of
     leftToRight, rightToLeft :
     MoveTo(TextPoint.h, TextPoint.v);
     bottomToTop, topToBottom :
     MoveTo(TextPoint.h - StringWidth(str) div 2, TextPoint.v);
     end;
     EraseRect(TextRect);
     DrawString(str);
    end;
  end;{DisplayValue}

{-------------------------------------------------------------------------------}
{Compute the current value of the current position of the Bar}

  procedure ComputeValue;

  begin
   with ViewRect do
    case direction of
     leftToRight :
     proportion := (oldspot.h - left) * 1.0 / (right - left);
     rightToLeft :
     proportion := (right - oldspot.h) * 1.0 / (right - left);
     bottomToTop :
     proportion := (bottom - oldspot.v) * 1.0 / (bottom - top);
     topToBottom :
     proportion := (oldspot.v - top) * 1.0 / (bottom - top);
    end;

   if proportion < 0 then
    proportion := 0;
   if proportion > 1.0 then
    proportion := 1.0;

   CurrentValue := round(proportion * (maximumValue - minimumValue) + minimumValue);
   DisplayValue;
  end;{ComputeValue}

{-------------------------------------------------------------------------------}
{This is the main BarButton routine.  First look up the rect passed in the first}
{four items of Hypercard's "It" variable.  }

 begin
  ButtonRect.left := IntExpr('item 1 of It');
  ButtonRect.top := IntExpr('item 2 of It');
  ButtonRect.right := IntExpr('item 3 of It');
  ButtonRect.bottom := IntExpr('item 4 of It');
  ButtonHeight := ButtonRect.bottom - ButtonRect.top;
  ButtonWidth := ButtonRect.right - ButtonRect.left;

{Set up two more rects; one will be filled with black, the other erased.}
  ViewRect := ButtonRect;
  InsetRect(ViewRect, 1, 1);
  DrawRect := ViewRect;
  BlankRect := DrawRect;

  with ButtonRect do
   if right - left > bottom - top then
    direction := leftToRight
   else
    direction := bottomToTop;

{Set the default values, and read each parameter for new values.}
  maximumValue := 100;
  minimumValue := 0;
  ShowValue := FALSE;
  SuppressDisplay := FALSE;
  InitialValue := -32767;{Hopefully no one will actually use that value!}

  with ParamPtr^ do
   begin
    if paramCount > 0 then
     begin
     ZeroToPas(params[1]^, str);
     direction := StrToNum(str);
     if (direction >= -4) and (direction <= -1) then
     begin
     SuppressDisplay := TRUE;
     direction := -direction;
     end;
     if (direction < 1) or (direction > 4) then
     direction := leftToRight;
     if paramCount > 1 then
     begin
     ZeroToPas(params[2]^, str);
     maximumValue := StrToNum(str);
     ShowValue := TRUE;
     if paramCount > 2 then
     begin
     ZeroToPas(params[3]^, str);
     minimumValue := StrToNum(str);
     if minimumValue >= maximumValue then
     minimumValue := maximumValue + 10;
     if paramCount > 3 then
     begin
     ZeroToPas(params[4]^, str);
     InitialValue := StrToNum(str);
     end;{end of reading fourth parameter = initial value}
     end;{end of reading third parameter = minimum value}
     end;{end of reading second parameter = maximum value}
     end;{end of reading first parameter = direction of bar}
   end;{with ParamPtr^}
  if SuppressDisplay then{if first parameter < 0, suppress display of numeric value}
   ShowValue := FALSE;

  if InitialValue = -32767 then
   GetMouse(spot){Get current loc of mouse if no initial value specified}
  else
   begin{force initial value of bar without mousedown}
    proportion := (InitialValue - minimumValue) * 1.0 / (maximumValue - minimumValue);
    if proportion < 0 then
     proportion := 0;
    if proportion > 1.0 then
     proportion := 1.0;
    case direction of
     leftToRight :
     spot.h := round(DrawRect.left + proportion * ButtonWidth);
     rightToLeft :
     spot.h := round(DrawRect.right - proportion * ButtonWidth);
     bottomToTop :
     spot.v := round(DrawRect.bottom - proportion * ButtonHeight);
     topToBottom :
     spot.v := round(DrawRect.top + proportion * ButtonHeight);
    end;{end of case direction}
   end;{end of forcing initial value}

  case direction of{compute size of bar regardless}
   leftToRight :
    begin
     DrawRect.right := spot.h;
     BlankRect.left := spot.h;
    end;
   rightToLeft :
    begin
     DrawRect.left := spot.h;
     BlankRect.right := spot.h;
    end;
   bottomToTop :
    begin
     DrawRect.top := spot.v;
     BlankRect.bottom := spot.v;
    end;
   topToBottom :
    begin
     DrawRect.bottom := spot.v;
     BlankRect.top := spot.v;
    end;
  end;{end of case direction}

  if ShowValue then{Set up stuff for ShowValue}
   begin
    if StringWidth(DePad(StringOf(maximumValue))) >= StringWidth(DePad(StringOf(minimumValue))) then
     TextWidth := StringWidth(DePad(StringOf(maximumValue)))
    else
     TextWidth := StringWidth(DePad(StringOf(minimumValue)));

    GetFontInfo(theInfo);
    TextHeight := theInfo.ascent;{numbers don't have descenders}

    case direction of
     leftToRight, rightToLeft :
     begin
     TextRect.top := ButtonRect.top + ButtonHeight div 2 - TextHeight div 2 - TextHeight div 4 + 2;
     TextRect.left := ButtonRect.right + 1;
     TextPoint.h := TextRect.left + TextHeight div 4;
     TextRect.bottom := TextRect.top + TextHeight + TextHeight div 2 - 2;
     TextPoint.v := TextRect.bottom - TextHeight div 4;
     end;
     bottomToTop, topToBottom :
     begin
     TextRect.top := ButtonRect.bottom + 2;
     TextPoint.h := ButtonRect.left + ButtonWidth div 2;
     TextRect.left := TextPoint.h - TextWidth div 2 - TextHeight div 4;
     TextRect.bottom := TextRect.top + TextHeight + TextHeight div 2 - 4;
     TextPoint.v := TextRect.bottom - TextHeight div 4;
     end;
    end;
    TextRect.right := TextRect.left + TextWidth + TextHeight div 2;
   end;{end setting up ShowValue stuff}

  oldspot := spot;
  dummy := SectRect(ViewRect, DrawRect, DrawRect);
  PaintRect(DrawRect);
  dummy := SectRect(ViewRect, BlankRect, BlankRect);
  EraseRect(BlankRect);
  DrawRect := ViewRect;{now will be used for the redrawing}
  InsetRect(ButtonRect, -10, -10);{allow user to miss rect by 10 pixels}
  if InitialValue > -32767 then{force initial value}
   begin{Display forced starting value}
    CurrentValue := InitialValue;
    DisplayValue;
   end
  else
   begin
    ComputeValue;{Display first real value if requested}
    repeat
     GetMouse(spot);{Get current position of mouse}
     InRect := PtInRect(spot, ButtonRect) and Button;
     if InRect then
     begin
     newLoc := TRUE;{guilty unless proven innocent}
     case direction of

     leftToRight, rightToLeft :
     begin
     if spot.h = oldspot.h then{no horizontal movement; don't redraw at all}
     newLoc := FALSE
     else
     begin
     if spot.h > oldspot.h then{moving right}
     begin
     DrawRect.right := spot.h;
     DrawRect.left := oldspot.h;
     end
     else{moving left}
     begin
     DrawRect.left := spot.h;
     DrawRect.right := oldspot.h;
     end;
     end;{end new horizontal loc}
     DrawRect.top := ViewRect.top;{restore top and bottom in case SectRect wiped them out with empty rect}
     DrawRect.bottom := ViewRect.bottom;
     end;{end horizontal case}

     bottomToTop, topToBottom :
     begin
     if spot.v = oldspot.v then{no vertical movement; don't redraw at all}
     newLoc := FALSE
     else
     begin
     if spot.v > oldspot.v then{moving down}
     begin
     DrawRect.bottom := spot.v;
     DrawRect.top := oldspot.v;
     end
     else{moving up}
     begin
     DrawRect.top := spot.v;
     DrawRect.bottom := oldspot.v;
     end;
     end;{end new vertical loc}
     DrawRect.left := ViewRect.left;{restore left and right in case SectRect wiped them out with empty rect}
     DrawRect.right := ViewRect.right;
     end;{end vertical case}
     end;{case block}

     dummy := SectRect(ViewRect, DrawRect, DrawRect);
     if newLoc then{Redraw if necessary}
     begin
     InvertRect(DrawRect);{Invert only the change in position}
     if ShowValue then
     ComputeValue;{Display current value if requested}
     end;
     oldspot := spot;{today becomes yesterday}
     end;{end InRect}

    until not Button;{loop until mouseUp}
    ComputeValue;{Put result in "the Result" even if they don't want it displayed}
   end;{end of event loop for real values}

  str := NumToStr(CurrentValue);{convert last value to string}
  paramPtr^.returnValue := PasToZero(str);{put string in "the result"}
 end;{end BarButton}

end.

-- part contents for card part 5
----- text -----
VESTIGIAL CARD: This is the complete text of the Lightspeed Pascal source of the BarButton XCMD.  If you want to recompile with modifications, be sure the files DA PasLib and MacTraps are in the Project, and then "Build and Save As" a Code resource of type 'XCMD'.  Then ResEdit the XCMD into your stack.