'=========================================================================== ' Subject: TEXTMODE WINDOZE ENGINE Date: 10-13-97 (18:48) ' Author: Sami Kyostila Code: QB, QBasic, PDS ' Origin: hiteck@mail.freenet.hut.fi Packet: TEXT.ABC '=========================================================================== '----[TWIN.BAS (C) Sami Ky”stil„ 1997]---------------------------------------- ' ÚÄÄÄÄÄÄ¿ÚÄÄ¿ÚÄÄÄÄÄ¿ÚÄÄÄÄ¿ ÚÄÄÄ¿ ÚÄÄÄÄ¿ÚÄÄÄÄ¿ ' ³Û° Û°³³Û°³³Û° Û°³³ÛÛÛ°À¿ÚÙÛÛ°À¿³ÛÛÛ°³³ÛÛÛ°³ ' ³Û° Û°³ÃÄÄ´³Û° Û°³³Û° Û°³³Û° Û°³³ Û°³³Û° ³ ' ú úúÄúÄ´Û° ۰ô۰ôÛ۰۰ô۰ ۰ô۰ ۰ô Û° ôÛÛ° ÃÄúÄúú ú ' ³Û°Û°Û°³³Û°³³Û°ÛÛ°³³Û° Û°³³Û° Û°³³Û° ³³Û° ³ ' ³ÛÛ°ÛÛ°³³Û°³³Û° Û°³³ÛÛÛ°ÚÙÀ¿ÛÛ°ÚÙ³ÛÛÛ°³³ÛÛÛ°³ ' ÀÄÄÄÄÄÄÙÀÄÄÙÀÄÄÄÄÄÙÀÄÄÄÄÙ ÀÄÄÄÙ ÀÄÄÄÄÙÀÄÄÄÄÙ ' ' EúNúGúIúNúE ' ' ::[V1.00]:: ' ' [TúEúXúTúMúOúDúE]-[VúEúRúSúIúOúN] ' ' ÚÄÄÄ¿ ÚÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ú úúÄúÄÄÄ´(C)ÃÄ´SúAúMúiÃÄ´KúYú™úSúTúiúLúŽÃÄÄúÄúú ú ' ÀÄÄÄÙ ÀÄÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ' ' ú úúÄúÄ1Ä9Ä9Ä7ÄúÄúú ú ' '---------------------------------------------------------------------------- ' ' If you have any comments, questions, bug reports, etc. please send them to: ' ' hiteck@freenet.hut.fi ' ' or: ' ' kemple.oy@mbnet.fi ' ' or contact hiteck in IRC ' '---------------------------------------------------------------------------- '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '* * '* You are granted a permission (and encouraged) to use this code to * '* build your own applications, as long as I am credited for the * '* engine, after all, it's not that easy to write 4000+ lines of source ;) * '* Also include the above box somewhere in your program's source * '* * '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '---------------------------------------------------------------------------- ' ' Required files: TWIN.BAS - Main source ' ' Programming language: Microsoft QuickBasic v4.5 ' (Should also run under QB v1.1 and PDS) ' '---------------------------------------------------------------------------- '---------------------------------------------------------------------------- ' ' This program has been completely written by me, Sami Ky”stil„, except ' for the following routines, which I have modified from other peoples' ' programs: ' ' - DMA Wav player modified from Mike Huff's DMAPLAY.BAS ' (added 32k+ file support) ' - Mouse routines modified from Mikrobitti Magazine's article ' - Original idea from William Yu's ABC Express Reader ' - High intensity backround colors from Byron Smith's program ' - Directory routines from QDIR.BAS (sorry, don't know who made it) ' ' Almost every SUB in this program is commented to help you master this ' engine. If a SUB's description says "SYSTEM", that means that ' you don't have to worry about that one, it is handled by the engine. ' ' Here is a list of some of the SUBS: ' (???? is a wildcard) ' ' Main - The engine's inmost core, handles all objects ' DefScreen - Defines screen parameters, like colors, screen lines etc. ' Initscreen - Place your object creation calls in here ' Create???? - These subs create objects, read the description to ' find out their parameters etc. ' KillWindow - This sub removes a window and it's contents ' You can remove a single object by setting it's ????.Active ' Flag to 0, for example for a Label, Label(Num).Active = 0 ' Redraw the screen after this ' WAVPlayDMA - Plays WAV/VOC files in the backround ' Exist - Checks if a file exists ' ????Volume - Sound Blaster volume settings ' Hiiripiiloon - Hides the mouse cursor, so the screen won't mess up when ' drawing (see sub MouseInside) ' Hiiriesiin - Shows the mouse cursor ' Dialog - Displays a message box, or prompt the user for information ' Query - Queries user for a text string (Name, Filename, etc.) ' FDialog - Initializes the built-in file browser (Save) ' FSelect - Initializes the built-in file browser (Load) ' SampleByte - Samples a byte from the Sound Blaster Mic port ' (Doesn't work under Win95, at least not on my machine) ' ' There are lots of more useful SUBS/FUNCTIONS, so please browse through the ' SUB/FUNCTION list (press F2 to view it). ' '---------------------------------------------------------------------------- '---------------------------------------------------------------------------- ' Features '---------------------------------------------------------------------------- ' ' - A complete text user interface with movable windows and objects ' - Built-in filesystem browser ' - Intuitive interface, which resembles many commercial applications, ' like MS QuickBasic v4.5 ' - DMA backround Wav player, which supports unlimited file lenghts ' - User definable screen parameters ' - Customisable memory usage (See CONST-statements below) ' ' ...and the list goes on ' '---------------------------------------------------------------------------- '---------------------------------------------------------------------------- ' What is this thing anyway? '---------------------------------------------------------------------------- ' ' This program is a GUI (Graphical user interface) that you can use to write ' programs without having to make a new user interface for every program. ' It has may useful objects, for example a button, a checkbox, an text input ' field etc. The objects are similar to ones in Microsoft Windows 95, so ' users won't have trouble adjusting to them. It's great for installation ' programs (see SUB BackroundCopy). ' '---------------------------------------------------------------------------- '---------------------------------------------------------------------------- ' Your first Windoze program. '---------------------------------------------------------------------------- ' ' To write a Windoze program, you need to do a couple of things first: ' First you must delete every executable statement from SUB Initscreen, ' so the objects of this demo are deleted and you get a clean table to start ' from. Then delete all user event handlers between the lines "Start of user ' code" and "End user code" in the main module. SUB Initscreen is called at ' the start of the program, so place all your object creation commands there. ' But before that, you need to make a window where you can place your ' objects, since they can't be placed on a plain desktop. So insert the ' following line to SUB Initscreen: ' ' CreateWindow 1, 1, 1, 60, 15, 15, 7 "Test window" ' ^ ^ ^ ^ ^ ^ ^ ^ ' index coords color topic ' ' ' This line calls SUB Createwindow, which creates and draws a window at ' (1,1) - (60, 15). The window's index number is 1 and it's topic is ' "Test window", and it is filled, with color 7 (gray) with a color 15 (white) ' border. To change any of these properties, refer to SUB CreateWindow ' for parameter descriptions. The index number is the handle of the window. ' It will be used to refer to the window when creating objects into it. ' Now you should add an object to the window. Lets start with the button. ' Add this line to SUB Initscreen: ' ' CreateButton 1, 1, 4, 2, 8, 3, "Exit", 15, 3 ' ^ ^ ^ ^ ^ ^ ^ ^ ^ ' host window handle | | | | | Caption Color ' index coords (x,y,xlen, ylen) ' ' This line call SUB Createbutton, which creates and draws a button in window ' 1, with an handle (index) number of 1, placed at 4x, 2y, 8 chars wide, ' 3 chars high, and with the text "Exit" printed on it, white over cyan ' Now, try to run your program. It should display a light gray window in ' the upper left corner of the screen, with an "Exit" button in it. When ' you click the button, nothing happens, so lets fix it. When a button is ' clicked, the variable Clickedbutton is assigned the value of the clicked ' button's index number, in this case 1. So lets make an event handler for ' the button, so when it is clicked, the program is ended. Add these lines ' after the line "Start user code" in the main module: ' ' IF ClickedButton = 1 THEN 'Test if button 1 is clicked ' END 'End program ' END IF ' ' C O N G R A T U L A T i O N S ! ' ' You've just completed your first Windoze program! It's just a small ' demonstration of Windoze's cababilities. And it's also quite boring. ' You can add more complex objects into you program, and multiple windows ' Check out SUBS Create?????? to learn how to make objects like radiobuttons, ' checkboxes, scrollbars and menus. See SUB ColPrint, to find out how to ' print colored text on objects that support it. ' '---------------------------------------------------------------------------- '---------------------------------------------------------------------------- ' Useful variables '---------------------------------------------------------------------------- ' ' AWin - Which window is active ' AText - Active textfield ' .- MenuSelected.Win - Window, where selected menu resides ' |- MenuSelected.Num - Number of the menu where the selected item is ' |- MenuSelected.Item - Number of selected item ' | ' Use in conjuction to find out what menu item was selected ' ' Key$ - Pressed keyboard key (INKEY$) ' MouseMove - If 1, then mouse was moved ' Clickedbutton - The index of the button which was clicked ' Click - If 1, then mouse was clicked ' DBLClick - If 1, then mouse was double-clicked ' Drag - If 1, then a window is being moved ' Hx, Hy - Mouse coordinates ' Hv - Mouse left button (if -1, then being held down) ' Hk - Mouse center button (if -1, then being held down) ' Ho - Mouse right button (if -1, then being held down) ' PlayingWAV& - If True, then the system is playing a wav file ' Version.Major - Major version (1 char string) ' Version.Minor - Minor version (2 char string) ' SelectedLBox - Selected list box '\ ' SelectedName$(Num) - Name of selected ListBox item '- use to find out what ' SelectedItem - Number of selected ListBox item '/ item the user selected ' from a list box ' EnterText - Number of the textfield where the ' user pressed enter ' ' Most objects have variables which you can read the objects value from ' (or set it). See SUB Create???? to find out the variables for an object. ' '---------------------------------------------------------------------------- '---------------------------------------------------------------------------- ' Known bugs '---------------------------------------------------------------------------- ' ' - Objects (Labels for example) cannot be updated from other windows than ' they are in. This is actually not a bug, I've disabled it, because it ' causes screen redraw errors. I have no idea how to go about this problem. ' It would require lots of calculation to find out where to draw and where ' not to draw. ' - The file browser sometimes behaves strangely, I have no idea why. ' If you have any suggestions, please email me. ' - You cannot initialize the file selector, if a sound is playing in the ' backround. I've removed that ability, because if you do it, then ' you'll get garbage instead of filenames. Again, please email me if you ' can help. '---------------------------------------------------------------------------- '$DYNAMIC DEFINT A-Z DECLARE SUB DmaState (StopGo%) DECLARE SUB MasterVolume (right%, Left%, Getvol%) DECLARE SUB DrawShadow (x%, y%, x2%, y2%) DECLARE SUB DrawMenuItems (WindowNum%, Num%) DECLARE SUB DrawMenuBox (WindowNum%, Num%) DECLARE SUB CreateMenu (WindowNum%, Num%, Caption$) DECLARE SUB AddMenuItem (WindowNum%, Num%, Caption$) DECLARE SUB DrawMenu (WindowNum%) DECLARE FUNCTION FDialog$ (Text$, StartDir$, StartFile$) DECLARE SUB ReadDir2 (Dir$) DECLARE FUNCTION GetFileAttr% (Filename$) DECLARE FUNCTION QDir$ (FileSpec$, Dirs) DECLARE FUNCTION MouseInside% (x%, y%, x2%, y2%) DECLARE FUNCTION RealLen% (Text$) DECLARE SUB ColPrint (Text$) DECLARE FUNCTION FSelect$ (Text$, StartDir$, FileSpec$) DECLARE SUB DrawTaskBar () DECLARE SUB DrawPBar (Num%) DECLARE SUB CreatePBar (WindowNum%, Num%, x%, y%, XLen%, UsedCol%, FreeCol%, Max&, Value&) DECLARE FUNCTION DMADone% () DECLARE SUB ReadDir (Dir$, FileSpec$) DECLARE FUNCTION Query$ (Topic$, Text$, TextField$, MaxLen, Password%) DECLARE FUNCTION SeekBufferLine% (Num%, LineNum%) DECLARE FUNCTION FSelect$ (Text$, Dir$, FileSpec$) DECLARE SUB Dir.init (path$, attrib%) DECLARE SUB WAVPlayDMA (File$, Freq&) DECLARE FUNCTION DMADone% () DECLARE SUB DMAPlay (Segment&, Offset&, Length&, Freq&) DECLARE SUB writedsp (Byte%) DECLARE FUNCTION DSPVersion! () DECLARE SUB GetBLASTER (DMA%, BasePort%, IRQ%) DECLARE FUNCTION ReadDAC% () DECLARE FUNCTION ReadDSP% () DECLARE FUNCTION ResetDSP% () DECLARE SUB ResetSB () DECLARE FUNCTION Samplebyte% () DECLARE SUB SpeakerState (OnOff%) DECLARE FUNCTION SpeakerStatus% () DECLARE SUB CreateTextField (WindowNum%, Num%, x%, y%, MaxLen%, FCol%, BCol%, Text$, Password) DECLARE SUB DrawTextField (Num%) DECLARE FUNCTION InputField$ (Text$, Key$, MaxLen%, TPos%) DECLARE FUNCTION Dialog% (Topic$, Text$, Button1$, Button2$, Button3$) DECLARE SUB KillWindow (Num%) DECLARE SUB SeekLine (FileNum%, LineNum%) DECLARE SUB CreateListBox (WindowNum%, Num%, x%, y%, XLen%, YLen%, Filename$, Offset%, FCol%, BCol%, ViewBox, Col) DECLARE SUB DrawListBox (Num%) DECLARE FUNCTION CountLines% (File$) DECLARE FUNCTION Exist% (File$) DECLARE SUB CreateLabel (WindowNum%, Num%, x%, y%, XLen%, YLen%, Style%, FCol%, BCol%, Caption$) DECLARE SUB PrintLine (Text$, XLen%) DECLARE FUNCTION Wrap$ (InputText$, Wrappos%) DECLARE SUB DrawLabel (Num%) DECLARE SUB CreateRadioButton (WindowNum%, Num%, x%, y%, State%, Group%, Caption$) DECLARE SUB DrawRadio (Num%) DECLARE SUB Switch (Var%, Value1%, Value2%) DECLARE SUB CreateCheckBox (WindowNum%, Num%, x%, y%, State%, Caption$) DECLARE SUB DrawCheckBox (Num%) DECLARE SUB CreateFrame (WindowNum%, Num%, x%, y%, XLen%, YLen%, Caption$, Style%, FCol%, BCol%) DECLARE SUB Box3D (x%, y%, x2%, y2%, Style%, FCol%, BCol%, Back%) DECLARE SUB DrawFrame (Num) DECLARE SUB CreateButton (WindowNum%, Num%, x%, y%, XLen%, YLen%, Caption$, FCol, BCol) DECLARE SUB DrawButton (Num, Pressed) DECLARE SUB ReDrawWindow (Num%) DECLARE SUB Hiirirajat (x1%, y1%, x2%, y2%) DECLARE SUB DrawDesk (x%, y%, x2%, y2%) DECLARE SUB EraseBox () DECLARE SUB DrawBox (x%, y%, x2%, y2%) DECLARE SUB Initscreen () DECLARE SUB DefScreen () DECLARE SUB ReDrawScreen () DECLARE SUB CreateWindow (Num%, x%, y%, x2%, y2%, FCol%, BCol%, Topic$) DECLARE SUB BlinkOff () DECLARE SUB Hiirilue (vasen%, oikea%, keski%, x%, y%) DECLARE SUB Main () DECLARE SUB UpdateMouse () DECLARE SUB Hiiriesiin () DECLARE SUB Hiiripiiloon () DECLARE SUB Hiiriajuri (ax%, bx%, cx%, dx%) DECLARE FUNCTION Hiiritarkista% () DECLARE SUB DrawWindow (Num) OPTION BASE 1 'WAV-playback '------------ DIM SHARED WavBuffer(0 TO 0) AS STRING * 8000 DIM SHARED WavFreq& DIM SHARED WavFileHandle& DIM SHARED WavOffset& DIM SHARED WavLength& DIM SHARED PlayingWAV& DIM SHARED BasePort% DIM SHARED LenPort% DIM SHARED Channel% DIM SHARED IRQ% DIM SHARED EnterText AS INTEGER GetBLASTER Channel%, BasePort%, IRQ% 'Read Sound Blaster parameters TYPE Registers ax AS INTEGER bx AS INTEGER cx AS INTEGER dx AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER ds AS INTEGER es AS INTEGER Flags AS INTEGER END TYPE TYPE VersionType Major AS STRING * 1 Minor AS STRING * 2 END TYPE TYPE PBarType Win AS INTEGER x AS INTEGER y AS INTEGER x2 AS INTEGER UsedCol AS INTEGER FreeCol AS INTEGER Max AS LONG Value AS LONG OldValue AS LONG Active AS INTEGER END TYPE TYPE TextFieldType Win AS INTEGER x AS INTEGER y AS INTEGER MaxLen AS INTEGER FCol AS INTEGER BCol AS INTEGER TPos AS INTEGER Password AS INTEGER Active AS INTEGER END TYPE TYPE ListBoxType FCol AS INTEGER BCol AS INTEGER Win AS INTEGER x AS INTEGER y AS INTEGER x2 AS INTEGER y2 AS INTEGER Offset AS INTEGER Total AS INTEGER Selected AS INTEGER Block AS INTEGER UseBuffer AS INTEGER ViewBox AS INTEGER Active AS INTEGER Col AS INTEGER END TYPE TYPE CheckBoxType Win AS INTEGER x AS INTEGER y AS INTEGER State AS INTEGER Active AS INTEGER END TYPE TYPE RadioType Win AS INTEGER x AS INTEGER y AS INTEGER State AS INTEGER Group AS INTEGER Active AS INTEGER END TYPE TYPE ButtonType Win AS INTEGER x AS INTEGER y AS INTEGER x2 AS INTEGER y2 AS INTEGER FCol AS INTEGER BCol AS INTEGER Active AS INTEGER END TYPE TYPE WindowType x AS INTEGER y AS INTEGER x2 AS INTEGER y2 AS INTEGER FCol AS INTEGER BCol AS INTEGER END TYPE TYPE BoxType Col AS INTEGER Char AS STRING * 1 END TYPE TYPE FrameType Win AS INTEGER x AS INTEGER y AS INTEGER x2 AS INTEGER y2 AS INTEGER Style AS INTEGER FCol AS INTEGER BCol AS INTEGER Active AS INTEGER END TYPE TYPE LabelType Win AS INTEGER x AS INTEGER y AS INTEGER x2 AS INTEGER y2 AS INTEGER Style AS INTEGER FCol AS INTEGER BCol AS INTEGER Active AS INTEGER END TYPE TYPE Menutype Caption AS STRING * 10 Items AS INTEGER Longest AS INTEGER END TYPE TYPE MenuSelectedType Win AS INTEGER Num AS INTEGER Item AS INTEGER END TYPE CONST Float = 0 CONST SingleNormal = 1 CONST DoubleNormal = 2 CONST SingleIN = 3 CONST SingleOUT = 4 CONST DoubleIN = 5 CONST DoubleOUT = 6 CONST Filled = 7 CONST MaxTextFields = 10 'Adjust for lower memory usage CONST MaxListBoxes = 10 CONST MaxLabels = 10 CONST MaxCheckBoxes = 10 CONST MaxRadioButtons = 10 CONST MaxWindows = 10 CONST MaxButtons = 20 CONST MaxFrames = 10 CONST MaxPBars = 3 CONST BufferSize = 2000 'Listbox Buffer size CONST True = 0 CONST False = NOT True DIM SHARED MenuBar(MaxWindows + 1, 8) AS Menutype DIM SHARED Menu$(MaxWindows + 1, 8, 0 TO 14) DIM SHARED MenuSelected AS MenuSelectedType DIM SHARED AMenu AS INTEGER DIM SHARED MenuItem AS INTEGER DIM SHARED PBar(MaxPBars) AS PBarType DIM SHARED Version AS VersionType DIM SHARED OldTimer& DIM SHARED TaskBarLine AS INTEGER DIM SHARED TaskBar AS INTEGER '---------------------------------------------------------------------------- 'You get an "Out of memory" error here, 'decrease the constant BufferSize (above) 'or the maximum number of listboxes (also 'above) DIM SHARED Buf(1 TO MaxListBoxes + 2, 0 TO BufferSize) AS INTEGER '---------------------------------------------------------------------------- DIM SHARED BufferPos AS INTEGER DIM SHARED ReadByte AS STRING * 1 DIM SHARED AText AS INTEGER DIM SHARED CursorX AS INTEGER DIM SHARED CursorY AS INTEGER DIM SHARED TextF(MaxTextFields + 1) AS TextFieldType DIM SHARED TextFText$(MaxTextFields + 1) DIM SHARED GTime AS LONG DIM SHARED SelectedItem AS INTEGER DIM SHARED Key$ DIM SHARED LBoxFilename$(MaxListBoxes + 2) DIM SHARED LBox(MaxListBoxes + 2) AS ListBoxType DIM SHARED Label(MaxLabels + 1) AS LabelType DIM SHARED LabelCaption$(MaxLabels + 1) DIM SHARED LockWindows AS INTEGER DIM SHARED CBoxCaption$(MaxCheckBoxes) DIM SHARED CBox(MaxCheckBoxes) AS CheckBoxType DIM SHARED RadioCaption$(MaxRadioButtons) DIM SHARED Radio(MaxRadioButtons) AS RadioType DIM SHARED Frame(MaxFrames + 2) AS FrameType DIM SHARED FrameCaption$(MaxFrames + 2) DIM SHARED Lines AS INTEGER DIM SHARED ClickedButton AS INTEGER DIM SHARED HoldButton AS INTEGER DIM SHARED But(MaxButtons + 3) AS ButtonType DIM SHARED ButCaption$(MaxButtons + 3) DIM SHARED Box(1 TO 260) AS BoxType DIM SHARED BoxX DIM SHARED BoxX2 DIM SHARED BoxY DIM SHARED BoxY2 DIM SHARED DragWin AS INTEGER DIM SHARED AWin AS INTEGER DIM SHARED WinTopic$(MaxWindows + 1) DIM SHARED Win(MaxWindows + 1) AS WindowType DIM SHARED Hx AS INTEGER DIM SHARED Hy AS INTEGER DIM SHARED Hv AS INTEGER DIM SHARED Hk AS INTEGER DIM SHARED Ho AS INTEGER DIM SHARED OldHiiriX AS INTEGER DIM SHARED OldHiiriY AS INTEGER DIM SHARED Click AS INTEGER DIM SHARED ActiveTopicF, ActiveTopicB DIM SHARED DeActiveTopicF, DeActiveTopicB DIM SHARED Drag AS INTEGER DIM SHARED DragOfs AS INTEGER DIM SHARED DragXLen AS INTEGER DIM SHARED DragYLen AS INTEGER DIM SHARED MouseMove AS INTEGER DIM SHARED DesktopFCol AS INTEGER DIM SHARED DesktopBCol AS INTEGER DIM SHARED DesktopChar$ DIM SHARED SelectedLBox AS INTEGER DIM SHARED Ku$ DIM SHARED Kr$ DIM SHARED Kl$ DIM SHARED Kd$ DIM SHARED SelectedName$(MaxListBoxes + 2) DIM SHARED Windows AS INTEGER DIM SHARED ClickCount AS LONG DIM SHARED DBLClick AS INTEGER DIM SHARED Regs AS Registers DIM SHARED Code(0 TO 55) DIM SHARED DTA AS STRING * 44 DIM SHARED TheString AS STRING * 80 RESTORE DirCode Chk& = 0 FOR i = 0 TO 55 READ Temp& Chk& = Chk& + Temp& Code(i) = Temp& NEXT IF Chk& <> -228741 THEN 'Checksum BEEP PRINT " þ Interrupt code array error" END END IF 'Define keys Ku$ = CHR$(0) + CHR$(72) Kr$ = CHR$(0) + CHR$(77) Kd$ = CHR$(0) + CHR$(80) Kl$ = CHR$(0) + CHR$(75) DefScreen SCREEN 0: CLS WIDTH 80, Lines VIEW PRINT 1 TO Lines BlinkOff Version.Major = "1" Version.Minor = "00" PRINT " þ Initializing mouse..." RESTORE MouseData DIM SHARED hiiri$ 'Konekielinen ajuri hiiri$ = SPACE$(57) 'Varataan tilaa FOR i% = 1 TO 57 READ a$ 'Luetaan data ja h$ = CHR$(VAL("&H" + a$)) 'muutetaan tekstimuotoisesta MID$(hiiri$, i%, 1) = h$ 'hexaluvusta tavuksi NEXT i% napit% = Hiiritarkista% 'Alustetaan hiiri IF (napit% = 0) THEN PRINT "Mouse not found!" END END IF Hiirirajat 0, 0, 80 * 8 - 8, Lines * 8 - 8 SCREEN , , 3, 0 DrawDesk 1, 1, 80, Lines + 1 PCOPY 3, 0 SCREEN , , 0, 0 LockWindows = False SelectedLBox = 1 SelectedItem = 0 AWin = 1 AText = 1 EnterText = 0 BufferPos = 0 PlayingWAV& = False Hiiriesiin LOCATE Lines \ 2, 36 Box3D 30, Lines \ 2 - 2, 50, Lines \ 2 + 2, SingleNormal, 15, 4, 3 DrawShadow 30, Lines \ 2 - 2, 49, Lines \ 2 + 3 LOCATE Lines \ 2, 32 COLOR 15, 4 PRINT "Initializing..." SCREEN , , 1, 0 Hiiripiiloon Initscreen ReDrawScreen PCOPY 1, 0 SCREEN , , 0, 0 ClickCount = TIMER Hiiriesiin Hiiriesiin MasterVolume 15, 15, True MasterVol = 15 DO UpdateMouse Main '---------------------------------------------------------------------------- ' Start user code '---------------------------------------------------------------------------- 'Play-Button IF ClickedButton = 1 THEN IF TextFText$(1) <> "" THEN IF Radio(1).State = True THEN Rate& = 8000: Speed! = .5 IF Radio(2).State = True THEN Rate& = 11025: Speed! = 1 IF Radio(3).State = True THEN Rate& = 16000: Speed! = 1.5 IF Radio(4).State = True THEN Rate& = 22050: Speed! = 2 IF Radio(5).State = True THEN Rate& = 32000: Speed! = 2.5 IF Radio(6).State = True THEN Rate& = 38000: Speed! = 3 IF Radio(7).State = True THEN Rate& = 44100: Speed! = 3.5 WAVPlayDMA TextFText$(1), Rate& IF PlayingWAV& = True THEN PBar(1).Max = LOF(WavFileHandle&) END IF END IF 'Volume buttons IF ClickedButton = 5 THEN MasterVol = MasterVol + 1 IF MasterVol > 15 THEN MasterVol = 15 CreateLabel 2, 1, 16, 10, 4, 3, Float, 16, 6, LTRIM$(RTRIM$(STR$(MasterVol))) MasterVolume MasterVol, MasterVol, True END IF IF ClickedButton = 6 THEN MasterVol = MasterVol - 1 IF MasterVol < 0 THEN MasterVol = 0 CreateLabel 2, 1, 16, 10, 4, 3, Float, 16, 6, LTRIM$(RTRIM$(STR$(MasterVol))) MasterVolume MasterVol, MasterVol, True END IF 'Update percent bar IF PlayingWAV& = True THEN PBar(1).Value = WavOffset& + 8000 END IF 'Browse-button IF ClickedButton = 2 THEN IF PlayingWAV& = False THEN TextFText$(1) = FSelect$("Choose a WAV file to play and then press the OK-button.", "c:\", "*.WAV") DrawTextField 1 END IF '"File"-menu in text viewer window, "Load"-item IF MenuSelected.Win = 4 AND MenuSelected.Num = 1 AND MenuSelected.Item = 1 THEN Filename$ = FSelect("Select a text file to view", "C:\", "*.TXT") IF Filename$ <> "" THEN CreateListBox 4, 2, 0, 1, 77, 5, Filename$, 0, 7, 1, True, False SelectedLBox = 1 END IF '"File"-menu in text viewer window, "Save"-item IF MenuSelected.Win = 4 AND MenuSelected.Num = 1 AND MenuSelected.Item = 2 THEN Filename$ = FDialog("Choose a filename where to save you work. (Demo Only)", "C:\", "FOO.TXT") END IF 'User selected an item in the list box IF SelectedLBox = 1 AND SelectedItem <> 0 AND AWin = 3 THEN Dummy = Dialog("Info", "You selected item" + STR$(SelectedItem), "OK", "", "") END IF 'Percent bars showing mouse movement 'Also checks if checkbox 1 is set IF CBox(1).State = True THEN PBar(2).Value = Hx PBar(3).Value = Hy END IF '"Menu"-menu in demowindow, 1st item IF MenuSelected.Win = 3 AND MenuSelected.Num = 1 AND MenuSelected.Item = 1 THEN SOUND 100, 1 SOUND 150, 1 SOUND 200, 1 END IF '"Menu"-menu in demowindow, 2nd item IF MenuSelected.Win = 3 AND MenuSelected.Num = 1 AND MenuSelected.Item = 2 THEN SOUND 500, 1 SOUND 550, 1 SOUND 600, 1 END IF '"Menu"-menu in demowindow, 3rd item IF MenuSelected.Win = 3 AND MenuSelected.Num = 1 AND MenuSelected.Item = 3 THEN SOUND 1000, 1 SOUND 1050, 1 SOUND 1100, 1 END IF '"Menu"-menu in demowindow, 4th item IF MenuSelected.Win = 3 AND MenuSelected.Num = 1 AND MenuSelected.Item = 4 THEN SOUND 1500, 1 SOUND 1550, 1 SOUND 1600, 1 END IF '"Menu"-menu in demowindow, "Quit"-Item 'NOTE: the separator line in the menu ' is also counted as an item, so ' the number of the "Quit"-item is ' 6 instead of 5 IF MenuSelected.Win = 3 AND MenuSelected.Num = 1 AND MenuSelected.Item = 6 THEN END END IF '"Help-menu in demowindow, "About"-Item IF MenuSelected.Win = 3 AND MenuSelected.Num = 2 AND MenuSelected.Item = 1 THEN Dummy = Dialog("About Windoze v" + Version.Major + "." + Version.Minor, "Windoze v" + Version.Major + "." + Version.Minor + " by Sami Ky”stil„ 1997. You may use this program freely as long as you give me credit for it", "OK", "", "") END IF '"Help-menu in demowindow, "About Taskbar"-Item IF MenuSelected.Win = 3 AND MenuSelected.Num = 2 AND MenuSelected.Item = 2 THEN Dummy = Dialog("About Taskbar", "The taskbar at the bottom of the screen can be removed if you find it disturbing from the SUB DefScreen", "OK", "", "") END IF '"Help-menu in demowindow, "Contact the Author"-Item IF MenuSelected.Win = 3 AND MenuSelected.Num = 2 AND MenuSelected.Item = 3 THEN Dummy = Dialog("Contacting the Author", "If you have any questions, comments, etc, feel free to send them to Sami Ky”stil„ (hiteck@freenet.hut.fi or kemple.oy@mbnet.fi)", "OK", "", "") END IF '"Help-menu in demowindow, "Free memory"-Item IF MenuSelected.Win = 3 AND MenuSelected.Num = 2 AND MenuSelected.Item = 5 THEN Dummy = Dialog("Free memory", "String:" + STR$(FRE(1)) + CHR$(255) + "Stack:" + STR$(FRE(0)) + " " + "Array:" + STR$(FRE(-1)), "OK", "", "") END IF 'Question-Button IF ClickedButton = 3 THEN Name$ = Query$("Query", "What is your name?", "", 15, False) IF Name$ = "" THEN Name$ = "Mr. Anonymous" Dummy = Dialog("Hi there", "Hi there, " + Name$ + "!", "Hi!", "", "") END IF '---------------------------------------------------------------------------- ' End user code '---------------------------------------------------------------------------- LOOP DirCode: 'Don't mess with this! 'I've included a checksum 'count to prevent possible 'data loss if someone messes 'with this. DATA -29867,22252,7767,5638,-29921,2142 DATA 8075,13502,11776,7304,30347,-1018,20653 DATA -29779,-21032,-14197,-29779,-21040 DATA -6005,20653,-29779,-21000,-21168,-16242 DATA 24095,-12968,-25600,22278,-29867,5868 DATA -29945,5758,-21508,-15477,-29781,-21567 DATA -15733,22699,-29781,-21562,-21672,-10100 DATA 22699,22699,1963,24351,23902,1226 DATA 0,0,0,0,0,0,0,0 MouseData: 'Don't mess with this either DATA 55, 89, E5, 8B, 5E, 0C, 8B, 07, 50, 8B, 5E, 0A, 8B, 07, 50, 8B DATA 5E, 08, 8B, 0F, 8B, 5E, 06, 8B, 17, 5B, 58, 1E, 07, CD, 33, 53 DATA 8B, 5E, 0C, 89, 07, 58, 8B, 5E, 0A, 89, 07, 8B, 5E, 08, 89, 0F DATA 8B, 5E, 06, 89, 17, 5D, CA, 08, 00 REM $STATIC SUB AddMenuItem (WindowNum, Num, Caption$) '---------------------------------------------------------------------------- ' Adds a menu item into a menu '---------------------------------------------------------------------------- ' ' WindowNum - Host window of the menu ' Num - The number of the menu in the window, ' counting from left to right (1: First, 2: Second etc.) ' Caption$ - Caption of the menu item. (Blank for a separator) ' '---------------------------------------------------------------------------- MenuBar(WindowNum, Num).Items = MenuBar(WindowNum, Num).Items + 1 IF MenuBar(WindowNum, Num).Items > Win(WindowNum).y2 - Win(WindowNum).y - 4 THEN MenuBar(WindowNum, Num).Items = Win(WindowNum).y2 - Win(WindowNum).y - 4 Menu$(WindowNum, Num, MenuBar(WindowNum, Num).Items) = Caption$ IF LEN(Caption$) > MenuBar(WindowNum, Num).Longest THEN MenuBar(WindowNum, Num).Longest = LEN(Caption$) DrawMenu WindowNum END SUB DEFSNG A-Z SUB BlinkOff '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- REDIM ML&(0 TO 1) ML&(0) = &HB31003B8 ML&(1) = &HCB10CD00 DEF SEG = VARSEG(ML&(0)) CALL absolute(VARPTR(ML&(0))) ERASE ML& END SUB DEFINT A-Z SUB Box3D (x, y, x2, y2, Style, FCol, BCol, Back) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF x2 > 80 THEN x2 = 80 IF y2 > Lines THEN y2 = Lines Hiiripiiloon 'Styles: '------- ' Float = 0 ' SingleNormal = 1 ' DoubleNormal = 2 ' SingleIN = 3 ' SingleOUT = 4 ' DoubleIN = 5 ' DoubleOUT = 6 ' Filled = 7 SELECT CASE Style CASE IS = 0 FOR i = y TO y2 - 1 COLOR FCol, BCol LOCATE i, x, 0 PRINT STRING$(x2 - x, " "); COLOR 0, Back IF i = y THEN PRINT "Ü"; ELSE PRINT "Û"; NEXT LOCATE y2, x + 1, 0 PRINT STRING$(x2 - x, "ß"); CASE IS = 1 FOR i = y TO y2 - 1 COLOR FCol, BCol LOCATE i, x, 0 IF i = y THEN PRINT CHR$(218) + STRING$(x2 - x - 2, "Ä") + CHR$(191); ELSE PRINT CHR$(179) + STRING$(x2 - x - 2, " ") + CHR$(179); END IF NEXT LOCATE y2, x, 0 PRINT CHR$(192) + STRING$(x2 - x - 2, "Ä") + CHR$(217); CASE IS = 2 FOR i = y TO y2 - 1 COLOR FCol, BCol LOCATE i, x, 0 IF i = y THEN PRINT CHR$(201) + STRING$(x2 - x - 2, "Í") + CHR$(187); ELSE PRINT CHR$(186) + STRING$(x2 - x - 2, " ") + CHR$(186); END IF NEXT LOCATE y2, x, 0 PRINT CHR$(200) + STRING$(x2 - x - 2, "Í") + CHR$(188); CASE IS = 3 FOR i = y TO y2 - 1 COLOR 15, BCol LOCATE i, x, 0 IF i = y THEN PRINT CHR$(218) + STRING$(x2 - x - 2, "Ä"); COLOR 8 PRINT CHR$(191); ELSE COLOR 15 PRINT CHR$(179) + STRING$(x2 - x - 2, " "); COLOR 8 PRINT CHR$(179); END IF NEXT LOCATE y2, x, 0 COLOR 8 PRINT CHR$(192) + STRING$(x2 - x - 2, "Ä") + CHR$(217); CASE IS = 4 FOR i = y TO y2 - 1 COLOR 8, BCol LOCATE i, x, 0 IF i = y THEN PRINT CHR$(218) + STRING$(x2 - x - 2, "Ä"); COLOR 15 PRINT CHR$(191); ELSE COLOR 8 PRINT CHR$(179) + STRING$(x2 - x - 2, " "); COLOR 15 PRINT CHR$(179); END IF NEXT LOCATE y2, x, 0 COLOR 15 PRINT CHR$(192) + STRING$(x2 - x - 2, "Ä") + CHR$(217); CASE IS = 5 FOR i = y TO y2 - 1 COLOR 15, BCol LOCATE i, x IF i = y THEN PRINT CHR$(201) + STRING$(x2 - x - 2, "Í"); COLOR 8 PRINT CHR$(187); ELSE COLOR 15 PRINT CHR$(186); COLOR 8 PRINT STRING$(x2 - x - 2, " ") + CHR$(186); END IF NEXT COLOR 8 LOCATE y2, x PRINT CHR$(200) + STRING$(x2 - x - 2, "Í") + CHR$(188); CASE IS = 6 FOR i = y TO y2 - 1 COLOR 8, BCol LOCATE i, x IF i = y THEN PRINT CHR$(201) + STRING$(x2 - x - 2, "Í"); COLOR 15 PRINT CHR$(187); ELSE COLOR 8 PRINT CHR$(186); COLOR 15 PRINT STRING$(x2 - x - 2, " ") + CHR$(186); END IF NEXT COLOR 15 LOCATE y2, x PRINT CHR$(200) + STRING$(x2 - x - 2, "Í") + CHR$(188); CASE IS = 7 FOR i = y TO y2 - 1 COLOR FCol, BCol LOCATE i, x PRINT STRING$(x2 - x, " "); NEXT END SELECT Hiiriesiin END SUB SUB CDVolume (right%, Left%, Getvol%) '---------------------------------------------------------------------------- ' Sets the CD-volume on the Sound Blaster card '---------------------------------------------------------------------------- ' ' Right% - Right volume ' Left% - Left volume ' Getvol% - If true, then volume will be read, not set ' '---------------------------------------------------------------------------- OUT BasePort% + 4, &H28 IF Getvol% THEN Left% = INP(BasePort% + 5) \ 16 right% = INP(BasePort% + 5) AND &HF EXIT SUB ELSE OUT BasePort% + 5, (right% + Left% * 16) AND &HFF END IF END SUB SUB ColPrint (Text$) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- '---------------------------------------------------------------------------- ' Prints color-coded text '---------------------------------------------------------------------------- ' Color codes: ' ' & followed by a color value between 0-15 (in hex) ' ' Example: ' ' This text is &Cred '---------------------------------------------------------------------------- FOR i = 1 TO LEN(Text$) Done = 0 DO IF MID$(Text$, i, 1) = "&" AND INSTR("0123456789ABCDEF", MID$(Text$, i + 1, 1)) AND i < LEN(Text$) THEN COLOR VAL("&H" + MID$(Text$, i + 1, 1)) i = i + 2 ELSE Done = 1 END IF LOOP UNTIL Done PRINT MID$(Text$, i, 1); NEXT END SUB FUNCTION CountLines% (File$) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- Lin% = 0 CountFile = FREEFILE OPEN File$ FOR INPUT AS #CountFile DO IF EOF(CountFile) THEN EXIT DO LINE INPUT #CountFile, Dummy$ Lin% = Lin% + 1 LOOP CountLines% = Lin% CLOSE CountFile END FUNCTION SUB CreateButton (WindowNum, Num, x, y, XLen, YLen, Caption$, FCol, BCol) '---------------------------------------------------------------------------- ' Creates a button '---------------------------------------------------------------------------- ' WindowNum - Host window number ' Num - Button index number ' x, y - Coords ' XLen, YLen - X lenght, Y lenght ' Caption$ - Caption, color codes can be used ' FCol, BCol - Button color '---------------------------------------------------------------------------- But(Num).Win = WindowNum But(Num).x = x But(Num).y = y But(Num).x2 = x + XLen But(Num).y2 = y + YLen But(Num).FCol = FCol But(Num).BCol = BCol But(Num).Active = 1 ButCaption$(Num) = Caption$ DrawButton Num, False END SUB SUB CreateCheckBox (WindowNum, Num, x, y, State, Caption$) '---------------------------------------------------------------------------- ' Creates a checkbox '---------------------------------------------------------------------------- ' WindowNum - Host window number ' Num - Index number ' x, y - Coords ' State - True/False ' Caption$ - Caption, color codes can be used '---------------------------------------------------------------------------- CBox(Num).Win = WindowNum CBox(Num).x = x CBox(Num).y = y CBox(Num).State = State CBoxCaption$(Num) = Caption$ CBox(Num).Active = 1 DrawCheckBox Num END SUB SUB CreateFrame (WindowNum, Num, x, y, XLen, YLen, Caption$, Style, FCol, BCol) '---------------------------------------------------------------------------- ' Creates a frame '---------------------------------------------------------------------------- ' WindowNum - Host window number ' Num - Index number ' x, y - Coords ' XLen, YLen - X lenght, Y lenght ' Caption$ - Caption, color codes can be used ' Style - Border style: ' + Float ' + SingleIN/OUT/Normal ' + DoubleIN/OUT/Normal ' + Filled ' FCol, BCol - Color '---------------------------------------------------------------------------- Frame(Num).Win = WindowNum Frame(Num).x = x Frame(Num).y = y Frame(Num).x2 = x + XLen Frame(Num).y2 = y + YLen FrameCaption$(Num) = Caption$ Frame(Num).Style = Style Frame(Num).FCol = FCol Frame(Num).BCol = BCol Frame(Num).Active = 1 DrawFrame Num END SUB SUB CreateLabel (WindowNum, Num, x, y, XLen, YLen, Style, FCol, BCol, Caption$) '---------------------------------------------------------------------------- ' Creates a label '---------------------------------------------------------------------------- ' WindowNum - Host window number ' Num - Index number ' x, y - Coords ' XLen, YLen - X lenght, Y lenght ' Style - Border style: ' + Float ' + SingleIN/OUT/Normal ' + DoubleIN/OUT/Normal ' + Filled ' FCol, BCol - Color ' Caption$ - Caption, color codes can't be used '---------------------------------------------------------------------------- Label(Num).Win = WindowNum Label(Num).x = x Label(Num).y = y Label(Num).x2 = x + XLen Label(Num).y2 = y + YLen Label(Num).Style = Style Label(Num).FCol = FCol Label(Num).BCol = BCol LabelCaption$(Num) = Caption$ Label(Num).Active = 1 DrawLabel Num END SUB SUB CreateListBox (WindowNum, Num, x, y, XLen, YLen, Filename$, Offset, FCol, BCol, ViewBox, Col) '---------------------------------------------------------------------------- ' Creates a listbox '---------------------------------------------------------------------------- ' WindowNum - Host window number ' Num - Index number ' x, y - Coords ' XLen, YLen - X lenght, Y lenght ' Filename$ - Filename to read list from ' Offset - Startup offset ' FCol, BCol - Color ' ViewBox - If True, then listbox will be a file viewing box instead ' Col - If True, then color codes will be used when printing the text '---------------------------------------------------------------------------- IF Exist(Filename$) = False THEN LBox(Num).Total = 0 EXIT SUB END IF LBox(Num).Total = CountLines(Filename$) TempFile = FREEFILE OPEN Filename$ FOR BINARY AS #TempFile Ln& = LOF(TempFile) IF Ln& <= BufferSize THEN FOR i& = 1 TO Ln& GET #1, , ReadByte Buf(Num, i& - 1) = ASC(ReadByte) NEXT LBox(Num).UseBuffer = 1 ELSE LBox(Num).UseBuffer = 0 END IF CLOSE #TempFile LBox(Num).Win = WindowNum LBox(Num).x = x LBox(Num).y = y IF XLen - x >= Win(WindowNum).x2 - Win(WindowNum).x - 1 THEN XLen = Win(WindowNum).x2 - Win(WindowNum).x - x - 1 IF YLen - y >= Win(WindowNum).y2 - Win(WindowNum).y - 2 THEN YLen = Win(WindowNum).y2 - Win(WindowNum).y LBox(Num).x2 = x + XLen LBox(Num).y2 = y + YLen LBoxFilename$(Num) = Filename$ LBox(Num).Offset = Offset LBox(Num).Selected = Offset LBox(Num).FCol = FCol LBox(Num).BCol = BCol LBox(Num).ViewBox = ViewBox LBox(Num).Col = Col IF Offset > LBox(Num).Total THEN LBox(Num).Offset = LBox(Num).Total: LBox(Num).Selected = LBox(Num).Total LBox(Num).Active = 1 DrawListBox Num END SUB SUB CreateMenu (WindowNum, Num, Caption$) '---------------------------------------------------------------------------- ' Creates a menu into a window '---------------------------------------------------------------------------- ' WindowNum - Host window number ' Num - Number of menu, counting from the left (1...2...3...etc.) ' Caption$ - Caption '---------------------------------------------------------------------------- MenuBar(WindowNum, Num).Caption = Caption$ MenuBar(WindowNum, Num).Items = 0 END SUB SUB CreatePBar (WindowNum, Num, x, y, XLen, UsedCol, FreeCol, Max&, Value&) '---------------------------------------------------------------------------- ' Creates a percent bar '---------------------------------------------------------------------------- ' WindowNum - Host window number ' Num - Index number ' x, y - Coords ' XLen - X lenght ' UsedCol - Used color ' FreeCol - Free color ' Max& - Max value ' Value& - Startup value '---------------------------------------------------------------------------- PBar(Num).Win = WindowNum PBar(Num).x = x PBar(Num).y = y PBar(Num).x2 = x + XLen PBar(Num).UsedCol = UsedCol PBar(Num).FreeCol = FreeCol PBar(Num).Max = Max& PBar(Num).Value = Value& PBar(Num).OldValue = Value PBar(Num).Active = 1 DrawPBar Num END SUB SUB CreateRadioButton (WindowNum, Num, x, y, State, Group, Caption$) '---------------------------------------------------------------------------- ' Creates a radio box '---------------------------------------------------------------------------- ' WindowNum - Host window number ' Num - Index number ' x, y - Coords ' XLen, YLen - X lenght, Y lenght ' State - True/False ' Group - Number of group the radio box belongs to ' Caption$ - Caption, color codes can be used '---------------------------------------------------------------------------- Radio(Num).Win = WindowNum Radio(Num).x = x Radio(Num).y = y Radio(Num).State = State Radio(Num).Group = Group RadioCaption$(Num) = Caption$ Radio(Num).Active = 1 DrawRadio Num END SUB SUB CreateTextField (WindowNum, Num, x, y, MaxLen, FCol, BCol, Text$, Password) '---------------------------------------------------------------------------- ' Creates a text field '---------------------------------------------------------------------------- ' WindowNum - Host window number ' Num - Index number ' x, y - Coords ' MaxLen - Max lenght ' FCol, BCol - Color ' Text$ - Startup text ' Password - If true, then stars (*) will be displayed instead of chars '---------------------------------------------------------------------------- ' TextFText$(Num) contains the textfield's text '---------------------------------------------------------------------------- TextF(Num).Win = WindowNum TextF(Num).x = x TextF(Num).y = y TextF(Num).MaxLen = MaxLen TextF(Num).FCol = FCol TextF(Num).BCol = BCol Text$ = LEFT$(Text$, MaxLen) TextF(Num).TPos = LEN(Text$) TextFText$(Num) = Text$ TextF(Num).Password = Password TextF(Num).Active = 1 DrawTextField Num END SUB SUB CreateWindow (Num, x, y, x2, y2, FCol, BCol, Topic$) '---------------------------------------------------------------------------- ' Creates a window where other objects can be placed '---------------------------------------------------------------------------- ' Num - Index number ' x,y,x2,y2 - Coords ' FCol, BCol - Color ' Topic$ - Topic, color codes can't be used '---------------------------------------------------------------------------- Win(Num).x = x Win(Num).y = y Win(Num).x2 = x2 Win(Num).y2 = y2 Win(Num).FCol = FCol Win(Num).BCol = BCol WinTopic$(Num) = Topic$ DrawWindow Num END SUB SUB DefScreen '---------------------------------------------------------------------------- ' Defines screen parameters '---------------------------------------------------------------------------- ActiveTopicF = 15 'Active topic color ActiveTopicB = 4 DeActiveTopicF = 7 'DeActive topic color DeActiveTopicB = 0 DesktopFCol = 3 'Desktop color DesktopBCol = 1 DesktopChar$ = "°" 'Desktop character TaskBar = True 'Use taskbar? (True/False) Lines = 50 'Screen vertical lines: '---------------------- '25 '43 '50 END SUB FUNCTION Dialog (Topic$, Text$, Button1$, Button2$, Button3$) '---------------------------------------------------------------------------- ' Creates a dialogwindow '---------------------------------------------------------------------------- ' ' Topic$ - Window topic ' Text$ - Displayed text 'Button1$ - Button 1 text 'Button2$ - Button 2 text (if blank, then button won't be created) 'Button3$ - Button 3 text (if blank, then button won't be created) ' '---------------------------------------------------------------------------- ' When a dialog is active, all other objects are disabled '---------------------------------------------------------------------------- ' Returns the number of the pressed button (1, 2, or 3) '---------------------------------------------------------------------------- IF Button1$ = "" THEN EXIT FUNCTION x = 20 y = Lines \ 2 - 5 x2 = 60 y2 = Lines \ 2 + 5 CreateWindow MaxWindows + 1, x, y, x2, y2, 15, 7, Topic$ CreateLabel MaxWindows + 1, MaxLabels + 1, 0, 0, (x2 - x) - 1, (y2 - y) - 3, Filled, 0, 7, Text$ LockWindows = True AWin = MaxWindows + 1 IF Button2$ = "" AND Button3$ = "" AND Button1$ <> "" THEN CreateButton MaxWindows + 1, MaxButtons + 1, (x2 - x) \ 2 - 5, (y2 - y) - 4, 8, 1, Button1$, 15, 3 END IF IF Button2$ <> "" AND Button3$ = "" AND Button1$ <> "" THEN CreateButton MaxWindows + 1, MaxButtons + 1, 5, (y2 - y) - 4, 8, 1, Button1$, 15, 3 CreateButton MaxWindows + 1, MaxButtons + 2, (x2 - x) - 8 - 8, (y2 - y) - 4, 8, 1, Button2$, 15, 3 END IF IF Button2$ <> "" AND Button3$ <> "" AND Button1$ <> "" THEN CreateButton MaxWindows + 1, MaxButtons + 1, 3, (y2 - y) - 4, 8, 1, Button1$, 15, 3 CreateButton MaxWindows + 1, MaxButtons + 2, (x2 - x) \ 2 - 5, (y2 - y) - 4, 8, 1, Button2$, 15, 3 CreateButton MaxWindows + 1, MaxButtons + 3, (x2 - x) - 5 - 8, (y2 - y) - 4, 8, 1, Button3$, 15, 3 END IF ReDrawScreen DO UpdateMouse IF Button1$ <> "" AND Button2$ = "" AND Button3$ = "" THEN IF Key$ = CHR$(13) THEN ClickedButton = MaxButtons + 1: EXIT DO END IF IF Button1$ <> "" AND Button2$ <> "" AND Button3$ = "" THEN IF Key$ = CHR$(13) THEN ClickedButton = MaxButtons + 1: EXIT DO IF Key$ = CHR$(27) THEN ClickedButton = MaxButtons + 2: EXIT DO END IF Main LOOP UNTIL ClickedButton > MaxButtons Dialog = ClickedButton - MaxButtons KillWindow MaxWindows + 1 LockWindows = False END FUNCTION FUNCTION DMADone% '---------------------------------------------------------------------------- ' Use to see if a DMA transfer has been completed '---------------------------------------------------------------------------- Count% = INP(LenPort%) Count2% = INP(LenPort%) Count& = CLNG(Count% + 1) * CLNG(Count2% + 1) IF (Count& - 1) >= &HFFFF& THEN junk% = INP(DSPDataAvail%): DMADone% = -1 END FUNCTION SUB DMAPlay (Segment&, Offset&, Length&, Freq&) ' Transfers and plays the contents of the buffer. Length& = Length& - 1 Page% = 0 MemLoc& = Segment& * 16 + Offset& SELECT CASE Channel% CASE 0 PgPort% = &H87 AddPort% = &H0 LenPort% = &H1 ModeReg% = &H48 CASE 1 PgPort% = &H83 AddPort% = &H2 LenPort% = &H3 ModeReg% = &H49 CASE 2 PgPort% = &H81 AddPort% = &H4 LenPort% = &H5 ModeReg% = &H4A CASE 3 PgPort% = &H82 AddPort% = &H6 LenPort% = &H7 ModeReg% = &H4B CASE ELSE PRINT "DMA channels 0-3 only are supported." EXIT SUB END SELECT OUT &HA, &H4 + Channel% OUT &HC, &H0 OUT &HB, ModeReg% OUT AddPort%, MemLoc& AND &HFF OUT AddPort%, (MemLoc& AND &HFFFF&) \ &H100 IF (MemLoc& AND 65536) THEN Page% = Page% + 1 IF (MemLoc& AND 131072) THEN Page% = Page% + 2 IF (MemLoc& AND 262144) THEN Page% = Page% + 4 IF (MemLoc& AND 524288) THEN Page% = Page% + 8 OUT PgPort%, Page% OUT LenPort%, Length& AND &HFF OUT LenPort%, (Length& AND &HFFFF&) \ &H100 OUT &HA, Channel% IF Freq& < 23000 THEN TimeConst% = 256 - 1000000 \ Freq& writedsp &H40 writedsp TimeConst% writedsp &H14 writedsp (Length& AND &HFF) writedsp ((Length& AND &HFFFF&) \ &H100) ELSE IF DSPVersion! >= 3 THEN TimeConst% = ((65536 - 256000000 \ Freq&) AND &HFFFF&) \ &H100 writedsp &H40 writedsp TimeConst% writedsp (Length& AND &HFF) writedsp ((Length& AND &HFFFF&) \ &H100) writedsp &H91 ELSE PRINT "You need a Sound Blaster with a DSP v3.x+ to play at high speed." EXIT SUB END IF END IF END SUB SUB DmaState (StopGo%) ' Stops or continues DMA play. IF StopGo% THEN writedsp &HD4 ELSE writedsp &HD0 END SUB SUB DrawBox (x, y, x2, y2) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- Hiiripiiloon Offset& = 1 COLOR Win(AWin).FCol, 0 FOR i& = x + 1 TO x2 - 1 Box(Offset&).Char = CHR$(SCREEN(y, i&, 0)) Box(Offset&).Col = (SCREEN(y, i&, 1)) Offset& = Offset& + 1 IF Blink = 1 THEN COLOR Col + 16 LOCATE y, i& PRINT CHR$(SCREEN(y, i&)); NEXT FOR i& = x + 1 TO x2 - 1 Box(Offset&).Char = CHR$(SCREEN(y2 - 1, i&, 0)) Box(Offset&).Col = (SCREEN(y2 - 1, i&, 1)) Offset& = Offset& + 1 LOCATE y2 - 1, i& PRINT CHR$(SCREEN(y2 - 1, i&)); NEXT FOR i& = y TO y2 - 1 Box(Offset&).Char = CHR$(SCREEN(i&, x, 0)) Box(Offset&).Col = (SCREEN(i&, x, 1)) Offset& = Offset& + 1 LOCATE i&, x PRINT CHR$(SCREEN(i&, x)); NEXT FOR i& = y TO y2 - 1 Box(Offset&).Char = CHR$(SCREEN(i&, x2, 0)) Box(Offset&).Col = (SCREEN(i&, x2, 1)) Offset& = Offset& + 1 LOCATE i&, x2 PRINT CHR$(SCREEN(i&, x2)); NEXT BoxX = x BoxY = y BoxX2 = x2 BoxY2 = y2 Hiiriesiin END SUB SUB DrawButton (Num, Pressed) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF But(Num).Active = 0 THEN EXIT SUB Hiiripiiloon x = But(Num).x + Win(But(Num).Win).x + 1 y = But(Num).y + Win(But(Num).Win).y + 1 x2 = But(Num).x2 + Win(But(Num).Win).x + 1 y2 = But(Num).y2 + Win(But(Num).Win).y + 1 IF Pressed = False THEN FOR i = y TO y2 - 1 COLOR But(Num).FCol, But(Num).BCol LOCATE i, x PRINT STRING$(x2 - x, " "); COLOR 0, Win(But(Num).Win).BCol IF i = y THEN PRINT "Ü"; ELSE PRINT "Û"; NEXT COLOR 0, Win(But(Num).Win).BCol LOCATE y2, x + 1 PRINT STRING$(x2 - x, "ß"); COLOR But(Num).FCol, But(Num).BCol LOCATE y + ((y2 - y) \ 2), x + ((x2 - x) \ 2) - RealLen(ButCaption$(Num)) \ 2 ColPrint ButCaption$(Num) ELSE FOR i = y TO y2 - 1 LOCATE i, x COLOR 0, Win(But(Num).Win).BCol PRINT " "; COLOR But(Num).FCol, But(Num).BCol PRINT STRING$(x2 - x, " "); NEXT COLOR 0, Win(But(Num).Win).BCol LOCATE y2, x + 1 PRINT STRING$(x2 - x, " "); COLOR But(Num).FCol, But(Num).BCol LOCATE y + ((y2 - y) \ 2), x + ((x2 - x) \ 2) - RealLen(ButCaption$(Num)) \ 2 + 1 ColPrint ButCaption$(Num) END IF IF TaskBar = True THEN DrawTaskBar Hiiriesiin END SUB SUB DrawCheckBox (Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF CBox(Num).Active = 0 THEN EXIT SUB Hiiripiiloon x = CBox(Num).x + Win(CBox(Num).Win).x + 1 y = CBox(Num).y + Win(CBox(Num).Win).y + 1 COLOR Win(CBox(Num).Win).FCol, Win(CBox(Num).Win).BCol LOCATE y, x IF CBox(Num).State = True THEN ColPrint "[þ] " + CBoxCaption$(Num) ELSE ColPrint "[ ] " + CBoxCaption$(Num) END IF IF TaskBar = True THEN DrawTaskBar Hiiriesiin END SUB SUB DrawDesk (x, y, x2, y2) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF x2 > 80 THEN x2 = 80 IF y2 > Lines + 1 THEN y2 = Lines + 1 COLOR DesktopFCol, DesktopBCol FOR i& = y TO y2 - 1 LOCATE i&, x PRINT STRING$(x2 - x + 1, DesktopChar$); NEXT END SUB SUB DrawFrame (Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF Frame(Num).Active = 0 THEN EXIT SUB Hiiripiiloon x = Frame(Num).x + Win(Frame(Num).Win).x + 1 y = Frame(Num).y + Win(Frame(Num).Win).y + 1 x2 = Frame(Num).x2 + Win(Frame(Num).Win).x + 1 y2 = Frame(Num).y2 + Win(Frame(Num).Win).y + 1 Box3D x, y, x2, y2, Frame(Num).Style, Frame(Num).FCol, Frame(Num).BCol, Win(Frame(Num).Win).BCol COLOR Frame(Num).FCol, Frame(Num).BCol LOCATE y, x + 2 ColPrint FrameCaption$(Num) IF TaskBar = True THEN DrawTaskBar Hiiriesiin END SUB SUB DrawLabel (Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF Label(Num).Active = 0 THEN EXIT SUB Hiiripiiloon x = Label(Num).x + Win(Label(Num).Win).x + 1 y = Label(Num).y + Win(Label(Num).Win).y + 1 x2 = Label(Num).x2 + Win(Label(Num).Win).x + 1 y2 = Label(Num).y2 + Win(Label(Num).Win).y + 1 Box3D x, y, x2, y2, Label(Num).Style, Label(Num).FCol, Label(Num).BCol, Win(Label(Num).Win).BCol COLOR Label(Num).FCol, Label(Num).BCol LOCATE y + 1, x + 1 PrintLine LabelCaption$(Num), (x2 - x) - 3 IF TaskBar = True THEN DrawTaskBar Hiiriesiin END SUB SUB DrawListBox (Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF LBox(Num).Active = 0 THEN EXIT SUB x = LBox(Num).x + Win(LBox(Num).Win).x + 1 y = LBox(Num).y + Win(LBox(Num).Win).y + 1 x2 = LBox(Num).x2 + Win(LBox(Num).Win).x + 1 y2 = LBox(Num).y2 + Win(LBox(Num).Win).y + 1 Hiiripiiloon IF Win(LBox(Num).Win).x2 - Win(LBox(Num).Win).x <= 0 THEN Hiiriesiin: EXIT SUB IF LBox(Num).Total < 1 THEN Box3D x, y, x2, y2, Filled, LBox(Num).FCol, LBox(Num).BCol, 0 Hiiriesiin EXIT SUB END IF IF LBox(Num).Total = 0 THEN EXIT SUB IF LBox(SelectedLBox).Selected > LBox(SelectedLBox).Total - 1 THEN LBox(SelectedLBox).Selected = LBox(SelectedLBox).Total - 1 IF LBox(SelectedLBox).Selected < 0 THEN LBox(SelectedLBox).Selected = 0 IF LBox(Num).Selected < LBox(Num).Offset THEN LBox(Num).Offset = LBox(Num).Offset - 1 IF LBox(Num).Offset < 0 THEN LBox(Num).Offset = 0: LBox(Num).Selected = 0 IF LBox(Num).Selected > LBox(Num).Offset + (y2 - y - 1) THEN LBox(Num).Offset = LBox(Num).Offset + 1 IF LBox(Num).Offset > LBox(Num).Total THEN LBox(Num).Offset = LBox(Num).Total IF LBox(Num).ViewBox = True THEN LBox(Num).Offset = LBox(Num).Selected IF LBox(Num).Offset > LBox(Num).Total - (y2 - y) THEN LBox(Num).Offset = LBox(Num).Total - (y2 - y): LBox(Num).Selected = LBox(Num).Total - (y2 - y) END IF VLine = LBox(Num).Offset IF LBox(Num).ViewBox = True THEN IF LBox(Num).Total > y2 - y THEN Block = y + 1 + ((LBox(Num).Selected / (LBox(Num).Total - (y2 - y)))) * (y2 - y - 3) ELSE IF LBox(Num).Total > y2 - y THEN Block = y + 1 + ((LBox(Num).Selected / (LBox(Num).Total))) * (y2 - y - 3) END IF LBox(Num).Block = Block IF LBox(Num).UseBuffer = 0 THEN IF Exist(LBoxFilename$(Num)) = False THEN EXIT SUB TempFile = FREEFILE OPEN LBoxFilename$(Num) FOR INPUT AS #TempFile SeekLine TempFile, LBox(Num).Offset FOR i = y TO y2 - 1 IF i > Lines THEN EXIT FOR IF NOT EOF(TempFile) THEN DO LINE INPUT #TempFile, TempLine$ LOOP UNTIL TempLine$ <> "" OR EOF(TempFile) FOR ii = 1 TO LEN(TempLine$) IF MID$(TempLine$, ii, 1) = CHR$(9) THEN MID$(TempLine$, ii, 1) = " " NEXT ELSE TempLine$ = STRING$(x2 - x, " ") END IF IF VLine = LBox(Num).Selected AND LBox(Num).ViewBox = False THEN COLOR ActiveTopicF, ActiveTopicB SelectedName$(Num) = TempLine$ ELSE COLOR LBox(Num).FCol, LBox(Num).BCol END IF LOCATE i, x, 0 IF LBox(Num).Col = True THEN ColPrint LEFT$(TempLine$, x2 - x) + STRING$(x2 - x - RealLen(LEFT$(TempLine$, x2 - x)), " ") ELSE PRINT LEFT$(TempLine$, x2 - x) + STRING$(x2 - x - LEN(LEFT$(TempLine$, x2 - x)), " "); END IF COLOR 0, 7 LOCATE i, x2, 0 IF i > y AND i < y2 - 1 AND i <> Block AND (y2 - y) < LBox(Num).Total THEN PRINT "°"; END IF VLine = VLine + 1 Dummy$ = INKEY$ NEXT CLOSE #TempFile ELSEIF LBox(Num).UseBuffer = 1 THEN BufPos = SeekBufferLine(Num, LBox(Num).Offset) FOR i = y TO y2 - 1 IF i > Lines THEN EXIT FOR TempLine$ = "" IF VLine < LBox(Num).Total THEN DO IF BufPos > BufferSize THEN EXIT DO Char$ = CHR$(Buf(Num, BufPos)) BufPos = BufPos + 1 IF Char$ = CHR$(13) THEN EXIT DO TempLine$ = TempLine$ + Char$ LOOP FOR ii = 1 TO LEN(TempLine$) IF MID$(TempLine$, ii, 1) = CHR$(9) THEN MID$(TempLine$, ii, 1) = " " NEXT ELSE TempLine$ = STRING$(x2 - x, " ") END IF BufPos = BufPos + 1 IF VLine = LBox(Num).Selected AND LBox(Num).ViewBox = False THEN COLOR ActiveTopicF, ActiveTopicB SelectedName$(Num) = RTRIM$(TempLine$) ELSE COLOR LBox(Num).FCol, LBox(Num).BCol END IF LOCATE i, x, 0 IF LBox(Num).Col = True THEN ColPrint LEFT$(TempLine$, x2 - x) + STRING$(x2 - x - RealLen(LEFT$(TempLine$, x2 - x)), " ") ELSE PRINT LEFT$(TempLine$, x2 - x) + STRING$(x2 - x - LEN(LEFT$(TempLine$, x2 - x)), " "); END IF COLOR 0, 7 LOCATE i, x2, 0 IF i > y AND i < y2 - 1 AND i <> Block AND (y2 - y) < LBox(Num).Total THEN PRINT "°"; END IF VLine = VLine + 1 Dummy$ = INKEY$ NEXT END IF COLOR 0, 7 LOCATE y, x2 PRINT CHR$(24); LOCATE y2 - 1, x2 PRINT CHR$(25); IF (y2 - y) < LBox(Num).Total THEN LOCATE Block, x2 PRINT "Û"; END IF Hiiriesiin IF TaskBar = True THEN DrawTaskBar END SUB SUB DrawMenu (WindowNum) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- Hiiripiiloon x = Win(WindowNum).x + 1 y = Win(WindowNum).y + 1 x2 = Win(WindowNum).x2 LOCATE y, x - 1 COLOR 0, 7 PRINT STRING$(x2 - x + 2, " ") LOCATE y, x, 0 FOR i = 1 TO 8 IF i = AMenu THEN COLOR 7, 0 ELSE COLOR 0, 7 IF MenuBar(WindowNum, i).Items > 0 THEN PRINT MenuBar(WindowNum, i).Caption; END IF NEXT Hiiriesiin Hiiriesiin END SUB SUB DrawMenuBox (WindowNum, Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF MenuBar(WindowNum, Num).Items = 0 THEN EXIT SUB Hiiripiiloon x = Win(WindowNum).x + ((Num - 1) * 10) + 1 y = Win(WindowNum).y + 2 Longest = MenuBar(WindowNum, Num).Longest IF Longest < 10 THEN Longest = 10: MenuBar(WindowNum, Num).Longest = 10 Box3D x, y, x + Longest + 2 + 2, y + MenuBar(WindowNum, Num).Items + 1, SingleNormal, 0, 7, 0 FOR i = 1 TO MenuBar(WindowNum, Num).Items IF y + i > Lines THEN EXIT FOR IF MenuItem = i THEN COLOR 7, 0 ELSE COLOR 0, 7 LOCATE y + i, x + 1, 0 IF Menu$(WindowNum, Num, i) <> "" THEN PRINT " "; Menu$(WindowNum, Num, i); PRINT STRING$(Longest + 1 - LEN(Menu$(WindowNum, Num, i)), " "); ELSE LOCATE y + i, x, 0 PRINT "Ã" + STRING$(Longest + 2, "Ä") + "´"; END IF NEXT DrawShadow x, y, x + Longest + 3, y + MenuBar(WindowNum, Num).Items + 2 Hiiriesiin END SUB SUB DrawMenuItems (WindowNum, Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- x = Win(WindowNum).x + ((Num - 1) * 10) + 1 y = Win(WindowNum).y + 2 Longest = MenuBar(WindowNum, Num).Longest IF Longest < 10 THEN Longest = 10 FOR i = 1 TO MenuBar(WindowNum, Num).Items IF y + i > Lines THEN EXIT FOR IF MenuItem = i THEN COLOR 7, 0 ELSE COLOR 0, 7 LOCATE y + i, x + 1, 0 IF Menu$(WindowNum, Num, i) <> "" THEN PRINT " "; Menu$(WindowNum, Num, i); PRINT STRING$(Longest + 1 - LEN(Menu$(WindowNum, Num, i)), " "); ELSE LOCATE y + i, x, 0 PRINT "Ã" + STRING$(Longest + 2, "Ä") + "´"; END IF NEXT END SUB SUB DrawPBar (Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF PBar(Num).Active = 0 THEN EXIT SUB x = PBar(Num).x + Win(PBar(Num).Win).x + 1 y = PBar(Num).y + Win(PBar(Num).Win).y + 1 x2 = PBar(Num).x2 + Win(PBar(Num).Win).x + 1 PBar(Num).OldValue = PBar(Num).Value IF Hx >= x AND Hx <= x2 AND Hy = y THEN Hiiripiiloon LOCATE y, x, 0 XLen = (PBar(Num).Value / PBar(Num).Max) * 100 * ((x2 - x) / 100) IF XLen > x2 - x THEN XLen = x2 - x IF XLen < 0 THEN XLen = 0 COLOR PBar(Num).UsedCol, 0 PRINT STRING$(XLen, "Û"); COLOR 0, PBar(Num).FreeCol PRINT STRING$((x2 - x) - XLen, "°"); Hiiriesiin END SUB SUB DrawRadio (Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF Radio(Num).Active = 0 THEN EXIT SUB Hiiripiiloon x = Radio(Num).x + Win(Radio(Num).Win).x + 1 y = Radio(Num).y + Win(Radio(Num).Win).y + 1 COLOR Win(Radio(Num).Win).FCol, Win(Radio(Num).Win).BCol LOCATE y, x IF Radio(Num).State = True THEN ColPrint "(" + CHR$(4) + ") " + RadioCaption$(Num) ELSE ColPrint "( ) " + RadioCaption$(Num) END IF IF TaskBar = True THEN DrawTaskBar Hiiriesiin END SUB SUB DrawShadow (x, y, x2, y2) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- YLen = y2 - y XLen = x2 - x + 1 IF x2 < 80 THEN FOR i& = y + 1 TO YLen + y IF i& = Lines + 1 THEN EXIT FOR Char$ = CHR$(SCREEN(i&, x + XLen, 0)) Col = (SCREEN(i&, x + XLen, 1)) IF Col < 128 THEN Col = Col MOD 16 Blink = 0 ELSE Col = Col MOD 16 Blink = 1 END IF IF Blink = 1 THEN COLOR 16, 0 ELSE COLOR 8, 0 LOCATE i&, x + XLen PRINT Char$; IF x + XLen + 1 < 81 THEN Char$ = CHR$(SCREEN(i&, x + XLen + 1, 0)) Col = (SCREEN(i&, x + XLen + 1, 1)) IF Col < 128 THEN Col = Col MOD 16 Blink = 0 ELSE Col = Col MOD 16 Blink = 1 END IF IF Blink = 1 THEN COLOR 16, 0 ELSE COLOR 8, 0 PRINT Char$; END IF NEXT END IF IF y2 < Lines + 1 THEN FOR i& = x + 2 TO XLen + x - 1 LOCATE y + YLen, i& Char$ = CHR$(SCREEN(y + YLen, i&, 0)) Col = (SCREEN(y + YLen, i&, 1)) IF Col < 128 THEN Col = Col MOD 16 Blink = 0 ELSE Col = Col MOD 16 Blink = 1 END IF IF Blink = 1 THEN COLOR 16, 0 ELSE COLOR 8, 0 LOCATE y + YLen, i& PRINT Char$; NEXT END IF END SUB SUB DrawTaskBar '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- Hiiripiiloon Windows = 0 FOR i = 1 TO MaxWindows IF Win(i).x > 0 AND Win(i).x2 - Win(i).x > 0 THEN Windows = Windows + 1 END IF NEXT x = 12 y = Lines LOCATE y, 1 COLOR 0, 0 PRINT STRING$(10, "."); COLOR 0, 7 PRINT STRING$(70, " "); FOR xx = 11 TO 71 STEP 10 LOCATE y, xx PRINT "³"; NEXT FOR i = 1 TO Windows LOCATE y, x IF AWin = i THEN COLOR 15, 1 ELSE COLOR 0, 7 END IF PRINT LEFT$(WinTopic$(i), 9) + STRING$(9 - LEN(LEFT$(WinTopic$(i), 9)), " "); x = x + 10 IF x = 72 THEN x = 12 y = y - 1 LOCATE y, 1 COLOR 0, 0 PRINT STRING$(10, "."); COLOR 0, 7 PRINT STRING$(70, " "); COLOR 0, 7 FOR xx = 11 TO 71 STEP 10 LOCATE y, xx PRINT "³"; NEXT END IF NEXT TaskBarLine = y COLOR 4, 0 LOCATE Lines, 1 PRINT "þ"; COLOR 1 PRINT "W"; COLOR 1 PRINT "I"; COLOR 9 PRINT "N"; COLOR 3 PRINT "D"; COLOR 11 PRINT "O"; COLOR 15 PRINT "Z"; COLOR 15 PRINT "E"; COLOR 4 PRINT "þ "; COLOR 0, 7 PRINT " "; LOCATE Lines, 73, 0 COLOR 4, 7 PRINT TIME$; Hiiriesiin END SUB SUB DrawTextField (Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF TextF(Num).Active = 0 THEN EXIT SUB IF Win(TextF(Num).Win).x2 - Win(TextF(Num).Win).x <= 0 THEN EXIT SUB Hiiripiiloon x = TextF(Num).x + Win(TextF(Num).Win).x + 1 y = TextF(Num).y + Win(TextF(Num).Win).y + 1 COLOR TextF(Num).FCol, TextF(Num).BCol LOCATE y, x IF TextF(Num).Password = False THEN PRINT TextFText$(Num) + STRING$(TextF(Num).MaxLen - LEN(TextFText$(Num)), " ") ELSE PRINT STRING$(LEN(TextFText$(Num)), "*") + STRING$(TextF(Num).MaxLen - LEN(TextFText$(Num)), " ") END IF IF TextF(Num).TPos > LEN(TextFText$(Num)) THEN TextF(Num).TPos = LEN(TextFText$(Num)) IF TaskBar = True THEN DrawTaskBar Hiiriesiin END SUB SUB DrawWindow (Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- Hiiripiiloon x = Win(Num).x y = Win(Num).y x2 = Win(Num).x2 y2 = Win(Num).y2 FCol = Win(Num).FCol BCol = Win(Num).BCol Topic$ = WinTopic$(Num) IF x2 < x THEN SWAP x2, x IF y2 < y THEN SWAP y2, y IF x2 > 80 THEN x2 = 80 IF y2 > Lines + 1 THEN y2 = Lines + 1 IF x < 1 THEN x = 1 IF y < 1 THEN y = 1 XLen = x2 - x + 1 YLen = y2 - y UpLine$ = STRING$(XLen, CHR$(32)) IF LEN(Topic$) > XLen THEN Topic$ = LEFT$(Topic$, XLen) MID$(UpLine$, (XLen \ 2) - LEN(Topic$) \ 2 + 1) = Topic$ LOCATE y, x IF AWin = Num THEN COLOR ActiveTopicF, ActiveTopicB ELSE COLOR DeActiveTopicF, DeActiveTopicB PRINT UpLine$; COLOR FCol, BCol FOR i& = 1 TO YLen - 2 LOCATE y + i&, x PRINT CHR$(179) + STRING$(XLen - 2, " ") + CHR$(179); NEXT LOCATE y + i&, x PRINT CHR$(192) + STRING$(XLen - 2, CHR$(196)) + CHR$(217); DrawShadow x, y, x2, y2 FOR i = 1 TO 8 IF MenuBar(Num, i).Items > 0 THEN DrawMenu Num: EXIT SUB NEXT Hiiriesiin END SUB FUNCTION DSPVersion! ' Gets the DSP version. writedsp &HE1 Temp% = ReadDSP% Temp2% = ReadDSP% DSPVersion! = VAL(STR$(Temp%) + "." + STR$(Temp2%)) END FUNCTION SUB EraseBox '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- Hiiripiiloon Offset& = 1 x = BoxX y = BoxY x2 = BoxX2 y2 = BoxY2 FOR i& = x + 1 TO x2 - 1 Char$ = Box(Offset&).Char Col = Box(Offset&).Col Offset& = Offset& + 1 IF Col < 128 THEN FCol = Col MOD 16 BCol = Col \ 16 Blink = 0 ELSE FCol = (Col MOD 16) + 16 BCol = Col \ 16 Blink = 1 END IF COLOR FCol, BCol LOCATE y, i& PRINT Char$; NEXT FOR i& = x + 1 TO x2 - 1 Char$ = Box(Offset&).Char Col = Box(Offset&).Col Offset& = Offset& + 1 IF Col < 128 THEN FCol = Col MOD 16 BCol = Col \ 16 Blink = 0 ELSE FCol = (Col MOD 16) + 16 BCol = Col \ 16 Blink = 1 END IF COLOR FCol, BCol LOCATE y2 - 1, i& PRINT Char$; NEXT FOR i& = y TO y2 - 1 Char$ = Box(Offset&).Char Col = Box(Offset&).Col Offset& = Offset& + 1 IF Col < 128 THEN FCol = Col MOD 16 BCol = Col \ 16 Blink = 0 ELSE FCol = (Col MOD 16) + 16 BCol = Col \ 16 Blink = 1 END IF COLOR FCol, BCol LOCATE i&, x PRINT Char$; NEXT FOR i& = y TO y2 - 1 Char$ = Box(Offset&).Char Col = Box(Offset&).Col Offset& = Offset& + 1 IF Col < 128 THEN FCol = Col MOD 16 BCol = Col \ 16 Blink = 0 ELSE FCol = (Col MOD 16) + 16 BCol = Col \ 16 Blink = 1 END IF COLOR FCol, BCol LOCATE i&, x2 PRINT Char$; NEXT Hiiriesiin END SUB FUNCTION Exist% (File$) '---------------------------------------------------------------------------- ' Checks if a file exists '---------------------------------------------------------------------------- ' ' File$ - File to check ' '---------------------------------------------------------------------------- ' Returns True if file exists, else False '---------------------------------------------------------------------------- IF File$ = "" THEN Exist = False: EXIT FUNCTION Checkfile = FREEFILE OPEN File$ FOR BINARY AS #Checkfile IF LOF(Checkfile) = 0 THEN Exist = False CLOSE #Checkfile KILL File$ ELSE Exist = True CLOSE #Checkfile END IF END FUNCTION FUNCTION FDialog$ (Text$, StartDir$, StartFile$) '---------------------------------------------------------------------------- ' Initializes a FileSaveDialog '---------------------------------------------------------------------------- ' Text$ - Prompt text ' StartDir$ - Startup directory 'StartFile$ - Default filename '---------------------------------------------------------------------------- ' Returns blank, if user selected "Cancel" '---------------------------------------------------------------------------- IF PlayingWAV& = True THEN EXIT FUNCTION Dir$ = UCASE$(StartDir$) IF Dir$ = "" THEN Dir$ = "c:\" IF RIGHT$(Dir$, 1) <> "\" THEN Dir$ = Dir$ + "\" CreateWindow MaxWindows + 1, 15, 4, 65, 23, 15, 7, Dir$ CreateButton MaxWindows + 1, MaxButtons + 1, 38, 2, 8, 3, "OK", 15, 4 CreateButton MaxWindows + 1, MaxButtons + 2, 38, 7, 8, 3, "Cancel", 15, 4 CreateFrame MaxWindows + 1, MaxFrames + 1, 1, 1, 16, 4, "Filename", SingleNormal, 0, 7 CreateFrame MaxWindows + 1, MaxFrames + 2, 19, 1, 15, 11, "Dirs/Drives", SingleNormal, 0, 7 CreateLabel MaxWindows + 1, MaxLabels + 1, 0, 13, 49, 3, SingleNormal, 0, 7, Text$ CreateTextField MaxWindows + 1, MaxTextFields + 1, 3, 3, 12, 16, 7, StartFile$, False IF FileSpec$ = "" THEN FileSpec$ = "*.*" ReadDir2 Dir$ AText = MaxTextFields + 1 OldAWin = AWin AWin = MaxWindows + 1 LockWindows = True ReDrawScreen DO UpdateMouse Main IF SelectedLBox = MaxListBoxes + 2 AND SelectedItem <> 0 THEN IF INSTR(SelectedName$(MaxListBoxes + 2), ":") > 0 THEN Dir$ = SelectedName$(MaxListBoxes + 2) ELSEIF INSTR(SelectedName$(MaxListBoxes + 2), ".") > 0 THEN FOR i = LEN(Dir$) - 1 TO 1 STEP -1 IF MID$(Dir$, i, 1) = "\" THEN EXIT FOR NEXT Dir$ = LEFT$(Dir$, i) ELSE Dir$ = Dir$ + SelectedName$(MaxListBoxes + 2) + "\" END IF ReadDir2 Dir$ WinTopic$(MaxWindows + 1) = Dir$ ReDrawScreen END IF Hiiriesiin IF EnterText = MaxTextFields + 1 THEN EXIT DO LOOP UNTIL ClickedButton > MaxButtons IF ClickedButton = MaxButtons + 1 THEN IF TextFText$(MaxTextFields + 1) <> "" THEN FDialog$ = UCASE$(Dir$ + TextFText$(MaxTextFields + 1)) ELSEIF ClickedButton = MaxButtons + 2 THEN FDialog$ = "" END IF KillWindow MaxWindows + 1 LockWindows = False AWin = OldAWin ReDrawScreen END FUNCTION SUB FMVolume (right%, Left%, Getvol%) '---------------------------------------------------------------------------- ' Sets the FM-volume on the Sound Blaster card '---------------------------------------------------------------------------- ' ' Right% - Right volume ' Left% - Left volume ' Getvol% - If true, then volume will be read, not set ' '---------------------------------------------------------------------------- OUT BasePort% + 4, &H26 IF Getvol% THEN Left% = INP(BasePort% + 5) \ 16 right% = INP(BasePort% + 5) AND &HF EXIT SUB ELSE OUT BasePort% + 5, (right% + Left% * 16) AND &HFF END IF END SUB FUNCTION FSelect$ (Text$, StartDir$, FileSpec$) '---------------------------------------------------------------------------- ' Initializes a FileBrowseDialog '---------------------------------------------------------------------------- ' Text$ - Prompt text ' StartDir$ - Startup directory ' FileSpec$ - Filespec (ie "*.TXT", "*.*" for all files) '---------------------------------------------------------------------------- ' Returns blank, if user selected "Cancel" '---------------------------------------------------------------------------- IF PlayingWAV& = True THEN EXIT FUNCTION Dir$ = UCASE$(StartDir$) IF Dir$ = "" THEN Dir$ = "c:\" IF RIGHT$(Dir$, 1) <> "\" THEN Dir$ = Dir$ + "\" CreateWindow MaxWindows + 1, 15, 4, 65, 23, 15, 7, Dir$ + FileSpec$ CreateButton MaxWindows + 1, MaxButtons + 1, 38, 2, 8, 3, "OK", 15, 4 CreateButton MaxWindows + 1, MaxButtons + 2, 38, 7, 8, 3, "Cancel", 15, 4 CreateFrame MaxWindows + 1, MaxFrames + 1, 1, 1, 15, 11, "Files", SingleNormal, 0, 7 CreateFrame MaxWindows + 1, MaxFrames + 2, 19, 1, 15, 11, "Dirs/Drives", SingleNormal, 0, 7 CreateLabel MaxWindows + 1, MaxLabels + 1, 0, 13, 49, 3, SingleNormal, 0, 7, Text$ IF FileSpec$ = "" THEN FileSpec$ = "*.*" ReadDir Dir$, FileSpec$ OldAWin = AWin AWin = MaxWindows + 1 LockWindows = True ReDrawScreen DO UpdateMouse Main IF SelectedLBox = MaxListBoxes + 2 AND SelectedItem <> 0 THEN IF INSTR(SelectedName$(MaxListBoxes + 2), ":") > 0 THEN Dir$ = SelectedName$(MaxListBoxes + 2) ELSEIF INSTR(SelectedName$(MaxListBoxes + 2), ".") > 0 THEN FOR i = LEN(Dir$) - 1 TO 1 STEP -1 IF MID$(Dir$, i, 1) = "\" THEN EXIT FOR NEXT Dir$ = LEFT$(Dir$, i) ELSE Dir$ = Dir$ + SelectedName$(MaxListBoxes + 2) + "\" END IF ReadDir Dir$, FileSpec$ WinTopic$(MaxWindows + 1) = Dir$ + FileSpec$ ReDrawScreen END IF Hiiriesiin IF SelectedLBox = MaxListBoxes + 1 AND SelectedItem <> 0 THEN FSelect$ = Dir$ + SelectedName$(MaxListBoxes + 1) EXIT DO END IF LOOP UNTIL ClickedButton > MaxButtons IF ClickedButton = MaxButtons + 1 THEN IF SelectedName$(MaxListBoxes + 1) <> "" THEN FSelect$ = Dir$ + SelectedName$(MaxListBoxes + 1) ELSEIF ClickedButton = MaxButtons + 2 THEN FSelect$ = "" END IF KillWindow MaxWindows + 1 LockWindows = False AWin = OldAWin ReDrawScreen END FUNCTION SUB GetBLASTER (DMA%, BasePort%, IRQ%) '---------------------------------------------------------------------------- ' This subroutine parses the BLASTER environment string and returns settings. '---------------------------------------------------------------------------- IF LEN(ENVIRON$("BLASTER")) = 0 THEN PRINT "BLASTER environment variable not set.": EXIT SUB FOR Length% = 1 TO LEN(ENVIRON$("BLASTER")) SELECT CASE MID$(ENVIRON$("BLASTER"), Length%, 1) CASE "A" BasePort% = VAL("&H" + MID$(ENVIRON$("BLASTER"), Length% + 1, 3)) CASE "I" IRQ% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1)) CASE "D" DMA% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1)) END SELECT NEXT END SUB FUNCTION GetFileAttr% (Filename$) '======================================================================= 'Name: GetFileAttr% 'Purpose: This routine returns the attribute of a specified file '======================================================================= DEF SEG = VARSEG(Code(0)) ' point to QINT code Regs.ax = &H4300 ' specify get attribute TheString$ = Filename$ + CHR$(0) ' add a NUL byte for DOS Regs.dx = VARPTR(TheString$) ' DX points to the string Regs.ds = VARSEG(TheString$) ' DS point to segment CALL absolute(&H21, Regs, 0) ' get attribute in CX reg GetFileAttr% = Regs.cx AND &HFF ' get file attribute IF Regs.Flags AND 1 THEN GetAttr% = -1 ' if carry set, then cough DEF SEG ' return from hyper-space END FUNCTION DEFSNG A-Z SUB Hiiriajuri (ax%, bx%, cx%, dx%) DEF SEG = VARSEG(hiiri$) 'Segmentti talteen hiiri% = SADD(hiiri$) 'Offsetti talteen CALL absolute(ax%, bx%, cx%, dx%, hiiri%) 'Kutsu END SUB SUB Hiiriesiin ax% = 1 'Funktio 1 Hiiriajuri ax%, 0, 0, 0 'Kutsutaan hiiriajuria END SUB SUB Hiirilue (vasen%, oikea%, keski%, x%, y%) ax% = 3 'Funktio 3 Hiiriajuri ax%, bx%, cx%, dx% 'Kutsutaan hiiriajuria vasen% = ((bx% AND 1) <> 0) 'Luetaan nappien asennot oikea% = ((bx% AND 2) <> 0) 'bx:st„ keski% = ((bx% AND 4) <> 0) x% = cx% 'ja hiiren koordinaatit y% = dx% 'cx:st„ ja dx:st„ END SUB SUB Hiiripiiloon ax% = 2 'Funktio 2 Hiiriajuri ax%, 0, 0, 0 'Kutsutaan hiiriajuria END SUB SUB Hiirirajat (x1%, y1%, x2%, y2%) ax% = 7 'Funktio 7 cx% = x1% 'Rajat cx:„„n ja dx:„„n dx% = x2% Hiiriajuri ax%, 0, cx%, dx% 'Kutsutaan hiiriajuria ax% = 8 'Funktio 8 cx% = y1% 'Rajat cx:„„n ja dx:„„n dx% = y2% Hiiriajuri ax%, 0, cx%, dx% 'Kutsutaan hiiriajuria END SUB FUNCTION Hiiritarkista% ax% = 0 'Funktio 0 Hiiriajuri ax%, bx%, 0, 0 'Kutsutaan hiiriajuria IF (ax% = 0) THEN 'Onko ajuri k„yt”ss„? Hiiritarkista% = 0 'jos ei, palautetaan 0 ELSEIF (bx% = 3) THEN 'Kolminappinen hiiri? Hiiritarkista% = 3 ELSEIF (bx% = 0) THEN 'Ep„standardi hiiri? Hiiritarkista% = 1 ELSE Hiiritarkista% = 2 'Tavallinen kaksinappinen hiiri? END IF END FUNCTION DEFINT A-Z SUB Initscreen '---------------------------------------------------------------------------- ' Initializes the application '---------------------------------------------------------------------------- ' Place all your create???? statements here '---------------------------------------------------------------------------- CreateWindow 1, 10, 20, 60, 34, 15, 7, "Player" CreateWindow 2, 40, 30, 73, 47, 15, 3, "Config" 'If using QBasic v1.1, change the COMMAND$ below to "" CreateTextField 1, 1, 4, 3, 40, 16, 7, COMMAND$, False CreateFrame 1, 1, 2, 1, 45, 10, "Filename", SingleNormal, 0, 7 CreateFrame 1, 2, 4, 3, 40, 1, "", Float, 7, 0 CreateButton 1, 1, 18, 7, 10, 3, "Play " + CHR$(16), 15, 2 CreateButton 1, 2, 34, 5, 10, 1, "Browse...", 15, 3 CreateFrame 2, 4, 1, 1, 30, 7, "Playback rate", SingleNormal, 0, 3 CreateFrame 2, 5, 1, 9, 30, 5, "Volume", SingleNormal, 0, 3 CreateRadioButton 2, 1, 3, 3, False, 1, "8000" CreateRadioButton 2, 2, 3, 4, False, 1, "11025" CreateRadioButton 2, 3, 3, 5, False, 1, "16000" CreateRadioButton 2, 4, 3, 6, True, 1, "22050" CreateRadioButton 2, 5, 15, 3, False, 1, "32000" CreateRadioButton 2, 6, 15, 4, False, 1, "38000" CreateRadioButton 2, 7, 15, 5, False, 1, "44100" CreatePBar 1, 1, 4, 5, 28, 10, 7, 1000000, 0 CreateButton 2, 5, 3, 11, 3, 1, "+", 14, 4 CreateButton 2, 6, 8, 11, 3, 1, "-", 14, 4 MasterVolume 15, 15, False CreateLabel 2, 1, 16, 10, 4, 3, Float, 16, 6, "15" CreateWindow 3, 1, 1, 50, 19, 7, 1, "Textmode Windoze" CreateMenu 3, 1, "Menu" CreateMenu 3, 2, "Help" AddMenuItem 3, 1, "Sample Item" AddMenuItem 3, 1, "Another Sample Item" AddMenuItem 3, 1, "Yet Another Sample Item" AddMenuItem 3, 1, "Return of the Sample Item" AddMenuItem 3, 1, "" AddMenuItem 3, 1, "Quit" AddMenuItem 3, 2, "About" AddMenuItem 3, 2, "About Taskbar" AddMenuItem 3, 2, "Contacting the Author" AddMenuItem 3, 2, "" AddMenuItem 3, 2, "Free memory" CreateButton 3, 7, 2, 2, 17, 1, "Sample Button", 15, 3 CreateButton 3, 8, 2, 5, 16, 3, "&4C&Co&El&Fo&Ar&2s", 15, 7 CreateFrame 3, 6, 0, 9, 48, 6, "TextFields", SingleNormal, 7, 1 CreateTextField 3, 2, 2, 11, 40, 16, 7, "Textfield", False CreateTextField 3, 3, 2, 13, 20, 16, 7, "Password", True OPEN "TEMP.TMP" FOR OUTPUT AS #1 PRINT #1, "Item 1" PRINT #1, "Item 2" PRINT #1, "Item 3" PRINT #1, "Item 4" PRINT #1, "&1C&9o&3l&Bo&Frs" PRINT #1, "&9Blue" PRINT #1, "&AGreen" PRINT #1, "&BCyan" PRINT #1, "&CRed" PRINT #1, "&DPink" PRINT #1, "&EYellow" PRINT #1, "&FWhite" CLOSE #1 CreateListBox 3, 1, 24, 2, 16, 6, "TEMP.TMP", 0, 7, 0, False, True CreateWindow 4, 1, 40, 80, 48, 7, 1, "Mini text viewer" CreateMenu 4, 1, "File" AddMenuItem 4, 1, "Open..." AddMenuItem 4, 1, "Save...(Demo)" CreateWindow 5, 57, 1, 80, 9, 14, 2, "Windoze" CreatePBar 5, 2, 1, 1, 20, 14, 7, 80, 40 CreatePBar 5, 3, 1, 3, 20, 14, 7, INT(Lines), Lines \ 2 CreateCheckBox 5, 1, 1, 5, True, "Active" CreateButton 3, 3, 26, 13, 14, 1, "Question", 15, 4 END SUB FUNCTION InputField$ (Text$, Key$, MaxLen, TPos) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF Key$ = "" THEN InputField$ = Text$: EXIT FUNCTION SELECT CASE Key$ CASE IS = CHR$(8) IF LEN(Text$) > 0 THEN Text$ = LEFT$(Text$, TPos - 1) + MID$(Text$, TPos + 1, 255) TPos = TPos - 1 IF TPos = -1 THEN TPos = 0 Key$ = "" ELSE Key$ = "" END IF CASE IS = CHR$(0) + CHR$(75) IF TPos > 0 THEN TPos = TPos - 1 Key$ = "" CASE IS = CHR$(0) + CHR$(77) TPos = TPos + 1 IF TPos > MaxLen THEN TPos = MaxLen IF TPos > LEN(Text$) THEN TPos = LEN(Text$) Key$ = "" CASE IS = CHR$(0) + "S" Text$ = LEFT$(Text$, TPos) + MID$(Text$, TPos + 2, 255) Key$ = "" CASE IS = CHR$(9) Key$ = "" END SELECT IF LEFT$(Key$, 1) = CHR$(0) THEN Key$ = "" IF Key$ <> "" THEN Text$ = LEFT$(Text$, TPos) + Key$ + MID$(Text$, TPos + 1, 255) IF LEN(Text$) > MaxLen THEN Text$ = LEFT$(Text$, MaxLen) TPos = TPos + 1 IF TPos > MaxLen THEN TPos = MaxLen END IF InputField$ = Text$ END FUNCTION SUB KillWindow (Num) '---------------------------------------------------------------------------- ' Removes a window with the index number of Num '---------------------------------------------------------------------------- Win(Num).x = -1024 Win(Num).y = -1024 Win(Num).x2 = Win(Num).x IF TextF(AText).Win = Num THEN CursorX = 0: CursorY = 0 FOR i = 1 TO MaxFrames + 2 IF Frame(i).Win = Num THEN Frame(i).Active = 0 END IF NEXT FOR i = 1 TO MaxCheckBoxes IF CBox(i).Win = Num THEN CBox(i).Active = 0 END IF NEXT FOR i = 1 TO MaxRadioButtons IF Radio(i).Win = Num THEN Radio(i).Active = 0 END IF NEXT FOR i = 1 TO MaxLabels + 1 IF Label(i).Win = Num THEN Label(i).Active = 0 END IF NEXT FOR i = 1 TO MaxListBoxes + 2 IF LBox(i).Win = Num THEN LBox(i).Active = 0 END IF NEXT FOR i = 1 TO MaxTextFields + 1 IF TextF(i).Win = Num THEN TextF(i).Active = 0 END IF NEXT FOR i = 1 TO MaxButtons + 3 IF But(i).Win = Num THEN But(i).Active = 0 END IF NEXT FOR i = 1 TO MaxPBars IF PBar(i).Win = Num THEN PBar(i).Active = 0 END IF NEXT ReDrawScreen END SUB SUB LineVolume (right%, Left%, Getvol%) '---------------------------------------------------------------------------- ' Sets the Line in-volume on the Sound Blaster card '---------------------------------------------------------------------------- ' ' Right% - Right volume ' Left% - Left volume ' Getvol% - If true, then volume will be read, not set ' '---------------------------------------------------------------------------- OUT BasePort% + 4, &H2E IF Getvol% THEN Left% = INP(BasePort% + 5) \ 16 right% = INP(BasePort% + 5) AND &HF EXIT SUB ELSE OUT BasePort% + 5, (right% + Left% * 16) AND &HFF END IF END SUB DEFSNG A-Z SUB Main '----[TWIN.BAS (C) Sami Ky”stil„ 1997]---------------------------------------- ' ÚÄÄÄÄÄÄ¿ÚÄÄ¿ÚÄÄÄÄÄ¿ÚÄÄÄÄ¿ ÚÄÄÄ¿ ÚÄÄÄÄ¿ÚÄÄÄÄ¿ ' ³Û° Û°³³Û°³³Û° Û°³³ÛÛÛ°À¿ÚÙÛÛ°À¿³ÛÛÛ°³³ÛÛÛ°³ ' ³Û° Û°³ÃÄÄ´³Û° Û°³³Û° Û°³³Û° Û°³³ Û°³³Û° ³ ' ú úúÄúÄ´Û° ۰ô۰ôÛ۰۰ô۰ ۰ô۰ ۰ô Û° ôÛÛ° ÃÄúÄúú ú ' ³Û°Û°Û°³³Û°³³Û°ÛÛ°³³Û° Û°³³Û° Û°³³Û° ³³Û° ³ ' ³ÛÛ°ÛÛ°³³Û°³³Û° Û°³³ÛÛÛ°ÚÙÀ¿ÛÛ°ÚÙ³ÛÛÛ°³³ÛÛÛ°³ ' ÀÄÄÄÄÄÄÙÀÄÄÙÀÄÄÄÄÄÙÀÄÄÄÄÙ ÀÄÄÄÙ ÀÄÄÄÄÙÀÄÄÄÄÙ ' ' EúNúGúIúNúE ' ' ::[V1.00]:: ' ' [TúEúXúTúMúOúDúE]-[VúEúRúSúIúOúN] ' ' ÚÄÄÄ¿ ÚÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ú úúÄúÄÄÄ´(C)ÃÄ´SúAúMúiÃÄ´KúYú™úSúTúiúLúŽÃÄÄúÄúú ú ' ÀÄÄÄÙ ÀÄÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ' ' ú úúÄúÄ1Ä9Ä9Ä7ÄúÄúú ú ' '---------------------------------------------------------------------------- ' ' This is the core of the engine, which handles all object events. ' ' If you wish to make your own objects, add the handler code here. ' '---------------------------------------------------------------------------- IF CursorY > 0 AND CursorX > 0 AND TextF(AText).Win = AWin AND DragWin = 0 THEN LOCATE CursorY, CursorX, 1 PRINT ""; ELSE LOCATE CSRLIN, POS(0), 0 END IF IF TaskBar = True AND Click = 1 AND LockWindows = False THEN IF Hy >= TaskBarLine AND Hy <= Lines AND Hx > 11 AND Hx < 71 THEN NewAWin = (Hx - 11) \ 10 + ((Lines - Hy) * 6) + 1 IF NOT NewAWin > Windows THEN Click = 0 OldAWin = AWin AWin = -1 SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow INT(OldAWin) AWin = NewAWin ReDrawWindow AWin DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 END IF END IF END IF IF TaskBar = True AND Click = 1 AND LockWindows = False AND AMenu = 0 THEN IF Hy = Lines AND Hx < 10 THEN Dummy = Dialog("About Windoze v" + Version.Major + "." + Version.Minor, "Windoze v" + Version.Major + "." + Version.Minor + " by Sami Ky”stil„ 1997. You may use this program freely as long as you give me credit for it", "OK", "", "") END IF END IF IF Hv = -1 AND DragWin = 0 AND Drag = 0 AND AMenu = 0 THEN FOR i = 1 TO MaxWindows + 1 IF Hx >= Win(i).x AND Hx <= Win(i).x2 AND Hy = Win(i).y AND Win(i).x2 - Win(i).x <> 0 AND i = AWin THEN DragWin = i DrawBox Win(i).x, Win(i).y, Win(i).x2, Win(i).y2 DragOfs = Hx - Win(i).x DragXLen = Win(i).x2 - Win(i).x DragYLen = Win(i).y2 - Win(i).y Hiiripiiloon Hiirirajat DragOfs * 8, 0, 632 - ((Win(i).x2 - Win(i).x) - DragOfs) * 8, (Lines * 8) - (Win(i).y2 - Win(i).y) * 8 Hiiriesiin END IF NEXT END IF IF Hv = -1 AND DragWin > 0 AND MouseMove = 1 THEN EraseBox Win(DragWin).x = Hx - DragOfs Win(DragWin).y = Hy Win(DragWin).x2 = Hx - DragOfs + DragXLen Win(DragWin).y2 = Hy + DragYLen IF Win(DragWin).x < 1 THEN Win(DragWin).x = 1 IF Win(DragWin).y < 1 THEN Win(DragWin).y = 1 IF Win(DragWin).x2 - DragXLen < 1 THEN Win(DragWin).x2 = 1 + DragXLen IF Win(DragWin).y2 - DragYLen < 1 THEN Win(DragWin).y2 = 1 + DragYLen IF Win(DragWin).x + DragXLen > 80 THEN Win(DragWin).x = 80 - DragXLen IF Win(DragWin).y + DragYLen > Lines + 1 THEN Win(DragWin).y = Lines - DragYLen + 1 IF Win(DragWin).x2 > 80 THEN Win(DragWin).x2 = 80 IF Win(DragWin).y2 > Lines + 1 THEN Win(DragWin).y2 = Lines + 1 DrawBox Win(DragWin).x, Win(DragWin).y, Win(DragWin).x2, Win(DragWin).y2 END IF IF Hv = 0 AND DragWin > 0 THEN ReDrawScreen DragWin = 0 Hiiripiiloon Hiirirajat 0, 0, 79 * 8, Lines * 8 - 8 Hiiriesiin END IF IF DragWin = 0 THEN IF Key$ = CHR$(27) AND MenuBar(AWin, 1).Items > 0 AND MenuItem = 0 AND AMenu = 0 THEN Key$ = "" MenuItem = 0 AMenu = 1 Hiiripiiloon SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow AWin DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 DrawMenu AWin Hiiriesiin END IF IF Key$ = CHR$(27) AND AMenu <> 0 THEN Key$ = "" MenuItem = 0 AMenu = 0 Hiiripiiloon SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow AWin DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 Hiiriesiin END IF IF AMenu <> 0 AND Key$ = Kd$ AND MenuItem <> 0 THEN DO MenuItem = MenuItem + 1 IF MenuItem = 14 THEN MenuItem = 1 LOOP UNTIL Menu$(AWin, AMenu, MenuItem) <> "" Hiiripiiloon DrawMenuItems AWin, AMenu Hiiriesiin END IF IF AMenu <> 0 AND Key$ = Ku$ AND MenuItem <> 0 THEN DO MenuItem = MenuItem - 1 IF MenuItem < 1 THEN MenuItem = 14 LOOP UNTIL Menu$(AWin, AMenu, MenuItem) <> "" Hiiripiiloon DrawMenuItems AWin, AMenu Hiiriesiin END IF IF AMenu <> 0 AND Key$ = Kd$ AND MenuItem = 0 THEN Hiiripiiloon MenuItem = 1 SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow AWin DrawMenuBox AWin, AMenu DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 Hiiriesiin DrawMenu AWin END IF IF AMenu <> 0 AND Key$ = Kl$ THEN OldAMenu = AMenu IF MenuItem <> 0 THEN MenuItem = 1 DO AMenu = AMenu - 1 IF AMenu = 0 THEN AMenu = 8: IF AMenu = OldAMenu THEN EXIT DO LOOP UNTIL MenuBar(AWin, AMenu).Items > 0 Hiiripiiloon SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow AWin IF MenuItem > 0 THEN DrawMenuBox AWin, AMenu DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 Hiiriesiin DrawMenu AWin END IF IF AMenu <> 0 AND Key$ = Kr$ THEN OldAMenu = AMenu IF MenuItem <> 0 THEN MenuItem = 1 DO AMenu = AMenu + 1 IF AMenu = 8 THEN AMenu = 1 LOOP UNTIL MenuBar(AWin, AMenu).Items > 0 Hiiripiiloon SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow AWin IF MenuItem > 0 THEN DrawMenuBox AWin, AMenu DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 Hiiriesiin DrawMenu AWin END IF IF Hv = -1 AND Hy = Win(AWin).y + 1 THEN NewAMenu = (Hx - Win(AWin).x - 1) \ 10 + 1 IF NewAMenu = 0 THEN NewAMenu = 1 IF NewAMenu <> AMenu AND MenuBar(AWin, NewAMenu).Items > 0 THEN AMenu = NewAMenu MenuItem = 1 Hiiripiiloon SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow AWin DrawMenuBox AWin, AMenu DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 Hiiriesiin DrawMenu AWin END IF END IF IF Hy <> Win(AWin).y + 1 AND AMenu <> 0 THEN IF Hv = -1 AND Hx >= Win(AWin).x + ((AMenu - 1) * 10) + 1 AND Hx <= Win(AWin).x + ((AMenu - 1) * 10) + 1 + MenuBar(AWin, AMenu).Longest AND Hy >= Win(AWin).y + 2 AND Hy <= Win(AWin).y + 2 + MenuBar(AWin, AMenu).Items THEN NewItem = Hy - Win(AWin).y - 2 IF Menu$(AWin, AMenu, NewItem) <> "" THEN Hiiripiiloon MenuItem = NewItem DrawMenuItems AWin, AMenu Hiiriesiin END IF END IF END IF IF Hy <> Win(AWin).y + 1 AND AMenu <> 0 THEN IF Click = 1 AND NOT (Hx >= Win(AWin).x + ((AMenu - 1) * 10) + 1 AND Hx <= Win(AWin).x + ((AMenu - 1) * 10) + 1 + MenuBar(AWin, AMenu).Longest AND Hy >= Win(AWin).y + 2 AND Hy <= Win(AWin).y + 2 + MenuBar(AWin, AMenu).Items) THEN MenuItem = 0 AMenu = 0 SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow AWin DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 END IF END IF IF Click = 1 AND Hy <> Win(AWin).y + 1 AND AMenu <> 0 THEN IF Hx >= Win(AWin).x + ((AMenu - 1) * 10) + 1 AND Hx <= Win(AWin).x + ((AMenu - 1) * 10) + 1 + MenuBar(AWin, AMenu).Longest AND Hy > Win(AWin).y + 2 AND Hy <= Win(AWin).y + 2 + MenuBar(AWin, AMenu).Items THEN NewItem = Hy - Win(AWin).y - 2 IF Menu$(AWin, AMenu, NewItem) <> "" THEN Hiiripiiloon MenuItem = NewItem DrawMenuItems AWin, AMenu Hiiriesiin END IF END IF MenuSelected.Win = AWin MenuSelected.Num = AMenu MenuSelected.Item = MenuItem MenuItem = 0 AMenu = 0 Hiiripiiloon SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow AWin DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 Hiiriesiin END IF IF Key$ = CHR$(13) AND AMenu <> 0 THEN MenuSelected.Win = AWin MenuSelected.Num = AMenu MenuSelected.Item = MenuItem Key$ = "" MenuItem = 0 AMenu = 0 Hiiripiiloon SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow AWin DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 Hiiriesiin END IF END IF IF DragWin = 0 AND AMenu = 0 THEN IF Click = 1 AND LockWindows = False THEN IF Hx < Win(AWin).x OR Hx > Win(AWin).x2 OR Hy < Win(AWin).y OR Hy > Win(AWin).y2 THEN FOR i = 1 TO MaxWindows + 1 IF Hx >= Win(i).x AND Hx <= Win(i).x2 AND Hy >= Win(i).y AND Hy < Win(i).y2 AND Win(i).x2 > 1 THEN OldAWin = AWin AWin = -1 SCREEN , , 1, 0 PCOPY 0, 1 ReDrawWindow INT(OldAWin) AWin = i ReDrawWindow AWin IF TaskBar = True THEN DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 END IF NEXT END IF END IF IF Hv = -1 AND HoldButton = 0 THEN FOR i = 1 TO MaxButtons + 3 IF But(i).Win = AWin AND But(i).Active = 1 THEN IF Hx >= But(i).x + Win(But(i).Win).x + 1 AND Hx < But(i).x2 + Win(But(i).Win).x + 1 AND Hy >= But(i).y + Win(But(i).Win).y + 1 AND Hy <= But(i).y2 + Win(But(i).Win).y + 1 THEN HoldButton = i DrawButton INT(i), True END IF END IF NEXT END IF IF Hv = 0 AND HoldButton <> 0 THEN i = HoldButton IF Hx < But(i).x + Win(But(i).Win).x + 1 OR Hx >= But(i).x2 + Win(But(i).Win).x + 1 OR Hy < But(i).y + Win(But(i).Win).y + 1 OR Hy > But(i).y2 + Win(But(i).Win).y + 1 THEN DrawButton HoldButton, False HoldButton = 0 ELSE DrawButton HoldButton, False ClickedButton = HoldButton HoldButton = 0 END IF END IF IF HoldButton <> 0 THEN i = HoldButton IF Hx < But(i).x + Win(But(i).Win).x + 1 OR Hx >= But(i).x2 + Win(But(i).Win).x + 1 OR Hy < But(i).y + Win(But(i).Win).y + 1 OR Hy > But(i).y2 + Win(But(i).Win).y + 1 THEN DrawButton HoldButton, False HoldButton = 0 END IF END IF IF Click = 1 THEN FOR i = 1 TO MaxCheckBoxes IF CBox(i).Win = AWin AND CBox(i).Active = 1 THEN IF Hx >= CBox(i).x + Win(CBox(i).Win).x + 1 AND Hx <= CBox(i).x + Win(CBox(i).Win).x + 1 + RealLen(CBoxCaption$(i)) + 3 AND Hy = CBox(i).y + Win(CBox(i).Win).y + 1 THEN Switch CBox(i).State, True, False DrawCheckBox INT(i) END IF END IF NEXT END IF IF Click = 1 THEN FOR i = 1 TO MaxRadioButtons IF Radio(i).Win = AWin AND Radio(i).Active = 1 THEN IF Hx >= Radio(i).x + Win(Radio(i).Win).x + 1 AND Hx <= Radio(i).x + Win(Radio(i).Win).x + 1 + RealLen(RadioCaption$(i)) + 3 AND Hy = Radio(i).y + Win(Radio(i).Win).y + 1 THEN Radio(i).State = True FOR ii = 1 TO MaxRadioButtons IF ii <> i AND Radio(ii).Win = AWin AND Radio(ii).Group = Radio(i).Group THEN Radio(ii).State = False DrawRadio INT(ii) END IF NEXT DrawRadio INT(i) END IF END IF NEXT END IF IF Hv = -1 AND GTime MOD 40 = 0 THEN FOR i = 1 TO MaxListBoxes + 2 IF LBox(i).Win = AWin AND LBox(i).Total > 0 AND LBox(i).Active = 1 THEN IF Hx >= LBox(i).x + Win(LBox(i).Win).x + 1 AND Hx < LBox(i).x2 + Win(LBox(i).Win).x + 1 AND Hy >= LBox(i).y + Win(LBox(i).Win).y + 1 AND Hy < LBox(i).y2 + Win(LBox(i).Win).y + 1 THEN SelectedLBox = i IF LBox(i).ViewBox = False THEN LBox(i).Selected = LBox(i).Offset + Hy - (LBox(i).y + Win(LBox(i).Win).y) - 1 IF LBox(i).Selected >= LBox(i).Total - 1 THEN LBox(i).Selected = LBox(i).Total - 1 END IF DrawListBox INT(i) END IF IF Hx = LBox(i).x2 + Win(LBox(i).Win).x + 1 AND Hy = LBox(i).y + Win(LBox(i).Win).y + 1 THEN SelectedLBox = i LBox(i).Selected = LBox(i).Selected - 1 DrawListBox INT(i) END IF IF Hx = LBox(i).x2 + Win(LBox(i).Win).x + 1 AND Hy = LBox(i).y2 - 1 + Win(LBox(i).Win).y + 1 THEN SelectedLBox = i LBox(i).Selected = LBox(i).Selected + 1 DrawListBox INT(i) END IF END IF NEXT END IF IF Click = 1 THEN FOR i = 1 TO MaxListBoxes + 2 IF LBox(i).Win = AWin AND LBox(i).Total > 0 AND LBox(i).Active = 1 THEN IF Hx >= LBox(i).x + Win(LBox(i).Win).x + 1 AND Hx < LBox(i).x2 + Win(LBox(i).Win).x + 1 AND Hy >= LBox(i).y + Win(LBox(i).Win).y + 1 AND Hy < LBox(i).y2 + Win(LBox(i).Win).y + 1 AND LBox(i).ViewBox = False THEN SelectedLBox = i LBox(i).Selected = LBox(i).Offset + Hy - (LBox(i).y + Win(LBox(i).Win).y) - 1 IF LBox(i).Selected >= LBox(i).Total - 1 THEN LBox(i).Selected = LBox(i).Total - 1 DrawListBox INT(i) IF DBLClick = 1 THEN SelectedItem = LBox(SelectedLBox).Selected + 1 END IF END IF IF Hx = LBox(i).x2 + Win(LBox(i).Win).x + 1 AND Hy < LBox(i).y2 - 1 + Win(LBox(i).Win).y + 1 AND Hy > LBox(i).y + Win(LBox(i).Win).y + 1 THEN IF Hy < LBox(i).Block THEN SelectedLBox = i LBox(SelectedLBox).Selected = LBox(SelectedLBox).Selected - (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) LBox(SelectedLBox).Offset = LBox(SelectedLBox).Offset - (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) IF LBox(SelectedLBox).Selected < 0 THEN LBox(SelectedLBox).Selected = 0 IF LBox(SelectedLBox).Offset < 0 THEN LBox(SelectedLBox).Offset = 0 DrawListBox INT(SelectedLBox) ELSEIF Hy > LBox(i).Block THEN SelectedLBox = i LBox(SelectedLBox).Selected = LBox(SelectedLBox).Selected + (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) LBox(SelectedLBox).Offset = LBox(SelectedLBox).Offset + (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) IF LBox(SelectedLBox).Selected >= LBox(SelectedLBox).Total - 1 THEN LBox(SelectedLBox).Selected = LBox(SelectedLBox).Total - 1 IF LBox(SelectedLBox).Offset >= LBox(SelectedLBox).Total - 1 THEN LBox(SelectedLBox).Offset = LBox(SelectedLBox).Total - 1 - (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) DrawListBox INT(SelectedLBox) END IF END IF END IF NEXT END IF IF Key$ <> "" AND LBox(SelectedLBox).Win = AWin AND LBox(SelectedLBox).Total > 0 THEN IF Key$ = Ku$ THEN LBox(SelectedLBox).Selected = LBox(SelectedLBox).Selected - 1 DrawListBox INT(SelectedLBox) END IF IF Key$ = Kd$ THEN LBox(SelectedLBox).Selected = LBox(SelectedLBox).Selected + 1 DrawListBox INT(SelectedLBox) END IF IF Key$ = CHR$(13) THEN SelectedItem = LBox(SelectedLBox).Selected + 1 END IF IF Key$ = CHR$(0) + "Q" THEN LBox(SelectedLBox).Selected = LBox(SelectedLBox).Selected + (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) LBox(SelectedLBox).Offset = LBox(SelectedLBox).Offset + (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) IF LBox(SelectedLBox).Selected >= LBox(SelectedLBox).Total - 1 THEN LBox(SelectedLBox).Selected = LBox(SelectedLBox).Total - 1 IF LBox(SelectedLBox).Offset >= LBox(SelectedLBox).Total - 1 THEN LBox(SelectedLBox).Offset = LBox(SelectedLBox).Total - 1 - (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) DrawListBox INT(SelectedLBox) END IF IF Key$ = CHR$(0) + "I" THEN LBox(SelectedLBox).Selected = LBox(SelectedLBox).Selected - (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) LBox(SelectedLBox).Offset = LBox(SelectedLBox).Offset - (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) IF LBox(SelectedLBox).Selected < 0 THEN LBox(SelectedLBox).Selected = 0 IF LBox(SelectedLBox).Offset < 0 THEN LBox(SelectedLBox).Offset = 0 DrawListBox INT(SelectedLBox) END IF IF Key$ = CHR$(0) + "O" THEN LBox(SelectedLBox).Selected = LBox(SelectedLBox).Total - 1 LBox(SelectedLBox).Offset = LBox(SelectedLBox).Total - 1 - (LBox(SelectedLBox).y2 - LBox(SelectedLBox).y) DrawListBox INT(SelectedLBox) END IF IF Key$ = CHR$(0) + "G" THEN LBox(SelectedLBox).Selected = 0 LBox(SelectedLBox).Offset = 0 DrawListBox INT(SelectedLBox) END IF END IF IF Click = 1 THEN FOR i = 1 TO MaxTextFields + 1 IF TextF(i).Win = AWin AND TextF(i).Active = 1 THEN IF Hy = TextF(i).y + Win(TextF(i).Win).y + 1 AND Hx >= TextF(i).x + Win(TextF(i).Win).x + 1 AND Hx < TextF(i).x + TextF(i).MaxLen + Win(TextF(i).Win).x + 1 THEN AText = i TextF(i).TPos = Hx - TextF(i).x - Win(TextF(i).Win).x - 1 IF TextF(i).TPos > LEN(TextFText$(i)) THEN TextF(i).TPos = LEN(TextFText$(i)) CursorX = TextF(i).x + Win(TextF(i).Win).x + 1 + TextF(i).TPos CursorY = Hy END IF END IF NEXT END IF IF Key$ <> "" THEN IF Key$ = CHR$(0) + CHR$(15) THEN TextSearch = AText DO TextSearch = TextSearch - 1 IF TextSearch < 1 THEN TextSearch = MaxTextFields + 1 IF TextSearch = AText THEN EXIT DO IF TextF(TextSearch).Win = AWin AND TextSearch <> AText THEN AText = TextSearch EXIT DO END IF LOOP Key$ = "" END IF IF Key$ = CHR$(9) THEN TextSearch = AText DO TextSearch = TextSearch + 1 IF TextSearch > MaxTextFields + 1 THEN TextSearch = 1 IF TextSearch = AText THEN EXIT DO IF TextF(TextSearch).Win = AWin AND TextSearch <> AText THEN AText = TextSearch EXIT DO END IF LOOP Key$ = "" END IF END IF FOR i = 1 TO MaxPBars IF PBar(i).Value <> PBar(i).OldValue AND PBar(i).Win = AWin THEN DrawPBar INT(i) NEXT IF Key$ <> "" AND TextF(AText).Win = AWin THEN IF Key$ = CHR$(13) THEN EnterText = AText: Key$ = "" TextFText$(AText) = InputField(TextFText$(AText), Key$, TextF(AText).MaxLen, TextF(AText).TPos) DrawTextField AText END IF IF TextF(AText).MaxLen > 0 AND TextF(AText).Active = 1 THEN CursorX = TextF(AText).x + Win(TextF(AText).Win).x + 1 + TextF(AText).TPos CursorY = TextF(AText).y + Win(TextF(AText).Win).y + 1 END IF END IF IF PlayingWAV& = True AND DMADone% = -1 THEN WavOffset& = WavOffset& + 8000 IF WavLength& - WavOffset& < 8000 THEN PlayLength& = WavLength& - WavOffset& ELSE PlayLength& = 8000 IF PlayLength& <= 0 THEN CLOSE #WavFileHandle& PlayingWAV& = False WavLength& = 0 WavOffset& = 0 WavFreq& = 0 ELSE GET #WavFileHandle&, , WavBuffer(0) DMAPlay VARSEG(WavBuffer(0)), VARPTR(WavBuffer(0)), PlayLength& - 1, WavFreq& END IF END IF OldHiiriX = Hx OldHiiriY = Hy IF GTime MOD 100 = 0 THEN BlinkOff IF TaskBar = True AND TIMER >= OldTimer& + 1 THEN IF Hy > Lines - 1 AND Hx > 72 THEN Hiiripiiloon LOCATE Lines, 73, 0 COLOR 4, 7 PRINT TIME$; IF Hy > Lines - 1 AND Hx > 72 THEN Hiiriesiin OldTimer& = TIMER END IF END SUB DEFINT A-Z SUB MasterVolume (right%, Left%, Getvol%) '---------------------------------------------------------------------------- ' Sets the master volume on the Sound Blaster card '---------------------------------------------------------------------------- ' ' Right% - Right volume ' Left% - Left volume ' Getvol% - If true, then volume will be read, not set ' '---------------------------------------------------------------------------- OUT BasePort% + 4, &H22 'PRINT BasePort% IF Getvol% THEN Left% = INP(BasePort% + 5) \ 16 right% = INP(BasePort% + 5) AND &HF EXIT SUB ELSE OUT BasePort% + 5, (right% + Left% * 16) AND &HFF END IF END SUB SUB MicVolume (Volume%, Getvol%) '---------------------------------------------------------------------------- ' Sets the mic gain on the Sound Blaster card '---------------------------------------------------------------------------- ' ' Volume% - Volume ' Getvol% - If true, then volume will be read, not set ' '---------------------------------------------------------------------------- OUT BasePort% + 4, &HA IF Getvol% THEN Volume% = INP(BasePort% + 5) AND &HF EXIT SUB ELSE OUT BasePort% + 5, Volume% AND &HF END IF END SUB FUNCTION MouseInside (x, y, x2, y2) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF Hx >= x AND Hx <= x2 AND Hy >= y AND Hy <= y2 THEN MouseInside = True ELSE MouseInside = False END FUNCTION SUB PrintLine (Text$, XLen) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- Hiiripiiloon Wrapped$ = RTRIM$(Wrap$(Text$, XLen)) Text$ = LEFT$(Text$, LEN(Text$) - 1) StartPos = POS(0) FOR i = 1 TO LEN(Wrapped$) IF MID$(Wrapped$, i, 1) <> CHR$(255) THEN PRINT MID$(Wrapped$, i, 1); ELSE PRINT LOCATE , StartPos END IF NEXT Hiiriesiin END SUB FUNCTION QDir$ (FileSpec$, Dirs) '======================================================================= 'Name: QDir$ 'Purpose: Return next file that matches the original file spec '======================================================================= QDir$ = "" DEF SEG = VARSEG(Code(0)) ' point to QINT code ' Set up the DTA to our special work area Regs.ax = &H1A00 ' specify DTA address Regs.ds = VARSEG(DTA) ' DS reg has seg part Regs.dx = VARPTR(DTA) ' DX reg has offset CALL absolute(&H21, Regs, 0) ' do the business... ' Now see if we need a FIND FIRST or FIND NEXT CALL IF LEN(FileSpec$) THEN ' got a file spec so... Regs.ax = &H4E00 ' specify FIND FIRST IF Dirs = True THEN Regs.cx = &HFF ELSE Regs.cx = 39 ' no directories or vol labels END IF TheString$ = FileSpec$ + CHR$(0) ' add a NUL byte for DOS Regs.dx = VARPTR(TheString$) ' DX points to the string Regs.ds = VARSEG(TheString$) ' DS point to segment ELSE ' no file spec so... Regs.ax = &H4F00 ' specify FIND NEXT END IF CALL absolute(&H21, Regs, 0) ' do the business... ' If the carry flag is clear, then we've got a file spec ! IF (Regs.Flags AND 1) = 0 THEN ' carry clear = ok Filename$ = MID$(DTA, 31, 13) ' extract the file from the DTA QDir$ = LEFT$(Filename$, INSTR(Filename$, CHR$(0)) - 1) END IF DEF SEG ' return from hyper-space END FUNCTION FUNCTION Query$ (Topic$, Text$, TextField$, MaxLen, Password) '---------------------------------------------------------------------------- ' Prompts the user to enter information into a textfield '---------------------------------------------------------------------------- ' Topic$ - Window Topic ' Text$ - Prompt text ' TextField$ - Initial text ' MaxLen - Max lenght ' Password - If True, then a password dialog will be created '---------------------------------------------------------------------------- x = 20 y = Lines \ 2 - 6 x2 = 60 y2 = Lines \ 2 + 6 CreateWindow MaxWindows + 1, x, y, x2, y2, 15, 7, Topic$ CreateLabel MaxWindows + 1, MaxLabels + 1, 0, 0, (x2 - x) - 1, 3, Filled, 0, 7, Text$ LockWindows = True AWin = MaxWindows + 1 CreateButton MaxWindows + 1, MaxButtons + 1, 5, (y2 - y) - 4, 8, 1, "OK", 15, 3 CreateButton MaxWindows + 1, MaxButtons + 2, (x2 - x) - 8 - 8, (y2 - y) - 4, 8, 1, "Cancel", 15, 3 CreateFrame MaxWindows + 1, MaxFrames + 1, (x2 - x) \ 2 - (MaxLen \ 2) - 2, 5, MaxLen + 2, 1, "", Float, 0, 7 CreateTextField MaxWindows + 1, MaxTextFields + 1, (x2 - x) \ 2 - (MaxLen \ 2) - 2, 5, MaxLen + 2, 16, 7, TextField$, Password AText = MaxTextFields + 1 ReDrawScreen DO UpdateMouse Main IF EnterText = MaxTextFields + 1 THEN ClickedButton = MaxButtons + 1: EXIT DO IF Key$ = CHR$(27) THEN ClickedButton = MaxButtons + 2: EXIT DO LOOP UNTIL ClickedButton > MaxButtons IF ClickedButton = MaxButtons + 1 THEN Query$ = TextFText$(MaxTextFields + 1) ELSE Query$ = "" END IF KillWindow MaxWindows + 1 LockWindows = False CursorX = -1024 CursorY = -1024 END FUNCTION FUNCTION ReadDAC% ' Reads a byte from the DAC. writedsp &H20 ReadDAC% = ReadDSP% END FUNCTION SUB ReadDir (Dir$, FileSpec$) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- TempFile = FREEFILE OPEN "FSELECT.TMP" FOR OUTPUT AS #TempFile NFileSpec$ = Dir$ + FileSpec$ DO Filename$ = RTRIM$(LTRIM$(QDir$(NFileSpec$, False))) NFileSpec$ = "" IF Filename$ <> "" THEN PRINT #TempFile, RTRIM$(Filename$) ELSE EXIT DO END IF LOOP CLOSE #TempFile OPEN "FSELECT2.TMP" FOR OUTPUT AS #TempFile NFileSpec$ = Dir$ + "*.*" DO Filename$ = QDir$(NFileSpec$, True) NFileSpec$ = "" IF (LTRIM$(RTRIM$(Filename$))) <> "" THEN IF GetFileAttr(Dir$ + Filename$) AND 16 THEN IF Filename$ <> "." THEN PRINT #TempFile, RTRIM$(Filename$) END IF ELSE EXIT DO END IF LOOP PRINT #TempFile, "A:\" PRINT #TempFile, "C:\" PRINT #TempFile, "D:\" PRINT #TempFile, "E:\" PRINT #TempFile, "F:\" PRINT #TempFile, "G:\" PRINT #TempFile, "H:\" PRINT #TempFile, "I:\" PRINT #TempFile, "J:\" PRINT #TempFile, "K:\" PRINT #TempFile, "L:\" PRINT #TempFile, "M:\" PRINT #TempFile, "N:\" PRINT #TempFile, "O:\" PRINT #TempFile, "P:\" PRINT #TempFile, "Q:\" PRINT #TempFile, "R:\" PRINT #TempFile, "S:\" PRINT #TempFile, "T:\" PRINT #TempFile, "U:\" PRINT #TempFile, "V:\" PRINT #TempFile, "W:\" PRINT #TempFile, "X:\" PRINT #TempFile, "Y:\" PRINT #TempFile, "Z:\" CLOSE #TempFile CreateListBox MaxWindows + 1, MaxListBoxes + 1, 2, 2, 12, 10, "FSELECT.TMP", 0, 0, 3, False, False CreateListBox MaxWindows + 1, MaxListBoxes + 2, 20, 2, 12, 10, "FSELECT2.TMP", 0, 0, 3, False, False END SUB SUB ReadDir2 (Dir$) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- TempFile = FREEFILE OPEN "FSELECT2.TMP" FOR OUTPUT AS #TempFile NFileSpec$ = Dir$ + "*.*" DO Filename$ = QDir$(NFileSpec$, True) NFileSpec$ = "" IF (LTRIM$(RTRIM$(Filename$))) <> "" THEN IF GetFileAttr(Dir$ + Filename$) AND 16 THEN IF Filename$ <> "." THEN PRINT #TempFile, RTRIM$(Filename$) END IF ELSE EXIT DO END IF LOOP PRINT #TempFile, "A:\" PRINT #TempFile, "C:\" PRINT #TempFile, "D:\" PRINT #TempFile, "E:\" PRINT #TempFile, "F:\" PRINT #TempFile, "G:\" PRINT #TempFile, "H:\" PRINT #TempFile, "I:\" PRINT #TempFile, "J:\" PRINT #TempFile, "K:\" PRINT #TempFile, "L:\" PRINT #TempFile, "M:\" PRINT #TempFile, "N:\" PRINT #TempFile, "O:\" PRINT #TempFile, "P:\" PRINT #TempFile, "Q:\" PRINT #TempFile, "R:\" PRINT #TempFile, "S:\" PRINT #TempFile, "T:\" PRINT #TempFile, "U:\" PRINT #TempFile, "V:\" PRINT #TempFile, "W:\" PRINT #TempFile, "X:\" PRINT #TempFile, "Y:\" PRINT #TempFile, "Z:\" CLOSE #TempFile CreateListBox MaxWindows + 1, MaxListBoxes + 2, 20, 2, 12, 10, "FSELECT2.TMP", 0, 0, 3, False, False END SUB FUNCTION ReadDSP% ' Reads a byte from the DSP DO LOOP UNTIL INP(BasePort% + 14) AND &H80 ReadDSP% = INP(BasePort% + 10) END FUNCTION FUNCTION RealLen (Text$) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- Ln& = LEN(Text$) FOR i = 1 TO LEN(Text$) Done = 0 IF MID$(Text$, i, 1) = "&" AND INSTR("0123456789ABCDEF", MID$(Text$, i + 1, 1)) AND i < LEN(Text$) THEN Ln& = Ln& - 2 END IF NEXT RealLen = Ln& END FUNCTION SUB ReDrawScreen '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- Hiiripiiloon LOCATE CSRLIN, POS(0), 0 SCREEN , , 1, 0 PCOPY 3, 1 FOR i = 1 TO MaxWindows + 1 IF Win(i).x2 - Win(i).x <> 0 AND AWin <> i THEN ReDrawWindow i END IF NEXT ReDrawWindow AWin IF TaskBar = True THEN DrawTaskBar PCOPY 1, 0 SCREEN , , 0, 0 Hiiriesiin END SUB SUB ReDrawWindow (Num) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF Win(Num).x2 - Win(Num).x = 0 THEN EXIT SUB DrawWindow Num FOR i = 1 TO MaxFrames + 2 IF Frame(i).Win = Num THEN DrawFrame i END IF NEXT FOR i = 1 TO MaxCheckBoxes IF CBox(i).Win = Num THEN DrawCheckBox i END IF NEXT FOR i = 1 TO MaxRadioButtons IF Radio(i).Win = Num THEN DrawRadio i END IF NEXT FOR i = 1 TO MaxLabels + 1 IF Label(i).Win = Num THEN DrawLabel i END IF NEXT FOR i = 1 TO MaxListBoxes + 2 IF LBox(i).Win = Num THEN DrawListBox i END IF NEXT FOR i = 1 TO MaxTextFields + 1 IF TextF(i).Win = Num THEN DrawTextField i END IF NEXT FOR i = 1 TO MaxPBars IF PBar(i).Win = Num THEN DrawPBar i END IF NEXT FOR i = 1 TO MaxButtons + 3 IF But(i).Win = Num THEN DrawButton i, False END IF NEXT END SUB FUNCTION ResetDSP% ' Resets the DSP OUT BasePort% + 6, 1 FOR Count% = 1 TO 4 junk% = INP(BasePort% + 6) NEXT OUT BasePort% + 6, 0 IF INP(BasePort% + 14) AND &H80 = &H80 AND INP(BasePort% + 10) = &HAA THEN ResetDSP% = -1 ELSE ResetDSP% = 0 END IF END FUNCTION SUB ResetSB '---------------------------------------------------------------------------- ' Resets the Sound Blaster '---------------------------------------------------------------------------- OUT &H226, 1: OUT &H226, 0 DO x% = INP(&H22E) IF x% AND 128 THEN x% = INP(&H22A) IF x% = &HAA THEN EXIT DO END IF END IF LOOP DO x% = INP(&H22C) LOOP WHILE x% AND 128 OUT &H22, &HD1 END SUB FUNCTION Samplebyte% '---------------------------------------------------------------------------- ' Samples a byte from the Sound Blaster Microfone '---------------------------------------------------------------------------- bp% = BasePort% CALL writedsp(&H20) 'Command to sample one byte datavail% = bp% + 14 dly: IF INP(datavail%) AND &H80 = 0 THEN GOTO dly datread% = bp% + 10 bt% = INP(datread%) Samplebyte% = bt% END FUNCTION FUNCTION SeekBufferLine (Num, LineNum) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- Ln% = 1 FOR i& = 0 TO BufferSize IF Buf(Num, i&) = 13 THEN Ln% = Ln% + 1 IF Ln% > LineNum THEN EXIT FOR NEXT IF LineNum > 0 THEN SeekBufferLine = i& + 2 ELSE SeekBufferLine = 0 END FUNCTION SUB SeekLine (FileNum, LineNum) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- SEEK #FileNum, 1 FOR i = 0 TO LineNum - 1 IF EOF(FileNum) THEN EXIT FOR LINE INPUT #FileNum, Dummy$ NEXT END SUB SUB SetStereo (OnOff%) '---------------------------------------------------------------------------- ' Sets stereo on/off '---------------------------------------------------------------------------- OUT BasePort% + 4, &HE IF OnOff% THEN OUT BasePort% + 5, 2 ELSE OUT BasePort% + 5, 0 END SUB SUB SpeakerState (OnOff%) ' Turns speaker on or off. IF OnOff% THEN writedsp &HD1 ELSE writedsp &HD3 END SUB FUNCTION SpeakerStatus% OUT BasePort% + 4, &HD8 IF INP(BasePort% + 5) = &HFF THEN SpeakerStatus% = -1 ELSE SpeakerStatus% = 0 END FUNCTION SUB Switch (Var, Value1, Value2) '---------------------------------------------------------------------------- ' Switches values '---------------------------------------------------------------------------- ' ' Var - Variable to be changed ' Value1 - Value 1 ' Value2 - Value 2 ' '---------------------------------------------------------------------------- ' ' if Var = Value1 then Value2 will be assigned to Var ' ' if Var = Value2 then Value1 will be assigned to Var ' ' This SUB is used with Checkboxes and Radiobuttons ' '---------------------------------------------------------------------------- IF Var = Value1 THEN Var = Value2: EXIT SUB IF Var = Value2 THEN Var = Value1 END SUB SUB UpdateMouse '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- ' Reads mouse position and status '---------------------------------------------------------------------------- DialogClickedButton = 0 InputDialogClickedButton = 0 ClickedButton = 0 Key$ = INKEY$ MouseMove = 0 SelectedItem = 0 MovedBar = 0 ClickedRadioButton = 0 ClickedCheckBox = 0 EnterText = 0 Hiirilue Hiiriv%, Hiirio%, Hiirik%, HiiriX%, HiiriY% Hx = HiiriX% \ 8 + 1 Hy = HiiriY% \ 8 + 1 Hv = Hiiriv% Ho = Hiirio% Hk = Hiirik% IF Hv = 0 AND Click = -1 THEN Click = 1 ELSE IF Hv = 0 THEN Click = 0 IF Hv = 0 THEN Drag = 0 IF Hv = 0 THEN MovingBar = 0 IF Hv = -1 AND Click = 0 THEN Click = -1 IF Hx <> OldHiiriX THEN MouseMove = 1 IF Hy <> OldHiiriY THEN MouseMove = 1 IF Hx <> OldHiiriX AND Hv = -1 THEN Drag = 1 IF Hy <> OldHiiriY AND Hv = -1 THEN Drag = 1 DBLClick = 0 IF Click = 1 THEN IF MouseMove = 0 AND TIMER <= ClickCount + 1 THEN ClickCount = 0 DBLClick = 1 ELSE ClickCount = TIMER END IF END IF IF MouseMove = 1 THEN ClickCount = 0 GTime = GTime + 1 GTime = GTime MOD 64000 MenuSelected.Win = 0 MenuSelected.Num = 0 MenuSelected.Item = 0 END SUB SUB VocVolume (right%, Left%, Getvol%) '---------------------------------------------------------------------------- ' Sets the VOC-volume on the Sound Blaster card '---------------------------------------------------------------------------- ' ' Right% - Right volume ' Left% - Left volume ' Getvol% - If true, then volume will be read, not set ' '---------------------------------------------------------------------------- OUT BasePort% + 4, &H4 IF Getvol% THEN Left% = INP(BasePort% + 5) \ 16 right% = INP(BasePort% + 5) AND &HF EXIT SUB ELSE OUT BasePort% + 5, (right% + Left% * 16) AND &HFF END IF END SUB SUB WAVPlayDMA (File$, Freq&) '---------------------------------------------------------------------------- ' Plays a WAV, VOC, SND sound file in the backround '---------------------------------------------------------------------------- ' ' File$ - File to be played ' Freq& - Playback frequency ' '---------------------------------------------------------------------------- ' Set volume levels with *Volume subs '---------------------------------------------------------------------------- IF PlayingWAV& = True THEN CLOSE #WavFileHandle&: PlayingWAV& = False WavFile = FREEFILE IF Exist(File$) = False THEN EXIT SUB OPEN File$ FOR BINARY AS #WavFile IF RIGHT$(UCASE$(File$), 3) = "WAV" THEN GET #WavFile, 44, WavBuffer(0) Length& = LOF(1) - 44 ELSE GET #WavFile, , WavBuffer(0) Length& = LOF(1) END IF IF Length& > 8000 THEN WavLength& = Length& WavFileHandle& = WavFile WavOffset& = 0 WavFreq& = Freq& Length& = 8000 PlayingWAV& = True DMAPlay VARSEG(WavBuffer(0)), VARPTR(WavBuffer(0)), Length&, Freq& ELSE DMAPlay VARSEG(WavBuffer(0)), VARPTR(WavBuffer(0)), Length&, Freq& CLOSE #WavFile END IF END SUB FUNCTION Wrap$ (InputText$, Wrappos) '---------------------------------------------------------------------------- ' SúYúSúTúEúM '---------------------------------------------------------------------------- IF INSTR(InputText$, " ") = 0 THEN InputText$ = InputText$ + " ": Wrap$ = InputText$: EXIT FUNCTION InputText$ = InputText$ + " " IF LEN(InputText$) <= Wrappos THEN Wrap$ = InputText$: EXIT FUNCTION TPos = 1 OrgText$ = InputText$ OrgLen = LEN(InputText$) TPos2 = 1 TPos = 0 DO TPos = TPos + 1 TPos2 = TPos2 + 1 IF TPos2 > Wrappos + 1 THEN TPos2 = 0 FOR VPos = TPos TO TPos - Wrappos STEP -1 IF MID$(InputText$, VPos, 1) = " " THEN EXIT FOR NEXT InputText$ = LEFT$(InputText$, VPos - 1) + CHR$(255) + MID$(InputText$, VPos + 1, 255) TLen = TLen + 1 END IF LOOP UNTIL TLen >= OrgLen Wrap$ = LEFT$(InputText$, OrgLen) InputText$ = OrgText$ END FUNCTION SUB writedsp (Byte%) ' Writes a byte to the DSP DO LOOP WHILE INP(BasePort% + 12) AND &H80 OUT BasePort% + 12, Byte% END SUB