yeketaz
کاربر با تجربه
ارسال‌ها: 744
موضوع‌ها: 123
تاریخ عضویت: اسفند ۱۳۸۶
تشکرها : 520
( 1050 تشکر در 294 ارسال )
|
RE: سورس های آموزشی
پاوربیسیک کنسول نسخه 5
یک عدد را وارد می کنید بعد با استفاده از یک پنجره گرافیکی عدد را پردازش و عددی را بر می گرداند (50 برابر)
کد php: #COMPILER PBCC 5
#COMPILE EXE
#DIM ALL
%USEMACROS = 1
#INCLUDE "Win32API.inc"
FUNCTION DoProcess (BYVAL n AS LONG) AS LONG
'------------------------------------------------------------------
' Show a Graphic window and paint progressbars as given
' parameter n is processed. The Graphic window is closed
' when all work is done.
'------------------------------------------------------------------
' Note: SLEEP 50 is there just to slow things down for
' demonstration purpose. It should be changed to
' SLEEP 0 or 1 in a real process.
'------------------------------------------------------------------
LOCAL hGW, x, y AS LONG
STDOUT " Processing: " + STR$(n) ' Print to the console window
STDOUT
GRAPHIC WINDOW "Processing " + STR$(n), _ ' Create a Graphic window
350, 300, 306, 80 TO hGW
SetWindowPos hGW, %HWND_TOPMOST, 0,0,0,0, _
%SWP_NOMOVE OR %SWP_NOSIZE
GRAPHIC ATTACH hGW, 0& ' Without REDRAW for instant view
GRAPHIC COLOR RGB(0,0,0), RGB(255,255,223) ' Set up colors
GRAPHIC CLEAR ' Paint the background
GRAPHIC WIDTH 3 ' Make the bars 3 pixels wide
FOR x = 1 TO 50 ' Draw 50 bars
GRAPHIC LINE (20 + x * 5, 20) - _
(20 + x * 5, 30), RGB(0,0,255) ' Draw the bars
y = y + n ' Do some dummy processing
SLEEP 50 ' Fake some processing time
NEXT
GRAPHIC WINDOW END ' Close the Graphic window
FUNCTION = y ' Return the result
END FUNCTION
FUNCTION PBMAIN () AS LONG
'------------------------------------------------------------------
' Program entrance.
'------------------------------------------------------------------
LOCAL lRes AS LONG, n AS SINGLE
DO
COLOR 14, 9
PRINT CHR$(32, 201) + STRING$(35, 205) + CHR$(187, 32)
PRINT CHR$(32, 186) + " ProgressBar sample " + CHR$(186, 32)
PRINT CHR$(32, 200) + STRING$(35, 205) + CHR$(188, 32)
COLOR 15, 0
STDOUT
INPUT " Input any number and press Enter: ", n
PRINT
PRINT
lRes = DoProcess(n)
BEEP
PRINT " Result: " + STR$(lRes)
PRINT
PRINT " Press Y to repeat."
PRINT " Press any other key to exit: ";
IF UCASE$(WAITKEY$) = "Y" THEN
CLS
ELSE
EXIT DO
END IF
LOOP
END FUNCTION
پاوربسیک کسنول نسخه 5
با استفاده از توابع گرافیکی تصاویر متقارن و زیبایی رسم می کند
کد php: #COMPILER PBCC 5
#CONSOLE OFF
'====================================================================
FUNCTION PBMAIN AS LONG
'--------------------------------------------------------------------
' Program entrance
'------------------------------------------------------------------
LOCAL a,b, DelH, DelV, s, s1 AS DOUBLE
LOCAL i, j, n1, n2, n3, k, kmax,sel AS LONG
LOCAL x,x1,y,y1 AS DOUBLE
LOCAL demo AS LONG
LOCAL usecolor AS LONG
LOCAL kbd AS STRING
GRAPHIC WINDOW "Fractals demo", 150, 50, 500, 500 TO hGW1&
GRAPHIC ATTACH hgw1&, 0&, REDRAW ' Buffered draw is fastest
GRAPHIC COLOR %YELLOW, RGB(0,0,64)
GRAPHIC CLEAR
GRAPHIC REDRAW
GRAPHIC SET FOCUS
GRAPHIC SCALE (-320,-240)-(319,239) 'work with symmetric screen
'from minus to plus, zero in the middle
FOR SEL = 1 TO 9
SELECT CASE SEL
CASE 1 : A=-1.275 : B=0 : DELH=1.8 : DELV=.8 : N1=300 : KMAX=100
CASE 2 : A=-1 : B=0 : DELH=1.7 : DELV=1 : N1=300 : KMAX=100
CASE 3 : A=-.75 : B=0 : DELH=1.6 : DELV=1.1 : N1=300 : KMAX=100
CASE 4 : A=.25 : B=0 : DELH=1 : DELV=1.3 : N1=180 : KMAX=200
CASE 5 : A=-.3905 : B=.5868 : DELH=1.45 : DELV=1.2 : N1=275 : KMAX=150
CASE 6 : A=-.1226 : B=.7449 : DELH=1.4 : DELV=1.2 : N1=275 : KMAX=200
CASE 7 : A=-.11 : B=.67 : DELH=1.4 : DELV=1.3 : N1=240 : KMAX=100
CASE 8 : A=.32 : B=.043 : DELH=.9 : DELV=1.2 : N1=175 : KMAX=400
CASE ELSE : GOTO last
END SELECT
GRAPHIC CLEAR
N2=INT(N1*DELV/DELH)
IF B=0 THEN N3=0 ELSE N3=-N2
'first draw a box with the boundaries
GRAPHIC LINE (-N1,N2) - (N1,N2) 'bottom
GRAPHIC LINE (-N1,-N2) - (N1,-N2) 'top
GRAPHIC LINE (N1,N2) - (N1,-N2) 'right
GRAPHIC LINE (-N1,N2) - (-N1,-N2) 'left
FOR I=0 TO N1
FOR J=N3 TO N2
X=I*DELH/N1 : Y=J*DELV/N2
FOR K=1 TO KMAX
X1=X*X-Y*Y+A : Y1=2*X*Y+B
S=X*X+Y*Y : S1=(X-X1)*(X-X1)+(Y-Y1)*(Y-Y1)
IF S>1000 THEN GOTO repeat
IF S1<.0001 THEN GOTO putpixel
X=X1 : Y=Y1
NEXT K
putpixel:
usecolor = (j-n3)/(n2-n3)* 2^24
GRAPHIC SET PIXEL (I,J), usecolor
GRAPHIC SET PIXEL (-I,-J), usecolor
IF B=0 THEN
GRAPHIC SET PIXEL (I,-J), usecolor
GRAPHIC SET PIXEL (-I,J), usecolor
END IF
repeat:
NEXT J
'to see drawing, enable next GRAPHIC REDRAW, disable 2nd one
' GRAPHIC REDRAW
NEXT I
GRAPHIC REDRAW
SLEEP 2000 'adjust the "appreciation" time here
' If the 'ESC' key has been pressed exit the application
GRAPHIC INKEY$ TO kbd$
IF ASC(kbd$) = 27 THEN EXIT FOR
NEXT SEL
last:
GRAPHIC WINDOW END
END FUNCTION
اینم دو تا سورس کنسولیه دیگه :
1-خروج سی دی رام :
کد php: #COMPILER PBCC 5
#COMPILE EXE
'-----------------------------------------------------------------------------
' API Declaration (ex: WIN32API.INC)
'
DECLARE FUNCTION mciSendString LIB "WINMM.DLL" ALIAS "mciSendStringA" _
(lpstrCommand AS ASCIIZ, lpstrReturnString AS ASCIIZ, _
BYVAL uReturnLength AS LONG, BYVAL hwndCallback AS LONG) AS LONG
'-----------------------------------------------------------------------------
' Main application entry point...
'
FUNCTION PBMAIN () AS LONG
mciSendString "set cdaudio door open", "", 0, 0
END FUNCTION
2-بسته شدن سی دی رام :
کد php: #COMPILER PBCC 5
#COMPILE EXE
'-----------------------------------------------------------------------------
' API Declaration (ex: WIN32API.INC)
'
DECLARE FUNCTION mciSendString LIB "WINMM.DLL" ALIAS "mciSendStringA" _
(lpstrCommand AS ASCIIZ, lpstrReturnString AS ASCIIZ, _
BYVAL uReturnLength AS LONG, BYVAL hwndCallback AS LONG) AS LONG
'-----------------------------------------------------------------------------
' Main application entry point...
'
FUNCTION PBMAIN () AS LONG
mciSendString "set cdaudio door closed", "", 0, 0
END FUNCTION
ما که دیگه توی ایران ویج پیر شدیم  کم کم باید جامون رو بدیم به جوونا 
(آخرین ویرایش در این ارسال: ۰۷-دى-۱۳۸۷, ۲۰:۱۶:۱۴، توسط yeketaz.)
|
|
صفحه اصلی
انجمن
جستجو
فهرست اعضا
افزونه های فایرفاکس
» 
تشکر شده توسط :