home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 15
/
CD_ASCQ_15_070894.iso
/
vrac
/
dnalib7a.zip
/
SAVEAS.BAS
< prev
next >
Wrap
BASIC Source File
|
1994-05-14
|
21KB
|
609 lines
DECLARE SUB LineEdit(Allow$,Text$,Mouse%,MouseRow%,MouseCol%,Fill%,Row%,Col%,EditKey%,Attr%)
DECLARE SUB Popwind(Title$,Toprow%,Leftcolumn%,Bottomrow%,Rightcolumn%,Attr%,Shadow%,Border%)
DECLARE SUB Dialog(Choices$(),Title$,Seconds%,Mouse%,Cntr%,TopRow%,LeftColumn%,TxtColor%,Attr%,Shadow%,Border%)
DECLARE SUB RestoreScreen(ScreenID$,TopRow%,LeftColumn%)
DECLARE SUB SaveScreen(ScreenID$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Shadow%)
DECLARE SUB CalcByte(Attr%,LowByte%,HiByte%)
DECLARE SUB Clicked(Rgt%,Lft%,Row%,Col%)
DECLARE SUB HideCursor()
DECLARE SUB ShowCursor()
DECLARE FUNCTION LeftButtonReleased%()
SUB WriteToBox(ReturnedFile$,DefaultName$,Mouse%,Attr%,BarAttr%,ButtonAttr%,Shadow%,Border%)PUBLIC
$CODE SEG "DNASEG1"
DIM Directory$(1:100)
DIM Message$(2)
DirPointer% = 0
ON LOCAL ERROR GOTO ErrorHandle
Allow$ = CHR$(24) + "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_^$~!{}()@'`*.\:"
FileMask$ = "*.*"
CalcByte Attr%,FGround%,BGround%
CalcByte ButtonAttr%,BtFG%,BtBG%
CalcByte BarAttr%,BarFG%,BarBG%
IF Mouse% THEN HideCursor
SaveScreen DirScreen$,4,9,17,71,1
Popwind Title$,4,9,17,71,Attr%,Shadow%,Border%
Popwind Title$,8,11,13,69,Attr%,0,1
IF Mouse% THEN
COLOR FGround%,BGround%
LOCATE 4,10,0
PRINT CHR$(91,254,93);
END IF
Row% = 15:Col% = 13
COLOR BtFG%,BGround%
LOCATE 6,11,0
PRINT "File Name:";
COLOR BtFG%,BtBG%
LOCATE Row%, Col%,0
PRINT " Enter ";
COLOR 0,BGround%
LOCATE Row%, Col% + 7,0
PRINT "▄";
COLOR 0,BGround%
LOCATE Row% + 1,Col% + 1,0
PRINT "▀▀▀▀▀▀▀";
COLOR BtFG%,BtBG%
LOCATE Row%,Col% + 11,0
PRINT " Esc ";
COLOR 0,BGround%
LOCATE Row%,Col% + 16,0
PRINT "▄";
COLOR 0,BGround%
LOCATE Row% + 1,Col% + 12,0
PRINT "▀▀▀▀▀"
IF RIGHT$(CURDIR$,1) = "\" THEN 'make sure there is a back slash
Current$ = CURDIR$ + "*.*"
ELSE
Current$ = CURDIR$ + CHR$(92) + "*.*"
END IF
DO
IF DirCount% THEN 'empty out the array
FOR i% = 1 TO DirCount%
Directory$(i%) = ""
NEXT i%
END IF
FOR i% = 1 TO LEN(Current$) 'get the path, need this when testing ATTRIB
Test$ = RIGHT$(Current$,i%)
IF LEFT$(Test$,1) = CHR$(92) THEN
Path$ = LEFT$(Current$,LEN(Current$) - (i% - 1))
EXIT FOR
END IF
NEXT i%
i% = 1
DirName$ = DIR$(Path$ + "*.*",16) 'get directorys and put them in an array
IF LEN(DirName$) THEN
x% = ATTRIB(Path$ + DirName$)
IF x% = 16 THEN
Directory$(i%) = DirName$
ELSE
DECR i%
END IF
END IF
DO
DirName$ = DIR$
IF LEN(DirName$) THEN
x% = ATTRIB(Path$ + DirName$)
IF x% = 16 THEN
INCR i%
Directory$(i%) = DirName$
END IF
END IF
LOOP WHILE LEN(DirName$)
IF i% = 0 THEN i% = 1
IF LEN(Path$) > 3 THEN
IF LEN(Directory$(i%)) THEN
INCR i%
Directory$(i%) = ".."
ELSE
Directory$(i%) = ".."
END IF
END IF
DirCount% = i% 'keep a count of directorys
ARRAY SORT Directory$(1) FOR DirCount% 'sort them A - Z
PasteIn$ = ""
DirStart% = 1:DirFinish% = 16 'initialize these
DO
IF Mouse% THEN HideCursor
GOSUB PrintDirs
Current$ = Path$ + PasteIn$ + DefaultName$ 'display the full path and file name
IF LEN(Current$) < 48 THEN 'of the selected item
Add% = 48 - LEN(Current$)
Current$ = Current$ + SPACE$(Add%)
END IF
Current$ = UCASE$(Current$) 'force upper case
Editkey% = 0 'this causes LineEdit to print and exit
LineEdit Allow$,Current$,Mouse%,MouseRow%,MouseCol%,176,6,22,EditKey%,BarAttr%
Kurrent$ = Current$
Kurrent$ = RTRIM$(Kurrent$)
FOR i% = 1 TO LEN(Kurrent$) 'get the path and file name
Test$ = RIGHT$(Kurrent$,i%)
IF LEFT$(Test$,1) = CHR$(92) THEN
FindPath$ = LEFT$(Kurrent$,LEN(Kurrent$) - (i% - 1))
EXIT FOR
END IF
NEXT i%
DefaultName$ = LTRIM$(Kurrent$,FindPath$)
SELECT CASE Editkey%
CASE -255 'exit was with mouse
SELECT CASE MouseRow%
CASE 4 'cancel box
IF MouseCol% = 11 THEN
Editkey% = 27
ReturnedFile$ = ""
EXIT,EXIT
END IF
CASE 6 'line edit
IF MouseCol% > 21 AND MouseCol% < 70 THEN
Editkey% = 13
ReturnedFile$ = UCASE$(RTRIM$(Current$))
EXIT,EXIT
END IF
CASE 9 TO 12 'Dirs display
SELECT CASE MouseCol%
CASE 14 TO 24
IF DirStart% + MouseRow% - 9 <= DirCount% THEN
DirPointer% = DirStart% + MouseRow% - 9
ELSE
DirPointer% = DirCount%
END IF
GOTO MouseJumpToRepaint
CASE 28 TO 38
IF DirStart% + 4 + MouseRow% - 9 <= DirCount% THEN
DirPointer% = DirStart% + 4 + MouseRow% - 9
ELSE
DirPointer% = DirCount%
END IF
GOTO MouseJumpToRepaint
CASE 42 TO 52
IF DirStart% + 8 + MouseRow% - 9 <= DirCount% THEN
DirPointer% = DirStart% + 8 + MouseRow% - 9
ELSE
DirPointer% = DirCount%
END IF
GOTO MouseJumpToRepaint
CASE 56 TO 66
IF DirStart% + 12 + MouseRow% - 9 <= DirCount% THEN
DirPointer% = DirStart% + 12 + MouseRow% - 9
ELSE
DirPointer% = DirCount%
END IF
GOTO MouseJumpToRepaint
END SELECT
CASE 13 'scroll bar
IF MouseCol% > 51 AND MouseCol% < 68 THEN
GOTO MouseJumpToDirs
END IF
CASE 15 'Save and Esc buttons
SELECT CASE MouseCol%
CASE 13 TO 19 'Save
ReturnedFile$ = UCASE$(RTRIM$(Current$))
Editkey% = 13
EXIT,EXIT
CASE 24 TO 28 'Esc
ReturnedFile$ = ""
Editkey% = 27
EXIT,EXIT
END SELECT
CASE ELSE 'return to loop
END SELECT
CASE 9
DO
MouseJumpToDirs:
IF OldDirPointer% THEN
DirPointer% = OldDirPointer%
ELSE
DirPointer% = 1
END IF
DO
MouseJumpToRepaint:
IF Mouse% THEN HideCursor
GOSUB PrintDirs
Editkey% = 255 'fall through LineEdit
LineEdit Allow$,Current$,Mouse%,MouseRow%,MouseCol%,176,6,22,EditKey%,Attr%
WHILE NOT INSTAT
IF Mouse% THEN
ShowCursor
Rgt% = 0:Lft% = 0:MRow% = 0:MCol% = 0
Clicked Rgt%,Lft%,MRow%,MCol%
SELECT CASE MRow%
CASE 4 'cancel box
IF MCol% = 11 THEN
IF LeftButtonReleased% THEN
ReturnedFile$ = ""
Editkey% = 27
GOTO MouseJumpToExit
END IF
END IF
CASE 6 'line edit
IF MCol% > 21 AND MCol% < 70 THEN
IF LeftButtonReleased% THEN
Chose% = 9
GOTO MouseJumpToKeyBoard
END IF
END IF
CASE 9 TO 12 'Dirs display
SELECT CASE MCol%
CASE 14 TO 24
IF Lft% THEN
IF DirPointer% = DirStart% + MRow% - 9 THEN
IF LeftButtonReleased% THEN
Chose% = 13:GOTO MouseJumpToKeyBoard
END IF
ELSE
IF DirStart% + MRow% - 9 <= DirCount% THEN
DirPointer% = DirStart% + MRow% - 9
GOTO MouseJumpToRepaint
END IF
END IF
END IF
CASE 28 TO 38
IF Lft% THEN
IF DirPointer% = DirStart% + 4 + MRow% - 9 THEN
IF LeftButtonReleased% THEN
Chose% = 13:GOTO MouseJumpToKeyBoard
END IF
ELSE
IF DirStart% + 4 + MRow% - 9 <= DirCount% THEN
DirPointer% = DirStart% + 4 + MRow% - 9
GOTO MouseJumpToRepaint
END IF
END IF
END IF
CASE 42 TO 52
IF Lft% THEN
IF DirPointer% = DirStart% + 8 + MRow% - 9 THEN
IF LeftButtonReleased% THEN
Chose% = 13:GOTO MouseJumpToKeyBoard
END IF
ELSE
IF DirStart% + 8 + MRow% - 9 <= DirCount% THEN
DirPointer% = DirStart% + 8 + MRow% - 9
GOTO MouseJumpToRepaint
END IF
END IF
END IF
CASE 56 TO 66
IF Lft% THEN
IF DirPointer% = DirStart% + 12 + MRow% - 9 THEN
IF LeftButtonReleased% THEN
Chose% = 13:GOTO MouseJumpToKeyBoard
END IF
ELSE
IF DirStart% + 12 + MRow% - 9 <= DirCount% THEN
DirPointer% = DirStart% + 12 + MRow% - 9
GOTO MouseJumpToRepaint
END IF
END IF
END IF
END SELECT
CASE 13 'scroll bar
SELECT CASE MCol%
CASE 51 TO 52
IF DirCount% < 17 THEN
IF LeftButtonReleased% THEN
Chose% = -72:GOTO MouseJumpToKeyBoard
END IF
ELSE
IF LeftButtonReleased% THEN
Chose% = -75:GOTO MouseJumpToKeyBoard
END IF
END IF
CASE 67 TO 68
IF DirCount% < 17 THEN
IF LeftButtonReleased% THEN
Chose% = -80:GOTO MouseJumpToKeyBoard
END IF
ELSE
IF LeftButtonReleased% THEN
Chose% = -77:GOTO MouseJumpToKeyBoard
END IF
END IF
END SELECT
CASE 15 'Save and Esc buttons
SELECT CASE MCol%
CASE 13 TO 19 'Save
IF LeftButtonReleased% THEN
ReturnedFile$ = UCASE$(RTRIM$(Current$))
Editkey% = 13
GOTO MouseJumpToExit
END IF
CASE 24 TO 28 'Esc
IF LeftButtonReleased% THEN
ReturnedFile$ = ""
Editkey% = 27
GOTO MouseJumpToExit
END IF
END SELECT
END SELECT
END IF
WEND
Ky$ = INKEY$
IF LEN(Ky$) = 1 THEN
Chose% = ASC(Ky$)
ELSE
Chose% = -ASC(RIGHT$(Ky$,1))
END IF
MouseJumpToKeyBoard:
SELECT CASE Chose%
CASE -71 ' home
IF DirPointer% < 16 THEN
DirPointer% = 1
ELSE
DirPointer% = 1
DirStart% = 1
DirFinish% = 16
END IF
CASE -72 ' up arrow
IF DirPointer% > 1 THEN
DECR DirPointer%
IF DirPointer% < DirStart% THEN
DECR DirStart%:DECR DirFinish%
END IF
END IF
CASE -75 ' left arrow
IF DirPointer% - 4 > 0 THEN
DECR DirPointer%,4
IF DirPointer% < DirStart% THEN
IF DirStart% - 4 > 0 THEN
DECR DirStart%,4:DECR DirFinish%,4
ELSE
DirStart% = 1:DirFinish% = 16
END IF
END IF
ELSE
IF DirCount% > 16 THEN
DirStart% = 1:DirFinish% = 16
END IF
END IF
CASE -77 ' right arrow
IF DirPointer% + 4 <= DirCount% THEN
INCR DirPointer%,4
IF DirPointer% > DirFinish% THEN
IF DirFinish% + 4 < DirCount% THEN
INCR DirStart%,4:INCR DirFinish%,4
ELSE
DirFinish% = DirCount%
DirStart% = DirFinish% - 15
END IF
END IF
ELSE
IF DirCount% > 16 THEN
DirFinish% = DirCount%
DirStart% = DirFinish% - 15
END IF
END IF
CASE -79 ' end key
IF DirCount% < 16 THEN
DirPointer% = DirCount%
ELSE
DirPointer% = DirCount%
DirStart% = DirCount% - 15
DirFinish% = DirCount%
END IF
CASE -80 ' down arrow
IF DirPointer% < DirCount% THEN
INCR DirPointer%
IF DirPointer% > DirFinish% THEN
INCR DirStart%:INCR DirFinish%
END IF
END IF
CASE 9 ' tab key
OldDirPointer% = DirPointer%
DirPointer% = 0
EXIT,EXIT,EXIT
CASE 13 ' enter
IF Directory$(DirPointer%) = ".." THEN
Path$ = RTRIM$(Path$,CHR$(92))
FOR i% = 1 TO LEN(Path$)
Test$ = RIGHT$(Path$,i%)
IF LEFT$(Test$,1) = CHR$(92) THEN
Current$ = LEFT$(Path$,LEN(Path$) - (i% - 1))
OldDirPointer% = 0:DirPointer% = 0
EXIT,EXIT,EXIT,EXIT
END IF
NEXT i%
ELSE
Current$ = Path$ + PasteIn$
OldDirPointer% = 0:DirPointer% = 0
EXIT,EXIT,EXIT
END IF
CASE 27 ' Esc
Editkey% = 27
EXIT,EXIT,EXIT,EXIT
CASE ELSE
BEEP
END SELECT
LOOP
LOOP
CASE 13
ReturnedFile$ = UCASE$(RTRIM$(Current$))
EXIT,EXIT
CASE 27
ReturnedFile$ = ""
EXIT,EXIT
END SELECT
LOOP
LOOP
MouseJumpToExit:
Row% = 15:Col% = 13
SELECT CASE Editkey%
CASE 13 'Ok
IF Mouse% THEN HideCursor
COLOR FGround%,BGround%
LOCATE Row%,Col%,0
PRINT " ";
LOCATE Row% + 1,Col% + 1,0
PRINT " ";
COLOR BtFG%,BtBG%
LOCATE Row%,Col% + 1,0
PRINT " Enter "
CASE 27 'Esc
IF Mouse% THEN HideCursor
COLOR FGround%,BGround%
LOCATE Row%,Col% + 11,0
PRINT " ";
LOCATE Row% + 1,Col% + 12,0
PRINT " ";
COLOR BtFG%,BtBG%
LOCATE Row%,Col% + 12,0
PRINT " Esc "
END SELECT
IF Mouse% THEN ShowCursor
DELAY .5
IF Mouse% THEN HideCursor
RestoreScreen DirScreen$,4,9
EXIT SUB
'----------------------------------------------------------------------------
PrintDirs:
Row% = 9
Col% = 14
FOR a% = DirStart% TO DirFinish%
IF a% = DirStart% + 4 OR a% = DirStart% + 8 OR a% = DirStart% + 12 THEN Row% = 9:INCR Col%,14
IF a% = DirPointer% THEN
COLOR BarFG%,BarBG%
LOCATE Row%,Col%,0
IF LEN(Directory$(a%)) THEN
z% = 92
ELSE
z% = 32
END IF
IF Directory$(a%) = ".." THEN
PasteIn$ = ""
ELSE
PasteIn$ = Directory$(a%) + CHR$(92)
END IF
PRINT SPACE$(1) + Directory$(a%) + CHR$(z%) + SPACE$(9 - LEN(Directory$(a%)));
ELSE
COLOR FGround%,BGround%
LOCATE Row%,Col%,0
IF LEN(Directory$(a%)) THEN
z% = 92
ELSE
z% = 32
END IF
PRINT SPACE$(1) + Directory$(a%) + CHR$(z%) + SPACE$(9 - LEN(Directory$(a%)));
END IF
INCR Row%
NEXT a%
DirScrollBar% = DirCount% \ 14
IF DirScrollBar% < 1 THEN DirScrollBar% = 1
Bar% = 0
Col% = 52
IF DirPointer% THEN
ScrollDirPointer% = DirPointer%
ELSEIF OldDirPointer% THEN
ScrollDirPointer% = OldDirPointer%
ELSE
ScrollDirPointer% = 1
END IF
COLOR FGround%,BGround%
LOCATE 13,13,0
PRINT "┤ ├";
COLOR BtFG%,BGround%
LOCATE 13,14,0
PRINT ScrollDirPointer%; "of"; DirCount%;
FOR a% = DirStart% TO DirFinish%
COLOR FGround%,BGround%
LOCATE 13,Col%,0
IF a% = DirStart% THEN
PRINT CHR$(27);
ELSEIF a% = DirFinish% THEN
PRINT CHR$(26);
ELSE
IF Bar% = 0 THEN
c% = ScrollDirPointer%
FOR i% = 1 TO DirScrollBar%
b% = c% \ DirScrollBar%
IF a% = b% + DirStart% THEN
Bar% = 1
EXIT FOR
ELSE
INCR c%
END IF
NEXT i%
IF Bar% THEN
PRINT CHR$(219);
ELSE
IF Bar% = 0 AND a% = DirFinish% - 1 THEN
PRINT CHR$(219);
ELSE
PRINT CHR$(176);
END IF
END IF
ELSE
PRINT CHR$(176);
END IF
END IF
INCR Col%
NEXT a%
RETURN
'----------------------------------------------------------------------------
ErrorHandle:
SELECT CASE ERR
CASE 71
Message$(1) = " Disk Drive not Ready "
CASE 76
Message$(1) = " Path or File not Found "
END SELECT
Dialog Message$(),"Error",0,Mouse%,2,9,25,BarFG%,ButtonAttr%,Shadow%,Border%
RESUME NEXT
'----------------------------------------------------------------------------
END SUB