Category : Recently Uploaded Files
Archive   : MOVERS1.ZIP
Filename : MOVERS.BAS

 
Output of file : MOVERS.BAS contained in archive : MOVERS1.ZIP
DEFINT A-Z
'===============================DECLARES================================
DECLARE FUNCTION Ok% (Msg1$, Msg2$)
DECLARE SUB InfoBox (Msg1$, Msg2$)
DECLARE SUB CopyRecord ()
DECLARE SUB PasteRecord ()
DECLARE SUB Debugger ()
DECLARE SUB MoversHelp ()
DECLARE SUB ClearActionWindow (colr%)
DECLARE SUB NewPage (Page%, CursRow)
DECLARE SUB UpDateRecord (CursRow%, activeRecord%, FieldPositions%())
DECLARE SUB qbmouse (a%, b%, C%, d%)
DECLARE SUB up (colr)
DECLARE SUB down (colr)
DECLARE SUB TitleIt ()
DECLARE SUB NewTemplate (FieldPositions())
DECLARE SUB DrawActionWindow (ActionWindowTitle$)
DECLARE SUB SetFieldPositions (FieldPositions%())
DECLARE SUB Editor (In$, KeyCod%, FieldPositions())
DECLARE SUB DeleteRow ()
DECLARE SUB InsertRow ()

REM $DYNAMIC
'================================INCLUDE FILES==========================
REM $INCLUDE: 'e:\ezwindo\ezw1.bi'
REM $INCLUDE: 'd:\qb45\inc\qb.bi'
' ===============================VARIABLES==============================
DIM SHARED WindowArray%(32766)
DIM CtrlPressed AS INTEGER
DIM SHARED Bufseg AS INTEGER, offset AS INTEGER
DIM HiPos1(10), HiPos2(10, 20), MaxSize(10), maxitems(10), item$(10, 15), valid(10, 15), toggle(10, 15)
DIM SHARED FieldPositions(5, 2) AS INTEGER ' contains left column and right column for
' each field in editor window
DIM SHARED PageInfo(1 TO 1) AS pages ' Top of page record, bottom of page
' record, total Records, valid
'records
DIM SHARED Reg AS RegType
DIM SHARED RecordCopy AS Inven ' To store a record when copied
DIM SHARED CursSize AS INTEGER ' used to switch between reg cursor and
' insert cursor
DIM SHARED Inventory(1) AS Inven ' holds all records.
DIM SHARED FileLoaded AS INTEGER ' flag - true if a file has been load.
DIM SHARED CursRow AS INTEGER, TxtPos AS INTEGER, FieldNr AS INTEGER ' used in editor
DIM SHARED LeftCol AS INTEGER, RightCol AS INTEGER, RecordChanged AS INTEGER
DIM SHARED activeRecord AS INTEGER, BottomOfPage AS INTEGER, TopOfPage AS INTEGER
DIM SHARED Page AS INTEGER, NrPages AS INTEGER, TotalRecords AS INTEGER
DIM SHARED black, blue, green, cyan, red, magenta, brown, white, gray, lblue
DIM SHARED lgreen, lcyan, lred, lmagenta, yellow, bwhite
DIM SHARED bl ' Bottom line. I did consider allowing 43 or 50 line
' mode, but too much trouble keeping track of record
' when deleting or inserting, etc.
DIM SHARED ms ' mouse

CONST True = -1
CONST False = 0
'=====================PARSE COMMAND LINE AND SET VIDEO MODE================
DEF SEG = 0
IF PEEK(&H463) = &HB4 THEN
CursSize = 12
colr = 0
ELSE
CursSize = 7
colr = 1
END IF
IF INSTR(COMMAND$, "BW") THEN colr = 0 'user wants black/white
ms = 1 'assume mouse
IF INSTR(COMMAND$, "IM") THEN ms = 0 'user doesn't want mouse
COLOR 7, col * 5
bl = 25
' IF INSTR(COMMAND$, "43") THEN bl = 43 ' not worth 43 or 50 line mode
' IF INSTR(COMMAND$, "50") THEN bl = 50
WIDTH 80, bl
CLS
GOSUB setcolors
' ========================= INITIALIZE MENU ===========================

FOR i = 1 TO 10 'HiPos1() holds the location in each menu
HiPos1(i) = 1 'name for the 'hot' key - in this case it
NEXT i 'is the first letter in each name.
'Load in menu data from data statements at the end of this program
RESTORE PullDownMenuData
FOR menu = 1 TO 5 ' five menus: file, edit, rooms, search, help
READ maxitems(menu) 'Number of selections in each menu
READ MaxSize(menu) 'Max length of items in each menu
FOR slct = 1 TO maxitems(menu)
READ item$(menu, slct) 'Text displayed for selection
READ HiPos2(menu, slct) 'Hot key for each selection in menu
READ valid(menu, slct) 'Determines if grayed out or not
READ toggle(menu, slct) 'Determines if selection can be
NEXT slct
NEXT menu
menuline$ = " File Edit Rooms Search Help "
menurow = 1 'Screen row of menu line
menucol = 1 'Beginning column position
menuattr = 7 * 16 + 0 'Menu color
hotattr = 7 * 16 + 15 'Hot key hilite color
hiattr = 0 * 16 + 7 'Hilite bar color
NVattr = 7 * 16 + 8 'color for grayed-out
'selections
clearafter = 1 'erase menu after selection
menuslct = 1 'menu to start with
snd = 1 'turn sound on
shadow = 4
COLOR 0, 7
LOCATE 1, 1
PRINT menuline$;
'==========================Initialize window=============================
SetFieldPositions FieldPositions()
NrWindows = 3 ' These windows are also from John
StackSize% = NrWindows * (20 * 80 + 16) ' Strong's EZWindows routines. This
MaxNrWindows% = 3 ' initializes windows that can be used
initwindow StackSize%, MaxNrWindows% ' with a mouse
'=========================Draw Action window =========================
Title$ = "Editing Window"
DrawActionWindow Title$
SetFieldPositions FieldPositions()

'=============================initialize mouse ======================
CALL qbmouse(0, 0, 0, 0) 'initialize mouse
CALL qbmouse(1, 0, 0, 0) 'show mouse cursor
CALL qbmouse(10, 0, &H7000, 3844) 'set mouse cursor, make it a diamond
'=============================Main Decision loop ======================
' The decision loop is first checks to see if the menu has been called. If so,
' then it handles the menu selection.
' Next it checks to see if a file has been loaded. If a file is loaded, it checks
'for key strokes.
DO ' beginning of decision loop.
itemslct = -1
DEF SEG = &H40 'Check if ALT key is being pressed
x = PEEK(&H17) 'Bit 3 will be high if so
IF x AND 4 THEN
CtrlPressed = True
ELSE
CtrlPressed = False
END IF
DEF SEG '2^3 = 8
qbmouse 3, b, mx, my 'get mouse info
mx = mx / 8 + 1: my = my / 8 + 1 'convert to text coordinates

'If ALT key is pressed, or mouse button pushed while cursor
'positioned on menu bar, then enter the pulldown routine
IF (x AND 8) OR (b = 1 AND my = 1) THEN
WHILE LEN(INKEY$) ' clear the keybuffer
WEND

DEF SEG = 0
POKE (1050), PEEK(1052) 'empty keyboard buffer
DEF SEG
CALL pulldown(menuline$, menurow, menucol, menuattr, hotattr, hiattr, NVattr, HiPos1(), HiPos2(), MaxSize(), maxitems(), item$(), valid(), toggle(), ms, clearafter, shadow, snd, menuslct, itemslct)
'################## handle menu selection ############
IF menuslct = 1 THEN ' file menu
SELECT CASE itemslct
CASE 1 ' new option
Title$ = "UnTitled"
DrawActionWindow Title$
NewTemplate FieldPositions()
FOR x = 2 TO 3
FOR y = 1 TO maxitems(x)
IF x = 2 AND y = 3 THEN
ELSE
valid(x, y) = 1 'Determines if grayed out or not
END IF
NEXT y
NEXT x


CASE 2 ' Open option

CASE 3 ' save option

CASE 4 ' save as option

CASE 5 ' exit
' time to quite. Clean up before we leave.

END SELECT
ELSEIF menuslct = 2 THEN
SELECT CASE itemslct
CASE 1 ' delete row
KeyCode% = 131
Editor In$, KeyCode%, FieldPositions()
CASE 2 ' copy
KeyCode% = 130
Editor In$, KeyCode%, FieldPositions()

CASE 3 ' paste
KeyCode% = 143
Editor In$, KeyCode%, FieldPositions()
CASE 4 ' erase row
KeyCode% = 132
Editor In$, KeyCode%, FieldPositions()
CASE 5 ' insert row
KeyCode% = 136
Editor In$, KeyCode%, FieldPositions()
END SELECT
ELSEIF menuslct = 3 THEN ' Rooms menu
SELECT CASE itemslct
CASE 1 ' Kitchen
CASE 2 ' Living room
colr = SCREEN(3, 1, 1)
qbmouse 2, 0, 0, 0 'turn off mouse cursor
down (colr)
CALL qbmouse(1, 0, 0, 0) 'show mouse cursor

CASE 3
CASE 4
END SELECT

ELSEIF menuslct = 4 THEN

ELSEIF menuslct = 5 THEN

IF itemslct = 1 THEN
MoversHelp
END IF
END IF

seed = menuslct
IF seed = 0 THEN seed = 1
qbmouse 2, b, C, d
QwikPrt menuline$, 1, 1, 112
qbmouse 1, b, C, d

ELSEIF FileLoaded THEN
'##############check for keystrokes ###############3
In$ = INKEY$
IF LEN(In$) THEN
IF LEN(In$) = 1 THEN
KeyCode = ASC(In$)
IF CtrlPressed THEN KeyCode = KeyCode + 127
ELSEIF LEN(In$) = 2 THEN
KeyCode = -ASC(RIGHT$(In$, 1))
IF CtrlPressed THEN KeyCode = KeyCode - 126
END IF
Editor In$, KeyCode%, FieldPositions()
END IF

END IF
LOOP UNTIL menuslct = 1 AND itemslct = 5 '<== change this if your
'exit option is located
'somewhere different


' ============Exit, returning all memory, etc, back to DOS, we hope. ========
REDIM HiPos1(0), HiPos2(0, 0), MaxSize(0), maxitems(0), item$(0, 0), valid(0, 0), toggle(0, 0)

qbmouse 2, 0, 0, 0 'turn off mouse cursor
COLOR 7, 0
CLS
END


setcolors:

black = 0
blue = colr * -(lcd = 0)
green = 2 * colr - (colr = 0) * 7
IF lcd THEN green = 5
cyan = 3 * colr - (colr = 0) * 7
red = 4 * colr
magenta = 5 * colr
brown = 6 * colr
white = 7
gray = 8
lblue = 9 * colr - (colr = 0) * 15
lgreen = 10 * colr
lcyan = 11 * colr
lred = 12 * colr
lmagenta = 13 * colr
yellow = 14 * colr - (colr = 0) * 15
bwhite = 15
IF lcd THEN yellow = lred: bwhite = lred
RETURN

'---------------------------- End of Program Code ----------------------------

'=============================================================================
' M e n u D a t a
'=============================================================================


PullDownMenuData:

'File menu

DATA 5,10 : ' maxitems, maxsize
DATA "New ...", 1,1,0 : ' item, hipos, valid, toggle
DATA "Open ...",1,1,0 : ' the valid item determines whether the
DATA "Save...",1,1,0 : ' menu selection is grayed out or not
DATA "Save As",6,1,0 : ' 0 means the item is gray out, 1 means valid
DATA "Exit",2,1,0

' Edit menu
DATA 5,15 : ' maxitems, maxsize
DATA "Delete...Ctrl-D",1,0,0 : ' all items in this menu are grayed
DATA "Copy ...Ctrl-C",1,0,0 : ' out, until a new template is loaded
DATA "Paste ...Ctrl-P",1,0,0 : ' or a file is loaded.
DATA "Erase ...Ctrl-E",1,0,0
DATA "Insert...Ctrl-I",1,0,0
'Rooms menu

DATA 5,13
DATA "Kitchen ",1,0,0 : ' These menu items are all grayed out
DATA "Bedroom",1,0,0 : ' They are just here for illustration
DATA "Living Room",1,0,0 : ' for right now. I have to add some
DATA "Scroll Up", 8,0,0 : ' more to the template, then
DATA "Scroll Down",8,0,0 : ' straighten this menu out.

DATA 5,26 : ' more for just illustration. I haven't
DATA "Find...",1,1,0 : ' decided what all goes here yet.
DATA "Selected Text Ctrl+\",1,1,0 : ' They are not grayed out, but
DATA "Repeat Last Find F3",1,1,0 : ' they don't do anything yet
DATA "Change...",1,1,0
DATA "Label...",1,1,0

'Help menu

DATA 4,13 : ' only the first menu item does anything
DATA "Movers",1,1,0 : ' so far.
DATA "Telephone Nrs",1,1,0
DATA "",1,1,0
DATA "",1,1,0

'========================ROOMS for the empty template======================
TemplateData:
' DEN, 15 ITEMS
DATA DAVENPORTS
DATA CHAIRS
DATA BOOKCASES
DATA DESKS
DATA CLOCKS
DATA MIRRORS
DATA TABLES
DATA "MUSICAL INSTRUMENTS"
DATA "FIREPLACE EQUIPMENT"
DATA RUGS
DATA CARPETS
DATA CURTAINS
DATA DRAPERIES
DATA LAMPS
DATA "SUNDRY ITEMS"

' SUN ROOM, 10 ITEMS
DATA DAVENPORTS
DATA CHAIRS
DATA LAMPS
DATA RUGS
DATA "BIRD CAGES"
DATA CURTAINS
DATA DRAPERIES
DATA FERNERIES
DATA TABLES
DATA "SUNDRY ITEMS"

' LIBRARY, 21 ITEMS
DATA DAVENPORTS
DATA CHAIRS
DATA TABLES
DATA DESKS
DATA BOOKCASES
DATA RUGS
DATA CARPETS
DATA CLOCKS
DATA MIRRORS
DATA "MUSICAL INSTRUMETNS"
DATA "PHONOGRAPH, RECORDS"
DATA "PIANO, BENCH"
DATA "SHEET MUSIC"
DATA LAMPS
DATA CURTAINS
DATA DRAPERIES
DATA SHADES
DATA RADIO
DATA TELEVISION
DATA "FIREPLACE EQUIPMENT"
DATA "SUNDRY ITEMS"

' GARAGE AND MISCELLANEOUS, 13 ITEMS
DATA BICYCLES
DATA "GARDEN TOOLS"
DATA "LAWN MOWERS"
DATA "OTHER TOOLS"
DATA ACCESSORIES
DATA AWNINGS
DATA "PORCH FURNITURE"
DATA "WINDOW SCREENS"
DATA "SPORTING GOODS"
DATA FISHING
DATA GOLF
DATA HUNTING
DATA TENNIS

' BATHROOMS, 8 ITEMS
DATA "SHOWER CURTAINS"
DATA BENCHES
DATA "MEDICINE CABINETS"
DATA "BATH MATS"
DATA TABLES
DATA "HAND TOWELS"
DATA "GUEST TOWELS"
DATA "SUNDRY ITEMS"

' SERVANTS' ROOMS, 15 ITEMS
DATA "ELECTRIC DEVICES"
DATA CARPETS
DATA "BEDS AND SPRINGS"
DATA LAMPS
DATA BUREAUS
DATA CHAIRS
DATA MATTRESSES
DATA "CHEST, CHIFFONIERS"
DATA RUGS
DATA "CURTAINS, DRAPERIES"
DATA MIRRORS
DATA SHADES
DATA DRESSERS
DATA "DRESSING TABLES"
DATA "SUNDRY ITEMS"

'HALLS, 9 ITEMS
DATA CHAIRS
DATA DAVENPORTS
DATA TABLES
DATA "RUGS AND CARPETS"
DATA CLOCKS
DATA "LAMPS AND SHADES"
DATA MIRRORS
DATA "CURTAINS, DRAPERIES"
DATA "SUNDRY ITEMS"

' KITCHEN AND PANTRY, 10 ITEMS

DATA "KITCHEN UTENSILS"
DATA "ELECTRIC APPLIANCES"
DATA CLOCKS
DATA "HOUSEHOLD TOOLS"
DATA "VACUUM SWEEPERS"
DATA REFRIGERATOR
DATA CUTLERY
DATA "KITCHEN CABINETS"
DATA "MOPS, DUSTERS, ETC"
DATA "SUNDRY ITEMS"

' BREAKFAST ROOM, 5 ITEMS

DATA "ELECTRIC UTENSILS"
DATA "CHINA CABINET"
DATA "CHAIRS AND TABLES"
DATA BUFFET
DATA "SUNDRY ITEMS"


' WOMEN'S CLOTHING, 12 ITEMS
DATA SUITS
DATA COATS
DATA DRESSES
DATA HATS
DATA SHORTS
DATA SKIRTS
DATA SWEATERS
DATA UNDERWEAR
DATA SHIRTWAISTS
DATA HANKERCHIEFS
DATA HOSIERY
DATA "MISC ITEMS"




' DATA "LIVING ROOM'
DATA DAVENPORT
DATA CHAIRS
DATA TABLES
DATA DESKS
DATA BOOKCASES
DATA CARPETS
DATA CLOCKS
DATA CARPETS
DATA LAMPS
DATA MIRRORS
DATA PICTURES
DATA "MAGAZINE RACKS"
DATA "COFFEE TABLE"
DATA "SIDE TABLE"
DATA "FLOOR LAMPS"
DATA "PICTURES"
DATA CHAIRS
DATA STOOLS
DATA TABLES
DATA DESKS
DATA "SERVING TABLES
DATA BUFFET
DATA SIDEBOARD
DATA CABINETS

REM $STATIC
SUB ClearActionWindow (colr)
Reg.ax = 20 + (6 * 256)' 1 is the nr of lines to scroll. (6*256) is service 6
Reg.bx = colr * 256
Reg.cx = 1 + (256 * 5) ' Column 1 + Row 3-1 * 256
Reg.dx = 78 + (256 * 22) ' Column 78 + Row 23-1 * 256
CALL INTERRUPT(&H10, Reg, Reg)

END SUB

SUB CopyRecord
SHARED valid()
TxtCopy$ = ""
FOR x = FieldPositions(1, 1) TO FieldPositions(1, 2)
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
RecordCopy.Article = TxtCopy$
TxtCopy$ = ""
FOR x = FieldPositions(2, 1) TO FieldPositions(2, 2)
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
RecordCopy.Quanity = TxtCopy$
TxtCopy$ = ""
FOR x = FieldPositions(3, 1) TO FieldPositions(3, 2)
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
RecordCopy.Purchased = TxtCopy$
TxtCopy$ = ""
FOR x = FieldPositions(4, 1) TO FieldPositions(4, 2)
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
RecordCopy.Cost = TxtCopy$
TxtCopy$ = ""
FOR x = FieldPositions(5, 1) TO FieldPositions(5, 2)
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
RecordCopy.EstValue = TxtCopy$
TxtCopy$ = ""
valid(2, 3) = 1

InfoBox "Record Copied", ""
' Title$ = " ClipBoard "
' attr = magenta * 16 + yellow
' Bufseg = VARSEG(WindowArray%(0))
' frame$ = STRING$(8, CHR$(30))
' frame = SADD(frame$)
' savepop Title$, 2, 10, 30, 14, 50, attr, frame, -4, 1, Bufseg
' offset = WindowArray%(0)
' attr = magenta * 16 + bwhite
' lin$ = " Record Copied "
' QwikPrt lin$, 12, 32, attr
' WHILE INKEY$ <> ""
' WEND
' WHILE INKEY$ = ""
' WEND
'
' restwindo (Bufseg)

END SUB

SUB Debugger
' this sub is just to help debug the program. When the program is finished,
' this sub will be deleted. Right now I hope it alerts me when the records
' get out of sync. The biggest problem for me is keeping the math straight
' when scrolling, going from page to page, inserting and deleting lines

DebugMsg$ = STRING$(78, " ") ' I use line 25 to print my debug msgs. These
QwikPrt DebugMsg$, 25, 1, 112 ' two lines just clear line 25.

' The next two lines print information on line 25 to help me keep track of
' where the cursrow, activerecord, top and bottom of each page are.
' I haven't decided what purpose line 25 will accomplish at the end of all
' this. Message line, copyright line?? who knows?
DebugMsg$ = "Cursrow" + STR$(CursRow) + "; TopOfPage" + STR$(TopOfPage) + "; BottomOfPage" + STR$(BottomOfPage) + "; AR" + STR$(activeRecord)
QwikPrt DebugMsg$, 25, 1, 112
IF TopOfPage < 1 THEN
BEEP
STOP
ELSEIF CursRow < 6 THEN
BEEP
STOP
ELSEIF BottomOfPage < TopOfPage THEN
BEEP
STOP
ELSEIF CursRow > BottomOfPage - TopOfPage + 6 THEN
BEEP
STOP
ELSEIF activeRecord < TopOfPage OR activeRecord > BottomOfPage THEN
BEEP
STOP
END IF

END SUB

SUB DeleteRow
IF BottomOfPage > TopOfPage THEN
FOR x = activeRecord TO TotalRecords - 1
Inventory(x).Article = Inventory(x + 1).Article
Inventory(x).Quanity = Inventory(x + 1).Quanity
Inventory(x).Purchased = Inventory(x + 1).Purchased
Inventory(x).Cost = Inventory(x + 1).Cost
Inventory(x).EstValue = Inventory(x + 1).EstValue
Inventory(x).RecordNr = x
NEXT x
TotalRecords = TotalRecords - 1
BottomOfPage = BottomOfPage - 1
FOR x = Page TO NrPages
IF x > Page THEN
PageInfo(x).TopOfPage = PageInfo(x).TopOfPage - 1
END IF
IF x < NrPages THEN
PageInfo(x).BottomOfPage = PageInfo(x).BottomOfPage - 1
ELSE
PageInfo(x).BottomOfPage = TotalRecords
END IF
NEXT x
PageInfo(Page).TotalRecords = PageInfo(Page).TotalRecords - 1
PageInfo(Page).TotalValidRecords = PageInfo(Page).TotalRecords' Valid Records
IF activeRecord > BottomOfPage THEN
CursRow = BottomOfPage - TopOfPage + 6
IF CursRow > 23 THEN CursRow = 23
' CursRow = CursRow - 1
NewPage Page, CursRow
activeRecord = BottomOfPage

ELSE
y = activeRecord
NewPage Page, CursRow
activeRecord = y
END IF
ELSEIF TopOfPage = BottomOfPage THEN
Inventory(activeRecord).Article = ""
Inventory(activeRecord).Quanity = ""
Inventory(activeRecord).Purchased = ""
Inventory(activeRecord).Cost = ""
Inventory(activeRecord).EstValue = ""
NewPage Page, 6

END IF
Debugger
END SUB

SUB down (colr)
' This scrolls the action screen down
Reg.ax = 1 + (7 * 256)' 1 is the nr of lines to scroll. (6*256) is service 6
Reg.bx = colr * 256
Reg.cx = 1 + (256 * 5) ' Column 2 + Row 3-1 * 256
Reg.dx = 78 + (256 * 22) ' Column 79 + Row 25-1 * 256
CALL INTERRUPT(&H10, Reg, Reg)

END SUB

SUB DrawActionWindow (ActionWindowTitle$)
Reg.ax = 17 + (6 * 256)' 17 is the nr of lines to scroll. (6*256) is service 6
Reg.bx = colr * 256
Reg.cx = 1 + (256 * 5) ' Column 1 + Row 3-1 * 256
Reg.dx = 78 + (256 * 22) ' Column 78 + Row 23-1 * 256
CALL INTERRUPT(&H10, Reg, Reg)

frame$ = "°°°°°°°°" ' blocks all the way around
Tpos% = 2 ' title position - top center
frame% = SADD(frame$)
popwindo ActionWindowTitle$, Tpos%, 2, 1, 24, 80, 23, frame%, 1, 0
COLOR 7, 1
LOCATE 25, 1
HeaderLine$ = " Date Present "
QwikPrt HeaderLine$, 3, 2, 113
HeaderLine$ = " Article Quanity Purchased Cost Value "
QwikPrt HeaderLine$, 4, 2, 113
MsgLine$ = STRING$(80, "²") ' Not sure why a msg line is needed, but seemed
' like a good idea at the time
QwikPrt MsgLine$, 25, 1, 23
UnderLine$ = STRING$(78, "-")
QwikPrt UnderLine$, 5, 2, 23



END SUB

SUB Editor (In$, KeyCode%, FieldPositions()) STATIC
SHARED valid()
SELECT CASE KeyCode%
CASE 8 ' backspace
TxtCopy$ = ""
TxtPos = TxtPos - 1
IF TxtPos < LeftCol THEN
TxtPos = TxtPos + 1
ELSE
LOCATE , TxtPos, 0
IF InsertOn THEN
FOR x = TxtPos + 1 TO RightCol
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
TxtCopy$ = TxtCopy$ + " "
qbmouse 2, 0, 0, 0 'turn off mouse cursor
QwikPrt TxtCopy$, CursRow, TxtPos, 112
TxtCopy$ = ""
qbmouse 1, 0, 0, 0 'turn off mouse cursor

ELSE
qbmouse 2, 0, 0, 0 'turn off mouse cursor

QwikPrt " ", CursRow, TxtPos, 112
qbmouse 1, 0, 0, 0 'turn off mouse cursor
END IF
LOCATE , , 1
RecordChanged = True
END IF
CASE 9 ' tab
IF FieldNr < 5 THEN
FieldNr = FieldNr + 1
LeftCol = FieldPositions(FieldNr, 1)
RightCol = FieldPositions(FieldNr, 2)
LOCATE , LeftCol
TxtPos = LeftCol
END IF

CASE -15 ' Shift tab
IF FieldNr > 1 THEN
FieldNr = FieldNr - 1
LeftCol = FieldPositions(FieldNr, 1)
RightCol = FieldPositions(FieldNr, 2)
LOCATE , LeftCol
TxtPos = LeftCol
END IF

CASE 32 TO 127
RecordChanged = True
TxtCopy$ = ""
qbmouse 2, 0, 0, 0 'turn off mouse cursor

IF InsertOn THEN
IF TxtPos < RightCol THEN
FOR x = TxtPos TO RightCol - 1
TxtCopy$ = TxtCopy$ + CHR$(SCREEN(CursRow, x))
NEXT x
TxtCopy$ = In$ + TxtCopy$
QwikPrt TxtCopy$, CursRow, TxtPos, 112
TxtPos = TxtPos + 1
LOCATE , TxtPos
ELSE
BEEP
END IF

ELSE
QwikPrt In$, CursRow, TxtPos, 112
TxtPos = TxtPos + 1
IF TxtPos > RightCol THEN
TxtPos = RightCol
END IF
LOCATE , TxtPos
END IF
qbmouse 1, 0, 0, 0 'turn on mouse cursor
CASE -59, 131 ' F1, Ctrl-D, Delete Row
' If this menu item is grayed out, then you can't select it from
' the menu, but you can still press the hot keys Ctrl-D, so we
' must check the valid() array to determine if it is grayed out
' before we execute it.
IF valid(2, 1) THEN
IF Ok("Delete Record?", "") THEN
qbmouse 2, 0, 0, 0
DeleteRow
' NewPage Page, CursRow
LOCATE CursRow, LeftCol
qbmouse 1, 0, 0, 0
END IF
END IF
CASE -60, 136 'F2, Ctrl-I, Insert Row
IF valid(2, 5) THEN ' make sure item is not grayed out.
qbmouse 2, 0, 0, 0
y = activeRecord
InsertRow
NewPage Page, CursRow
LOCATE CursRow, LeftCol
activeRecord = y
qbmouse 1, 0, 0, 0
END IF
CASE -61, 130 'F3, Ctrl-C
IF valid(2, 2) THEN ' make sure item is not grayed out.

CopyRecord
END IF
CASE -62, 143 ' F4, Ctrl-P
IF valid(2, 3) THEN ' make sure item is not grayed out.
qbmouse 2, 0, 0, 0
PasteRecord
qbmouse 1, 0, 0, 0
END IF

CASE -73 ' page up
qbmouse 2, 0, 0, 0 'turn off mouse cursor

IF Page > 1 THEN
IF RecordChanged THEN
UpDateRecord CursRow, activeRecord, FieldPositions()
RecordChanged = False
END IF
Page = Page - 1
NewPage Page, 6
END IF
qbmouse 1, 0, 0, 0 'turn on mouse cursor
Debugger

CASE -81 ' page down
qbmouse 1, 0, 0, 0 'turn off mouse cursor

IF Page < NrPages THEN
IF RecordChanged THEN
UpDateRecord CursRow, activeRecord, FieldPositions()
RecordChanged = False
END IF
Page = Page + 1

NewPage Page, 6
END IF
qbmouse 1, 0, 0, 0 'turn on mouse cursor
Debugger
CASE 132 ' erase
IF valid(2, 4) THEN
qbmouse 2, 0, 0, 0
Inventory(activeRecord).Article = ""

Inventory(activeRecord).Quanity = ""
Inventory(activeRecord).Purchased = ""
Inventory(activeRecord).Cost = ""
Inventory(activeRecord).EstValue = ""

QwikPrt Inventory(activeRecord).Article, CursRow, FieldPositions(1, 1), 112
QwikPrt Inventory(activeRecord).Quanity, CursRow, FieldPositions(2, 1), 112
QwikPrt Inventory(activeRecord).Purchased, CursRow, FieldPositions(3, 1), 112
QwikPrt Inventory(activeRecord).Cost, CursRow, FieldPositions(4, 1), 112
QwikPrt Inventory(activeRecord).EstValue, CursRow, FieldPositions(5, 1), 112
qbmouse 1, 0, 0, 0

END IF
CASE -83 ' delete
IF valid(2, 3) THEN
RecordChanged = True
TxtCopy$ = ""
qbmouse 2, 0, 0, 0 'turn off mouse cursor

FOR x = TxtPos + 1 TO RightCol
TxtCopy$ = TxtCopy$ + CHR$(SCREEN(CursRow, x))
NEXT x
TxtCopy$ = TxtCopy$ + " "
QwikPrt TxtCopy$, CursRow, TxtPos, 112
'LOCATE , TxtPos
'PRINT TxtCopy$;
LOCATE , TxtPos
qbmouse 1, 0, 0, 0 'turn on mouse cursor

END IF
CASE -71 ' home
FieldNr = 1
LeftCol = FieldPositions(FieldNr, 1)
RightCol = FieldPositions(FieldNr, 2)
LOCATE , LeftCol
TxtPos = LeftCol
CASE -119 ' Control home
IF RecordChanged THEN
UpDateRecord CursRow, activeRecord, FieldPositions()
RecordChanged = False
END IF
IF CursRow > 6 THEN
activeRecord = (activeRecord - CursRow) + 6
CursRow = 6
END IF
FieldNr = 1
LeftCol = FieldPositions(FieldNr, 1)
RightCol = FieldPositions(FieldNr, 2)
TxtPos = LeftCol
LOCATE CursRow, LeftCol
CASE -79 ' end
FieldNr = 5
LeftCol = FieldPositions(FieldNr, 1)
RightCol = FieldPositions(FieldNr, 2)
LOCATE , LeftCol
TxtPos = LeftCol
CASE -117 ' control end
IF RecordChanged THEN
UpDateRecord CursRow, activeRecord, FieldPositions()
RecordChanged = False
END IF
IF BottomOfPage - TopOfPage + 1 < 18 THEN
activeRecord = BottomOfPage - TopOfPage + 1
CursRow = BottomOfPage - TopOfPage + 6
ELSE
activeRecord = activeRecord - CursRow + 23
CursRow = 23
END IF
FieldNr = 1
LeftCol = FieldPositions(FieldNr, 1)
RightCol = FieldPositions(FieldNr, 2)
TxtPos = LeftCol
LOCATE CursRow, LeftCol

CASE -77 ' right arrow
TxtPos = TxtPos + 1
IF TxtPos > RightCol THEN TxtPos = TxtPos - 1
LOCATE , TxtPos
CASE -75 ' left arrow
TxtPos = TxtPos - 1
IF TxtPos < LeftCol THEN TxtPos = TxtPos + 1
LOCATE , TxtPos
CASE -72 ' up arrow
IF CursRow > 6 THEN
IF RecordChanged THEN
UpDateRecord CursRow, activeRecord, FieldPositions()
RecordChanged = False
END IF
LOCATE CursRow - 1
CursRow = CursRow - 1
activeRecord = activeRecord - 1
ELSEIF activeRecord > TopOfPage THEN
qbmouse 2, 0, 0, 0 'turn off mouse cursor
IF RecordChanged THEN
UpDateRecord CursRow, activeRecord, FieldPositions()
RecordChanged = False
END IF
down 23
activeRecord = activeRecord - 1
LOCATE CursRow
QwikPrt Inventory(activeRecord).Article, CursRow, FieldPositions(1, 1), 112
QwikPrt Inventory(activeRecord).Quanity, CursRow, FieldPositions(2, 1), 112
QwikPrt Inventory(activeRecord).Purchased, CursRow, FieldPositions(3, 1), 112
QwikPrt Inventory(activeRecord).Cost, CursRow, FieldPositions(4, 1), 112
QwikPrt Inventory(activeRecord).EstValue, CursRow, FieldPositions(5, 1), 112
qbmouse 1, 0, 0, 0 'turn off mouse cursor
END IF
Debugger
CASE -80, 13 ' down arrow, enter
IF CursRow < 23 AND activeRecord < BottomOfPage THEN
IF RecordChanged THEN
UpDateRecord CursRow, activeRecord, FieldPositions()
RecordChanged = False
END IF
LOCATE CursRow + 1
CursRow = CursRow + 1
activeRecord = activeRecord + 1
ELSEIF activeRecord < BottomOfPage THEN
qbmouse 2, 0, 0, 0 'turn off mouse cursor
IF RecordChanged THEN
UpDateRecord CursRow, activeRecord, FieldPositions()
RecordChanged = False
END IF
up 23
LOCATE CursRow
activeRecord = activeRecord + 1
QwikPrt Inventory(activeRecord).Article, CursRow, FieldPositions(1, 1), 112
QwikPrt Inventory(activeRecord).Quanity, CursRow, FieldPositions(2, 1), 112
QwikPrt Inventory(activeRecord).Purchased, CursRow, FieldPositions(3, 1), 112
QwikPrt Inventory(activeRecord).Cost, CursRow, FieldPositions(4, 1), 112
QwikPrt Inventory(activeRecord).EstValue, CursRow, FieldPositions(5, 1), 112
qbmouse 1, 0, 0, 0 'turn off mouse cursor
END IF
IF KeyCode% = 13 THEN
FieldNr = 1
LeftCol = FieldPositions(FieldNr, 1)
RightCol = FieldPositions(FieldNr, 2)
LOCATE , LeftCol
TxtPos = LeftCol
END IF
Debugger

CASE -82 ' insert
InsertOn = NOT InsertOn
IF InsertOn THEN
LOCATE , , , 0, CursSize
ELSE
LOCATE , , , CursSize - 1, CursSize
END IF
CASE -132 ' Control Pgup
qbmouse 2, 0, 0, 0 'turn off mouse cursor

IF RecordChanged THEN
UpDateRecord CursRow, activeRecord, FieldPositions()
RecordChanged = False
END IF
Page = 1
NewPage Page, 6
qbmouse 1, 0, 0, 0 'turn on mouse cursor

CASE -118 ' control Pgdown
qbmouse 2, 0, 0, 0 'turn off mouse cursor

IF RecordChanged THEN
UpDateRecord CursRow, activeRecord, FieldPositions()
RecordChanged = False
END IF
Page = NrPages
NewPage NrPages, 6
qbmouse 1, 0, 0, 0 'turn on mouse cursor



END SELECT

END SUB

SUB InfoBox (Msg1$, Msg2$)
attr = magenta * 16 + yellow
msgattr = magenta * 16 + bwhite
hiattr = green * 16 + red
hotattr = blue * 16 + yellow
Action$ = "Ok"
OkBox 10, 30, attr, msgattr, hotattr, 1, Msg1$, Msg2$, Action$, -4, ms, 2

END SUB

SUB InsertRow
FOR x = TotalRecords + 1 TO activeRecord STEP -1
Inventory(x).Article = Inventory(x - 1).Article
Inventory(x).Quanity = Inventory(x - 1).Quanity
Inventory(x).Purchased = Inventory(x - 1).Purchased
Inventory(x).Cost = Inventory(x - 1).Cost
Inventory(x).EstValue = Inventory(x - 1).EstValue
Inventory(x).RecordNr = x
NEXT x
Inventory(activeRecord).Article = ""
Inventory(activeRecord).Quanity = ""
Inventory(activeRecord).Purchased = ""
Inventory(activeRecord).Cost = ""
Inventory(activeRecord).EstValue = ""
Inventory(activeRecord).RecordNr = activeRecord

TotalRecords = TotalRecords + 1
BottomOfPage = BottomOfPage + 1
FOR x = Page TO NrPages
IF x > Page THEN
PageInfo(x).TopOfPage = PageInfo(x).TopOfPage + 1
END IF
IF x < NrPages THEN
PageInfo(x).BottomOfPage = PageInfo(x).BottomOfPage + 1
ELSE
PageInfo(x).BottomOfPage = TotalRecords
END IF
PageInfo(x).TotalRecords = PageInfo(x).BottomOfPage - PageInfo(x).TopOfPage + 1' Total Records
NEXT x

END SUB

SUB MoversHelp
Title$ = " KeyBoard Commands "
attr = cyan * 16 + magenta
Bufseg = VARSEG(WindowArray%(0))
frame$ = STRING$(8, CHR$(30))
frame = SADD(frame$)
savepop Title$, 2, 6, 5, 19, 75, attr, frame, -4, 1, Bufseg
offset = WindowArray%(0)
attr = cyan * 16 + yellow
lin$ = "Tab - Go to next field Shft-Tab - Previous field"
QwikPrt lin$, 7, 6, attr
lin$ = "Home - First field Ctrl-Home - Top of page"
QwikPrt lin$, 8, 6, attr
lin$ = "End - Last field Ctrl-End - Bottom of page"
QwikPrt lin$, 9, 6, attr
lin$ = "Page up - Previous page Ctrl-Page up - First page"
QwikPrt lin$, 10, 6, attr
lin$ = "Page dn - Next page Ctrl-Page dn - Last page"
QwikPrt lin$, 11, 6, attr




WHILE INKEY$ <> ""
WEND
WHILE INKEY$ = ""
WEND
restwindo (Bufseg)
' GOSUB hak
a = 0
' CALL tickwait(a)
' IF a = 27 THEN GOTO pwdone

END SUB

SUB NewPage (Page, CR)
qbmouse 2, 0, 0, 0 'turn off mouse cursor

ClearActionWindow 23
TitleIt
Ro = 5
FOR x = PageInfo(Page).TopOfPage TO PageInfo(Page).BottomOfPage
IF Ro < 23 THEN
Ro = Ro + 1
QwikPrt Inventory(x).Article, Ro, FieldPositions(1, 1), 112
QwikPrt Inventory(x).Quanity, Ro, FieldPositions(2, 1), 112
QwikPrt Inventory(x).Purchased, Ro, FieldPositions(3, 1), 112
QwikPrt Inventory(x).Cost, Ro, FieldPositions(4, 1), 112
QwikPrt Inventory(x).EstValue, Ro, FieldPositions(5, 1), 112
END IF
NEXT x
LOCATE 6, 2, 1, CursSize - 1, CursSize
qbmouse 1, 0, 0, 0 'turn on mouse cursor

FileLoaded = True
TopOfPage = PageInfo(Page).TopOfPage
BottomOfPage = PageInfo(Page).BottomOfPage
LeftCol = FieldPositions(1, 1)
RightCol = FieldPositions(1, 2)
TxtPos = 2
InsertOn = False
FieldNr = 1
activeRecord = PageInfo(Page).TopOfPage
CursRow = CR
'IF CursRow > BottomOfPage THEN
' CursRow = BottomOfPage
' LOCATE CursRow
'END IF
END SUB

SUB NewTemplate (FieldPositions())
NrPages = 10 ' only one page so far.
TotalRecords = 118 ' total for all pages

' ========page info - not used in the program ==============
' I thought this page information might be needed, but haven't found any
' use for it yet. Maybe something like it will be needed when a file
' is loaded from disk.
REDIM PageInfo(NrPages) AS pages' 10 pages
PageInfo(1).PageTitle = "DEN" '15
PageInfo(1).TopOfPage = 1
PageInfo(2).PageTitle = "SUN ROOM" ' 10
PageInfo(2).TopOfPage = 16
PageInfo(3).PageTitle = "LIBRARY" ' 21
PageInfo(3).TopOfPage = 26
PageInfo(4).PageTitle = "GARAGE AND MISC" '13
PageInfo(4).TopOfPage = 47
PageInfo(5).PageTitle = "BATHROOMS" '8
PageInfo(5).TopOfPage = 60
PageInfo(6).PageTitle = "SERVANTS ROOMS" '15
PageInfo(6).TopOfPage = 68
PageInfo(7).PageTitle = "HALLS" '9
PageInfo(7).TopOfPage = 83
PageInfo(8).PageTitle = "KITCHEN UTENSILS" ' 10
PageInfo(8).TopOfPage = 92
PageInfo(9).PageTitle = "BREAKFAST ROOM" '5
PageInfo(9).TopOfPage = 102
PageInfo(10).PageTitle = "WOMENS CLOTHING" ' 12
PageInfo(10).TopOfPage = 107

FOR x = 1 TO NrPages
IF x < NrPages THEN
PageInfo(x).BottomOfPage = PageInfo(x + 1).TopOfPage - 1
ELSE
PageInfo(x).BottomOfPage = TotalRecords
END IF
PageInfo(x).TotalRecords = PageInfo(x).BottomOfPage - PageInfo(x).TopOfPage + 1' Total Records
PageInfo(x).TotalValidRecords = PageInfo(x).TotalRecords' Valid Records
NEXT x
REDIM Inventory(TotalRecords + 50) AS Inven
RESTORE TemplateData
FOR x = 1 TO TotalRecords
READ Inventory(x).Article
Inventory(x).Quanity = STRING$(4, CHR$(32))
Inventory(x).Purchased = STRING$(10, CHR$(32))
Inventory(x).Cost = STRING$(10, CHR$(32))
Inventory(x).EstValue = STRING$(10, CHR$(32))
Inventory(x).RecordNr = x
NEXT x
Page = 1
CursRow = 6
NewPage Page, CursRow
END SUB

FUNCTION Ok (Msg1$, Msg2$)
wattr = magenta * 16 + yellow
msgattr = magenta * 16 + bwhite
hiattr = green * 16 + red
hotattr = blue * 16 + yellow
'ufseg = VARSEG(WindowArray%(0))
'frame$ = STRING$(8, CHR$(30))
'frame = SADD(frame$)
Choice1$ = "OK": Choice2$ = "Cancel"
ChooseBox 10, 30, Msg1$, Msg2$, Choice1$, Choice2$, 1, 1, wattr, msgattr, hiattr, hotattr, -4, ms, 2, Choice
IF Choice = 1 THEN
Ok = True
ELSE
Ok = False
END IF
END FUNCTION

SUB PasteRecord
QwikPrt RecordCopy.Article, CursRow, FieldPositions(1, 1), 112
QwikPrt RecordCopy.Quanity, CursRow, FieldPositions(2, 1), 112
QwikPrt RecordCopy.Purchased, CursRow, FieldPositions(3, 1), 112
QwikPrt RecordCopy.Cost, CursRow, FieldPositions(4, 1), 112
QwikPrt RecordCopy.EstValue, CursRow, FieldPositions(5, 1), 112
RecordChanged = True

END SUB

SUB qbmouse (a, b, C, d)
SHARED Reg AS RegType
Reg.ax = a
Reg.bx = b
Reg.cx = C
Reg.dx = d
CALL INTERRUPT(&H33, Reg, Reg)
a = Reg.ax
b = Reg.bx
C = Reg.cx
d = Reg.dx
END SUB

SUB SetFieldPositions (FieldPositions())
FieldPositions(1, 1) = 2: FieldPositions(1, 2) = 21 ' Article field beginning and ending positions
FieldPositions(2, 1) = 23: FieldPositions(2, 2) = 26' Quanity field beginning and ending positions
FieldPositions(3, 1) = 30: FieldPositions(3, 2) = 39' Purchased field beginning and ending positions
FieldPositions(4, 1) = 42: FieldPositions(4, 2) = 51' Cost field beginning and ending positions
FieldPositions(5, 1) = 54: FieldPositions(5, 2) = 63' Value field beginning and ending positions

END SUB

SUB TitleIt
UnderLine$ = STRING$(78, "-")
QwikPrt UnderLine$, 5, 2, 23
x$ = LTRIM$(RTRIM$(PageInfo(Page).PageTitle))

x = LEN(x$)
x = (78 - x) / 2
LOCATE 5, x: PRINT x$;

END SUB

SUB up (colr)
Reg.ax = 1 + (6 * 256)' 1 is the nr of lines to scroll. (6*256) is service 6
Reg.bx = colr * 256
Reg.cx = 1 + (256 * 5) ' Column 1 + Row 3-1 * 256
Reg.dx = 78 + (256 * 22) ' Column 78 + Row 23-1 * 256
CALL INTERRUPT(&H10, Reg, Reg)
END SUB

SUB UpDateRecord (CursRow, activeRecord, FieldPositions())
' This sub is called whenever flag RecordChanged is valid and we
' move off the record or move to another page (or save the file when
' that part is written.)

TxtCopy$ = ""
FOR x = FieldPositions(1, 1) TO FieldPositions(1, 2)
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
Inventory(activeRecord).Article = TxtCopy$
TxtCopy$ = ""
FOR x = FieldPositions(2, 1) TO FieldPositions(2, 2)
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
Inventory(activeRecord).Quanity = TxtCopy$
TxtCopy$ = ""
FOR x = FieldPositions(3, 1) TO FieldPositions(3, 2)
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
Inventory(activeRecord).Purchased = TxtCopy$
TxtCopy$ = ""
FOR x = FieldPositions(4, 1) TO FieldPositions(4, 2)
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
Inventory(activeRecord).Cost = TxtCopy$
TxtCopy$ = ""
FOR x = FieldPositions(5, 1) TO FieldPositions(5, 2)
AscCode = SCREEN(CursRow, x)
TxtCopy$ = TxtCopy$ + CHR$(AscCode)
NEXT x
Inventory(activeRecord).EstValue = TxtCopy$
TxtCopy$ = ""


END SUB



  3 Responses to “Category : Recently Uploaded Files
Archive   : MOVERS1.ZIP
Filename : MOVERS.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/