1 line
12 KiB
OpenEdge ABL
Executable File
1 line
12 KiB
OpenEdge ABL
Executable File
unit FileInNOut;
|
|
|
|
interface
|
|
uses
|
|
Palettes, Globals, Utilities;
|
|
|
|
function OpenFile (fileName: Str255; vNum: Integer): Boolean;
|
|
function DoOpen: Boolean;
|
|
function WriteFile (theFile, volNum: Integer): Boolean;
|
|
function DoSaveAs: Boolean;
|
|
function DoSave: Boolean;
|
|
function DoClose: Boolean;
|
|
function SaveNoClose: Integer;
|
|
function SaveFirst: Integer;
|
|
procedure SavePrefs;
|
|
|
|
implementation
|
|
|
|
{=================================}
|
|
|
|
function IOCheck (theErr: OSErr): Integer;
|
|
var
|
|
dummyInt: Integer;
|
|
line1, line2: Str255;
|
|
alertHandle: AlertTHndl;
|
|
alertRect: Rect;
|
|
begin
|
|
UseResFile(editorResNum);
|
|
if (theErr <> NoErr) then
|
|
begin
|
|
InitCursor;
|
|
case theErr of
|
|
DskFulErr:
|
|
GetIndString(line1, fileStrIDs, 1);
|
|
FNFErr:
|
|
GetIndString(line1, fileStrIDs, 2);
|
|
WPrErr:
|
|
GetIndString(line1, fileStrIDs, 3);
|
|
FLckdErr:
|
|
GetIndString(line1, fileStrIDs, 4);
|
|
VLckdErr:
|
|
GetIndString(line1, fileStrIDs, 5);
|
|
FBsyErr, OpWrErr:
|
|
GetIndString(line1, fileStrIDs, 6);
|
|
EOFErr:
|
|
GetIndString(line1, fileStrIDs, 7);
|
|
otherwise
|
|
GetIndString(line1, fileStrIDs, 10);
|
|
end;
|
|
NumToString(theErr, line2);
|
|
line2 := CONCAT('Error code = ', line2);
|
|
ParamText(line1, line2, '', '');
|
|
alertHandle := AlertTHndl(Get1Resource('ALRT', fileAlertID));
|
|
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(fileAlertID, nil);
|
|
end;
|
|
IOCheck := theErr;
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
function OpenFile;
|
|
var
|
|
textLength: LongInt;
|
|
resultCode: OSErr;
|
|
dummy: Boolean;
|
|
|
|
begin
|
|
SpinBall;
|
|
OpenFile := FALSE;
|
|
resultCode := FSOpen(fileName, vNum, fileNumber);
|
|
if (IOCheck(resultCode) <> 0) then
|
|
Exit(OpenFile);
|
|
|
|
SpinBall;
|
|
resultCode := SetFPos(fileNumber, FSFromStart, 0);
|
|
if (IOCheck(resultCode) <> 0) then
|
|
begin
|
|
fileIsOpen := TRUE;
|
|
dummy := DoClose;
|
|
Exit(OpenFile);
|
|
end;
|
|
|
|
SpinBall;
|
|
textLength := SIZEOF(houseRec);
|
|
resultCode := FSRead(fileNumber, textLength, @thisHouse);
|
|
if (IOCheck(resultCode) <> 0) then
|
|
begin
|
|
fileIsOpen := TRUE;
|
|
dummy := DoClose;
|
|
Exit(OpenFile);
|
|
end;
|
|
|
|
SpinBall;
|
|
if (thisHouse.timeStamp <= 0) then
|
|
begin
|
|
GenericAlert(24);
|
|
fileIsOpen := TRUE;
|
|
volumeNumber := vNum;
|
|
dummy := DoClose;
|
|
Exit(OpenFile);
|
|
end;
|
|
|
|
SpinBall;
|
|
fileIsOpen := TRUE;
|
|
OpenFile := TRUE;
|
|
lockIt := FALSE;
|
|
volumeNumber := vNum;
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
function SimpleFileFilter (p: ParmBlkPtr): BOOLEAN;
|
|
begin
|
|
SimpleFileFilter := TRUE; {Don't show it -- default}
|
|
with p^.ioFlFndrInfo do
|
|
if (fdType = 'GLhs') then
|
|
SimpleFileFilter := FALSE; {Show it}
|
|
end;
|
|
|
|
{=====================================}
|
|
|
|
function DoOpen;
|
|
var
|
|
dlgOrigin: Point;
|
|
theTypeList: SFTypeList;
|
|
theReply: SFReply;
|
|
begin
|
|
DoOpen := FALSE;
|
|
SetPt(dlgOrigin, dlgLeft + rightOffset, dlgTop + downOffset);
|
|
theTypeList[0] := 'GLhs';
|
|
|
|
SFPGetFile(dlgOrigin, '', @SimpleFileFilter, -1, theTypeList, nil, theReply, custGetID, nil);
|
|
with theReply do
|
|
begin
|
|
if (good) then
|
|
begin
|
|
housesName := fName;
|
|
DoOpen := (OpenFile(fName, vRefNum));
|
|
InitCursor;
|
|
end
|
|
else
|
|
begin
|
|
DoOpen := FALSE;
|
|
Exit(DoOpen);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{=====================================}
|
|
|
|
function WriteFile;
|
|
var
|
|
index, temp: Integer;
|
|
fileLength: LongInt;
|
|
resultCode: OSErr;
|
|
|
|
begin
|
|
SpinBall;
|
|
WriteFile := FALSE;
|
|
fileLength := SIZEOF(houseRec);
|
|
|
|
SpinBall;
|
|
resultCode := SetFPos(theFile, FSFromStart, 0);
|
|
if (IOCheck(resultCode) <> 0) then
|
|
begin
|
|
Exit(WriteFile);
|
|
end;
|
|
|
|
SpinBall;
|
|
resultCode := FSWrite(theFile, fileLength, @thisHouse);
|
|
if (IOCheck(resultCode) <> 0) then
|
|
begin
|
|
Exit(WriteFile);
|
|
end;
|
|
|
|
SpinBall;
|
|
resultCode := SetEOF(theFile, fileLength);
|
|
if (IOCheck(resultCode) <> 0) then
|
|
begin
|
|
Exit(WriteFile);
|
|
end;
|
|
|
|
SpinBall;
|
|
resultCode := FlushVol(nil, volNum);
|
|
if (IOCheck(resultCode) <> 0) then
|
|
begin
|
|
Exit(WriteFile);
|
|
end;
|
|
|
|
SpinBall;
|
|
changed := FALSE;
|
|
WriteFile := TRUE;
|
|
end;
|
|
|
|
{=====================================}
|
|
|
|
function DoSaveAs;
|
|
var
|
|
dlgOrigin: Point;
|
|
theReply: SFReply;
|
|
resultCode: OSErr;
|
|
theInfo: FInfo;
|
|
|
|
begin
|
|
DoSaveAs := FALSE;
|
|
|
|
if (fileIsOpen) then
|
|
begin
|
|
if (not DoClose) then
|
|
Exit(DoSaveAs);
|
|
end;
|
|
|
|
SetPt(dlgOrigin, dlgLeft + rightOffset + 20, dlgTop + downOffset);
|
|
SFPutFile(dlgOrigin, 'Name for house:', '', nil, theReply);
|
|
with theReply do
|
|
begin
|
|
if (not good) then
|
|
Exit(DoSaveAs);
|
|
|
|
volumeNumber := vRefNum;
|
|
resultCode := GetFInfo(fName, vRefNum, theInfo);
|
|
|
|
case resultCode of
|
|
NoErr:
|
|
if (theInfo.fdType <> 'GLhs') then
|
|
begin
|
|
GenericAlert(kErrFileExists);
|
|
Exit(DoSaveAs);
|
|
end;
|
|
FNFErr:
|
|
begin
|
|
resultCode := Create(fname, vRefNum, 'GLed', 'GLhs');
|
|
if (IOCheck(resultCode) <> 0) then
|
|
Exit(DoSaveAs);
|
|
end;
|
|
otherwise
|
|
begin
|
|
GenericAlert(resultCode);
|
|
Exit(DoSaveAs);
|
|
end;
|
|
end; {end - case}
|
|
|
|
{SetCursor- watch}
|
|
housesName := fName;
|
|
if (thisHouse.firstFile = '') then
|
|
thisHouse.firstFile := housesName;
|
|
|
|
GetDateTime(thisHouse.timeStamp);
|
|
if (not lockIt) then
|
|
thisHouse.timeStamp := -thisHouse.timeStamp;
|
|
|
|
SpinBall;
|
|
|
|
resultCode := FSOpen(fName, vRefNum, fileNumber);
|
|
if (IOCheck(resultCode) <> 0) then
|
|
Exit(DoSaveAs);
|
|
|
|
if (not WriteFile(fileNumber, vRefNum)) then
|
|
begin
|
|
InitCursor;
|
|
Exit(DoSaveAs);
|
|
end;
|
|
InitCursor;
|
|
|
|
end; {end - with}
|
|
|
|
fileIsOpen := TRUE;
|
|
EnableItem(GetMenu(mFile), iSave);
|
|
DoSaveAs := TRUE;
|
|
end;
|
|
|
|
{=====================================}
|
|
|
|
function DoSave;
|
|
var
|
|
resultCode: OSErr;
|
|
|
|
begin
|
|
DoSave := FALSE;
|
|
if ((housesName = 'untitled') and (not fileIsOpen)) then
|
|
begin
|
|
if (not DoSaveAs) then
|
|
Exit(DoSave);
|
|
end
|
|
else
|
|
begin
|
|
GetDateTime(thisHouse.timeStamp);
|
|
if (not lockIt) then
|
|
thisHouse.timeStamp := -thisHouse.timeStamp;
|
|
if (not WriteFile(fileNumber, volumeNumber)) then
|
|
begin
|
|
InitCursor;
|
|
Exit(DoSave);
|
|
end;
|
|
InitCursor;
|
|
end;
|
|
DoSave := TRUE;
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
function DoClose;
|
|
var
|
|
resultCode: OSErr;
|
|
|
|
begin
|
|
DoClose := FALSE;
|
|
|
|
if (fileIsOpen) then
|
|
begin
|
|
resultCode := FSClose(fileNumber);
|
|
if (IOCheck(resultCode) <> 0) then
|
|
Exit(DoClose);
|
|
|
|
resultCode := FlushVol(nil, volumeNumber);
|
|
if (IOCheck(resultCode) <> 0) then
|
|
Exit(DoClose);
|
|
|
|
EnableItem(GetMenu(mFile), 1);
|
|
EnableItem(GetMenu(mFile), 2);
|
|
DisableItem(GetMenu(mFile), 4);
|
|
DisableItem(GetMenu(mFile), 5);
|
|
DisableItem(GetMenu(mFile), 6);
|
|
DisableItem(GetMenu(mFile), 7);
|
|
end;
|
|
|
|
fileIsOpen := FALSE;
|
|
housesName := 'untitled';
|
|
DoClose := TRUE;
|
|
end;
|
|
|
|
{=====================================}
|
|
|
|
function SaveNoClose;
|
|
const
|
|
saveBut = 1;
|
|
closeBut = 2;
|
|
cancelBut = 6;
|
|
|
|
var
|
|
leaveDlg: Boolean;
|
|
theDlgPtr: DialogPtr;
|
|
wasPort: GrafPtr;
|
|
tempRect: Rect;
|
|
cntlType, index, itemHit, tempInt, rightOff, downOff: Integer;
|
|
dlgItem: Handle;
|
|
|
|
{-------------------------}
|
|
|
|
procedure Redraw;
|
|
var
|
|
index: Integer;
|
|
begin
|
|
SetPort(theDlgPtr); {Point to our dialog window}
|
|
GetDItem(theDlgPtr, saveBut, cntlType, dlgItem, 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;
|
|
|
|
{-------------------------}
|
|
|
|
begin
|
|
GetPort(wasPort);
|
|
theDlgPtr := GetNewDialog(saveNoCloseID, nil, Pointer(-1));
|
|
with theDlgPtr^.portBits do
|
|
begin
|
|
rightOff := rightOffset - bounds.left;
|
|
downOff := downOffset - bounds.top;
|
|
end;
|
|
MoveWindow(theDlgPtr, rightOff, downOff, FALSE);
|
|
ShowWindow(theDlgPtr);
|
|
SelectWindow(theDlgPtr);
|
|
SetPort(theDlgPtr);
|
|
|
|
Redraw;
|
|
leaveDlg := FALSE;
|
|
|
|
repeat
|
|
ModalDialog(nil, itemHit);
|
|
GetDItem(theDlgPtr, itemHit, cntlType, dlgItem, tempRect);
|
|
|
|
if (itemHit = saveBut) or (itemHit = closeBut) or (itemHit = cancelBut) then
|
|
begin
|
|
SaveNoClose := itemHit;
|
|
leaveDlg := TRUE;
|
|
end;
|
|
|
|
until leaveDlg;
|
|
|
|
DisposDialog(theDlgPtr);
|
|
if (toolWndo <> nil) then
|
|
SetPort(toolWndo)
|
|
else
|
|
SetPort(wasPort);
|
|
end;
|
|
|
|
{=====================================}
|
|
|
|
function SaveFirst;
|
|
const
|
|
saveBut = 1;
|
|
quitBut = 2;
|
|
cancelBut = 6;
|
|
|
|
var
|
|
leaveDlg: Boolean;
|
|
theDlgPtr: DialogPtr;
|
|
wasPort: GrafPtr;
|
|
tempRect: Rect;
|
|
cntlType, index, itemHit, tempInt, rightOff, downOff: Integer;
|
|
dlgItem: Handle;
|
|
|
|
{-------------------------}
|
|
|
|
procedure Redraw;
|
|
var
|
|
index: Integer;
|
|
begin
|
|
SetPort(theDlgPtr); {Point to our dialog window}
|
|
GetDItem(theDlgPtr, saveBut, cntlType, dlgItem, 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;
|
|
|
|
{-------------------------}
|
|
|
|
begin
|
|
GetPort(wasPort);
|
|
theDlgPtr := GetNewDialog(saveNoQuitID, nil, Pointer(-1));
|
|
with theDlgPtr^.portBits do
|
|
begin
|
|
rightOff := rightOffset - bounds.left;
|
|
downOff := downOffset - bounds.top;
|
|
end;
|
|
MoveWindow(theDlgPtr, rightOff, downOff, FALSE);
|
|
ShowWindow(theDlgPtr);
|
|
SelectWindow(theDlgPtr);
|
|
SetPort(theDlgPtr);
|
|
|
|
Redraw;
|
|
leaveDlg := FALSE;
|
|
|
|
repeat
|
|
ModalDialog(nil, itemHit);
|
|
GetDItem(theDlgPtr, itemHit, cntlType, dlgItem, tempRect);
|
|
|
|
if (itemHit = saveBut) or (itemHit = quitBut) or (itemHit = cancelBut) then
|
|
begin
|
|
SaveFirst := itemHit;
|
|
leaveDlg := TRUE;
|
|
end;
|
|
until leaveDlg;
|
|
|
|
DisposDialog(theDlgPtr);
|
|
if (toolWndo <> nil) then
|
|
SetPort(toolWndo)
|
|
else
|
|
SetPort(wasPort);
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure SavePrefs;
|
|
type
|
|
prefType = record
|
|
resName: string[32];
|
|
controlIs: Integer;
|
|
leftIs, rightIs, energyIs, bandIs: Integer;
|
|
buttonIs, restoreIs: Boolean;
|
|
leftNameIs, rightNameIs, energyNameIs, bandNameIs: string[12];
|
|
isKeyBoard: Integer;
|
|
end;
|
|
prefPtr = ^prefType;
|
|
prefHand = ^prefPtr;
|
|
var
|
|
theirPrefs: prefHand;
|
|
theErr: OSErr;
|
|
volName: Str255;
|
|
|
|
begin
|
|
UseResFile(editorResNum);
|
|
|
|
theirPrefs := prefHand(NewHandle(SIZEOF(prefType)));
|
|
if (theirPrefs <> nil) then
|
|
HLock(Handle(theirPrefs))
|
|
else
|
|
begin
|
|
GenericAlert(kErrSavingPrefs);
|
|
Exit(SavePrefs);
|
|
end;
|
|
Handle(theirPrefs) := GetResource('Gprf', 128);
|
|
if ((ResError = noErr) and (theirPrefs <> nil)) then
|
|
with theirPrefs^^ do
|
|
begin
|
|
resName := resourceName;
|
|
controlIs := controlMethod;
|
|
leftIs := leftKey;
|
|
rightIs := rightKey;
|
|
energyIs := energyKey;
|
|
bandIs := bandKey;
|
|
buttonIs := buttonFires;
|
|
restoreIs := restoreColor;
|
|
leftNameIs := leftName;
|
|
rightNameIs := rightName;
|
|
energyNameIs := energyName;
|
|
bandNameIs := bandName;
|
|
isKeyBoard := herKeyBoard;
|
|
end
|
|
else
|
|
begin
|
|
GenericAlert(kErrSavingPrefs);
|
|
Exit(SavePrefs);
|
|
end;
|
|
ChangedResource(Handle(theirPrefs));
|
|
WriteResource(Handle(theirPrefs));
|
|
if (ResError <> noErr) then
|
|
begin
|
|
if ((ResError = FLckdErr) or (ResError = VLckdErr) or (ResError = WPrErr)) then
|
|
GenericAlert(kErrSavingPrefs)
|
|
else
|
|
GenericAlert(ResError);
|
|
end;
|
|
HUnlock(Handle(theirPrefs));
|
|
ReleaseResource(Handle(theirPrefs));
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
end. |