Macintosh-SW
/
Glider4
mirror of https://github.com/softdorothy/Glider4.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
Glider4/RoomEditor_103/Sources/E-Utilities.p

1 line
28 KiB
OpenEdge ABL
Executable File
Raw Blame History

unit Utilities;
interface
uses
Palettes, Globals;
procedure SpinBall;
function SameScreenDepth: Boolean;
function DoRandom (range: Integer): Integer;
procedure UpdateMenuItems (whatMode: Integer);
procedure Select;
procedure Deselect;
procedure DoMarquee;
procedure GenericAlert (whatGives: Integer);
function ErrorCheckObject (var wasObject: objectData; var errorType: Integer): Boolean;
procedure DoCustomizeKeys;
function idleFilter (theDialog: DialogPtr; var theEvent: EventRecord; var itemHit: integer): boolean;
procedure DoAbout;
{=================================}
implementation
{=================================}
var
screenNum: Integer;
timeWas: LongInt;
{=================================}
procedure SpinBall;
var
tempByte: SignedByte;
begin
if (ballList = nil) then
Exit(SpinBall);
tempByte := HGetState(Handle(ballList));
HLock(Handle(ballList));
with ballList^^ do
begin
if (whichBall = -1) then
Exit(SpinBall);
if (whichBall >= kCursCount) then
whichBall := 1
else
whichBall := whichBall + 1;
if (useColorCursor) then
SetCCursor(ballC[whichBall])
else
SetCursor(ball[whichBall]^^);
end;
HSetState(Handle(ballList), tempByte);
end;
{=================================}
function SameScreenDepth;
var
err: OSErr;
thisWorld: SysEnvRec;
theDevice: GDHandle;
begin
SameScreenDepth := TRUE;
err := SysEnvirons(1, thisWorld);
with thisWorld do
begin
if (hasColorQD) then
begin
theDevice := GetMainDevice;
HLock(Handle(theDevice));
if ((inColor) and (theDevice^^.gdPMap^^.pixelSize <> 4)) then
SameScreenDepth := FALSE
else if ((not inColor) and (theDevice^^.gdPMap^^.pixelSize <> 1)) then
SameScreenDepth := FALSE;
HUnlock(Handle(theDevice));
end; {end - hasColorQD}
end; {with thisWorld}
end;
{=================================}
function DoRandom;
var
rawResult: LongInt;
begin
rawResult := ABS(Random);
DoRandom := (rawResult * range) div 32768;
end;
{=================================}
procedure UpdateMenuItems;
begin
case whatMode of
editToObject:
begin
SetItem(GetMenu(mEdit), iCut, 'Cut Object');
SetItem(GetMenu(mEdit), iCopy, 'Copy Object');
SetItem(GetMenu(mEdit), iPaste, 'Paste Object');
DisableItem(GetMenu(mEdit), iPaste);
SetItem(GetMenu(mEdit), iClear, 'Clear Object');
editRoom := FALSE;
if (objectScrapDirty) then
EnableItem(GetMenu(mEdit), iPaste)
else if (roomScrapDirty) then
begin
SetItem(GetMenu(mEdit), iPaste, 'Paste Room');
EnableItem(GetMenu(mEdit), iPaste);
end;
end;
editToRoom:
begin
SetItem(GetMenu(mEdit), iCut, 'Cut Room');
SetItem(GetMenu(mEdit), iCopy, 'Copy Room');
SetItem(GetMenu(mEdit), iPaste, 'Paste Room');
DisableItem(GetMenu(mEdit), iPaste);
SetItem(GetMenu(mEdit), iClear, 'Clear Room');
editRoom := TRUE;
if (roomScrapDirty) then
EnableItem(GetMenu(mEdit), iPaste)
else if (objectScrapDirty) then
begin
SetItem(GetMenu(mEdit), iPaste, 'Paste Object');
EnableItem(GetMenu(mEdit), iPaste);
end;
end;
fileExists:
begin
DisableItem(GetMenu(mFile), iNew);
DisableItem(GetMenu(mFile), iOpen);
EnableItem(GetMenu(mFile), iClose);
EnableItem(GetMenu(mFile), iSave);
EnableItem(GetMenu(mFile), iSaveAs);
EnableItem(GetMenu(mEdit), iCut);
EnableItem(GetMenu(mEdit), iCopy);
EnableItem(GetMenu(mEdit), iClear);
if (roomScrapDirty) then
EnableItem(GetMenu(mEdit), iPaste)
else if (objectScrapDirty) then
begin
SetItem(GetMenu(mEdit), iPaste, 'Paste Object');
EnableItem(GetMenu(mEdit), iPaste);
end;
EnableItem(GetMenu(mSpecial), iTryGlider);
EnableItem(GetMenu(mSpecial), iGoToRoom);
EnableItem(GetMenu(mSpecial), iPrevRoom);
EnableItem(GetMenu(mSpecial), iNextRoom);
EnableItem(GetMenu(mSpecial), iNewRoom);
EnableItem(GetMenu(mWindows), iTools);
EnableItem(GetMenu(mWindows), iHouse);
EnableItem(GetMenu(mWindows), iRoomBack);
EnableItem(GetMenu(mWindows), iRoomCond);
DisableItem(GetMenu(mWindows), iObject);
end;
fileIsNew:
begin
DisableItem(GetMenu(mFile), iNew);
DisableItem(GetMenu(mFile), iOpen);
EnableItem(GetMenu(mFile), iClose);
DisableItem(GetMenu(mFile), iSave);
EnableItem(GetMenu(mFile), iSaveAs);
EnableItem(GetMenu(mEdit), iCut);
EnableItem(GetMenu(mEdit), iCopy);
EnableItem(GetMenu(mEdit), iClear);
if (roomScrapDirty) then
EnableItem(GetMenu(mEdit), iPaste)
else if (objectScrapDirty) then
begin
SetItem(GetMenu(mEdit), iPaste, 'Paste Object');
EnableItem(GetMenu(mEdit), iPaste);
end;
EnableItem(GetMenu(mSpecial), iTryGlider);
EnableItem(GetMenu(mSpecial), iGoToRoom);
EnableItem(GetMenu(mSpecial), iPrevRoom);
EnableItem(GetMenu(mSpecial), iNextRoom);
EnableItem(GetMenu(mSpecial), iNewRoom);
EnableItem(GetMenu(mWindows), iTools);
EnableItem(GetMenu(mWindows), iHouse);
EnableItem(GetMenu(mWindows), iRoomBack);
EnableItem(GetMenu(mWindows), iRoomCond);
DisableItem(GetMenu(mWindows), iObject);
end;
noFileOpen:
begin
EnableItem(GetMenu(mFile), iNew);
EnableItem(GetMenu(mFile), iOpen);
DisableItem(GetMenu(mFile), iClose);
DisableItem(GetMenu(mFile), iSave);
DisableItem(GetMenu(mFile), iSaveAs);
DisableItem(GetMenu(mEdit), iCut);
DisableItem(GetMenu(mEdit), iCopy);
DisableItem(GetMenu(mEdit), iPaste);
DisableItem(GetMenu(mEdit), iClear);
DisableItem(GetMenu(mSpecial), iTryGlider);
DisableItem(GetMenu(mSpecial), iGoToRoom);
DisableItem(GetMenu(mSpecial), iPrevRoom);
DisableItem(GetMenu(mSpecial), iNextRoom);
DisableItem(GetMenu(mSpecial), iNewRoom);
DisableItem(GetMenu(mWindows), iTools);
DisableItem(GetMenu(mWindows), iHouse);
DisableItem(GetMenu(mWindows), iRoomBack);
DisableItem(GetMenu(mWindows), iRoomCond);
DisableItem(GetMenu(mWindows), iObject);
end;
otherwise
;
end;
end;
{=================================}
procedure Select;
begin
if (oneActive = 0) then
begin
DisableItem(GetMenu(mWindows), iObject);
Exit(Select);
end;
EnableItem(GetMenu(mWindows), iObject);
SetPort(GrafPtr(mainWndo));
ClipRect(wholeArea);
PenNormal;
PenMode(patXOr);
PenPat(marqueePat[4]); {Initial set-up pattern for marquee}
FrameRect(thisRoom.theObjects[oneActive].boundRect);
marqueeIndex := 0; {Start marquee pats at pat 1}
marqueeTime := TRUE;
with thisRoom.theObjects[oneActive] do
begin
case (objectIs) of {Pop the handle out}
table, shelf:
begin
SetPt(startPt, boundRect.right, (boundRect.top + boundRect.bottom) div 2);
SetPt(endPt, boundRect.right + 4, (boundRect.top + boundRect.bottom) div 2);
end;
cabnet, extRct, obsRct, bnsRct, window, mirror:
begin
SetPt(startPt, boundRect.right, boundRect.bottom);
SetPt(endPt, boundRect.right + 4, boundRect.bottom + 4);
end;
flrVnt, candle, ball, fshBwl, toastr:
begin
SetPt(startPt, (boundRect.left + boundRect.right) div 2, boundRect.top - 1);
SetPt(endPt, (boundRect.left + boundRect.right) div 2, amount);
end;
celVnt, celDct, drip:
begin
SetPt(startPt, (boundRect.left + boundRect.right) div 2, boundRect.bottom + 1);
SetPt(endPt, (boundRect.left + boundRect.right) div 2, amount);
end;
lftFan:
begin
SetPt(startPt, boundRect.left - 1, (boundRect.top + boundRect.bottom) div 2);
SetPt(endPt, amount, (boundRect.top + boundRect.bottom) div 2);
end;
ritFan, grease:
begin
SetPt(startPt, boundRect.right + 1, (boundRect.top + boundRect.bottom) div 2);
SetPt(endPt, amount, (boundRect.top + boundRect.bottom) div 2);
end;
otherwise
begin
SetPt(startPt, -500, -500);
SetPt(endPt, -499, -499);
end;
end; {End of case}
end; {End of with}
SetRect(handleRect, endPt.h - 3, endPt.v - 3, endPt.h + 3, endPt.v + 3);
MoveTo(startPt.h, startPt.v);
LineTo(endPt.h, endPt.v);
PaintRect(handleRect);
PenNormal;
if (toolWndo <> nil) then
SetPort(toolWndo);
end;
{=================================}
procedure Deselect;
begin
DisableItem(GetMenu(mWindows), iObject);
if (oneActive = 0) then
begin
Exit(Deselect);
end;
repeat
DoMarquee;
until (marqueeIndex = 0);
SetPort(GrafPtr(mainWndo));
PenMode(patXOr);
PenPat(marqueePat[4]);
FrameRect(thisRoom.theObjects[oneActive].boundRect);
MoveTo(startPt.h, startPt.v);
LineTo(endPt.h, endPt.v);
PaintRect(handleRect);
PenNormal;
oneActive := 0;
handleRect := nullRect;
if (toolWndo <> nil) then
SetPort(toolWndo);
marqueeTime := FALSE;
end;
{=================================}
procedure DoMarquee;
var
dummyLong: LongInt;
begin
Delay(2, dummyLong);
SetPort(GrafPtr(mainWndo));
PenNormal;
PenMode(patXOr);
PenPat(marqueePat[marqueeIndex]);
FrameRect(thisRoom.theObjects[oneActive].boundRect);
MoveTo(startPt.h, startPt.v);
LineTo(endPt.h, endPt.v);
PaintRect(handleRect);
marqueeIndex := marqueeIndex + 1;
if (marqueeIndex > 3) then
marqueeIndex := 0;
if (toolWndo <> nil) then
SetPort(toolWndo);
end;
{=================================}
procedure GenericAlert;
var
dummyInt: Integer;
line1, line2: Str255;
alertHandle: AlertTHndl;
alertRect: Rect;
begin
UseResFile(editorResNum);
InitCursor;
if (whatGives > 0) then
begin
GetIndString(line1, alertStrIDs, whatGives);
line2 := '';
end
else
begin
GetIndString(line1, alertStrIDs, 1);
NumToString(whatGives, line2);
line2 := CONCAT('Error = ', line2);
end;
ParamText(line1, line2, '', '');
alertHandle := AlertTHndl(Get1Resource('ALRT', alertID));
if (alertHandle <> nil) then
begin
HNoPurge(Handle(alertHandle));
alertRect := alertHandle^^.boundsRect;
OffsetRect(alertRect, -alertRect.left, -alertRect.top);
dummyInt := (screenBits.bounds.right - alertRect.right) div 2;
OffsetRect(alertRect, dummyInt, 0);
dummyInt := (screenBits.bounds.bottom - alertRect.bottom) div 3;
OffsetRect(alertRect, 0, dummyInt);
alertHandle^^.boundsRect := alertRect;
HPurge(Handle(alertHandle));
end;
dummyInt := Alert(alertID, nil);
end;
{=================================}
function ErrorCheckObject;
const
noError = 0;
kindError = 1;
boundError = 2;
amountError = 3;
extraError = 4;
isOnError = 5;
var
inError: Boolean;
{-----------------}
procedure ShiftOrSet (var valueIs, otherValue: Integer; valueShould, objectType: Integer; upDown: Boolean);
begin
case objectType of {these objects are just set}
table, shelf:
if (upDown) then
otherValue := otherValue + (valueShould - valueIs);
cabnet, extRct, obsRct, bnsRct, window, mirror:
;
otherwise {other objects are offset}
otherValue := otherValue + (valueShould - valueIs);
end;
valueIs := valueShould;
end;
{-----------------}
begin
inError := FALSE;
errorType := noError;
with wasObject do
begin
case objectIs of
nulObj..obsRct, flrVnt..ritFan, clock..rbrBnd:
;
litSwt..guitar, drip..window, paintg..dnStar:
;
otherwise
begin
objectIs := 0;
inError := TRUE;
errorType := kindError;
end;
end; {case - objectIs}
with boundRect do
begin
if (left < 0) then
begin
ShiftOrSet(left, right, 0, objectIs, FALSE);
inError := TRUE;
errorType := boundError;
end;
if (left > (512 - 16)) then
begin
ShiftOrSet(left, right, 512 - 16, objectIs, FALSE);
inError := TRUE;
errorType := boundError;
end;
if (right > 512) then
begin
ShiftOrSet(right, left, 512, objectIs, FALSE);
inError := TRUE;
errorType := boundError;
end;
if (right < 16) then
begin
ShiftOrSet(right, left, 16, objectIs, FALSE);
inError := TRUE;
errorType := boundError;
end;
if (top < 0) then
begin
ShiftOrSet(top, bottom, 0, objectIs, TRUE);
inError := TRUE;
errorType := boundError;
end;
if (top > (342 - 16)) then
begin
ShiftOrSet(top, bottom, 342 - 16, objectIs, TRUE);
inError := TRUE;
errorType := boundError;
end;
if (bottom > 342) then
begin
ShiftOrSet(bottom, top, 342, objectIs, TRUE);
inError := TRUE;
errorType := boundError;
end;
if (bottom < 16) then
begin
ShiftOrSet(bottom, top, 16, objectIs, TRUE);
inError := TRUE;
errorType := boundError;
end;
end; {end - with boundRect}
case objectIs of
extRct, upStar, dnStar:
if ((amount < 1) or (amount > 80)) then {room link must be 1..80}
begin
amount := roomAt;
inError := TRUE;
errorType := amountError;
end;
pwrSwt:
if ((amount < 0) or (amount > 16)) then {object link must be 0..16}
begin
amount := 0;
inError := TRUE;
errorType := amountError;
end;
flrVnt, candle, toastr, ball, fshBwl: {air etc. column not too high}
if ((amount < ceilingVert + 10) or (amount > boundRect.top)) then
begin
amount := ceilingVert + 10;
inError := TRUE;
errorType := amountError;
end;
celVnt, celDct, drip: {air etc. column not too low}
if ((amount < boundRect.bottom) or (amount > floorVert)) then
begin
amount := floorVert;
inError := TRUE;
errorType := amountError;
end;
lftFan: {air column not too left}
if ((amount < 0) or (amount > boundRect.left)) then
begin
amount := 0;
inError := TRUE;
errorType := amountError;
end;
ritFan, grease: {air etc. column not too right}
if ((amount < boundRect.right) or (amount > 512)) then
begin
amount := 512;
inError := TRUE;
errorType := amountError;
end;
clock, paper, bnsRct: {points not too high or neg.}
if ((amount < 0) or (amount > 10000)) then
begin
amount := 1000;
inError := TRUE;
errorType := amountError;
end;
battry, rbrBnd: {things not too high or neg.}
if ((amount < 0) or (amount > 100)) then
begin
amount := 20;
inError := TRUE;
errorType := amountError;
end;
outlet, teaKtl: {delay not too high or neg.}
if ((amount < 0) or (amount > 600)) then
begin
amount := 30;
inError := TRUE;
errorType := amountError;
end;
otherwise
end; {case - objectIs}
case objectIs of
celDct: {room must be 1..80}
if ((extra < 1) or (extra > 80)) then
begin
extra := roomAt;
inError := TRUE;
errorType := extraError;
end;
drip, fshBwl:
if ((extra < 0) or (extra > 600)) then
begin
extra := 30;
inError := TRUE;
errorType := extraError;
end;
end; {case - objectIs}
end; {end - with wasObject}
ErrorCheckObject := inError;
end;
{=================================}
procedure DoCustomizeKeys;
const
okayItem = 1;
cancelItem = 2;
leftIcon = 3;
rightIcon = 4;
energyIcon = 5;
bandIcon = 6;
leftStat = 7;
rightStat = 8;
energyStat = 9;
bandStat = 10;
modeStat = 11;
energyRadio = 12;
bandRadio = 13;
type
string12 = string[12];
var
wasPort: GrafPtr;
itemT, itemHit, i, rawKey, rawChar: Integer;
newLeftKey, newRightKey, newEnergyKey, newBandKey: Integer;
theState, tempLong: LongInt;
tempStr: Str255;
itemH, keyHandle: Handle;
theDlgPtr: DialogPtr;
tempRect: Rect;
newLeftName, newRightName, newEnergyName, newBandName: string[12];
leaveDlg, newButtonFires: Boolean;
{------------------}
procedure RefreshIt;
begin
SetPort(theDlgPtr);
GetDItem(theDlgPtr, okayItem, itemT, itemH, tempRect);{Get the item handle}
PenSize(3, 3); {Change pen to draw thick default outline}
InsetRect(tempRect, -4, -4); {Draw outside the button by 1 pixel}
FrameRoundRect(tempRect, 16, 16); {Draw the outline}
PenNormal;
end;
{------------------}
function ShowKeyName (rawKeyCode, rawCharCode: Integer): string12;
begin
if ((rawCharCode >= $21) and (rawCharCode <= $7A)) then
begin
if ((rawKeyCode >= $41) and (rawKeyCode <= $5C)) then
tempStr := CONCAT(CHR(rawCharCode), ' keypad')
else
tempStr := CONCAT(CHR(rawCharCode), ' key');
end
else
case rawCharCode of
$01:
tempStr := 'home';
$03:
tempStr := 'enter';
$04:
tempStr := 'end';
$05:
tempStr := 'help';
$08:
tempStr := 'delete';
$09:
tempStr := 'tab';
$0B:
tempStr := 'page up';
$0C:
tempStr := 'page down';
$0D:
tempStr := 'return';
$10:
case rawKeyCode of
$60:
tempStr := 'F5 key';
$61:
tempStr := 'F6 key';
$62:
tempStr := 'F7 key';
$63:
tempStr := 'F3 key';
$64:
tempStr := 'F8 key';
$65:
tempStr := 'F9 key';
$67:
tempStr := 'F11 key';
$69:
tempStr := 'F13 key';
$6B:
tempStr := 'F14 key';
$6D:
tempStr := 'F10 key';
$6F:
tempStr := 'F12 key';
$71:
tempStr := 'F15 key';
$76:
tempStr := 'F4 key';
$78:
tempStr := 'F2 key';
$7A:
tempStr := 'F1 key';
otherwise
NumToString(rawKeyCode, tempStr);
end;
$1A:
tempStr := 'clear';
$1B:
if (rawKeyCode = $47) then
tempStr := 'clear'
else
tempStr := 'escape';
$1C:
tempStr := 'left arrow';
$1D:
tempStr := 'right arrow';
$1E:
tempStr := 'up arrow';
$1F:
tempStr := 'down arrow';
$20:
tempStr := 'space';
$7F:
tempStr := 'del key';
otherwise
tempStr := 'unknown';
end;
ShowKeyName := tempStr;
end;
{------------------}
begin
FlushEvents(EveryEvent, 0);
GetPort(wasPort);
UseResFile(editorResNum);
theDlgPtr := GetNewDialog(rCustomKeysID, nil, Pointer(-1));
tempRect := theDlgPtr^.portRect;
tempRect.Top := ((screenBits.Bounds.Bottom - screenBits.Bounds.Top) - (tempRect.Bottom - tempRect.Top)) div 2;
tempRect.Left := ((screenBits.Bounds.Right - screenBits.Bounds.Left) - (tempRect.Right - tempRect.Left)) div 2;
MoveWindow(theDlgPtr, tempRect.Left, tempRect.Top, TRUE);{Now move the window to the proper position}
ShowWindow(theDlgPtr);
SelectWindow(theDlgPtr);
SetPort(theDlgPtr);
newLeftKey := leftKey;
newRightKey := rightKey;
newEnergyKey := energyKey;
newBandKey := bandKey;
newButtonFires := buttonFires;
newLeftName := leftName;
newRightName := rightName;
newEnergyName := energyName;
newBandName := bandName;
GetDItem(theDlgPtr, leftStat, itemT, itemH, tempRect);
SetIText(itemH, newLeftName);
GetDItem(theDlgPtr, rightStat, itemT, itemH, tempRect);
SetIText(itemH, newRightName);
GetDItem(theDlgPtr, energyStat, itemT, itemH, tempRect);
SetIText(itemH, newEnergyName);
GetDItem(theDlgPtr, bandStat, itemT, itemH, tempRect);
SetIText(itemH, newBandName);
if (newButtonFires) then
GetDItem(theDlgPtr, bandRadio, itemT, itemH, tempRect)
else
GetDItem(theDlgPtr, energyRadio, itemT, itemH, tempRect);
SetCtlValue(ControlHandle(itemH), 1);
RefreshIt;
leaveDlg := FALSE;
repeat
ModalDialog(nil, itemHit);
GetDItem(theDlgPtr, itemHit, itemT, itemH, tempRect);
if ((itemHit >= leftIcon) and (itemHit <= bandIcon)) then
begin
GetDItem(theDlgPtr, itemHit, itemT, itemH, tempRect);
InvertRect(tempRect);
GetDItem(theDlgPtr, modeStat, itemT, itemH, tempRect);
SetIText(itemH, 'The next key you strike will control this function.');
InvertRect(tempRect);
repeat
until not Button;
FlushEvents(everyEvent, 0);
repeat
until GetNextEvent(keyDownMask, theEvent);
rawKey := LoWord(BitAnd(KeyCodeMask, theEvent.message) div $FF);
rawChar := LoWord(BitAnd(CharCodeMask, theEvent.message));
FlushEvents(everyEvent, 0);
InvertRect(tempRect);
GetDItem(theDlgPtr, itemHit, itemT, itemH, tempRect);
InvertRect(tempRect);
tempStr := ShowKeyName(rawKey, rawChar);
GetDItem(theDlgPtr, itemHit + 4, itemT, itemH, tempRect);
SetIText(itemH, tempStr);
if (tempStr = 'tab') then
begin
SysBeep(3);
GetDItem(theDlgPtr, modeStat, itemT, itemH, tempRect);
SetIText(itemH, 'The TAB key is reserved for pausing Glider.');
Delay(180, tempLong);
case itemHit of
leftIcon:
tempStr := newLeftName;
rightIcon:
tempStr := newRightName;
energyIcon:
tempStr := newEnergyName;
otherwise
tempStr := newBandName;
end;
GetDItem(theDlgPtr, itemHit + 4, itemT, itemH, tempRect);
SetIText(itemH, tempStr);
end
else
case itemHit of
leftIcon:
begin
newLeftKey := rawKey;
newLeftName := COPY(tempStr, 1, 12);
end;
rightIcon:
begin
newRightKey := rawKey;
newRightName := COPY(tempStr, 1, 12);
end;
energyIcon:
begin
newEnergyKey := rawKey;
newEnergyName := COPY(tempStr, 1, 12);
end;
otherwise
begin
newBandKey := rawKey;
newBandName := COPY(tempStr, 1, 12);
end;
end;
GetDItem(theDlgPtr, modeStat, itemT, itemH, tempRect);
SetIText(itemH, 'Click on an icon to change its controlling key.');
end;
if (itemHit = energyRadio) then
begin
newButtonFires := FALSE;
GetDItem(theDlgPtr, energyRadio, itemT, itemH, tempRect);
SetCtlValue(ControlHandle(itemH), 1);
GetDItem(theDlgPtr, bandRadio, itemT, itemH, tempRect);
SetCtlValue(ControlHandle(itemH), 0);
end;
if (itemHit = bandRadio) then
begin
newButtonFires := TRUE;
GetDItem(theDlgPtr, bandRadio, itemT, itemH, tempRect);
SetCtlValue(ControlHandle(itemH), 1);
GetDItem(theDlgPtr, energyRadio, itemT, itemH, tempRect);
SetCtlValue(ControlHandle(itemH), 0);
end;
if (itemHit = okayItem) then
begin
leaveDlg := TRUE;
if ((newLeftKey = newRightKey) or (newLeftKey = newEnergyKey) or (newLeftKey = newBandKey)) then
begin
SysBeep(3);
newLeftKey := leftKey;
newLeftName := leftName;
GetDItem(theDlgPtr, leftStat, itemT, itemH, tempRect);
SetIText(itemH, newLeftName);
GetDItem(theDlgPtr, modeStat, itemT, itemH, tempRect);
SetIText(itemH, 'Your Left Key has been assigned to another function.');
Delay(180, tempLong);
GetDItem(theDlgPtr, modeStat, itemT, itemH, tempRect);
SetIText(itemH, 'Click on an icon to change its controlling key.');
leaveDlg := FALSE;
end;
if ((newRightKey = newEnergyKey) or (newRightKey = newBandKey)) then
begin
SysBeep(3);
newRightKey := rightKey;
newRightName := rightName;
GetDItem(theDlgPtr, rightStat, itemT, itemH, tempRect);
SetIText(itemH, newRightName);
GetDItem(theDlgPtr, modeStat, itemT, itemH, tempRect);
SetIText(itemH, 'Your Right Key has been assigned to another function.');
Delay(180, tempLong);
GetDItem(theDlgPtr, modeStat, itemT, itemH, tempRect);
SetIText(itemH, 'Click on an icon to change its controlling key.');
leaveDlg := FALSE;
end;
if (newEnergyKey = newBandKey) then
begin
SysBeep(3);
newEnergyKey := energyKey;
newEnergyName := energyName;
GetDItem(theDlgPtr, energyStat, itemT, itemH, tempRect);
SetIText(itemH, newEnergyName);
GetDItem(theDlgPtr, modeStat, itemT, itemH, tempRect);
SetIText(itemH, 'Your Energize Key has been assigned to another function.');
Delay(180, tempLong);
GetDItem(theDlgPtr, modeStat, itemT, itemH, tempRect);
SetIText(itemH, 'Click on an icon to change its controlling key.');
leaveDlg := FALSE;
end;
if (leaveDlg) then
begin
leftKey := newLeftKey;
rightKey := newRightKey;
energyKey := newEnergyKey;
bandKey := newBandKey;
buttonFires := newButtonFires;
leftName := newLeftName;
rightName := newRightName;
energyName := newEnergyName;
bandName := newBandName;
end;
end;
if (ItemHit = cancelItem) then
leaveDlg := TRUE;
until leaveDlg;
SetPort(GrafPtr(wasPort));
DisposDialog(theDlgPtr);
end;
{=================================}
function idleFilter;
var
iconNum, iType: Integer;
timeIs: LongInt;
tempRect: Rect;
iHand, icnHand: Handle;
cicnHand: CIconHandle;
begin
idleFilter := FALSE;
if ((theEvent.what = KeyDown) and (BitAnd(theEvent.message, CharCodeMask) = 13)) then
begin
itemHit := 1;
idleFilter := TRUE;
end;
timeIs := TickCount;
if (timeIs > timeWas + 90) then
begin
timeWas := TickCount;
screenNum := screenNum + 1;
if (screenNum > 3) then
screenNum := 0;
for iconNum := 2 to 10 do
begin
Delay(2, timeIs);
GetDItem(theDialog, iconNum, iType, iHand, tempRect);
if (inColor) then
begin
cicnHand := GetCIcon(1226 + iconNum + (screenNum * 9));
if (cicnHand <> nil) then
begin
PlotCIcon(tempRect, cicnHand);
DisposCIcon(cicnHand);
end;
end
else
begin
icnHand := GetIcon(1226 + iconNum + (screenNum * 9));
if (icnHand <> nil) then
PlotIcon(tempRect, icnHand);
end;
end; {end - for iconnum}
end; {end - if (timeIs }
end;
{=================================}
procedure DoAbout;
const
okayButton = 1;
var
savePort: GrafPtr;
ExitDialog: boolean;
excessSpace, DType, Index, itemHit, temp: Integer;
iTemp: LongInt;
DItem: Handle;
ThisEditText: TEHandle;
CItem, CTempItem: controlhandle;
GetSelection: DialogPtr;
TheDialogPtr: DialogPeek;
tempRect: Rect;
{----------------------------------}
procedure Refresh_Dialog; {Refresh the dialogs non-controls}
var
rTempRect: Rect; {Temp rectangle used for drawing}
begin
SetPort(GetSelection); {Point to our dialog window}
GetDItem(GetSelection, okayButton, DType, DItem, tempRect);{Get the item handle}
PenSize(3, 3); {Change pen to draw thick default outline}
InsetRect(tempRect, -4, -4); {Draw outside the button by 1 pixel}
FrameRoundRect(tempRect, 16, 16); {Draw the outline}
PenSize(1, 1); {Restore the pen size to the default value}
end;
{----------------------------------}
begin {Start of dialog handler}
GetPort(savePort); {Get the previous grafport}
GetSelection := GetNewDialog(228, nil, Pointer(-1));{Bring in the dialog resource}
tempRect := GetSelection^.portRect; {Get window size, we will now center it}
tempRect.Top := ((screenBits.Bounds.Bottom - screenBits.Bounds.Top) - (tempRect.Bottom - tempRect.Top)) div 2;
tempRect.Left := ((screenBits.Bounds.Right - screenBits.Bounds.Left) - (tempRect.Right - tempRect.Left)) div 2;
MoveWindow(GetSelection, tempRect.Left, tempRect.Top, TRUE);{Now move the window to the proper position}
ShowWindow(GetSelection); {Open a dialog box}
SelectWindow(GetSelection); {Lets see it}
SetPort(GetSelection); {Prepare to add conditional text}
Refresh_Dialog; {Draw any Lists, lines, or rectangles}
timeWas := TickCount; {Initialize the tick counter}
screenNum := 0; {Initialize the set of icons displaying}
ExitDialog := FALSE; {Do not exit dialog handle loop yet}
repeat {Start of dialog handle loop}
ModalDialog(@idleFilter, itemHit);{Wait until an item is hit}
GetDItem(GetSelection, itemHit, DType, DItem, tempRect); {Get item information}
CItem := Pointer(DItem); {Get the control handle}
if (ItemHit = okayButton) then {Handle the Button being pressed}
begin
exitDialog := TRUE; {Exit the dialog when this selection is made}
end; {End for this item selected}
until exitDialog; {Handle dialog items until exit selected}
SetPort(GrafPtr(savePort)); {Restore the previous grafport}
DisposDialog(GetSelection); {Flush the dialog out of memory}
end; {End of procedure}
{=================================}
end.
Reference in New Issue View Git Blame Copy Permalink