جومانگ Close
تبلیغات در بلاگ اسکای

این برنامه باعث تولید رنگین کمان می شود
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

 





-->
<< 1 2 3 4