Filter: Difference between revisions

Line 2,994:
{{works with|Visual Basic for DOS|1.0}}
{{works with|PDS|7.x}}
 
===Using two arrays===
This version uses two arrays.
 
<syntaxhighlight lang="qbasic">
' OPTION EXPLICIT
Line 2,999 ⟶ 3,003:
' Filter
' This program selects certain elements from an array into a new array in a generic way
 
' SUBs
DECLARE SUB getNewArray (iGetWhat AS INTEGER)
 
' Var
' $DYNAMIC
 
TYPE regSub
aNum AS INTEGER
END TYPE
CONST Even = 2
CONST Uneven = 1
CONST cFile = "DUMMY$$$.$$$"
CONST False = 0, True = NOT False
 
DIM t AS INTEGER
DIM t2 AS INTEGER
DIM f AS INTEGER
DIM i AS INTEGER
DIM iFlag AS INTEGER
DIM iGetWhat AS INTEGER
DIM iArray%(1 TO 1)
DIM iArray2%(1 TO 1)
DIM rSub AS regSub
 
' Initialize vars
' Register
iFlag = False
TYPE regSub
f = FREEFILE
aNum AS INTEGER
iGetWhat = Even
END TYPE
 
' Main program cycle
CLS
RANDOMIZE TIMER
t = INT(RND * 300) + 1
REDIM iArray%(1 TO t)
 
' Main program cycle
OPEN cFile FOR OUTPUT AS #f
CLOSE
 
OPEN cFile FOR RANDOM AS #f LEN = LEN(rSub)
 
CLS
PRINT "Select items in an array into a new array in a generic way."
PRINT "Base array:"
Line 3,027 ⟶ 3,045:
iArray%(i) = INT(RND * 2000) + 1
PRINT iArray%(i);
IF (iArray%(i) MOD 2) = 0 AND iGetWhat = Even THEN
iFlag = True
ELSEIF (iArray%(i) MOD 2) <> 0 AND iGetWhat = Uneven THEN
iFlag = True
END IF
 
IF iFlag THEN
rSub.aNum = iArray%(i)
PUT #f, , rSub
iFlag = False
END IF
NEXT i
PRINT
 
' GetsRedims the new array of evens
t2 = LOF(f) / LEN(rSub)
getNewArray Even
REDIM iArray2%(1 TO t2)
 
FOR i = 1 TO t2
GET #f, i, rSub
iArray2%(i) = rSub.aNum
NEXT i
 
CLOSE #f
KILL cFile
 
PRINT
 
' Shows the result
IF t2 > 0 THEN
t = UBOUND(iArray2%)
PRINT "Selected items from the array (total:"; t2; "of"; t; "):"
IF t > 0 THEN
FOR i = 1 TO t2
PRINT "Selected items from the array (total:"; t; "of"; UBOUND(iArray%); "):"
FOR i = 1 TO t
PRINT iArray2%(i);
NEXT i
Line 3,044 ⟶ 3,082:
PRINT
PRINT "End of program."
END</syntaxhighlight>
END
 
REM $STATIC
SUB getNewArray (iGetWhat AS INTEGER)
' Var
DIM f AS INTEGER
DIM t AS INTEGER
DIM i AS INTEGER
DIM aFlag AS INTEGER
DIM rSub AS regSub
SHARED iArray%()
SHARED iArray2%()
CONST aName$ = "DUMMY$$$.$$$"
CONST False = 0, True = NOT False
f = FREEFILE
OPEN aName$ FOR OUTPUT AS #f
CLOSE
 
OPEN aName$ FOR RANDOM AS #f LEN = LEN(rSub)
t = UBOUND(iArray%)
aFlag = False
FOR i = 1 TO t
IF (iArray%(i) MOD 2) = 0 AND iGetWhat = Even THEN
aFlag = True
ELSEIF (iArray%(i) MOD 2) <> 0 AND iGetWhat = Uneven THEN
aFlag = True
END IF
 
IF aFlag THEN
rSub.aNum = iArray%(i)
PUT #f, , rSub
aFlag = False
END IF
NEXT i
 
' Redims the 2nd array
t = LOF(f) / LEN(rSub)
REDIM iArray2%(1 TO t)
 
FOR i = 1 TO t
GET #f, i, rSub
iArray2%(i) = rSub.aNum
NEXT i
CLOSE #f
KILL aName$
 
END SUB
</syntaxhighlight>
{{out}}
The output can change as the size of the base array and its values varies on each run.
Line 3,105 ⟶ 3,094:
</pre>
 
==={{header|QBASIC}}Using one array===
Extra points: This version uses one array.
{{works with|QuickBasic|4.x}}
{{works with|Visual Basic for DOS|1.0}}
{{works with|PDS|7.x}}
<syntaxhighlight lang="qbasic">
' OPTION EXPLICIT
Line 3,115 ⟶ 3,102:
' This program selects certain elements from an array into a new array in a generic way
' Extra points: Destroys the original values in the array
 
' SUBs
DECLARE SUB getNewArray (iGetWhat AS INTEGER)
 
' Var
' $DYNAMIC
 
TYPE regSub
aNum AS INTEGER
END TYPE
CONST Even = 2
CONST Uneven = 1
CONST cFile = "DUMMY$$$.$$$"
CONST False = 0, True = NOT False
DIM t AS INTEGER
DimDIM t2 AS INTEGER
DIM f AS INTEGER
DIM i AS INTEGER
DIM iFlag AS INTEGER
DIM iGetWhat AS INTEGER
DIM iArray%(1 TO 1)
DIM rSub AS regSub
 
' Initialize vars
' Register
iFlag = False
TYPE regSub
t = INT(RND * 300) + 1
aNum AS INTEGER
f = FREEFILE
END TYPE
iGetWhat = Even
REDIM iArray%(1 TO t)
 
' Main program cycle
OPEN cFile FOR OUTPUT AS #f
CLOSE
 
OPEN cFile FOR RANDOM AS #f LEN = LEN(rSub)
 
CLS
RANDOMIZE TIMER
t = INT(RND * 300) + 1
REDIM iArray%(1 TO t)
PRINT "Select items in an array into a new array in a generic way."
PRINT "Base array:"
Line 3,143 ⟶ 3,142:
iArray%(i) = INT(RND * 2000) + 1
PRINT iArray%(i);
IF (iArray%(i) MOD 2) = 0 AND iGetWhat = Even THEN
iFlag = True
ELSEIF (iArray%(i) MOD 2) <> 0 AND iGetWhat = Uneven THEN
iFlag = True
END IF
 
IF iFlag THEN
rSub.aNum = iArray%(i)
PUT #f, , rSub
iFlag = False
END IF
NEXT i
PRINT
 
' GetsRedims the new array of evens
t = LOF(f) / LEN(rSub)
getNewArray Even
REDIM iArray%(1 TO t)
 
FOR i = 1 TO t
GET #f, i, rSub
iArray%(i) = rSub.aNum
NEXT i
 
CLOSE #f
KILL cFile
 
PRINT
 
' Shows the result
58

edits