'=========================================================================== ' Subject: MESSAGE, INPUT BOXES V1.4 Date: 04-28-99 (21:54) ' Author: Jernej Simoncic Code: QB, PDS ' Origin: jernej.simoncic@guest.arnes.si Packet: DIRECTQB.ABC '=========================================================================== ' ' Message box, Input box, Menu and Button for QB 4.5 with DirectQB ' Version 1.4 ' ' Usage: see subs & funtions ' Note: only Button supports layers. All other use VIDEO layer (screen). ' ' Important: All dialog boxes use Nx6 font. One is stored in this program ' ' What's new: ' Version 1.1: ' - bugfix in Menu: if clickout% was disabled and somebody dragged mouse ' out of menu, menu was closed ' - selectable colors (scroll down to see) ' - selectable button width & height ' Version 1.2: ' - BarBox - message box with value selection scrollbar ' - fonts can be proportional, but height must still be 6 pixels. ' Version 1.21: ' - fixed some minor bugs ' Version 1.3: ' - OpenDialog - file open dialog box ' Version 1.4: ' - SaveDialog - file save dialog box ' - works with DirectQB 1.5 ' ' Use freely in your programs, just give me a credit. ' ' Jernej Simoncic, jernej.simoncic@guest.arnes.si ' Download latest version at: http://www2.arnes.si/~sopjsimo/ ' ICQ#: 26266467 ' '$INCLUDE: 'directqb.bi' DEFINT A-Z DECLARE SUB Button (lay%, bx%, by%, bwidth%, bheight%, txt$, press%) DECLARE FUNCTION Menu% (x%, y%, Items AS STRING, clickouts%, restbck%) DECLARE FUNCTION MsgBox% (txt$, btn$, tit$, resbk%) DECLARE SUB BarBox (inpval%, txt$, btn$, tit$, minval%, maxval%, pbutton%, resbk%) DECLARE SUB InputBox (inptext$, txt$, btn$, tit$, pbutton%, resbk%) DECLARE FUNCTION OpenDialog$ (ext$, tit$) DECLARE SUB ShellSort (a$(), number%, Direction%) DECLARE SUB SaveDialog (file$, tit$, chkexist%) DIM Font AS STRING * 2305 RESTORE Font FOR i% = 0 TO 47 READ t$ Result$ = "" FOR j% = 0 TO (LEN(t$)) \ 4 - 1 Bytes4$ = MID$(t$, j% * 4 + 1, 4) b& = 0 FOR t% = 4 TO 1 STEP -1 b& = b& * 64 + ASC(MID$(Bytes4$, t%)) - 48 NEXT FOR t% = 1 TO 3 Result$ = Result$ + CHR$(b& AND 255): b& = b& \ 256 NEXT NEXT u$ = Result$ MID$(Font, i% * 48 + 1, 48) = u$ NEXT READ t t$ = CHR$(t) MID$(Font, 2305, 1) = t$ 'Uncomment folowing lines, if you want to save font to file 'OPEN "6x6.FNT" FOR BINARY AS 1 'PUT 1, , Font 'CLOSE 1 DIM SHARED face, shaddow, hilight, black, Text, deftbar 'colors to use a = DQBinit(1, 0) IF a THEN PRINT "DQbInit error: "; a: END IF NOT DQBmouseDetected THEN PRINT "Mouse required." DQBclose END END IF SCREEN 13 face = DQBfindCol(47, 47, 47) 'you can change these, if shaddow = DQBfindCol(31, 31, 31) 'you want different colors hilight = DQBfindCol(63, 63, 63) black = DQBfindCol(0, 0, 0) deftbar = DQBfindCol(0, 0, 47) Text = DQBfindCol(63, 63, 63) DQBsetFont Font a% = MsgBox("This is standard message box. It can have up to 3 buttons.", "OK Cancel", "MsgBox", 1) a% = Menu(50, 50, "This is a menu It can have up to 30 items.", 1, 1) Text$ = "Your text:" InputBox Text$, "This is input box, a message box with input field. You can type text, which will be visible in input field below:", "OK", "InputBox", btn%, 1 vl% = 50 BarBox vl%, "This is bar box, message box with scrollbar. Please select value: Value: |", "Next >>", "BarBox", -10, 40, btn%, 1 f$ = OpenDialog("basbi exe", "File open dialog box") IF f$ > "" THEN a5 = MsgBox("You have selected file: " + f$, "OK", "File selected", 1) SaveDialog f$, "File save dialog box", ex% IF f$ > "" AND ex% = 0 THEN a% = MsgBox("You typed file name: " + f$, "OK", "Returned", 1) ELSEIF f$ > "" AND ex% = -1 THEN a% = MsgBox("File " + f$ + " already exists.", "OK", "Returned", 1) END IF DQBmouseHide DQBclose Font: DATA "6mVKdY10000N4b8Q7@03<00`7AlA4c<300X27f`Q:0000PPS?h02000P0>hS320000" DATA "P078`12000000000X2000P7ZXQ2:0000h04<`P0L00000000hS?0002LP078h300" DATA "P07ZP0200008PP:LP0000024h3180000P04n01200000008n0000000Dh3500000" DATA "P02L`Q?0000n`178P000000000000000P0280020000D@1000000005n@Q?D0000" DATA "PP7lX0?8000R@02@8200004X01:D000002800000000@028P0100008@014P0000" DATA "PP:LX2200008PP?8P0000000004@0200000n00000000000002000P04P04P0000" DATA "`Q8Z82700008P1:8`10000?2`18n0000`S0<80?0000<@19n@0000P?P`S0l0000" DATA "`18l8270000n8018P000007R`Q8L0000`Q8N80700000020P0000000@004@0200" DATA "P04P01200000`30l0000008@P04P0000P31H0040000L8R;P`100007R8R?R0000" DATA "`S4L81?0000N828Rh10000?B8Q4l0000h34L0Q?0000n017@P3000P7PHR8N0000" DATA "H35L@Q=0000h014@P3000P34@09H0000835H@Q<0000h014Bh3000P8fXR8R0000" DATA "8R0000@00<@0180008X03:T0000" DATA "034@01>00000@S:R8200000\8Q4B0000006T@2600000`S4B`140000L@29L@000" DATA "00;`02800000`1>4P300004h01480000009T@27000008R8DP000000R8R:D0000" DATA "009HP1900000@29L@060000lP04l0000P14P0160000P020P020000<@P04`0000" DATA "@1:00000000001:h00000016LP140000@P3400000000h0000000001>l1000000" DATA "lQ34000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "00000000000000000000000000000000@17P0270000000000000000000000000" DATA "0000000000000000000000000000000000000000000Dh33@h300006lP04l0000" DATA "0000000000000000000000000000000000000000000Bh18Ph100000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "0000000000000000000000000000000000000000000000000000000000000000" DATA "000000000000000000000P2N`S0l0000@17h@0>0000000000000000000000000" DATA "000000000000h`?>00000@0441110000la7Ola70000nhS?nh30000004P1H0000" DATA "H06P00000003`04D`070008H@P02@000D10@0@50000D0010@1000`7@014O0000" DATA "P33>`0>00002lQ?O8000000lL0?0000000?n4000000>hP3>@2700`7@014O0000" DATA "hS028P?00003`04<<000008H@06P0000815B@20000P16HP16HP16HP16HP16HP1" DATA "6HP16HP16HP16HP16HP16@P16HP16HP03 maxval% THEN inpval% = maxval% IF inpval% < minval% THEN inpval% = minval% WHILE INKEY$ <> "": WEND 'clear keyboard buffer IF LEN(tit$) > 2 THEN IF MID$(tit$, LEN(tit$) - 2, 1) = "|" THEN 'extract title color from title titleclr% = VAL("&h" + RIGHT$(tit$, 2)) 'text, if given tit$ = LEFT$(tit$, LEN(tit$) - 3) END IF END IF DQBwait 1 'no flicker DQBgetCol titleclr%, r%, g%, B% 'find title text color IF (.3 * r% + .59 * g% + .11 * B%) > 31 THEN titletxtclr% = DQBfindCol(0, 0, 0) ELSE titletxtclr% = DQBfindCol(63, 63, 63) txxt$ = txt$ 'do not change text argument IF RIGHT$(txxt$, 1) = "|" THEN txxt$ = LEFT$(txxt$, LEN(txxt$) - 1) vr% = 1 ELSEIF RIGHT$(txxt$, 1) = "@" THEN txxt$ = LEFT$(txxt$, LEN(txxt$) - 1) vr% = 2 END IF DIM Lines(maxlines%) AS STRING 'array to hold text lines numlines% = maxlines% + 1 'default number of lines FOR i% = 0 TO maxlines% 'parse text l% = INSTR(txxt$, " ") IF l% > 0 THEN Lines(i%) = LEFT$(txxt$, l% - 1) txxt$ = RIGHT$(txxt$, LEN(txxt$) - (l% + 1)) ELSE Lines(i%) = txxt$ txxt$ = "" END IF IF LEN(Lines(i%)) > 50 THEN Lines(i%) = LEFT$(Lines(i%), 50) 'too long lines cause problems IF DQBlen(Lines(i%)) > maxlen% THEN maxlen% = DQBlen(Lines(i%)) 'find longest line lenght IF LEN(txxt$) = 0 THEN 'we have parsed whole text IF DQBlen(Lines(i%)) = maxlen% THEN maxlen% = maxlen% + DQBlen(LTRIM$(RTRIM$(STR$(maxval%)))) numlines% = i% + 3 'number of lines (+2 for text EXIT FOR 'field) END IF NEXT btt$ = btn$ 'same as text DIM ButtonT(2) AS STRING FOR i% = 0 TO 2 'parse buttons l% = INSTR(btt$, " ") IF l% > 0 THEN ButtonT(i%) = LEFT$(btt$, l% - 1) btt$ = RIGHT$(btt$, LEN(btt$) - (l% + 1)) ELSE ButtonT(i%) = btt$ btt$ = "" END IF IF DQBlen(ButtonT(i%)) > 48 THEN DO ButtonT(i%) = LEFT$(ButtonT(i%), LEN(ButtonT(t%)) - 1) LOOP UNTIL DQBlen(ButtonT(t%)) <= 48 END IF IF LEN(btt$) = 0 THEN numbuttons% = i% + 1: EXIT FOR NEXT IF DQBlen(tit$) > maxlen% THEN maxlen% = DQBlen(tit$) 'adjust maxlen% IF numbuttons% = 1 AND maxlen% < 42 THEN maxlen% = 42 IF numbuttons% = 2 AND maxlen% < 96 THEN maxlen% = 96 IF numbuttons% = 3 AND maxlen% < 150 THEN maxlen% = 150 DQBwait 1 DQBmouseHide 'hide mouse when drawing IF resbk% THEN 'do we want to restore background 'calc size Size% = DQBsize(150 - maxlen% \ 2, 89 - numlines% * 3, 171 + maxlen% \ 2, 112 + numlines% * 3) DIM Back%(Size% \ 2) 'get background DQBget 0, 150 - maxlen% \ 2, 89 - numlines% * 3, 171 + maxlen% \ 2, 112 + numlines% * 3, VARSEG(Back%(0)), VARPTR(Back%(0)) END IF len2% = 167 + maxlen% \ 2 - (153 - maxlen% \ 2) 'draw window Button 0, 150 - maxlen% \ 2, 89 - numlines% * 3, 20 + maxlen%, 23 + numlines% * 6, "", 0 DQBboxf 0, 151 - maxlen% \ 2, 90 - numlines% * 3, 169 + maxlen% \ 2, 97 - numlines% * 3, titleclr% 'draw bar DQBboxf 0, 152 - maxlen% \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, 168 + maxlen% \ 2, 104 + (numlines% - 2) * 3, face IF vr% = 0 THEN DQBprint 0, LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3), 160 - DQBlen(LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black ELSEIF vr% = 1 THEN DQBprint 0, Lines(numlines% - 3) + LTRIM$(RTRIM$(STR$(inpval%))), 160 - DQBlen(LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black ELSE DQBprint 0, Lines(numlines% - 3), 160 - DQBlen(Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black END IF DQBline 0, 153 - maxlen% \ 2, 99 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 99 + (numlines% - 2) * 3, shaddow DQBline 0, 153 - maxlen% \ 2, 100 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 100 + (numlines% - 2) * 3, hilight Button 0, 152 - maxlen% \ 2 + (inpval% - minval%) * (len2% / leng%), 95 + (numlines% - 2) * 3, 2, 9, "", 0 'print title DQBprint 0, tit$, 160 - DQBlen(tit$) \ 2, 91 - numlines% * 3, titletxtclr% FOR i% = 0 TO numlines% - 4 'print message DQBprint 0, Lines(i%), 160 - DQBlen(Lines(i%)) \ 2, 99 - numlines% * 3 + i% * 6, black NEXT DIM ButtonDown(2) AS INTEGER 'which button is pressed DQBmouseShow 'show mouse FirstTime% = -1 'needed for button drawing DO IF DQBmouseLB = 0 AND FirstTime% = 0 THEN 'check for pressed button FOR i% = 0 TO 2 IF ButtonDown(i%) = -1 THEN found% = i% + 1 'one is pressed NEXT IF found% <> 0 THEN pbutton% = found% EXIT DO END IF END IF DO in$ = INKEY$ IF in$ = CHR$(27) THEN pbutton% = -2: EXIT DO 'exit if Esc is pressed IF in$ = CHR$(13) THEN pbutton% = -1: EXIT DO ' " Enter " IF LEFT$(in$, 1) = CHR$(0) THEN SELECT CASE RIGHT$(in$, 1) CASE "H", "M" inpval% = inpval% + 1 IF inpval% > maxval% THEN inpval% = maxval% DQBwait 1 DQBmouseHide DQBboxf 0, 152 - maxlen% \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, 168 + maxlen% \ 2, 104 + (numlines% - 2) * 3, face IF vr% = 0 THEN DQBprint 0, LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3), 160 - DQBlen(LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black ELSEIF vr% = 1 THEN DQBprint 0, Lines(numlines% - 3) + LTRIM$(RTRIM$(STR$(inpval%))), 160 - DQBlen(LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black ELSE DQBprint 0, Lines(numlines% - 3), 160 - DQBlen(Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black END IF DQBline 0, 153 - maxlen% \ 2, 99 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 99 + (numlines% - 2) * 3, shaddow DQBline 0, 153 - maxlen% \ 2, 100 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 100 + (numlines% - 2) * 3, hilight Button 0, 152 - maxlen% \ 2 + (inpval% - minval%) * (len2% / leng%), 95 + (numlines% - 2) * 3, 2, 9, "", 0 DQBmouseShow CASE "P", "K" inpval% = inpval% - 1 IF inpval% < minval% THEN inpval% = minval% DQBwait 1 DQBmouseHide DQBboxf 0, 152 - maxlen% \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, 168 + maxlen% \ 2, 104 + (numlines% - 2) * 3, face IF vr% = 0 THEN DQBprint 0, LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3), 160 - DQBlen(LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black ELSEIF vr% = 1 THEN DQBprint 0, Lines(numlines% - 3) + LTRIM$(RTRIM$(STR$(inpval%))), 160 - DQBlen(LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black ELSE DQBprint 0, Lines(numlines% - 3), 160 - DQBlen(Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black END IF DQBline 0, 153 - maxlen% \ 2, 99 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 99 + (numlines% - 2) * 3, shaddow DQBline 0, 153 - maxlen% \ 2, 100 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 100 + (numlines% - 2) * 3, hilight Button 0, 152 - maxlen% \ 2 + (inpval% - minval%) * (len2% / leng%), 95 + (numlines% - 2) * 3, 2, 9, "", 0 DQBmouseShow END SELECT END IF LOOP UNTIL DQBmouseLB OR FirstTime% IF in$ <> "" THEN EXIT DO 'if key was pressed, exit mx% = DQBmouseX my% = DQBmouseY FOR i% = 0 TO 2 'reset button values ButtonDown(i%) = 0 NEXT 'find, if any button is pressed IF my% >= 100 + numlines% * 3 AND my% <= 110 + numlines% * 3 AND NOT FirstTime% THEN IF numbuttons% = 1 THEN SELECT CASE mx% CASE 134 TO 186: ButtonDown(0) = -1 END SELECT ELSEIF numbuttons% = 2 THEN SELECT CASE mx% CASE 107 TO 159: ButtonDown(0) = -1 CASE 161 TO 213: ButtonDown(1) = -1 END SELECT ELSE SELECT CASE mx% CASE 80 TO 132: ButtonDown(0) = -1 CASE 134 TO 186: ButtonDown(1) = -1 CASE 188 TO 240: ButtonDown(2) = -1 END SELECT END IF END IF IF my% >= 95 + (numlines% - 2) * 3 AND my% <= 104 + (numlines% - 2) * 3 AND mx% >= 153 - maxlen% \ 2 AND mx% <= 167 + maxlen% \ 2 THEN x% = mx% - (153 - maxlen% \ 2) inpval% = x% * (leng% / len2%) + minval% DQBwait 1 DQBmouseHide DQBboxf 0, 152 - maxlen% \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, 168 + maxlen% \ 2, 104 + (numlines% - 2) * 3, face IF vr% = 0 THEN DQBprint 0, LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3), 160 - DQBlen(LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black ELSEIF vr% = 1 THEN DQBprint 0, Lines(numlines% - 3) + LTRIM$(RTRIM$(STR$(inpval%))), 160 - DQBlen(LTRIM$(RTRIM$(STR$(inpval%))) + Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black ELSE DQBprint 0, Lines(numlines% - 3), 160 - DQBlen(Lines(numlines% - 3)) \ 2, 99 - numlines% * 3 + (numlines% - 3) * 6, black END IF DQBline 0, 153 - maxlen% \ 2, 99 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 99 + (numlines% - 2) * 3, shaddow DQBline 0, 153 - maxlen% \ 2, 100 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 100 + (numlines% - 2) * 3, hilight Button 0, 152 - maxlen% \ 2 + (inpval% - minval%) * (len2% / leng%), 95 + (numlines% - 2) * 3, 2, 9, "", 0 DQBmouseShow END IF DQBwait 1 'with this, mouse pointer shouldn't flicker DQBmouseHide 'hide mouse cursor when drawing SELECT CASE numbuttons% 'draw buttons CASE 1 Button 0, 134, 100 + numlines% * 3, 0, 0, ButtonT(0), ButtonDown(0) CASE 2 Button 0, 107, 100 + numlines% * 3, 0, 0, ButtonT(0), ButtonDown(0) Button 0, 161, 100 + numlines% * 3, 0, 0, ButtonT(1), ButtonDown(1) CASE 3 Button 0, 80, 100 + numlines% * 3, 0, 0, ButtonT(0), ButtonDown(0) Button 0, 134, 100 + numlines% * 3, 0, 0, ButtonT(1), ButtonDown(1) Button 0, 188, 100 + numlines% * 3, 0, 0, ButtonT(2), ButtonDown(2) END SELECT DQBmouseShow 'show cursor FirstTime% = 0 LOOP IF resbk% THEN 'restore background image DQBmouseHide DQBfPut 0, 150 - maxlen% \ 2, 89 - numlines% * 3, VARSEG(Back%(0)), VARPTR(Back%(0)) DQBmouseShow END IF ERASE Back%, Lines, ButtonT, ButtonDown END SUB ' ' Button - draw button at given location ' ' Usage: Button layer%, x%, y%, bwidth%, bheight%, text$, press% ' ' layer% layer to draw button on ' x%, y% button position ' bwidth% button width (set to 0 to use default) ' bheight% button height (set to 0 to use default) ' text$ text to show ' press% bevel inset/raised ' '============================================================================= ' ' Notes: -mouse cursor isn't hidden when drawing button ' -used by MsgBox, InputBox, BarBox and Menu ' ' Requires: DirectQB ' ' Button by Jernej Simnocic ' SUB Button (lay%, bx%, by%, bwidth%, bheight%, txt$, press%) away% = 2 IF bwidth% = 0 THEN bwidth% = 52 IF bheight% = 0 THEN bheight% = 10: away% = 3 DQBboxf lay%, bx%, by%, bx% + bwidth%, by% + bheight%, face DQBbox lay%, bx%, by%, bx% + bwidth%, by% + bheight%, hilight SELECT CASE press% CASE 0 DQBline lay%, bx%, by% + bheight%, bx% + bwidth%, by% + bheight%, shaddow DQBline lay%, bx% + bwidth%, by%, bx% + bwidth%, by% + bheight%, shaddow DQBprint lay%, txt$, bx% + INT(.5 + bwidth% / 2) - DQBlen(txt$) \ 2, by% + away%, black CASE ELSE DQBline lay%, bx%, by%, bx% + bwidth%, by%, shaddow DQBline lay%, bx%, by%, bx%, by% + bheight%, shaddow DQBprint lay%, txt$, bx% + INT(.5 + bwidth% / 2) + 1 - DQBlen(txt$) \ 2, by% + 1 + away%, black END SELECT END SUB ' ' InputBox - message box with text input field ' ' Usage: InputBox inputtext$, showtext$, buttons$, title$, pbutton%, restbck% ' ' inputtext$ Returns text typed into input box. Can be used to set ' default text. ' showtext$ Text to show in input box. (like text$ in MsgBox) ' buttons$ Buttons to show. ' title$ InputBox title text. Can include title color: add | and ' color in hex (example: "Title text|03" - cyan background) ' pbutton% Contains pressed button number at exit. (Enter:-1, Esc:-2) ' restbck% Restore background at exit. ' '============================================================================= ' ' Notes: lenght of text to return isn't limited. Size of input field depends ' on longest line lenght and title. If text is too long to fit in input ' field, only last chars will be shown. ' ' Requires: DirectQB, SUB Button ' ' InputBox by Jernej Simoncic ' SUB InputBox (inptext$, txt$, btn$, tit$, pbutton%, resbk%) maxlines% = 6 'maximum number of lines - change 'if you need more maxlines% = maxlines% - 1 titleclr% = deftbar 'default title color WHILE INKEY$ <> "": WEND 'clear keyboard buffer IF LEN(tit$) > 2 THEN IF MID$(tit$, LEN(tit$) - 2, 1) = "|" THEN 'extract title color from title titleclr% = VAL("&h" + RIGHT$(tit$, 2)) 'text, if given tit$ = LEFT$(tit$, LEN(tit$) - 3) END IF END IF DQBwait 1 'no flicker DQBgetCol titleclr%, r%, g%, B% 'find title text color IF (.3 * r% + .59 * g% + .11 * B%) > 31 THEN titletxtclr% = DQBfindCol(0, 0, 0) ELSE titletxtclr% = DQBfindCol(63, 63, 63) txxt$ = txt$ 'do not change text argument DIM Lines(maxlines%) AS STRING 'array to hold text lines numlines% = maxlines% + 1 'default number of lines FOR i% = 0 TO maxlines% 'parse text l% = INSTR(txxt$, " ") IF l% > 0 THEN Lines(i%) = LEFT$(txxt$, l% - 1) txxt$ = RIGHT$(txxt$, LEN(txxt$) - (l% + 1)) ELSE Lines(i%) = txxt$ txxt$ = "" END IF IF LEN(Lines(i%)) > 50 THEN Lines(i%) = LEFT$(Lines(i%), 50) 'too long lines cause problems IF DQBlen(Lines(i%)) > maxlen% THEN maxlen% = DQBlen(Lines(i%)) 'find longest line lenght IF LEN(txxt$) = 0 THEN 'we have parsed whole text numlines% = i% + 3 'number of lines (+2 for text EXIT FOR 'field) END IF NEXT btt$ = btn$ 'same as text DIM ButtonT(2) AS STRING FOR i% = 0 TO 2 'parse buttons l% = INSTR(btt$, " ") IF l% > 0 THEN ButtonT(i%) = LEFT$(btt$, l% - 1) btt$ = RIGHT$(btt$, LEN(btt$) - (l% + 1)) ELSE ButtonT(i%) = btt$ btt$ = "" END IF IF DQBlen(ButtonT(i%)) > 48 THEN DO ButtonT(i%) = LEFT$(ButtonT(i%), LEN(ButtonT(t%)) - 1) LOOP UNTIL DQBlen(ButtonT(t%)) <= 48 END IF IF LEN(btt$) = 0 THEN numbuttons% = i% + 1: EXIT FOR NEXT IF DQBlen(tit$) > maxlen% THEN maxlen% = DQBlen(tit$) 'adjust maxlen% IF numbuttons% = 1 AND maxlen% < 42 THEN maxlen% = 42 IF numbuttons% = 2 AND maxlen% < 96 THEN maxlen% = 96 IF numbuttons% = 3 AND maxlen% < 150 THEN maxlen% = 150 DQBwait 1 DQBmouseHide 'hide mouse when drawing IF resbk% THEN 'do we want to restore background 'calc size Size% = DQBsize(150 - maxlen% \ 2, 89 - numlines% * 3, 171 + maxlen% \ 2, 112 + numlines% * 3) DIM Back%(Size% \ 2) 'get background DQBget 0, 150 - maxlen% \ 2, 89 - numlines% * 3, 171 + maxlen% \ 2, 112 + numlines% * 3, VARSEG(Back%(0)), VARPTR(Back%(0)) END IF 'draw window Button 0, 150 - maxlen% \ 2, 89 - numlines% * 3, 20 + maxlen%, 23 + numlines% * 6, "", 0 DQBboxf 0, 151 - maxlen% \ 2, 90 - numlines% * 3, 169 + maxlen% \ 2, 97 - numlines% * 3, titleclr% 'draw input field DQBboxf 0, 153 - maxlen% \ 2, 95 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 98 + numlines% * 3, black DQBbox 0, 153 - maxlen% \ 2, 95 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 98 + numlines% * 3, shaddow DQBline 0, 153 - maxlen% \ 2, 98 + numlines% * 3, 167 + maxlen% \ 2, 98 + numlines% * 3, hilight DQBline 0, 167 + maxlen% \ 2, 95 + (numlines% - 2) * 3, 167 + maxlen% \ 2, 98 + numlines% * 3, hilight 'print title DQBprint 0, tit$, 160 - DQBlen(tit$) \ 2, 91 - numlines% * 3, titletxtclr% 'print default text DQBprint 0, inptext$, 155 - maxlen% \ 2, 97 + (numlines% - 2) * 3, textcol FOR i% = 0 TO numlines% - 3 'print message DQBprint 0, Lines(i%), 160 - DQBlen(Lines(i%)) \ 2, 99 - numlines% * 3 + i% * 6, black NEXT DIM ButtonDown(2) AS INTEGER 'which button is pressed DQBmouseShow 'show mouse FirstTime% = -1 'needed for button drawing DO IF DQBmouseLB = 0 AND FirstTime% = 0 THEN 'check for pressed button FOR i% = 0 TO 2 IF ButtonDown(i%) = -1 THEN found% = i% + 1 'one is pressed NEXT IF found% <> 0 THEN pbutton% = found% EXIT DO END IF END IF DO in$ = INKEY$ IF in$ <> "" THEN SELECT CASE in$ CASE CHR$(27) pbutton% = -2: EXIT DO 'exit if Esc is pressed CASE CHR$(13) pbutton% = -1: EXIT DO ' " Enter " CASE CHR$(8) IF LEN(inptext$) > 0 THEN inptext$ = LEFT$(inptext$, LEN(inptext$) - 1) END IF in$ = "" CASE ELSE inptext$ = inptext$ + in$ in$ = "" END SELECT IF DQBlen(inptext$) > maxlen% + 10 THEN shwt$ = inptext$ DO shwt$ = RIGHT$(shwt$, LEN(shwt$) - 1) LOOP UNTIL DQBlen(shwt$) <= maxlen% + 10 ELSE shwt$ = inptext$ END IF DQBwait 1 DQBmouseHide DQBboxf 0, 154 - maxlen% \ 2, 96 + (numlines% - 2) * 3, 166 + maxlen% \ 2, 97 + numlines% * 3, black DQBprint 0, shwt$, 155 - maxlen% \ 2, 97 + (numlines% - 2) * 3, textcol DQBmouseShow END IF LOOP UNTIL DQBmouseLB OR FirstTime% IF in$ <> "" THEN EXIT DO 'if key was pressed, exit mx% = DQBmouseX my% = DQBmouseY FOR i% = 0 TO 2 'reset button values ButtonDown(i%) = 0 NEXT 'find, if any button is pressed IF my% >= 100 + numlines% * 3 AND my% <= 110 + numlines% * 3 AND NOT FirstTime% THEN IF numbuttons% = 1 THEN SELECT CASE mx% CASE 134 TO 186: ButtonDown(0) = -1 END SELECT ELSEIF numbuttons% = 2 THEN SELECT CASE mx% CASE 107 TO 159: ButtonDown(0) = -1 CASE 161 TO 213: ButtonDown(1) = -1 END SELECT ELSE SELECT CASE mx% CASE 80 TO 132: ButtonDown(0) = -1 CASE 134 TO 186: ButtonDown(1) = -1 CASE 188 TO 240: ButtonDown(2) = -1 END SELECT END IF END IF DQBwait 1 'with this, mouse pointer shouldn't flicker DQBmouseHide 'hide mouse cursor when drawing SELECT CASE numbuttons% 'draw buttons CASE 1 Button 0, 134, 100 + numlines% * 3, 0, 0, ButtonT(0), ButtonDown(0) CASE 2 Button 0, 107, 100 + numlines% * 3, 0, 0, ButtonT(0), ButtonDown(0) Button 0, 161, 100 + numlines% * 3, 0, 0, ButtonT(1), ButtonDown(1) CASE 3 Button 0, 80, 100 + numlines% * 3, 0, 0, ButtonT(0), ButtonDown(0) Button 0, 134, 100 + numlines% * 3, 0, 0, ButtonT(1), ButtonDown(1) Button 0, 188, 100 + numlines% * 3, 0, 0, ButtonT(2), ButtonDown(2) END SELECT DQBmouseShow 'show cursor FirstTime% = 0 LOOP IF resbk% THEN 'restore background image DQBmouseHide DQBfPut 0, 150 - maxlen% \ 2, 89 - numlines% * 3, VARSEG(Back%(0)), VARPTR(Back%(0)) DQBmouseShow END IF ERASE Back%, Lines, ButtonT, ButtonDown END SUB ' ' Menu - draws a menu and returns selected item ' ' Usage: item% = Menu(x%, y%, Items$, clickoutside%, restbck%) ' ' item% returns selected item number (-1 if clicked outside) ' x%, y% position of menu ' Items$ menu items. Separate with two spaces. Use - for line ' clickoutside% close menu if clicked outside borders ' restbck% restore background after closing ' '============================================================================= ' ' Note: no checks are done ' ' Requires: DirectQB ' ' Menu by Jernej Simoncic ' FUNCTION Menu (x%, y%, Items AS STRING, clickouts%, restbck%) maxitems% = 30 'maximum number of items - should be fine txxt$ = Items DIM Items(maxitems%) AS STRING FOR i% = 0 TO maxitems% 'parse items l% = INSTR(txxt$, " ") IF l% > 0 THEN Items(i%) = LEFT$(txxt$, l% - 1) txxt$ = RIGHT$(txxt$, LEN(txxt$) - (l% + 1)) ELSE Items(i%) = txxt$ txxt$ = "" END IF IF LEN(Items(i%)) > 50 THEN Items(i%) = LEFT$(Items(i%), 20) 'too long items cause problems IF DQBlen(Items(i%)) > maxlen% THEN maxlen% = DQBlen(Items(i%)) 'find longest item lenght IF LEN(txxt$) = 0 THEN 'we have parsed whole text numitems% = i% + 1 'number of items EXIT FOR END IF NEXT DQBwait 1 DQBmouseHide 'hide mouse cursor when drawing IF restbck% <> 0 THEN 'get background image Size% = DQBsize(x%, y%, x% + maxlen% + 6, y% + numitems% * 6 + 6) DIM Back%(Size% \ 2) DQBget 0, x%, y%, x% + maxlen% + 6, y% + numitems% * 6 + 6, VARSEG(Back%(0)), VARPTR(Back%(0)) END IF 'draw menu Button 0, x%, y%, maxlen% + 6, numitems% * 6 + 6, "", 0 FOR i% = 0 TO numitems% - 1 'print items IF Items(i%) <> "-" THEN DQBprint 0, Items(i%), x% + 3, y% + i% * 6 + 3, black ELSE DQBline 0, x% + 3, y% + i% * 6 + 5, x% + maxlen% + 3, y% + i% * 6 + 5, shaddow DQBline 0, x% + 3, y% + i% * 6 + 6, x% + maxlen% + 3, y% + i% * 6 + 6, hilight END IF NEXT DQBmouseShow DO DO IF NOT DQBmouseLB AND sel% > 0 AND sel% <= numitems% THEN 'did we Menu = sel% 'select something GOTO MenuEnd END IF IF NOT DQBmouseLB THEN noout% = 0 'needed for outside of menu click LOOP UNTIL DQBmouseLB 'detection mx% = DQBmouseX my% = DQBmouseY DQBwait 1 DQBmouseHide 'hide mouse cursor 're-draw menu DQBboxf 0, x% + 1, y% + 1, x% + maxlen% + 5, y% + numitems% * 6 + 5, face FOR i% = 0 TO numitems% - 1 IF Items(i%) <> "-" THEN DQBprint 0, Items(i%), x% + 3, y% + i% * 6 + 3, black ELSE DQBline 0, x% + 3, y% + i% * 6 + 5, x% + maxlen% + 3, y% + i% * 6 + 5, shaddow DQBline 0, x% + 3, y% + i% * 6 + 6, x% + maxlen% + 3, y% + i% * 6 + 6, hilight END IF NEXT sel% = 0 'is any item selected IF mx% > x% + 3 AND mx% < x% + maxlen% + 3 THEN sel% = (my% - y% - 3) \ 6 IF sel% < numitems% AND sel% >= 0 THEN 'yes IF Items(sel%) <> "-" THEN 'we can't select separator DQBboxf 0, x% + 3, y% + sel% * 6 + 2, x% + maxlen% + 3, y% + sel% * 6 + 8, black DQBprint 0, Items(sel%), x% + 3, y% + sel * 6 + 3, textcol sel% = sel% + 1 noout% = -1 'this variable tells, if mouse was draged ELSE 'out of menu, or if not sel% = 0 END IF ELSE 'no, did we click outside of menu IF clickouts% AND (my% < y% OR my% > y% + numitems% * 6 + 6) AND NOT noout% THEN Menu = -1 '(if mouse was accidently draged out of GOTO MenuEnd 'menu, menu won't be closed) END IF END IF ELSE 'same as above IF clickouts% AND NOT noout% THEN Menu = -1 GOTO MenuEnd END IF END IF DQBmouseShow LOOP MenuEnd: IF restbck% <> 0 THEN 'restore background DQBmouseHide DQBfPut 0, x%, y%, VARSEG(Back%(0)), VARPTR(Back%(0)) DQBmouseShow END IF ERASE Back%, Items END FUNCTION ' ' MsgBox - draws a message box ' ' Usage: ret% = MsgBox(text$, button$, title$, restbck%) ' ' ret% pressed button (1,2,3; -1: Enter; -2: Esc) ' text$ text to show. Separate lines with two spaces ' button$ buttons to show. Separate with two spaces ' title$ MsgBox title text. Can include title color: add | and color in ' hex (example: "Title text|0C" - bright red background) ' restbck% restore background after closing ' '============================================================================= ' ' Important! Font size must be 6x6, or MsgBox will look horrible. ' ' Limitations: 19 lines of text (for more, change maxlines% var) ' 3 buttons ' no line wrapping ' ' Requires: DirectQB, SUB Button ' ' MsgBox by Jernej Simoncic ' FUNCTION MsgBox (txt$, btn$, tit$, resbk%) maxlines% = 19 'maximum number of lines - change 'if you need more maxlines% = maxlines% - 1 titleclr% = deftbar 'default title color WHILE INKEY$ <> "": WEND 'clear keyboard buffer IF LEN(tit$) > 2 THEN IF MID$(tit$, LEN(tit$) - 2, 1) = "|" THEN 'extract title color from title titleclr% = VAL("&h" + RIGHT$(tit$, 2)) 'text, if given tit$ = LEFT$(tit$, LEN(tit$) - 3) END IF END IF DQBwait 1 'no flicker DQBgetCol titleclr%, r%, g%, B% 'find title text color IF (.3 * r% + .59 * g% + .11 * B%) > 31 THEN titletxtclr% = DQBfindCol(0, 0, 0) ELSE titletxtclr% = DQBfindCol(63, 63, 63) txxt$ = txt$ 'do not change text argument DIM Lines(maxlines%) AS STRING 'array to hold text lines numlines% = maxlines% + 1 'default number of lines FOR i% = 0 TO maxlines% 'parse text l% = INSTR(txxt$, " ") IF l% > 0 THEN Lines(i%) = LEFT$(txxt$, l% - 1) txxt$ = RIGHT$(txxt$, LEN(txxt$) - (l% + 1)) ELSE Lines(i%) = txxt$ txxt$ = "" END IF IF LEN(Lines(i%)) > 50 THEN Lines(i%) = LEFT$(Lines(i%), 50) 'too long lines cause problems IF DQBlen(Lines(i%)) > maxlen% THEN maxlen% = DQBlen(Lines(i%)) 'find longest line lenght IF LEN(txxt$) = 0 THEN 'we have parsed whole text numlines% = i% + 1 'number of lines EXIT FOR END IF NEXT btt$ = btn$ 'same as text DIM ButtonT(2) AS STRING FOR i% = 0 TO 2 'parse buttons l% = INSTR(btt$, " ") IF l% > 0 THEN ButtonT(i%) = LEFT$(btt$, l% - 1) btt$ = RIGHT$(btt$, LEN(btt$) - (l% + 1)) ELSE ButtonT(i%) = btt$ btt$ = "" END IF IF DQBlen(ButtonT(i%)) > 48 THEN DO ButtonT(i%) = LEFT$(ButtonT(i%), LEN(ButtonT(t%)) - 1) LOOP UNTIL DQBlen(ButtonT(t%)) <= 48 END IF IF LEN(btt$) = 0 THEN numbuttons% = i% + 1: EXIT FOR NEXT IF DQBlen(tit$) > maxlen% THEN maxlen% = DQBlen(tit$) 'adjust maxlen% IF numbuttons% = 1 AND maxlen% < 42 THEN maxlen% = 42 IF numbuttons% = 2 AND maxlen% < 96 THEN maxlen% = 96 IF numbuttons% = 3 AND maxlen% < 150 THEN maxlen% = 150 DQBwait 1 DQBmouseHide 'hide mouse when drawing IF resbk% THEN 'do we want to restore background 'calc size Size% = DQBsize(150 - maxlen% \ 2, 89 - numlines% * 3, 171 + maxlen% \ 2, 112 + numlines% * 3) DIM Back%(Size% \ 2) 'get background DQBget 0, 150 - maxlen% \ 2, 89 - numlines% * 3, 171 + maxlen% \ 2, 112 + numlines% * 3, VARSEG(Back%(0)), VARPTR(Back%(0)) END IF 'draw window Button 0, 150 - maxlen% \ 2, 89 - numlines% * 3, 20 + maxlen%, 23 + numlines% * 6, "", 0 DQBboxf 0, 151 - maxlen% \ 2, 90 - numlines% * 3, 169 + maxlen% \ 2, 97 - numlines% * 3, titleclr% 'print title DQBprint 0, tit$, 160 - DQBlen(tit$) \ 2, 91 - numlines% * 3, titletxtclr% FOR i% = 0 TO numlines% - 1 'print message DQBprint 0, Lines(i%), 160 - DQBlen(Lines(i%)) \ 2, 99 - numlines% * 3 + i% * 6, black NEXT DIM ButtonDown(2) AS INTEGER 'which button is pressed DQBmouseShow 'show mouse FirstTime% = -1 'needed for button drawing DO IF DQBmouseLB = 0 AND FirstTime% = 0 THEN 'check for pressed button FOR i% = 0 TO 2 IF ButtonDown(i%) = -1 THEN found% = i% + 1 'one is pressed NEXT IF found% <> 0 THEN MsgBox = found% EXIT DO END IF END IF DO in$ = INKEY$ IF in$ = CHR$(27) THEN MsgBox = -2: EXIT DO 'exit if Esc is pressed IF in$ = CHR$(13) THEN MsgBox = -1: EXIT DO ' " Enter " LOOP UNTIL DQBmouseLB OR FirstTime% IF in$ <> "" THEN EXIT DO 'if key was pressed, exit mx% = DQBmouseX my% = DQBmouseY FOR i% = 0 TO 2 'reset button values ButtonDown(i%) = 0 NEXT 'find, if any button is pressed IF my% >= 100 + numlines% * 3 AND my% <= 110 + numlines% * 3 AND NOT FirstTime% THEN IF numbuttons% = 1 THEN SELECT CASE mx% CASE 134 TO 186: ButtonDown(0) = -1 END SELECT ELSEIF numbuttons% = 2 THEN SELECT CASE mx% CASE 107 TO 159: ButtonDown(0) = -1 CASE 161 TO 213: ButtonDown(1) = -1 END SELECT ELSE SELECT CASE mx% CASE 80 TO 132: ButtonDown(0) = -1 CASE 134 TO 186: ButtonDown(1) = -1 CASE 188 TO 240: ButtonDown(2) = -1 END SELECT END IF END IF DQBwait 1 'with this, mouse pointer shouldn't flicker DQBmouseHide 'hide mouse cursor when drawing SELECT CASE numbuttons% 'draw buttons CASE 1 Button 0, 134, 100 + numlines% * 3, 0, 0, ButtonT(0), ButtonDown(0) CASE 2 Button 0, 107, 100 + numlines% * 3, 0, 0, ButtonT(0), ButtonDown(0) Button 0, 161, 100 + numlines% * 3, 0, 0, ButtonT(1), ButtonDown(1) CASE 3 Button 0, 80, 100 + numlines% * 3, 0, 0, ButtonT(0), ButtonDown(0) Button 0, 134, 100 + numlines% * 3, 0, 0, ButtonT(1), ButtonDown(1) Button 0, 188, 100 + numlines% * 3, 0, 0, ButtonT(2), ButtonDown(2) END SELECT DQBmouseShow 'show cursor FirstTime% = 0 LOOP IF resbk% THEN 'restore background image DQBmouseHide DQBfPut 0, 150 - maxlen% \ 2, 89 - numlines% * 3, VARSEG(Back%(0)), VARPTR(Back%(0)) DQBmouseShow END IF ERASE Back%, Lines, ButtonT, ButtonDown END FUNCTION ' ' OpenDialog - file selection dialog box ' ' Usage: file$ = OpenDialog (extensions$, title$) ' ' file$ returns selected file (null string, if pressed cancel) ' extensions$ file extensions to show (example: "modmidxm stm" - show ' *.mod, *.mid, *.xm and *.stm files) ' title$ dialog box title ' '============================================================================ ' ' Original by Angelo Mottola (from DQbTools). ' Changed by Jernej Simoncic: a bit different interface, different extensions ' at once, combined with ShellSort ' FUNCTION OpenDialog$ (ext$, tit$) DIM file(512) AS STRING, Dir(128) AS STRING DIM NumFiles AS INTEGER, NumDirs AS INTEGER DIM FilePos AS INTEGER, DirPos AS INTEGER DIM FileCur AS SINGLE, DirCur AS SINGLE DIM FileStep AS SINGLE, DirStep AS SINGLE DIM FileSel AS STRING DQBmouseHide Button 0, 20, 28, 280, 142, "", 0 DQBboxf 0, 21, 29, 299, 36, deftbar DQBprint 0, tit$, 160 - DQBlen(tit$) \ 2, 30, textcol DQBprint 0, "Files", 30, 52, textcol Button 0, 30, 60, 95, 80, "", 1 DQBboxf 0, 31, 61, 124, 139, black Button 0, 127, 63, 10, 0, "ƒ", 0 Button 0, 127, 126, 10, 0, "„", 0 Button 0, 127, 74, 10, 51, "", 1 DQBprint 0, "Dirs/Drives", 175, 52, textcol Button 0, 176, 60, 80, 80, "", 1 Button 0, 259, 63, 10, 0, "ƒ", 0 Button 0, 259, 126, 10, 0, "„", 0 Button 0, 259, 74, 10, 51, "", 1 Button 0, 166, 148, 0, 0, "Cancel", 0 Button 0, 90, 148, 0, 0, "OK", 0 GOSUB ShowListLoad DO x = DQBmouseX: y = DQBmouseY IF NOT (x > 127 AND x < 137 AND y < 73 AND y > 63) THEN Button 0, 127, 63, 10, 0, "ƒ", 0 END IF IF NOT (x > 127 AND x < 137 AND y > 126 AND y < 136) THEN Button 0, 127, 126, 10, 0, "„", 0 END IF IF NOT (x > 259 AND x < 269 AND y < 76 AND y > 60) THEN Button 0, 259, 63, 10, 0, "ƒ", 0 END IF IF NOT (x > 259 AND x < 269 AND y > 126 AND y < 136) THEN Button 0, 259, 126, 10, 0, "„", 0 END IF IF NOT (y > 148 AND y < 158) THEN DQBwait 1 Button 0, 90, 148, 0, 0, "OK", 0 Button 0, 166, 148, 0, 0, "Cancel", 0 ELSE IF NOT (x > 90 AND x < 142) THEN DQBwait 1 Button 0, 90, 148, 0, 0, "OK", 0 END IF IF NOT (x > 166 AND x < 218) THEN DQBwait 1 Button 0, 166, 148, 0, 0, "Cancel", 0 END IF END IF IF NOT DQBmouseLB AND readytogo = -1 THEN IF y > 148 AND y < 158 THEN IF x > 90 AND x < 142 THEN Button 0, 90, 148, 0, 0, "OK", 1 EXIT DO ELSEIF x > 166 AND x < 218 THEN Button 0, 166, 148, 0, 0, "Cancel", 1 FileSel = "": EXIT DO END IF END IF END IF readytogo = 0 IF DQBmouseLB THEN IF y > 148 AND y < 158 THEN IF x > 90 AND x < 142 THEN readytogo = -1 DQBwait 1 DQBmouseHide Button 0, 90, 148, 0, 0, "OK", 1 DQBmouseShow ELSEIF x > 166 AND x < 218 THEN DQBwait 1 DQBmouseHide Button 0, 166, 148, 0, 0, "Cancel", 1 DQBmouseShow readytogo = -1 END IF END IF IF y > 60 AND y < 136 THEN IF x > 127 AND x < 137 AND y < 73 AND FilePos > 0 THEN DQBwait 4 DQBwait 1 DQBmouseHide FilePos = FilePos - 1: FileCur = FileCur - FileStep Button 0, 127, 63, 10, 0, "ƒ", 1 Button 0, 30, 60, 95, 80, "", 1 DQBboxf 0, 31, 61, 124, 139, black Button 0, 127, 74, 10, 51, "", 1 FOR i = 0 TO 9 DQBprint 0, file(FilePos + i), 32, 61 + (i * 8), textcol NEXT i DQBboxf 0, 128, 76 + INT(FileCur), 136, 84 + INT(FileCur), deftbar DQBmouseShow END IF IF x > 127 AND x < 137 AND y > 126 AND FilePos < NumFiles - 9 THEN DQBwait 4 FilePos = FilePos + 1: FileCur = FileCur + FileStep DQBwait 1 DQBmouseHide Button 0, 127, 126, 10, 0, "„", 1 Button 0, 30, 60, 95, 80, "", 1 DQBboxf 0, 31, 61, 124, 139, black Button 0, 127, 74, 10, 51, "", 1 FOR i = 0 TO 9 DQBprint 0, file(FilePos + i), 32, 61 + (i * 8), textcol NEXT i DQBboxf 0, 128, 76 + INT(FileCur), 136, 84 + INT(FileCur), deftbar DQBmouseShow END IF IF x > 259 AND x < 269 AND y < 76 AND DirPos > 0 THEN DQBwait 4 DQBmouseHide DirPos = DirPos - 1: DirCur = DirCur - DirStep Button 0, 259, 63, 10, 0, "ƒ", 1 Button 0, 175, 60, 82, 80, "", 1 DQBboxf 0, 176, 61, 256, 139, black Button 0, 259, 74, 10, 51, "", 1 FOR i = 0 TO 9 DQBprint 0, Dir(DirPos + i), 177, 61 + (i * 8), textcol NEXT i DQBboxf 0, 260, 76 + INT(DirCur), 268, 84 + INT(DirCur), deftbar DQBmouseShow END IF IF x > 259 AND x < 269 AND y > 126 AND DirPos < NumDirs - 9 THEN DQBwait 4 DQBmouseHide Button 0, 259, 126, 10, 0, "„", 1 DirPos = DirPos + 1: DirCur = DirCur + DirStep Button 0, 175, 60, 82, 80, "", 1 DQBboxf 0, 176, 61, 256, 139, black Button 0, 259, 74, 10, 51, "", 1 FOR i = 0 TO 9 DQBprint 0, Dir(DirPos + i), 177, 61 + (i * 8), textcol NEXT i DQBboxf 0, 260, 76 + INT(DirCur), 268, 84 + INT(DirCur), deftbar DQBmouseShow END IF IF x > 30 AND x < 125 THEN IF (FilePos + ((y - 61) \ 8)) < NumFiles THEN FileSel = file(FilePos + ((y - 61) \ 8)) path$ = DQBdrive$ + ":\" + DQBpath$ IF RIGHT$(path$, 1) <> "\" THEN path$ = path$ + "\" path$ = path$ + FileSel IF DQBlen(path$) > 160 THEN DO path$ = RIGHT$(path$, LEN(path$) - 1) LOOP UNTIL DQBlen(path$) <= 160 path$ = ".." + path$ END IF DQBmouseHide DQBboxf 0, 30, 42, 299, 50, face DQBprint 0, path$, 30, 42, black DQBmouseShow END IF END IF IF x > 175 AND x < 257 THEN DQBwait 4 DirSel = DirPos + ((y - 61) \ 8) IF DirSel > (NumDirs - DQBnumDrives) THEN IF DirSel <= NumDirs THEN DQBsetDrive CHR$(DirSel - NumDirs + DQBnumDrives + 64) END IF ELSE CHDIR Dir(DirPos + ((y - 61) \ 8)) END IF GOSUB ShowListLoad DQBwait 20 END IF END IF END IF LOOP OpenDialog$ = FileSel DQBmouseHide DQBmouseShow EXIT FUNCTION ShowListLoad: FOR i = 0 TO 512: file(i) = "" IF i <= 128 THEN Dir(i) = "" NEXT i NumFiles = 0 e$ = ext$ DO ex$ = LTRIM$(RTRIM$(LEFT$(e$, 3))) file(NumFiles) = DQBdir$("*." + ex$, 32) IF file(NumFiles) <> "" THEN DO NumFiles = NumFiles + 1 IF NumFiles = 512 THEN EXIT DO file(NumFiles) = DQBdir$("", 32) LOOP WHILE file(NumFiles) <> "" END IF IF LEN(e$) >= 3 THEN e$ = RIGHT$(e$, LEN(e$) - 3) LOOP UNTIL LEN(e$) < 3 NumDirs = 0 Dir(0) = DQBdir$("*.", 16) IF Dir(0) <> "" THEN DO NumDirs = NumDirs + 1 IF NumDirs = 120 THEN EXIT DO Dir(NumDirs) = DQBdir$("", 16) LOOP WHILE Dir(NumDirs) <> "" END IF NumDirs = NumDirs - 1 ShellSort Dir(), NumDirs, 0 FOR i = 1 TO DQBnumDrives NumDirs = NumDirs + 1 Dir(NumDirs) = "[-" + CHR$(64 + i) + "-]" NEXT i path$ = DQBdrive$ + ":\" + DQBpath$ IF DQBlen(path$) > 160 THEN DO path$ = RIGHT$(path$, LEN(path$) - 1) LOOP UNTIL DQBlen(path$) <= 160 path$ = ".." + path$ END IF IF RIGHT$(path$, 1) <> "\" THEN path$ = path$ + "\" 'path$ = path$' + "*" + ext$ IF LEN(path$) < 33 THEN path$ = path$ + SPACE$(33 - LEN(path$)) ShellSort file(), NumFiles - 1, 0 DQBmouseHide DQBsetTextBackCol face DQBsetTextStyle 1 DQBprint 0, path$, 30, 42, black Button 0, 127, 74, 10, 51, "", 1 Button 0, 30, 60, 95, 80, "", 1 DQBboxf 0, 31, 61, 124, 139, black Button 0, 175, 60, 82, 80, "", 1 DQBboxf 0, 176, 61, 256, 139, black FilePos = 0: DirPos = 0: FileCur = 0: DirCur = 0 IF NumFiles <= 10 THEN FileStep = 0 DQBboxf 0, 128, 76, 136, 124, deftbar ELSE FileStep = 40 / (NumFiles - 9) DQBboxf 0, 128, 76, 136, 84, deftbar END IF IF NumDirs <= 10 THEN DirStep = 0 DQBboxf 0, 260, 76, 268, 124, deftbar ELSE DirStep = 40 / (NumDirs - 9) DQBboxf 0, 260, 76, 268, 84, deftbar END IF DQBsetTextStyle 0 FOR i = 0 TO 9 IF file(i) <> "" THEN DQBprint 0, file(i), 32, 61 + (i * 8), textcol END IF DQBprint 0, Dir(i), 177, 61 + (i * 8), textcol NEXT i DQBmouseShow FileSel = "" RETURN END FUNCTION REM $STATIC ' ' SaveDialog - file save dialog box ' ' Usage: SaveDialog (file$, title$, exists%) ' ' file$ returns typed file name (null string, if pressed cancel) ' title$ dialog box title ' exists% Returns -1 if file exists ' '============================================================================ ' ' Note: SaveDialog does not restore screen after exiting. You have to take ' care of that. ' ' Original by Angelo Mottola (from DQbTools). ' Changed by Jernej Simoncic: a bit different interface, different extensions ' at once, combined with ShellSort ' SUB SaveDialog (file$, tit$, exist%) DIM Dir(128) AS STRING, NumDirs AS INTEGER DIM DirPos AS INTEGER, DirCur AS SINGLE DIM DirStep AS SINGLE, FileSel AS STRING DQBmouseHide Button 0, 20, 28, 280, 142, "", 0 DQBboxf 0, 21, 29, 299, 36, deftbar DQBprint 0, tit$, 160 - DQBlen(tit$) \ 2, 30, textcol Button 0, 31, 90, 108, 8, "", 1 DQBboxf 0, 32, 91, 138, 97, black DQBprint 0, "Dirs/Drives", 175, 52, textcol Button 0, 176, 60, 80, 80, "", 1 Button 0, 259, 63, 10, 0, "ƒ", 0 Button 0, 259, 126, 10, 0, "„", 0 Button 0, 259, 74, 10, 51, "", 1 Button 0, 166, 148, 0, 0, "Cancel", 0 Button 0, 90, 148, 0, 0, "OK", 0 GOSUB ShowListSave DQBprint 0, file$ + "_", 33, 92, textcol DQBmouseShow DO x = DQBmouseX: y = DQBmouseY IF NOT (x > 259 AND x < 269 AND y < 76 AND y > 60) THEN Button 0, 259, 63, 10, 0, "ƒ", 0 END IF IF NOT (x > 259 AND x < 269 AND y > 126 AND y < 136) THEN Button 0, 259, 126, 10, 0, "„", 0 END IF IF NOT (y > 148 AND y < 158) THEN DQBwait 1 Button 0, 90, 148, 0, 0, "OK", 0 Button 0, 166, 148, 0, 0, "Cancel", 0 ELSE IF NOT (x > 90 AND x < 142) THEN DQBwait 1 Button 0, 90, 148, 0, 0, "OK", 0 END IF IF NOT (x > 166 AND x < 218) THEN DQBwait 1 Button 0, 166, 148, 0, 0, "Cancel", 0 END IF END IF IF NOT DQBmouseLB AND readytogo = -1 THEN IF y > 148 AND y < 158 THEN IF x > 90 AND x < 142 THEN Button 0, 90, 148, 0, 0, "OK", 1 EXIT DO ELSEIF x > 166 AND x < 218 THEN Button 0, 166, 148, 0, 0, "Cancel", 1 file$ = "": EXIT DO END IF END IF END IF readytogo = 0 IF DQBmouseLB THEN IF y > 148 AND y < 158 THEN IF x > 90 AND x < 142 THEN readytogo = -1 DQBwait 1 DQBmouseHide Button 0, 90, 148, 0, 0, "OK", 1 DQBmouseShow ELSEIF x > 166 AND x < 218 THEN DQBwait 1 DQBmouseHide Button 0, 166, 148, 0, 0, "Cancel", 1 DQBmouseShow readytogo = -1 END IF END IF IF y > 60 AND y < 140 THEN IF x > 259 AND x < 269 AND y < 76 AND DirPos > 0 THEN DQBwait 4 DQBmouseHide DirPos = DirPos - 1: DirCur = DirCur - DirStep Button 0, 259, 63, 10, 0, "ƒ", 1 Button 0, 175, 60, 82, 80, "", 1 DQBboxf 0, 176, 61, 256, 139, black Button 0, 259, 74, 10, 51, "", 1 FOR i = 0 TO 9 DQBprint 0, Dir(DirPos + i), 177, 61 + (i * 8), textcol NEXT i DQBboxf 0, 260, 76 + INT(DirCur), 268, 84 + INT(DirCur), deftbar DQBmouseShow END IF IF x > 259 AND x < 269 AND y > 126 AND DirPos < NumDirs - 9 THEN DQBwait 4 DQBmouseHide Button 0, 259, 126, 10, 0, "„", 1 DirPos = DirPos + 1: DirCur = DirCur + DirStep Button 0, 175, 60, 82, 80, "", 1 DQBboxf 0, 176, 61, 256, 139, black Button 0, 259, 74, 10, 51, "", 1 FOR i = 0 TO 9 DQBprint 0, Dir(DirPos + i), 177, 61 + (i * 8), textcol NEXT i DQBboxf 0, 260, 76 + INT(DirCur), 268, 84 + INT(DirCur), deftbar DQBmouseShow END IF IF x > 175 AND x < 257 THEN DQBwait 4 DirSel = DirPos + ((y - 61) \ 8) IF DirSel > (NumDirs - DQBnumDrives) THEN IF DirSel <= NumDirs THEN DQBsetDrive CHR$(DirSel - NumDirs + DQBnumDrives + 64) END IF ELSE CHDIR Dir(DirPos + ((y - 61) \ 8)) END IF GOSUB ShowListSave DQBwait 20 END IF END IF END IF k$ = INKEY$ IF k$ <> "" THEN DQBmouseHide k$ = UCASE$(k$) SELECT CASE k$ CASE "A" TO "Z", "0" TO "9", ".", "-", "+", "~", "!", "(", ")", CHR$(128) TO CHR$(173) IF k$ = "." THEN IF INSTR(file$, ".") = 0 THEN file$ = file$ + "." ELSE IF INSTR(file$, ".") > 0 THEN IF LEN(file$) < INSTR(file$, ".") + 3 THEN file$ = file$ + k$ END IF ELSE IF LEN(file$) < 8 THEN file$ = file$ + k$ END IF END IF CASE CHR$(8) IF LEN(file$) > 0 THEN file$ = LEFT$(file$, LEN(file$) - 1) CASE CHR$(13) IF LEN(file$) > 0 THEN EXIT DO ELSE EXIT SUB END IF END SELECT DQBboxf 0, 32, 91, 138, 97, black DQBprint VIDEO, file$ + "_", 33, 92, textcol DQBmouseShow END IF LOOP IF file$ <> "" THEN IF LCASE$(DQBdir$(file$, &H20)) = LCASE$(file$) THEN exist% = -1 END IF END IF EXIT SUB ShowListSave: DQBmouseHide FOR i = 0 TO 128: Dir(i) = "": NEXT i NumDirs = 0 Dir(0) = DQBdir$("*.", 16) IF Dir(0) <> "" THEN DO NumDirs = NumDirs + 1 IF NumDirs = 120 THEN EXIT DO Dir(NumDirs) = DQBdir$("", 16) LOOP WHILE Dir(NumDirs) <> "" END IF NumDirs = NumDirs - 1 FOR i = 1 TO DQBnumDrives NumDirs = NumDirs + 1 Dir(NumDirs) = "[-" + CHR$(64 + i) + "-]" NEXT i path$ = DQBdrive$ + ":\" + DQBpath$ IF RIGHT$(path$, 1) <> "\" THEN path$ = path$ + "\" IF LEN(path$) < 33 THEN path$ = path$ + SPACE$(33 - LEN(path$)) IF LEN(path$) < 33 THEN path$ = path$ + SPACE$(33 - LEN(path$)) DQBsetTextStyle 1 DQBsetTextBackCol face DQBprint 0, path$, 30, 42, black Button 0, 175, 60, 82, 80, "", 1 DQBboxf 0, 176, 61, 256, 139, black DirPos = 0: DirCur = 0 IF NumDirs <= 10 THEN DirStep = 0 DQBboxf 0, 260, 76, 268, 124, deftbar ELSE DirStep = 40 / (NumDirs - 9) DQBboxf 0, 260, 76, 268, 84, deftbar END IF DQBsetTextStyle 0 FOR i = 0 TO 9 DQBprint 0, Dir(i), 177, 61 + (i * 8), textcol NEXT i DQBmouseShow RETURN END SUB '=========================================================================== ' Subject: SHELL SORT SUBROUTINE Date: 06-22-98 (22:10) ' Author: Douglas Bunger Code: QB, QBasic, PDS ' Origin: www.public.usit.net/dbunger/.. Packet: ALGOR.ABC '=========================================================================== '====================================== SUB ShellSort (a$(), number, direction) '====================================== ' number = items in array to be sorted ' (first item must be #1) ' direction = 0 for ascending ' 1 for decending ' Offset = number \ 2 DO WHILE Offset > 0: limit = number - Offset DO: switch = 0 FOR row = 0 TO limit: doit = 0 IF direction = 0 THEN IF a$(row) > a$(row + Offset) THEN doit = 1 ELSE IF a$(row) < a$(row + Offset) THEN doit = 1 END IF IF doit = 1 THEN SWAP a$(row), a$(row + Offset): switch = row NEXT row: limit = switch - Offset LOOP WHILE switch: Offset = Offset \ 2 LOOP END SUB