چراغ راهنمایی

چراغ راهنمایی
CLS
SCREEN 12
'------------------------------------
LINE (320, 240)-(380, 40), 15, B
LINE (335, 240)-(365, 440), 15, B
CIRCLE (350, 70), 25, 8
CIRCLE (350, 140), 25, 8
CIRCLE (350, 210), 25, 8
'-------------------------
PAINT (350, 70), 15, 8
PAINT (350, 140), 15, 8
PAINT (350, 210), 15, 8
'------------------------------------
DO
  PAINT (350, 210), 15, 8
  PAINT (350, 70), 4, 8
  SLEEP 4
  PAINT (350, 70), 15, 8
  PAINT (350, 140), 14, 8
  SLEEP 1
  PAINT (350, 140), 15, 8
  PAINT (350, 210), 2, 8
  SLEEP 6
LOOP UNTIL INKEY$ = CHR$(27)
END

رنگین کمان

این برنامه باعث تولید رنگین کمان می شود
SCREEN 13
DO
  FOR A = 0 TO 200
     LINE (0, A)-(320, A), A + Col
     IF INKEY$ <> "" THEN END
     LOCATE 12, 8: PRINT "http:\RFazli.blogfa.com"
  NEXT A
  Col = Col + 1
LOOP

جستجو باینری ۱

جستجو باینری
CLS
INPUT "How many number : ", n
DIM a(n)
PRINT
PRINT "enter"; n; "number : ": PRINT
FOR i = 1 TO n
   INPUT a(i)
NEXT
FOR i = 1 TO n - 1
   FOR j = 1 TO n - i
      IF a(j) > a(j + 1) THEN SWAP a(j), a(j + 1)
NEXT j, i
FOR i = 1 TO n
   PRINT a(i);
NEXT i
PRINT : PRINT
INPUT "Enter search number : ", x
l = 1: h = n
WHILE h >= l
   mi = INT((h + l) / 2)
   IF a(mi) = x THEN PRINT "found your number in araye"; mi: END
   IF a(mi) < x THEN
      l = mi + 1
   ELSE
        h = mi - 1
   END IF
  
WEND
PRINT "no found !!!"

ریزش برف

این برنامه باعث ریزش برف می شود

RANDOMIZE TIMER
SCREEN 13
MinX = 0
MinY = 0
MaxX = 319 - MinX
MaxY = 199 - MinY
MaxSnow = 1000
Text$ = "http:\RFazli.blogfa.com"
TYPE Snows
X AS INTEGER
Y AS INTEGER
Col AS INTEGER
END TYPE

DIM Snow(MaxSnow) AS Snows

  ';;;;;;;;;;;;;;;;
  ';; Make Snows ;;
  ';;;;;;;;;;;;;;;;
   FOR MSnow = 1 TO MaxSnow
     Snow(MSnow).X = MinX + INT(RND * (MaxX)) + 1
     Snow(MSnow).Y = MinY + INT(RND * (MaxY)) + 1
     Snow(MSnow).Col = 15'30 + INT(RND * 1) + 1
   NEXT MSnow
 
   COLOR INT(RND * 14) + 1
   LOCATE INT(RND * 19) + 4, INT(RND * (34 - LEN(Text$)))
   PRINT Text$
   COLOR INT(RND * 14) + 1
   LOCATE INT(RND * 19) + 4, INT(RND * (34 - LEN(Text$)))
   PRINT Text$
 
  ';;;;;;;;;;;;;;;;;;
  ';; Main Program ;;
  ';;;;;;;;;;;;;;;;;;
DO
   FOR CheckLocateSnow = 1 TO MaxSnow
  
    OldX = Snow(CheckLocateSnow).X
    OldY = Snow(CheckLocateSnow).Y

    IF Snow(CheckLocateSnow).Y + 1 > MaxY THEN
       Snow(CheckLocateSnow).Y = MinY
    END IF

    IF POINT(Snow(CheckLocateSnow).X, Snow(CheckLocateSnow).Y + 1) = 0 THEN
         Snow(CheckLocateSnow).Y = Snow(CheckLocateSnow).Y + 1
         GOTO NextSnow
    END IF
    IF POINT(Snow(CheckLocateSnow).X + 1, Snow(CheckLocateSnow).Y) = 0 THEN
       IF POINT(Snow(CheckLocateSnow).X + 1, Snow(CheckLocateSnow).Y + 1) = 0 THEN
         Snow(CheckLocateSnow).Y = Snow(CheckLocateSnow).Y + 1
         Snow(CheckLocateSnow).X = Snow(CheckLocateSnow).X + 1
         GOTO NextSnow
        END IF
    END IF
    IF POINT(Snow(CheckLocateSnow).X - 1, Snow(CheckLocateSnow).Y) = 0 THEN
      IF POINT(Snow(CheckLocateSnow).X - 1, Snow(CheckLocateSnow).Y + 1) = 0 THEN
         Snow(CheckLocateSnow).Y = Snow(CheckLocateSnow).Y + 1
         Snow(CheckLocateSnow).X = Snow(CheckLocateSnow).X - 1
         GOTO NextSnow
       END IF
    END IF

NextSnow:       

  ';;;;;;;;;;;;;;;;;
  '; Erase Old Snow
  ';;;;;;;;;;;;;;;;;
       IF ((OldX = Snow(CheckLocateSnow).X) AND (OldY = Snow(CheckLocateSnow).Y)) OR Snow(CheckLocateSnow).Y + 1 > MaxY THEN
         Snow(CheckLocateSnow).Y = MinY
       ELSE
         PSET (OldX, OldY), 0
       END IF
      
 

  ';;;;;;;;;;;;;;;;;;;
  ';; Draw New Snow ;;
  ';;;;;;;;;;;;;;;;;;;
       PSET (Snow(CheckLocateSnow).X, Snow(CheckLocateSnow).Y), Snow(CheckLocateSnow).Col
  ';;;;;;;;;;;;;;;;;;;;
  'Key Exit !!!!!!!!!!!
  ';;;;;;;;;;;;;;;;;;;;
       IF INKEY$ <> "" THEN END
    NEXT CheckLocateSnow
LOOP

عمل شیفت

بر روی کارکتر ورودی عمل شیفت را انجام می دهد
CLS
DIM a AS STRING
DIM b(100) AS INTEGER
INPUT "enter a string ..."; a$
INPUT "how many shift..."; x
k = LEN(a$)
FOR i = 1 TO k
        temp = ASC(MID$(a$, i, 1))
        FOR j = 0 TO 7 STEP 1
        b(8 * i - j) = temp MOD 2
        temp = temp 2
        NEXT j
NEXT i
FOR d = 8 * k TO 1 STEP -1
b(d + x) = b(d)
NEXT d
FOR q = 1 TO x
b(q) = 0
NEXT q
FOR i = 1 TO k
ar = 1
        FOR j = 8 * i TO 8 * (i - 1) + 1 STEP -1
        tempk = tempk + ar * b(j)
        ar = ar * 2
        NEXT j
        PRINT CHR$(tempk),
        tempk = 0
NEXT i

لوزی خیام پاسکال

لوزی خیام پاسکال

DECLARE FUNCTION fact! (a!)
CLS
INPUT p
p = p - 1
x = p + 1
FOR i = 0 TO 2 * p
   FOR j = 0 TO ABS(p - i)
      PRINT "  ";
   NEXT j
   x = x - 1
   s = ABS(p - ABS(x))
   FOR k = 0 TO s
      PRINT USING "##"; fact(s) / (fact(k) * fact(s - k));
      PRINT "  ";
   NEXT k
PRINT
PRINT
NEXT i
END

FUNCTION fact (a)
l = 1
FOR j = 1 TO a
   l = l * j
NEXT j
fact = l

END FUNCTION

مثلث خیام پاسکال

با دادن ردیف مثلث خیام پاسکال خروجی این برنامه چاپ این اعداد به صورت مثلث تا ردیف مورد نظر است

DECLARE FUNCTION fact! (a!)
CLS
INPUT p
p = p - 1
FOR i = 0 TO p
   FOR j = 0 TO p - i
      PRINT "  ";
   NEXT j
   FOR k = 0 TO i
      PRINT USING "##"; fact(i) / (fact(k) * fact(i - k));
      PRINT "  ";
   NEXT k
PRINT
PRINT
NEXT i
END

FUNCTION fact (a)
l = 1
FOR j = 1 TO a
   l = l * j
NEXT j
fact = l

END FUNCTION