$CPU 8086          'make compatible with XT systems
$LIB ALL OFF       'turn off all PowerBASIC libraries
$ERROR ALL OFF     'turn off all PowerBASIC error checking
$OPTIMIZE SIZE     'optimize for smaller code
 $COMPILE UNIT      'compile to a UNIT (.PBU)
'$COMPILE EXE       'compile to a UNIT (.PBU)

DEFINT A-Z         'Required for all numeric functions, forces PB to not
                   'include floating point in UNIT (makes it smaller)
DECLARE SUB Button(Text$,Press%,Row%,Col%,HotKey%,ButtonAttr%,Attr%)
DECLARE SUB LEdit(Allow$,Text$,M%,MouseRow%,MouseCol%,Fill%,Row%,Col%,EditKey%,Attr%)
DECLARE SUB PUTSCREEN(BYVAL X AS STRING)
DECLARE FUNCTION GETSCREEN() AS STRING
DECLARE SUB BWINDOW(Title$,Toprow%,Leftcolumn%,Bottomrow%,Rightcolumn%,Attr%,Shadow%,Border%)
DECLARE SUB CalcByte(Attr%,LowByte%,HiByte%)
DECLARE SUB MCLICKED(Rgt%,Lft%,Row%,Col%)
DECLARE SUB MOUSEOFF()
DECLARE SUB MOUSEON()
DECLARE FUNCTION ISMOUSELBR()
DECLARE FUNCTION MBOX(ROW,COL,ATTR,MSG$(),OPT$,BTYPE) AS STRING
$CODE SEG "MLIB2"

SUB SAVEAS(RTFILE$,ATTR%,BARATTR%,BUTTONATTR%,SHADOW%,BORDER%,M%)PUBLIC


REDIM Directory$(1:300)
REDIM Message$(2)
DirPointer% = 0
'/*DefaultName$ = ReturnedFile$
DefaultName$ = RTFILE$
ON LOCAL ERROR GOTO ErrorHandle

Allow$ = CHR$(24) + "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_^$~!{}()@'`*.\:"
FileMask$ = "*.*"

CalcByte Attr%,FGround%,BGround%
CalcByte ButtonAttr%,BtFG%,BtBG%
CalcByte BarAttr%,BarFG%,BarBG%

IF M% THEN MOUSEOFF
SCREEN1$ = GETSCREEN
'SaveScreen DirScreen$,4,9,17,71,1

BWINDOW Title$,4,9,17,71,Attr%,Shadow%,Border%
BWINDOW Title$,8,11,13,69,Attr%,0,1

IF M% 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:";

Button " Enter ",0,Row%,Col%,HotKey%,ButtonAttr%,Attr%
Button " Esc ",0,Row%,Col% + 11,HotKey%,ButtonAttr%,Attr%

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 M% THEN MOUSEOFF

  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

  LEdit Allow$,Current$,M%,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 M% THEN MOUSEOFF
           GOSUB PrintDirs
           Editkey% = 255  'fall through LineEdit
           LEDIT Allow$,Current$,M%,MouseRow%,MouseCol%,176,6,22,EditKey%,Attr%

           WHILE NOT INSTAT
             IF M% THEN
               MOUSEON
               Rgt% = 0:Lft% = 0:MRow% = 0:MCol% = 0
               MCLICKED Rgt%,Lft%,MRow%,MCol%
               SELECT CASE MRow%
                     CASE 4  'cancel box
                       IF MCol% = 11 THEN
                         IF ISMOUSELBR THEN
                           ReturnedFile$ = ""
                           Editkey% = 27
                           GOTO MouseJumpToExit
                         END IF
                       END IF
                     CASE 6  'line edit
                       IF MCol% > 21 AND MCol% < 70 THEN
                         IF ISMOUSELBR 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 ISMOUSELBR 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 ISMOUSELBR 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 ISMOUSELBR 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 ISMOUSELBR 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 ISMOUSELBR THEN
                                    Chose% = -72:GOTO MouseJumpToKeyBoard
                                  END IF
                                ELSE
                                  IF ISMOUSELBR THEN
                                    Chose% = -75:GOTO MouseJumpToKeyBoard
                                  END IF
                                END IF
                              CASE 67 TO 68
                                IF DirCount% < 17 THEN
                                  IF ISMOUSELBR THEN
                                    Chose% = -80:GOTO MouseJumpToKeyBoard
                                  END IF
                                ELSE
                                  IF ISMOUSELBR 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 ISMOUSELBR THEN
                                  ReturnedFile$ = UCASE$(RTRIM$(Current$))
                                  Editkey% = 13
                                  GOTO MouseJumpToExit
                                END IF
                              CASE 24 TO 28  'Esc
                                IF ISMOUSELBR 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 M% THEN MOUSEOFF
          Button " Enter ",1,Row%,Col%,HotKey%,ButtonAttr%,Attr%

        CASE 27 'Esc
          IF M% THEN MOUSEOFF
          Button " Esc ",1,Row%,Col% + 11,HotKey%,ButtonAttr%,Attr%

END SELECT

IF M% THEN MOUSEON
DELAY .5
IF M% THEN MOUSEOFF
PUTSCREEN SCREEN1$
RTFILE$ = ReturnedFile$
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% = DirStart% + 4 OR a% = DirStart% + 8 OR a% = DirStart% + 12  THEN Row% = 9:INCR Col%,13
    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$(12 - 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$(12 - LEN(Directory$(a%)));
    END IF
    INCR Row%
  NEXT a%

'/*DirScrollDBAR% = DirCount% \ 14
DirScrollDBAR% = DirCount% \ 14
IF DirScrollDBAR% < 1 THEN DirScrollDBAR% = 1
DBAR% = 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%;
    LOCATE 13,Col%,0
    P! =(ScrollDirPointer%/DirCount%)
    T = P! * 14
    T$ = CHR$(27)+STRING$(14,176)+CHR$(26)
    MID$(T$,T+1,1) = CHR$(219)
    PRINT T$
'/* SAY 25,1,STR$(T),12
'
'   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 DBAR% = 0 THEN
'         c% = ScrollDirPointer%
'         FOR i% = 1 TO DirScrollDBAR%
'           b% = (c% \ DirScrollDBAR%)
'           IF a% = b% + DirStart% THEN
'             DBAR% = 1
'             EXIT FOR
'           ELSE
'             INCR c%
'           END IF
'         NEXT i%
'         IF DBAR% THEN
'           PRINT CHR$(219);
'         ELSE
'           IF DBAR% = 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

  T$ = MBOX(ROW,COL,ATTR,Message$(),"SHADOW",Border%)
  'MBOX Message$(),"Error",0,M%,2,9,25,BarFG%,Shadow%,Border%

RESUME NEXT
'----------------------------------------------------------------------------
END SUB
'/*--------------------------------------------------------------------
'   $INCLUDE "C:\CODE\MLIB\MLIB.INC"
'   RTFILE$ = "nofile"
'   SAVEAS RTFILE$,31,14,79,1,1,0
'   PRINT "'"RTFILE$"'"
'   INPUT Z
'/*--------------------------------------------------------------------