ریزش برف

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

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