Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

PBCC Program to browse big CSV files

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBCC Program to browse big CSV files

    Code:
    'PBCC 6.0 Program/Manuel Valdés/November 2020
    #COMPILE EXE
    #DIM ALL
    #OPTIMIZE SPEED
    #BREAK ON
    
    
    %STD_INPUT_HANDLE = &HFFFFFFF6???
    %ENABLE_EXTENDED_FLAGS = &H0080
    
    DECLARE FUNCTION ShowWindow LIB "USER32.DLL" ALIAS "ShowWindow" (BYVAL hWnd AS DWORD, BYVAL nCmdShow AS LONG) AS LONG
    DECLARE FUNCTION GetLargestConsoleWindowSize LIB "KERNEL32.DLL" ALIAS "GetLargestConsoleWindowSize" (BYVAL hConsoleOutput AS DWORD) AS DWORD
    DECLARE FUNCTION SetConsoleFont LIB "KERNEL32.DLL" ALIAS "SetConsoleFont"(BYVAL hConsole AS DWORD, BYVAL dwIndex AS DWORD) AS LONG
    DECLARE FUNCTION GetNumberOfConsoleFonts LIB "KERNEL32.DLL" ALIAS "GetNumberOfConsoleFonts"() AS LONG
    DECLARE FUNCTION GetStdHandle LIB "Kernel32.dll" ALIAS "GetStdHandle"(BYVAL nStdHandle AS DWORD) AS DWORD
    DECLARE FUNCTION SetConsoleMode LIB "KERNEL32.DLL" ALIAS "SetConsoleMode" (BYVAL hConsoleHandle AS DWORD, BYVAL dwMode AS DWORD) AS LONG
    
    GLOBAL ROWS&,COLUMNS&,LOREG&,COLNAME$(),N&,JP&,CMP$(),AL$(),LG&(),E&,R&,RH&,CH$,CH1$,PCOL&
    GLOBAL FG%,BG%,BC&,CRS%,ARCH$,A&,LN$,FI&,BL$,ASTR$(),PT???(),L$,OFS&,DCH$
    
    FUNCTION PBMAIN () AS LONG
    LOCAL TEMP$,L$,I&,J&,O$,LD&,FN&,DR&,DRH&,RCN$
    DIM LG&(2000),AL$(2000),COLNAME$(2000),ASTR$(250)
    DisableQuickEditMode()
    CURSOR OFF
    FG% = 7 'Can change the foreground and background colors
    BG% = 1
    FN& = GetNumberOfConsoleFonts
    FI& = 1 + FN&\2
    DR& = 1
    DRH& = 2
    DCH$=CHR$(34,44,34)
    COLOR FG%,BG%
    CLS
    CALL GFORMAT(FI&,DR&,DRH&)
    BL$="F1 - Help"
    MOUSE 3, DOWN, DOUBLE
    MOUSE ON
    ROWS&=0
    COLUMNS&=1
    LOREG&=0
    LOCATE 4,4
    CON.PRINT "Enter the file name: ";
    CALL FORMATTED_INPUT_X(30,4,60,30,ARCH$,1,1,CRS%)
    IF CRS%<>1 OR ARCH$="" THEN
    CLS
    END
    END IF
    COLOR FG%,BG%
    LOCATE 6,4
    CON.PRINT "Field separator : ";
    CALL FORMATTED_INPUT_X(30,6,4,4,DCH$,1,1,CRS%)
    CONSOLE NAME ARCH$
    IF INSTR(UCASE$(ARCH$),".CSV")>0 THEN
    OPEN ARCH$ FOR INPUT AS #1
    LINE INPUT #1,TEMP$
    IF LEN(TEMP$)=0 THEN
    CLOSE 1
    CLS
    END
    END IF
    AL$(COLUMNS&)="I"
    COLNAME$(COLUMNS&)="A"
    FOR I&=1 TO LEN(TEMP$)
    IF MID$(TEMP$,I&,LEN(DCH$))= DCH$ THEN
    INCR COLUMNS&
    AL$(COLUMNS&)="I"
    IF COLUMNS&<27 THEN
    COLNAME$(COLUMNS&)=CHR$(64+COLUMNS&)
    ELSEIF COLUMNS&<703 THEN
    COLNAME$(COLUMNS&)=CHR$(64+((COLUMNS&-1)\26))+CHR$(65+((COLUMNS&-1) MOD 26))
    ELSEIF COLUMNS&<1379 THEN
    COLNAME$(COLUMNS&)=CHR$(64+(COLUMNS&-27)\676)+CHR$(65+(COLUMNS&-703)\26)+CHR$(65+((COLUMNS&-1) MOD 26))
    ELSE
    COLNAME$(COLUMNS&)=CHR$(64+(COLUMNS&-27)\676)+CHR$(65+(COLUMNS&-1379)\26)+CHR$(65+((COLUMNS&-1) MOD 26))
    END IF
    END IF
    NEXT
    CLOSE 1
    OPEN UCASE$(ARCH$) FOR INPUT LOCK SHARED AS #1
    OPEN REMOVE$(UCASE$(ARCH$),".CSV")+".SQC" FOR BINARY AS #2
    IF LOF(2)>0 THEN
    GET #2,1,ROWS&
    GET #2,5,COLUMNS&
    DIM PT???(ROWS&)
    GET #2,9,PT???() TO ROWS&
    ELSE
    FILESCAN #1, RECORDS TO ROWS&
    PRINT ROWS&,COLUMNS&
    PUT #2,1,ROWS&
    PUT #2,5,COLUMNS&
    DIM PT???(ROWS&)
    PT???(1)=1
    FOR I& = 2 TO ROWS&
    LINE INPUT #1,L$
    PT???(I&)=SEEK(#1)
    IF I& MOD 10000 = 0 THEN
    LOCATE 6,25
    CON.PRINT "Reading line ";I&;
    END IF
    NEXT
    PUT #2,9,PT???() TO ROWS&
    END IF
    CLOSE 2
    ROWS&=ROWS&-1
    DIM CMP$(50000,COLUMNS&)
    END IF
    N&=1
    E&=1
    J&=0
    JP&=0
    OFS&=0
    DO
    'RESET LG&() 'Comment to keep columns width stable
    FOR I&=N& TO N&+R&\2
    SEEK #1,PT???(I&+OFS&)
    LINE INPUT #1,TEMP$
    TEMP$=TRIM$(TEMP$,CHR$(34))
    FOR J&=1 TO COLUMNS&
    CMP$(I&,J&)=PARSE$(TEMP$,DCH$,J&)
    IF LEN(CMP$(I&,J&))>LG&(J&) THEN LG&(J&)=LEN(CMP$(I&,J&))
    NEXT
    NEXT
    FOR J&=1 TO COLUMNS&
    LOREG&=LOREG&+LG&(J&)
    NEXT
    IF ROWS&>0 THEN CALL BROW(0)
    O$=WAITKEY$
    IF O$=CHR$(27) THEN EXIT
    IF ASC(O$,3)=2 THEN
    IF MOUSEY<3 THEN
    IF MOUSEX>9 AND MOUSEX<RH& THEN
    LD&=0
    FOR I&=JP&+1 TO COLUMNS&
    LD&=LD&+LG&(I&)+1
    IF MOUSEX<(LD&+10) THEN EXIT FOR
    NEXT
    IF AL$(I&)="I" THEN
    AL$(I&)="D"
    ELSE
    AL$(I&)="I"
    END IF
    ELSE
    FOR I&=1 TO COLUMNS&
    IF AL$(I&)="I" THEN
    AL$(I&)="D"
    ELSE
    AL$(I&)="I"
    END IF
    NEXT
    END IF
    ELSE
    E&=0.4+(MOUSEY-2)/2
    END IF
    END IF
    SELECT CASE UCASE$(O$)
    CASE CHR$(0,59)
    FI& = 1 + FN&\2
    CALL MHelp()
    CALL GFORMAT(FI&,DR&,DRH&)
    CASE CHR$(0,60)
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN
    IF FI&>0 THEN DECR FI&
    ELSE
    IF FI&<FN& THEN INCR FI&
    END IF
    DR&=1
    DRH&=1
    CALL GFORMAT(FI&,DR&,DRH&)
    CASE CHR$(0,61)
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN
    IF R&>10 THEN INCR DR&
    ELSE
    IF DR&>0 THEN DECR DR&
    END IF
    CALL GFORMAT(FI&,DR&,DRH&)
    CASE CHR$(0,62)
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN
    IF RH&>20 THEN INCR DRH&
    ELSE
    IF DRH&>0 THEN DECR DRH&
    END IF
    CALL GFORMAT(FI&,DR&,DRH&)
    
    CASE CHR$(0,63) 'F5 'Jump to/highligth the entered record number
    LOCATE R&+BC&-3,5
    CON.PRINT "Go to Record Nr. :"
    CALL FORMATTED_INPUT_X(24,R&+BC&-3,7,7,RCN$,1,1,CRS%)
    IF CRS%=1 AND VAL(RCN$)<=ROWS&-1 THEN
    OFS&=50000*(VAL(RCN$)\50000)
    N&=VAL(RCN$)-OFS&-R&\2
    E&= 1+R&\2
    END IF
    COLOR FG%,BG%
    LOCATE R&+BC&-3,5
    CON.PRINT SPC(40)
    
    CASE CHR$(0,64) 'F6 'Copy the highlighted record to the Clipboard
    CLIPBOARD RESET
    SEEK #1,PT???(OFS&+N&+E&-1)
    LINE INPUT #1,TEMP$
    TEMP$=TRIM$(TEMP$,CHR$(34))
    L$=""
    FOR I&=1 TO COLUMNS&
    L$=L$+USING$("###",I&)+" "+PARSE$(TEMP$,DCH$,I&)+$CRLF
    NEXT
    CLIPBOARD SET TEXT L$
    
    CASE CHR$(0,65) 'F7 'Edit the highlighted record
    SEEK #1,PT???(OFS&+N&+E&-1)
    LINE INPUT #1,L$
    CALL FORMATTED_INPUT_X(7,R&+BC&-5,LEN(L$),RH&-10,L$,1,1,CRS%)
    IF CRS%=1 THEN
    OPEN ARCH$ FOR BINARY LOCK SHARED AS #3
    SEEK #3,PT???(OFS&+N&+E&-1)
    PUT$ #3,L$
    CLOSE 3
    END IF
    LOCATE R&+BC&-5,2
    COLOR FG%,BG%
    CON.PRINT SPC(RH&-2)
    
    CASE CHR$(0,66) 'F8
    
    CASE CHR$(0,67) 'F9
    
    CASE CHR$(0,80) 'Arrow Down
    IF R&=2*ROWS&-1 THEN
    IF E&<MAX(ROWS&,R&\2) THEN INCR E&
    ELSE
    IF E&<MIN(ROWS&,R&)\2+1 THEN
    INCR E&
    ELSE
    IF N&<ROWS&-1 THEN INCR N&
    END IF
    END IF
    CASE CHR$(0,72) 'Arrow Up
    IF E&>1 THEN
    DECR E&
    ELSE
    DECR N&
    END IF
    CASE CHR$(0,81) 'Page Down
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN 'If left control down
    IF OFS&<ROWS&-50000 THEN OFS&=OFS&+50000
    ELSE
    N&=N&+R&\2
    END IF
    CASE CHR$(0,73) 'Page Up
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN 'If left control down
    IF OFS&>50000 THEN OFS&=OFS&-50000
    ELSE
    N&=N&-R&\2
    END IF
    CASE CHR$(0,71) 'Home
    N&=1
    E&=1
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN 'If left control down
    OFS&=0
    ELSE
    IF OFS&>50000 THEN OFS&=OFS&-50000
    END IF
    CASE CHR$(0,77) 'Arrow Right
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN 'If left control down
    JP&=COLUMNS&-1 'Go to last column
    ELSE
    INCR JP& 'Shift one column to right
    IF JP&=COLUMNS& THEN JP&=COLUMNS&-1
    END IF
    CASE CHR$(0,75) 'Arrow Left
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN 'If left control down
    JP&=0 'Go to first column
    ELSE
    DECR JP& 'Shift one column to left
    IF JP&<0 THEN JP&=0
    END IF
    CASE CHR$(0,79) 'End
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN 'If left control down
    OFS&=ROWS&-50000
    N&=ROWS&-OFS&-1
    ELSE
    N&=ROWS&-R&\2
    E&=1+R&\2
    END IF
    END SELECT
    IF N&>50000-R&\2-1 THEN N&=50000-R&\2
    IF N&<1 THEN N&=1
    LOOP
    CLOSE 1
    CLS
    END FUNCTION
    
    SUB BROW(FL&)
    LOCAL I&,J&,H&,LIN$,PL&,PC&,B&,FEC$,HD$,S&
    COLOR FG%,BG%
    LIN$="ÚÄÄÄÄÄÄÄ"
    J&=JP&
    PL&=8
    DO UNTIL J&=COLUMNS& OR PL&>=RH&-1
    INCR J&
    PC&=0
    LIN$=LIN$+CHR$(194)
    INCR PL&
    WHILE PC&<LG&(J&) AND PL&<RH&-1
    INCR PC&
    INCR PL&
    LIN$=LIN$+CHR$(196)
    WEND
    LOOP
    IF J&=COLUMNS& OR PL&>=RH&-1 THEN
    LIN$=LIN$+CHR$(191)+SPACE$(RH&-4)
    END IF
    LOCATE 1,1
    CON.PRINT OEMTOCHR$(GRAPHIC,LEFT$(LIN$,RH&));
    LIN$="³Row\Col"
    J&=JP&
    PL&=8
    DO UNTIL J&=COLUMNS& OR PL&>=RH&-1
    INCR J&
    PC&=0
    LIN$=LIN$+CHR$(179)
    INCR PL&
    DO UNTIL PC&=LG&(J&) OR PL&>=RH&-2
    INCR PL&
    INCR PC&
    LIN$=LIN$+MID$(COLNAME$(J&)+STRING$(LG&(J&),32),PC&,1)
    LOOP
    WHILE PC&<LG&(J&) AND PL&<RH&-1
    INCR PC&
    INCR PL&
    LIN$=LIN$+CHR$(32)
    WEND
    LOOP
    IF J&=COLUMNS& OR PL&>=RH&-1 THEN LIN$=LIN$+CHR$(179)+SPACE$(RH&-4)
    LOCATE 2,1
    CON.PRINT OEMTOCHR$(GRAPHIC,LEFT$(LIN$,RH&));
    LIN$="ÃÄÄÄÄÄÄÄ"
    PL&=8
    J&=JP&
    DO UNTIL J&=COLUMNS& OR PL&>=RH&-1
    INCR J&
    PC&=0
    LIN$=LIN$+CHR$(197)
    INCR PL&
    WHILE PC&<LG&(J&) AND PL&<RH&-1
    INCR PC&
    INCR PL&
    LIN$=LIN$+CHR$(196)
    WEND
    LOOP
    IF J&=COLUMNS& OR PL&>=RH&-1 THEN LIN$=LIN$+CHR$(180)+SPACE$(RH&-4)
    LOCATE 3,1
    CON.PRINT OEMTOCHR$(GRAPHIC,LEFT$(LIN$,RH&));
    HD$=LEFT$(LIN$,RH&)
    IF R&>2*ROWS& THEN R&=2*ROWS&-1
    FOR B&=1 TO R& STEP 2
    A&=1+B&\2+N&-1
    LIN$=CHR$(179)+USING$("#######",A&+OFS&)
    J&=JP&
    PL&=8
    DO UNTIL J&=COLUMNS& OR PL&>=RH&-1
    INCR J&
    FEC$=""
    PC&=0
    LIN$=LIN$+CHR$(179)
    INCR PL&
    DO UNTIL PC&=LG&(J&) OR PL&=>RH&-1
    INCR I&
    INCR PC&
    IF AL$(J&)="I" THEN
    LIN$=LIN$+MID$(CMP$(A&,J&)+STRING$(LG&(J&),32),PC&,1)
    ELSE
    LIN$=LIN$+MID$(STRING$(LG&(J&)-LEN(CMP$(A&,J&)),32)+CMP$(A&,J&),PC&,1)
    END IF
    INCR PL&
    LOOP
    LOOP
    IF J&=COLUMNS& OR PL&>=RH&-1 THEN LIN$=LIN$+CHR$(179)+SPACE$(RH&-4)
    IF B&=2*E&-1 AND FL&=0 THEN
    COLOR 15,3
    ELSE
    COLOR FG%,BG%
    END IF
    LOCATE B&+3,1
    CON.PRINT OEMTOCHR$(GRAPHIC,LEFT$(LIN$,PL&+1));
    COLOR FG%,BG%
    CON.PRINT SPC(RH&-PL&);
    LOCATE B&+4,1
    IF B&=R& THEN EXIT
    CON.PRINT OEMTOCHR$(GRAPHIC,HD$);
    CON.PRINT SPC(RH&-PL&);
    NEXT
    COLOR FG%,BG%
    LIN$="ÀÄÄÄÄÄÄÄ"
    J&=JP&
    PL&=8
    DO UNTIL J&=COLUMNS& OR PL&>=RH&-1
    INCR J&
    PC&=0
    LIN$=LIN$+CHR$(193)
    INCR PL&
    WHILE PC&<LG&(J&) AND PL&<RH&-1
    INCR PC&
    INCR PL&
    LIN$=LIN$+CHR$(196)
    WEND
    LOOP
    IF J&=COLUMNS& OR PL&>=RH&-1 THEN LIN$=LIN$+CHR$(217)+SPACE$(RH&-4)
    LOCATE B&+4,1
    CON.PRINT OEMTOCHR$(GRAPHIC,LEFT$(LIN$,RH&));
    LOCATE R&+BC&-3,(RH&-7)\2
    CON.PRINT BL$;
    END SUB
    
    SUB FORMATTED_INPUT_X(XF AS LONG,YF AS LONG,LF AS LONG,LC AS LONG,CAD$,PF AS LONG,FT AS LONG,CRS%)
    REDIM ASTR$(5000)
    LOCAL CD$,CH1 AS STRING
    LOCAL L,PI,I AS LONG
    LOCAL LD&
    LOCAL J&
    ASTR$(0)=CHR$(0)
    CD$=CAD$+STRING$(LF,32)
    FOR I = 1 TO LF
    ASTR$(I) = MID$(CD$,I,1)
    NEXT
    PI=1
    L = LF
    WHILE ASTR$(L) = CHR$(32)
    DECR L
    WEND
    IF L < 0 THEN L = 0
    IF L=0 THEN
    '
    ELSEIF L>LC THEN
    PI=L-LC
    ELSE
    '
    END IF
    IF PF=0 THEN PF=1
    DO
    LOCATE YF,XF-5
    CON.PRINT USING$("####",L)
    IF PF < PI THEN DECR PI
    IF PF > PI + LC THEN INCR PI
    LOCATE YF,XF
    CH1$ = CHR$(0)
    FOR I = PI TO PI + LC
    IF I = PF THEN
    COLOR 15,4
    ELSE
    COLOR 15,3
    END IF
    IF FT = 5 THEN
    CON.PRINT CHR$(176);
    ELSE
    CON.PRINT OEMTOCHR$(GRAPHIC,(ASTR$(I)));
    END IF
    IF FT=2 THEN
    IF I=2 OR I=4 THEN
    CON.PRINT CHR$(47);
    END IF
    ELSEIF FT=3 AND I=2 THEN
    CON.PRINT CHR$(58);
    ELSEIF FT=4 THEN
    IF I=2 OR I=5 THEN
    CON.PRINT CHR$(46);
    ELSEIF I=8 THEN
    CON.PRINT CHR$(45);
    END IF
    ELSE
    END IF
    NEXT
    CH$=""
    DO
    SLEEP 0
    CH$=WAITKEY$
    IF CH$<>"" THEN EXIT LOOP
    LOOP
    IF ASC(CH$,3)=2 THEN
    IF MOUSEY<4 THEN
    IF MOUSEX>9 AND MOUSEX<RH& THEN
    LD&=0
    FOR I&=JP&+1 TO COLUMNS&
    LD&=LD&+LG&(I&)+1
    IF MOUSEX<(LD&+10) THEN EXIT FOR
    NEXT
    IF AL$(I&)="I" THEN
    AL$(I&)="D"
    ELSE
    AL$(I&)="I"
    END IF
    ELSE
    FOR I&=1 TO COLUMNS&
    IF AL$(I&)="I" THEN
    AL$(I&)="D"
    ELSE
    AL$(I&)="I"
    END IF
    NEXT
    END IF
    ELSE
    LD&=0
    FOR I&=JP&+1 TO COLUMNS&
    LD&=LD&+LG&(I&)+1
    IF MOUSEX<(LD&+10) THEN EXIT FOR
    NEXT
    XF=9+LD&-LG&(I&)
    YF=MOUSEY-3
    PCOL&=I&-JP&
    E&=0.4+(MOUSEY-2)/2
    END IF
    EXIT LOOP
    END IF
    IF ASC(CH$,3)>0 THEN
    CH$=""
    CRS%=0
    EXIT LOOP
    END IF
    IF LEN(CH$) = 1 THEN
    SELECT CASE CH$
    CASE CHR$(8)
    FOR I = PF TO L
    ASTR$(I-1) = ASTR$(I)
    NEXT
    IF PF > 1 THEN DECR PF
    IF L > 1 THEN
    ASTR$(L) = CHR$(32)
    DECR L
    END IF
    CASE CHR$(27)
    EXIT SELECT
    CASE CHR$(9)
    EXIT SELECT
    CASE > CHR$(27)
    IF L < LF THEN INCR L
    FOR I = L TO PF STEP - 1
    ASTR$(I) = ASTR$(I-1)
    NEXT
    ASTR$(PF)=CH$
    LOCATE YF,XF+(PF-PI)
    IF PF < LF THEN
    IF FT=5 THEN
    CON.PRINT CHR$(176);
    ELSE
    CON.PRINT CH$;
    END IF
    INCR PF
    END IF
    IF FT=5 THEN CH$=CHR$(13)
    CH$=CHR$(0,0)
    END SELECT
    ELSE
    CH$=RIGHT$(CH$,1)
    SELECT CASE CH$
    CASE CHR$(75)
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN
    CRS%=11
    EXIT LOOP
    ELSE
    IF PF > 1 THEN
    DECR PF
    END IF
    END IF
    CASE CHR$(77)
    IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN
    CRS%=9
    EXIT LOOP
    ELSE
    IF PF < LF THEN
    INCR PF
    IF PF > L THEN INCR L
    END IF
    END IF
    CASE CHR$(83)
    FOR I = PF TO L-1
    ASTR$(I) = ASTR$(I+1)
    NEXT
    IF L >= PF THEN
    ASTR$(L) = CHR$(32)
    DECR L
    END IF
    CASE ELSE
    IF L < LF THEN INCR L
    FOR I = L TO PF STEP - 1
    ASTR$(I) = ASTR$(I-1)
    NEXT
    SELECT CASE CH$ 'Spanish characters
    CASE CHR$(30)
    ASTR$(PF) = CHR$(160) 'á Alt a
    CASE CHR$(18)
    ASTR$(PF) = CHR$(130) 'é Alt e
    CASE CHR$(23)
    ASTR$(PF) = CHR$(161) 'í Alt i
    CASE CHR$(24)
    ASTR$(PF) = CHR$(162) 'ó Alt o
    CASE CHR$(22)
    ASTR$(PF) = CHR$(163) 'ú Alt u
    CASE CHR$(49)
    ASTR$(PF) = CHR$(164) 'ñ Alt n
    CASE CHR$(50)
    ASTR$(PF) = CHR$(165) 'Ñ Alt m
    CASE ELSE
    ASTR$(PF) = MID$(CH$,2,1)
    END SELECT
    LOCATE YF,XF+(PF-PI)
    IF PF < LF THEN
    IF FT=5 THEN
    CON.PRINT CHR$(176)
    ELSE
    'CON.PRINT CH$
    END IF
    INCR PF
    END IF
    END SELECT
    END IF
    ' 1-Cr 2-Esc 3-AUp 4-PgUp 5-ADn 6-PgDn 7-F10 8-^ALeft 9-^ARight 10-^PgDn
    CRS% = INSTR(CHR$(13)+CHR$(27)+CHR$(72)+CHR$(73)+CHR$(80)+CHR$(81)+CHR$(66)+CHR$(116)+CHR$(115)+CHR$(118)+_
    CHR$(132)+CHR$(71)+CHR$(79)+CHR$(82)+CHR$(60)+CHR$(63)+CHR$(61)+CHR$(59)+CHR$(67)+CHR$(64)+CHR$(65)+CHR$(62),CH$)
    '11-^ALeft 12-Home 13-END 14-Ins 15-F2 16-F5 17-F3 18-F1 19-F9 20-F6 21-F7 22-F4
    CD$ = ""
    IF CRS% = 1 THEN
    FOR I = 1 TO L
    CD$=CD$+ASTR$(I)
    NEXT
    CAD$=CD$
    EXIT LOOP
    ELSEIF CRS%=2 THEN
    EXIT LOOP
    ELSEIF CRS% > 2 THEN
    IF PF<LF THEN DECR PF
    EXIT LOOP
    END IF
    IF MOUSEY = 2 AND MOUSEX < RH& THEN
    IF AL$(J&) = "I" THEN
    AL$(J&) = "D"
    ELSE
    AL$(J&) = "I"
    END IF
    IF ASC(CH$,3)=2 THEN EXIT LOOP
    END IF
    LOOP
    END SUB
    
    SUB GFORMAT(FI&,DR&,DRH&)
    LOCAL WI&,HE&
    LOCAL ClientSize AS DWORD
    SetConsoleFont(GETSTDOUT,FI&) 'Font Index 0 to FN&
    ClientSize = GetLargestConsoleWindowSize(GETSTDOUT)
    R& = HI(WORD,ClientSize)-DR&-2
    RH& = LO(WORD,ClientSize)-DRH&
    CONSOLE SET SCREEN R&, RH&
    ShowWindow CONSHNDL, 0
    SLEEP 3
    ShowWindow CONSHNDL, 3
    DESKTOP GET CLIENT TO WI&,HE&
    CONSOLE SET LOC (WI&-CON.SIZE.X)\2,(HE&-CON.SIZE.Y)\2 'Centered in the client's desktop
    IF R& MOD 2 = 0 THEN
    BC&=9
    ELSE
    BC&=10
    END IF
    R& = HI(WORD,ClientSize)-DR&-BC&
    END SUB
    
    SUB MHelp()
    LOCAL I&
    LOCATE 20,(RH&-80)\2:CON.PRINT OEMTOCHR$(CHR$(218)+STRING$(80,196)+CHR$(191))
    FOR I&=1 TO 21
    LOCATE I&+20,(RH&-80)\2
    CON.PRINT OEMTOCHR$(CHR$(179)+STRING$(80,32)+CHR$(179))
    NEXT
    LOCATE 41,(RH&-80)\2:CON.PRINT OEMTOCHR$(CHR$(192)+STRING$(80,196)+CHR$(217))
    
    LOCATE 22,(RH&-76)\2:CON.PRINT " HELP"
    LOCATE 25,(RH&-76)\2:CON.PRINT "F2 = Increase the font size Ctrl+F2 = Decrease the font size"
    LOCATE 27,(RH&-76)\2:CON.PRINT "F3 = Increase the console width Ctrl+F3 = Decrease the console width"
    LOCATE 29,(RH&-76)\2:CON.PRINT "F4 = Increase the Console height Ctrl+F4 = Decrease the console height"
    LOCATE 31,(RH&-76)\2:CON.PRINT "F5 = Jump to Record Number X Ctrl+End = Go to the last Record"
    LOCATE 33,(RH&-76)\2:CON.PRINT "F6 = Copy Record to the Clipboard Ctrl+Home = Go to the first Record"
    LOCATE 35,(RH&-76)\2:CON.PRINT "F7 = Record edit function. To keep the file format, the number of separators "
    LOCATE 37,(RH&-76)\2:CON.PRINT " and the whole record length must be preserved"
    LOCATE 39,(RH&-76)\2:CON.PRINT " Use cursor keys, PgUp, PgDown, Home and End to navigate"
    WAITKEY$
    END SUB
    
    SUB DisableQuickEditMode()
    LOCAL hStdIn, dwMode AS DWORD'
    hStdIn = GetStdHandle(%STD_INPUT_HANDLE)
    dwMode = dwMode OR %ENABLE_EXTENDED_FLAGS
    SetConsoleMode BYVAL hStdIn, BYVAL dwMode
    END SUB

  • #2
    '
    Code:
    'PBCC 6.0 Program/Manuel Valdés/November 2020
    #compile exe
    #dim all
    #optimize speed
    #break on
    
    %STD_INPUT_HANDLE = &HFFFFFFF6???
    %ENABLE_EXTENDED_FLAGS = &H0080
    
    declare function ShowWindow lib "USER32.DLL" alias "ShowWindow" (byval hWnd as dword, byval nCmdShow as long) as long
    declare function GetLargestConsoleWindowSize lib "KERNEL32.DLL" alias "GetLargestConsoleWindowSize" (byval hConsoleOutput as dword) as dword
    declare function SetConsoleFont lib "KERNEL32.DLL" alias "SetConsoleFont"(byval hConsole as dword, byval dwIndex as dword) as long
    declare function GetNumberOfConsoleFonts lib "KERNEL32.DLL" alias "GetNumberOfConsoleFonts"() as long
    declare function GetStdHandle lib "Kernel32.dll" alias "GetStdHandle"(byval nStdHandle as dword) as dword
    declare function SetConsoleMode lib "KERNEL32.DLL" alias "SetConsoleMode" (byval hConsoleHandle as dword, byval dwMode as dword) as long
    
    global ROWS&,COLUMNS&,LOREG&,COLNAME$(),N&,JP&,CMP$(),AL$(),LG&(),E&,R&,RH&,CH$,CH1$,PCOL&
    global FG%,BG%,BC&,CRS%,ARCH$,A&,LN$,FI&,BL$,ASTR$(),PT???(),L$,OFS&,DCH$
    
    function pbmain () as long
      local TEMP$,L$,I&,J&,O$,LD&,FN&,DR&,DRH&,RCN$
      dim LG&(2000),AL$(2000),COLNAME$(2000),ASTR$(250)
      local SCA as long
      DisableQuickEditMode()
      cursor off
      FG% = 7 'Can change the foreground and background colors
      BG% = 1
      FN& = GetNumberOfConsoleFonts
      FI& = 1 + FN&\2
      DR& = 1
      DRH& = 2
      DCH$=chr$(34,44,34)
      color FG%,BG%
      cls
      call GFORMAT(FI&,DR&,DRH&)
      BL$="F1 - Help"
      mouse 3, down, double
      mouse on
      ROWS&=0
      COLUMNS&=1
      LOREG&=0
      locate 4,4
      con.print "Enter the file name: ";
      call FORMATTED_INPUT_X(30, 4, 60, 30, ARCH$, 1, 1, CRS%)
      if CRS% <> 1 or ARCH$= "" then
        cls
        end
      end if
      color FG%,BG%
      locate 6,4
      con.print "Field separator : ";
      call FORMATTED_INPUT_X(30,6,4,4,DCH$,1,1,CRS%)
      console name ARCH$
      if instr(ucase$(ARCH$),".CSV")>0 then
        open ARCH$ for input as #1
        line input #1,TEMP$
        if len(TEMP$)=0 then
          close 1
          cls
          end
        end if
        AL$(COLUMNS&) = "I"
        COLNAME$(COLUMNS&) = "A"
        for I&=1 to len(TEMP$)
          if mid$(TEMP$,I&,len(DCH$)) = DCH$ then
          incr COLUMNS&
          AL$(COLUMNS&) = "I"
            if COLUMNS& < 27 then
              COLNAME$(COLUMNS&) = chr$(64 + COLUMNS&)
            elseif COLUMNS&<703 then
              COLNAME$(COLUMNS&) = chr$(64 + ((COLUMNS& - 1) \ 26)) + _
                                   chr$(65 + ((COLUMNS&-1) mod 26))
            elseif COLUMNS&<1379 then
              COLNAME$(COLUMNS&) = chr$(64 + (COLUMNS&-27) \ 676) + _
                                   chr$(65 + (COLUMNS&-703) \ 26) + _
                                   chr$(65 + ((COLUMNS&-1) mod 26))
            else
              COLNAME$(COLUMNS&) = chr$(64 + (COLUMNS& - 27) \ 676) + _
                                   chr$(65 + (COLUMNS& - 1379) \ 26) + _
                                   chr$(65 + ((COLUMNS& - 1) mod 26))
            end if
          end if
        next
        close 1
        open ucase$(ARCH$) for input lock shared as #1
        open remove$(ucase$(ARCH$),".CSV")+".SQC" for binary as #2
        if lof(2)>0 then
          get #2,1,ROWS&
          get #2,5,COLUMNS&
          dim PT???(ROWS&)
          get #2,9,PT???() to ROWS&
        else
          filescan #1, records to ROWS&
          print ROWS&,COLUMNS&
          put #2,1,ROWS&
          put #2,5,COLUMNS&
          dim PT???(ROWS&)
          PT???(1)=1
          for I& = 2 to ROWS&
            line input #1,L$
            PT???(I&)=seek(#1)
            if I& mod 10000 = 0 then
              locate 6,25
              con.print "Reading line ";I&;
            end if
          next
          put #2,9,PT???() to ROWS&
        end if
        close 2
        ROWS&=ROWS&-1
        dim CMP$(50000,COLUMNS&)
      end if
      N&=1
      E&=1
      J&=0
      JP&=0
      OFS&=0
      do
        'RESET LG&() 'Comment to keep columns width stable
        for I&=N& to N&+R&\2
          seek #1,PT???(I&+OFS&)
          line input #1,TEMP$
          TEMP$=trim$(TEMP$,chr$(34))
          for J&=1 to COLUMNS&
            CMP$(I&,J&)=parse$(TEMP$,DCH$,J&)
            if len(CMP$(I&, J&)) > LG&(J&) then LG&(J&) = len(CMP$(I&, J&))
          next
        next
        for J&=1 to COLUMNS&
          LOREG&=LOREG&+LG&(J&)
        next
        if ROWS& > 0 then call BROW(0)
        O$=waitkey$
        if O$=chr$(27) then exit
        if asc(O$,3)=2 then
          if mousey<3 then
            if mousex>9 and mousex<RH& then
              LD&=0
              for I&=JP&+1 to COLUMNS&
                LD&=LD&+LG&(I&)+1
                if mousex<(LD&+10) then exit for
              next
              if AL$(I&)="I" then
                AL$(I&)="D"
              else
                AL$(I&)="I"
              end if
            else
              for I&=1 to COLUMNS&
                if AL$(I&)="I" then
                  AL$(I&)="D"
                else
                  AL$(I&)="I"
                end if
              next
            end if
          else
            E&=0.4+(mousey-2)/2
          end if
        end if
        SCA = con.inshift
        select case ucase$(O$)
          case chr$(0,59)
            FI& = 1 + FN&\2
            call MHelp()
            call GFORMAT(FI&,DR&,DRH&)
          case chr$(0,60)
            'IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN
            if bit(SCA, 3) then 'If left control down
              if FI&>0 then decr FI&
            else
              if FI&<FN& then incr FI&
            end if
            DR&=1
            DRH&=1
            call GFORMAT(FI&,DR&,DRH&)
          case chr$(0,61)
            'IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN
            if bit(SCA, 3) then 'If left control down
              if R&>10 then incr DR&
            else
              if DR&>0 then decr DR&
            end if
            call GFORMAT(FI&,DR&,DRH&)
          case chr$(0,62)
            'IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN
            if bit(SCA, 3) then 'If left control down
              if RH&>20 then incr DRH&
            else
              if DRH&>0 then decr DRH&
            end if
            call GFORMAT(FI&,DR&,DRH&)
    
          case chr$(0,63) 'F5 'Jump to/highligth the entered record number
            locate R&+BC&-3,5
            con.print "Go to Record Nr. :"
            call FORMATTED_INPUT_X(24,R&+BC&-3,7,7,RCN$,1,1,CRS%)
            if CRS%=1 and val(RCN$)<=ROWS&-1 then
              OFS&=50000*(val(RCN$)\50000)
              N&=val(RCN$)-OFS&-R&\2
              E&= 1+R&\2
            end if
            color FG%,BG%
            locate R&+BC&-3,5
            con.print spc(40)
    
          case chr$(0,64) 'F6 'Copy the highlighted record to the Clipboard
            clipboard reset
            seek #1,PT???(OFS&+N&+E&-1)
            line input #1,TEMP$
            TEMP$ = trim$(TEMP$, chr$(34))
            L$=""
            for I&=1 to COLUMNS&
              L$=L$+using$("###",I&)+" "+parse$(TEMP$,DCH$,I&)+$crlf
            next
            clipboard set text L$
    
          case chr$(0,65) 'F7 'Edit the highlighted record
            seek #1,PT???(OFS&+N&+E&-1)
            line input #1,L$
            call FORMATTED_INPUT_X(7,R&+BC&-5,len(L$),RH&-10,L$,1,1,CRS%)
            if CRS%=1 then
              open ARCH$ for binary lock shared as #3
              seek #3,PT???(OFS&+N&+E&-1)
              put$ #3,L$
              close 3
            end if
            locate R&+BC&-5,2
            color FG%,BG%
            con.print spc(RH&-2)
    
          case chr$(0,66) 'F8
    
          case chr$(0,67) 'F9
    
          case chr$(0, 80) 'Arrow Down
            if R&=2*ROWS&-1 then
              if E&<max(ROWS&,R&\2) then incr E&
            else
              if E&<min(ROWS&,R&)\2+1 then
                incr E&
              else
                if N&<ROWS&-1 then incr N&
              end if
            end if
          case chr$(0,72) 'Arrow Up
            if E&>1 then
              decr E&
            else
              decr N&
            end if
          case chr$(0, 81) 'Page Down
            'IF MID$(BIN$(INSHIFT, 8), 5, 1) = "1" THEN 'If left control down
            if bit(SCA, 3) then 'If left control down
              if OFS& < ROWS& - 50000 then OFS& = OFS& + 50000
            else
              N& = N& + R& \ 2
            end if
          case chr$(0, 73) 'Page Up
            'IF MID$(BIN$(INSHIFT, 8), 5, 1) = "1" THEN 'If left control down
            if bit(SCA, 3) then 'If left control down
              if OFS& > 50000 then OFS& = OFS& - 50000
            else
              N&=N&-R&\2
            end if
          case chr$(0,71) 'Home
            N&=1
            E&=1
            'IF MID$(BIN$(INSHIFT, 8), 5, 1) = "1" THEN 'If left control down
            if bit(SCA, 3) then 'If left control down
              OFS& = 0
            else
              if OFS& > 50000 then OFS& = OFS& - 50000
            end if
          case chr$(0, 77) 'Arrow Right
            'IF MID$(BIN$(INSHIFT, 8), 5, 1) = "1" THEN 'If left control down
            if bit(SCA, 3) then 'If left control down
              JP&=COLUMNS&-1 'Go to last column
            else
              incr JP& 'Shift one column to right
              if JP&=COLUMNS& then JP&=COLUMNS&-1
            end if
          case chr$(0, 75) 'Arrow Left
            'IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN 'If left control down
            if bit(SCA, 3) then 'If left control down
              JP&=0 'Go to first column
            else
              decr JP& 'Shift one column to left
              if JP&<0 then JP&=0
            end if
          case chr$(0,79) 'End
            'IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN 'If left control down
            if bit(SCA, 3) then 'If left control down
              OFS&=ROWS&-50000
              N&=ROWS&-OFS&-1
            else
              N&=ROWS&-R&\2
              E&=1+R&\2
            end if
        end select
        if N&>50000-R&\2-1 then N&=50000-R&\2
        if N&<1 then N&=1
      loop
      close 1
      cls
    end function
    '-------------------------------------------------------------------------------
    sub BROW(FL&)
      local I&,J&,H&,LIN$,PL&,PC&,B&,FEC$,HD$,S&
      color FG%,BG%
      LIN$="ÚÄÄÄÄÄÄÄ"
      J&=JP&
      PL&=8
      do until J&=COLUMNS& or PL&>=RH&-1
        incr J&
        PC&=0
        LIN$=LIN$+chr$(194)
        incr PL&
        while PC&<LG&(J&) and PL&<RH&-1
          incr PC&
          incr PL&
          LIN$=LIN$+chr$(196)
        wend
      loop
      if J&=COLUMNS& or PL&>=RH&-1 then
        LIN$=LIN$+chr$(191)+space$(RH&-4)
      end if
      locate 1,1
      con.print oemtochr$(graphic,left$(LIN$,RH&));
      LIN$="³Row\Col"
      J&=JP&
      PL&=8
      do until J&=COLUMNS& or PL&>=RH&-1
        incr J&
        PC&=0
        LIN$=LIN$+chr$(179)
        incr PL&
        do until PC&=LG&(J&) or PL&>=RH&-2
          incr PL&
          incr PC&
          LIN$=LIN$+mid$(COLNAME$(J&)+string$(LG&(J&),32),PC&,1)
        loop
        while PC&<LG&(J&) and PL&<RH&-1
          incr PC&
          incr PL&
          LIN$=LIN$+chr$(32)
        wend
      loop
      if J& = COLUMNS& or PL& >= RH& - 1 then LIN$ = LIN$+chr$(179) + space$(RH&-4)
      locate 2,1
      con.print oemtochr$(graphic,left$(LIN$,RH&));
      LIN$="ÃÄÄÄÄÄÄÄ"
      PL&=8
      J&=JP&
      do until J&=COLUMNS& or PL&>=RH&-1
        incr J&
        PC&=0
        LIN$=LIN$+chr$(197)
        incr PL&
        while PC&<LG&(J&) and PL&<RH&-1
          incr PC&
          incr PL&
          LIN$=LIN$+chr$(196)
        wend
      loop
      if J&=COLUMNS& or PL&>=RH&-1 then LIN$=LIN$+chr$(180)+space$(RH&-4)
      locate 3,1
      con.print oemtochr$(graphic,left$(LIN$,RH&));
      HD$=left$(LIN$,RH&)
      if R&>2*ROWS& then R&=2*ROWS&-1
      for B&=1 to R& step 2
        A&=1+B&\2+N&-1
        LIN$=chr$(179)+using$("#######",A&+OFS&)
        J&=JP&
        PL&=8
        do until J&=COLUMNS& or PL&>=RH&-1
          incr J&
          FEC$=""
          PC&=0
          LIN$=LIN$+chr$(179)
          incr PL&
          do until PC&=LG&(J&) or PL&=>RH&-1
            incr I&
            incr PC&
            if AL$(J&)="I" then
              LIN$=LIN$+mid$(CMP$(A&,J&)+string$(LG&(J&),32),PC&,1)
            else
              LIN$=LIN$+mid$(string$(LG&(J&)-len(CMP$(A&,J&)),32)+CMP$(A&,J&),PC&,1)
            end if
            incr PL&
          loop
        loop
        if J&=COLUMNS& or PL&>=RH&-1 then LIN$=LIN$+chr$(179)+space$(RH&-4)
        if B&=2*E&-1 and FL&=0 then
          color 15,3
        else
          color FG%,BG%
        end if
        locate B&+3,1
        con.print oemtochr$(graphic,left$(LIN$,PL&+1));
        color FG%,BG%
        con.print spc(RH&-PL&);
        locate B&+4,1
        if B&=R& then exit
        con.print oemtochr$(graphic,HD$);
        con.print spc(RH&-PL&);
      next
      color FG%,BG%
      LIN$="ÀÄÄÄÄÄÄÄ"
      J&=JP&
      PL&=8
      do until J&=COLUMNS& or PL&>=RH&-1
        incr J&
        PC&=0
        LIN$=LIN$+chr$(193)
        incr PL&
        while PC&<LG&(J&) and PL&<RH&-1
          incr PC&
          incr PL&
          LIN$=LIN$+chr$(196)
        wend
      loop
      if J&=COLUMNS& or PL&>=RH&-1 then LIN$=LIN$+chr$(217)+space$(RH&-4)
      locate B&+4,1
      con.print oemtochr$(graphic,left$(LIN$,RH&));
      locate R&+BC&-3,(RH&-7)\2
      con.print BL$;
    end sub
    '-------------------------------------------------------------------------------
    sub FORMATTED_INPUT_X(XF as long, YF as long, LF as long, LC as long, CAD$, _
                          PF as long, FT as long,CRS%)
      redim ASTR$(5000)
      local CD$, CH1 as string
      local L,PI,I, SCA as long
      local LD&
      local J&
      ASTR$(0) = chr$(0)
      CD$ = CAD$ + string$(LF, 32)
      for I = 1 to LF
        ASTR$(I) = mid$(CD$, I, 1)
      next
      PI = 1
      L = LF
      while ASTR$(L) = chr$(32)
        decr L
      wend
      if L < 0 then L = 0
      if L=0 then
        '
      elseif L>LC then
        PI=L-LC
      else
      '
      end if
      if PF = 0 then PF = 1
      do
        locate YF, XF - 5
        con.print using$("####",L)
        if PF < PI then decr PI
        if PF > PI + LC then incr PI
        locate YF,XF
        CH1$ = chr$(0)
        for I = PI to PI + LC
          if I = PF then
            color 15,4
          else
            color 15,3
          end if
          if FT = 5 then
            con.print chr$(176);
          else
            con.print oemtochr$(graphic,(ASTR$(I)));
          end if
          if FT=2 then
            if I=2 or I=4 then
              con.print chr$(47); '/
            end if
          elseif FT=3 and I=2 then
            con.print chr$(58); ':
          elseif FT=4 then
            if I=2 or I=5 then
              con.print chr$(46); '.
            elseif I=8 then
              con.print chr$(45); '-
            end if
          else  '<<===== ?????
          end if
        next
        CH$=""
        do
          sleep 0
          CH$=waitkey$
          if CH$ <> "" then exit loop
        loop
        if asc(CH$, 3) = 2 then
          if mousey < 4 then
            if mousex > 9 and mousex < RH& then
              LD& = 0
              for I& = JP& + 1 to COLUMNS&
                LD& = LD& + LG&(I&) + 1
                if mousex<(LD& + 10) then exit for
              next
              if AL$(I&) = "I" then
                AL$(I&) = "D"
              else
                AL$(I&) = "I"
              end if
            else
              for I&=1 to COLUMNS&
                if AL$(I&) = "I" then
                  AL$(I&) = "D"
                else
                  AL$(I&) = "I"
                end if
              next
            end if
          else
            LD&=0
            for I& = JP& + 1 to COLUMNS&
              LD& = LD& + LG&(I&) + 1
              if mousex < (LD& + 10) then exit for
            next
            XF = 9 + LD& - LG&(I&)
            YF = mousey - 3
            PCOL& = I& - JP&
            E& = 0.4 + (mousey - 2) / 2
          end if
        exit loop
        end if
        if asc(CH$, 3) > 0 then
          CH$ = ""
          CRS% = 0
          exit loop
        end if
        if len(CH$) = 1 then
          select case CH$
            case chr$(8) 'backspace
              for I = PF to L
                ASTR$(I - 1) = ASTR$(I)
              next
              if PF > 1 then decr PF
              if L > 1 then
                ASTR$(L) = chr$(32)
                decr L
              end if
            case chr$(27) 'esc
              exit select
            case chr$(9) 'tab
              exit select
            case > chr$(27)
              if L < LF then incr L
              for I = L to PF step - 1
                ASTR$(I) = ASTR$(I-1)
              next
              ASTR$(PF) = CH$
              locate YF,XF+(PF-PI)
              if PF < LF then
                if FT = 5 then
                  con.print chr$(176); 'degree sign
                else
                  con.print CH$;
                end if
                incr PF
              end if
              if FT=5 then CH$=chr$(13)
                CH$=chr$(0,0)
          end select
        else
          CH$=right$(CH$,1)
          SCA = inshift
          select case CH$
            case chr$(75) 'K
              if mid$(bin$(inshift,8),5,1)="1" then
                CRS%=11
                exit loop
              else
                if PF > 1 then
                  decr PF
                end if
              end if
            case chr$(77) 'M
              'IF MID$(BIN$(INSHIFT,8),5,1)="1" THEN
              if bit(SCA, 3) then 'If left control down
                CRS% = 9
                exit loop
              else
                if PF < LF then
                  incr PF
                  if PF > L then incr L
                end if
              end if
            case chr$(83) 'S
              for I = PF to L-1
                ASTR$(I) = ASTR$(I+1)
              next
              if L >= PF then
                ASTR$(L) = chr$(32) '$spc
                decr L
              end if
            case else
              if L < LF then incr L
              for I = L to PF step - 1
                ASTR$(I) = ASTR$(I - 1)
              next
              select case CH$ 'Spanish characters
                case chr$(30)
                  ASTR$(PF) = chr$(160) 'á Alt a
                case chr$(18)
                  ASTR$(PF) = chr$(130) 'é Alt e
                case chr$(23)
                  ASTR$(PF) = chr$(161) 'í Alt i
                case chr$(24)
                  ASTR$(PF) = chr$(162) 'ó Alt o
                case chr$(22)
                  ASTR$(PF) = chr$(163) 'ú Alt u
                case chr$(49)
                  ASTR$(PF) = chr$(164) 'ñ Alt n
                case chr$(50)
                  ASTR$(PF) = chr$(165) 'Ñ Alt m
                case else
                  ASTR$(PF) = mid$(CH$,2,1)
              end select
              locate YF,XF+(PF-PI)
              if PF < LF then
                if FT=5 then
                  con.print chr$(176) 'degree sign
                else
                  'CON.PRINT CH$
                end if
                incr PF
              end if
          end select
        end if
        ' 1-Cr 2-Esc 3-AUp 4-PgUp 5-ADn 6-PgDn 7-F10 8-^ALeft 9-^ARight 10-^PgDn
        'CRS% = INSTR(CHR$(13)+CHR$(27)+CHR$(72)+CHR$(73)+CHR$(80)+CHR$(81)+CHR$(66)+CHR$(116)+CHR$(115)+CHR$(118)+_
         '      CHR$(132)+CHR$(71)+CHR$(79)+CHR$(82)+CHR$(60)+CHR$(63)+CHR$(61)+CHR$(59)+CHR$(67)+CHR$(64)+CHR$(65)+CHR$(62),CH$)
        CRS% = instr(chr$(13, 27, 72, 73, 80, 81, 66, 116, 115, 118, 132, 71, 79, _
                          82, 60,63,61,59,67,64,65,62), CH$)
        '11-^ALeft 12-Home 13-END 14-Ins 15-F2 16-F5 17-F3 18-F1 19-F9 20-F6 21-F7 22-F4
        CD$ = ""
        if CRS% = 1 then
          for I = 1 to L
            CD$=CD$ + ASTR$(I)
          next
          CAD$=CD$
          exit loop
        elseif CRS% = 2 then
          exit loop
        elseif CRS% > 2 then
          if PF < LF then decr PF
          exit loop
        end if
        if mousey = 2 and mousex < RH& then
          if AL$(J&) = "I" then
            AL$(J&) = "D"
          else
            AL$(J&) = "I"
          end if
          if asc(CH$,3)=2 then exit loop
        end if
      loop
    end sub
    '-------------------------------------------------------------------------------
    sub GFORMAT(FI&,DR&,DRH&)
      local WI&,HE&
      local ClientSize as dword
      SetConsoleFont(getstdout,FI&) 'Font Index 0 to FN&
      ClientSize = GetLargestConsoleWindowSize(getstdout)
      R& = hi(word,ClientSize)-DR&-2
      RH& = lo(word,ClientSize)-DRH&
      console set screen R&, RH&
      ShowWindow conshndl, 0
      sleep 3
      ShowWindow conshndl, 3
      desktop get client to WI&,HE&
      console set loc (WI&-con.size.x)\2,(HE&-con.size.y)\2 'Centered in the client's desktop
      if R& mod 2 = 0 then
        BC&=9
      else
        BC&=10
      end if
      R& = hi(word,ClientSize)-DR&-BC&
    end sub
    '-------------------------------------------------------------------------------
    sub MHelp()
      local I&
      locate 20,(RH&-80)\2:con.print oemtochr$(chr$(218)+string$(80,196)+chr$(191))
      for I&=1 to 21
        locate I&+20,(RH&-80)\2
        con.print oemtochr$(chr$(179)+string$(80,32)+chr$(179))
      next
      locate 41,(RH&-80)\2:con.print oemtochr$(chr$(192)+string$(80,196)+chr$(217))
    
      locate 22,(RH&-76)\2:con.print " HELP"
      locate 25,(RH&-76)\2:con.print "F2 = Increase the font size Ctrl+F2 = Decrease the font size"
      locate 27,(RH&-76)\2:con.print "F3 = Increase the console width Ctrl+F3 = Decrease the console width"
      locate 29,(RH&-76)\2:con.print "F4 = Increase the Console height Ctrl+F4 = Decrease the console height"
      locate 31,(RH&-76)\2:con.print "F5 = Jump to Record Number X Ctrl+End = Go to the last Record"
      locate 33,(RH&-76)\2:con.print "F6 = Copy Record to the Clipboard Ctrl+Home = Go to the first Record"
      locate 35,(RH&-76)\2:con.print "F7 = Record edit function. To keep the file format, the number of separators "
      locate 37,(RH&-76)\2:con.print " and the whole record length must be preserved"
      locate 39,(RH&-76)\2:con.print " Use cursor keys, PgUp, PgDown, Home and End to navigate"
      waitkey$
    end sub
    '-------------------------------------------------------------------------------
    sub DisableQuickEditMode()
      local hStdIn, dwMode as dword'
      hStdIn = GetStdHandle(%STD_INPUT_HANDLE)
      dwMode = dwMode or %ENABLE_EXTENDED_FLAGS
      SetConsoleMode byval hStdIn, byval dwMode
    end sub '
    Dale

    Comment

    Working...
    X