## 帐号 自动登录 找回密码 密码 注册

# SmallBasic图形编程大杂烩 发表于 2010-6-16 10:36:58 | 显示全部楼层 |阅读模式
 本帖最后由 akyao 于 2010-6-16 10:40 编辑 SmallBasic图形编程大杂烩 一起来研究研究 源代码：'*************************************************************************************** 'XZG681 'Sample program to demonstate virtually all of the SmallBasic GraphicsWindow commands 'Includes use of Shapes, Images, Arrays, Mouse and Keyboard control 'Does all of the main features required to write games using basic examples 'You will need to look at the code to see what is supposed to happen and how it is done 'Play with it, change it, break it then fix it '*************************************************************************************** ' 'Create a graphics window ' 'Keep it hidden till we want to show it GraphicsWindow.Hide() 'Give it a title GraphicsWindow.Title = "Graphics Window Example" 'Set its size and position (use variables gw and gh because they may be useful later) gw = 800 gh = 600 GraphicsWindow.Width = gw GraphicsWindow.Height = gh 'The top and left = 4 position the window neatly in the top left of the screen GraphicsWindow.Top = 4 GraphicsWindow.Left = 4 'Set a background colour GraphicsWindow.BackgroundColor = "LightBlue" 'Set it so it cannot be resized GraphicsWindow.CanResize = "False" 'Show the window GraphicsWindow.Show() ' 'Create a red ball of diameter 50 (radius 25) and place it in the middle of the window (leave it there for 5 seconds) ' radius = 25 GraphicsWindow.BrushColor = "Red" GraphicsWindow.PenColor = "Black" ' We set the position to be the (screen centre - radius), since the screen position is defined as the top left of the ball ball = Shapes.AddEllipse(2*radius,2*radius) Shapes.Move(ball,gw/2-radius,gh/2-radius) Program.Delay(5000) ' 5000 milliseconds = 5 seconds ' 'Move the ball randomly by animation 10 times (once per second) ' For i = 1 To 10 x = Math.GetRandomNumber(gw) y = Math.GetRandomNumber(gh) Shapes.Animate(ball,x-radius,y-radius,1000) Program.Delay(1000) ' We have to delay (pause) to wait for the animation to finish EndFor ' 'Move the ball to follow the mouse for 10 seconds ' start = Clock.Second time = 0 While (time < 10) xm = GraphicsWindow.MouseX ym = GraphicsWindow.MouseY Shapes.Move(ball,xm-radius,ym-radius) time = Clock.Second - start 'If we go over the minute then seconds go back to 0 so add 60 seconds If (time < 0) Then time = time+60 EndIf 'Display the mouse coordinates - first overwrite the last output GraphicsWindow.PenColor = GraphicsWindow.BackgroundColor GraphicsWindow.BrushColor = GraphicsWindow.BackgroundColor GraphicsWindow.FillRectangle(gw-120,10,120,30) GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontSize = 20 GraphicsWindow.DrawText(gw-120,10,"("+xm+","+ym+")") EndWhile ' 'Use 10 balls and move the one selected by the mouse left down (delete with right down) 'Run until all balls are deleted 'The moved balls change colour ' GraphicsWindow.Clear() 'Create an array of 10 balls and their random positions nball = 10 For i = 1 To nball GraphicsWindow.BrushColor = "LightGreen" GraphicsWindow.PenColor = "Black" xi = radius + Math.GetRandomNumber(gw-2*radius) yi = radius + Math.GetRandomNumber(gh-2*radius) ball = Shapes.AddEllipse(2*radius,2*radius) Shapes.Move(ball,xi-radius,yi-radius) ballsi = ball EndFor start = Clock.Second iball = 0 While (nball > 0) If (Mouse.IsLeftButtonDown = "True") Then xm = GraphicsWindow.MouseX ym = GraphicsWindow.MouseY 'If no ball selected, then check if we are over one If (iball = 0) Then For i = 1 To nball dist = Math.SquareRoot((xm-xi)*(xm-xi)+(ym-yi)*(ym-yi)) If (dist <= radius) Then iball = i 'To change the colour we delete it and replace it with a new ball GraphicsWindow.BrushColor = "Pink" Shapes.Remove(ballsiball) ballsiball = Shapes.AddEllipse(2*radius,2*radius) 'We are finished and don't want to continue checking since we have already deleted a ball so end this loop Goto completed1 EndIf EndFor EndIf completed1: 'Move selected ball If (iball > 0) Then ball = ballsiball xiball = xm yiball = ym Shapes.Move(ball,xiball-radius,yiball-radius) EndIf Else 'drop current ball iball = 0 EndIf 'Delete a ball with right click If (Mouse.IsRightButtonDown = "True") Then xm = GraphicsWindow.MouseX ym = GraphicsWindow.MouseY For i = 1 To nball dist = Math.SquareRoot((xm-xi)*(xm-xi)+(ym-yi)*(ym-yi)) If (dist <= radius) Then 'Remove the displayed object Shapes.Remove(ballsi) 'Now remove the array element i - we do this by overwriting it with the balls further up the array For j = i To nball-1 ballsj = ballsj+1 xj = xj+1 yj = yj+1 EndFor 'Delete the last ball (now moved up the array 1 place) ballsnball = "" xnball = "" ynball = "" 'Reduce the count of balls nball = nball-1 'We are finished and don't want to continue checking since we have already deleted a ball so end this loop Goto completed2 EndIf EndFor EndIf completed2: EndWhile ' 'Replace the ball with an image and move with arrow keys for 20 seconds ' 'Delete the last ball and set a new one as a downloaded image - get its radius GraphicsWindow.Clear() image = ImageList.LoadImage("http://www.smallbasic.cn/template/sns/image/logo.jpg") ball = Shapes.AddImage(image) radius = ImageList.GetWidthOfImage(image)/2 'Set variables to say if keys are pressed or not keyLeft = 0 keyRight = 0 keyUp = 0 keyDown = 0 'Start an event for keydown and keyup GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp 'Use the event to set the keypress flags - these are only called when a key is pressed or released Sub OnKeyDown key = GraphicsWindow.LastKey If (key = "Left") Then keyLeft = 1 ElseIf (key = "Right") Then keyRight = 1 ElseIf (key = "Up") Then keyUp = 1 ElseIf (key = "Down") Then keyDown = 1 EndIF EndSub Sub OnKeyUp key = GraphicsWindow.LastKey If (key = "Left") Then keyLeft = 0 ElseIf (key = "Right") Then keyRight = 0 ElseIf (key = "Up") Then keyUp = 0 ElseIf (key = "Down") Then keyDown = 0 EndIF EndSub 'Start in window centre x = gw/2 y = gh/2 start = Clock.Second time = 0 While (time < 20) 'Update position if a key is currently down If (keyLeft = 1) Then x = x-1 EndIf If (keyRight = 1) Then x = x+1 EndIf If (keyUp = 1) Then y = y-1 ' The pixes for the window increase downwards from the top EndIf If (keyDown = 1) Then y = y+1 EndIf 'Check for ball leaving screen - reneter other side If (x < 0) Then x = gw EndIf If (x > gw) Then x = 0 EndIf If (y < 0) Then y = gh EndIf If (y > gh) Then y = 0 EndIf 'Move the ball to the new position Shapes.Move(ball,x-radius,y-radius) 'Put a small delay in - the computer is too quick - this controls the update rate (frames per second) 'This is not the true fps since it doesn't account for the time drawing etc fps = 500 Program.Delay(1000/fps) time = Clock.Second - start 'If we go over the minute then add 60 seconds If (time < 0) Then time = time+60 EndIf EndWhile ' 'Now use the arrow keys to accelerate the ball and run until 50 wall hits (almost the same code) 'We can use the keyboard events unchanged 'Reverse spin the ball when we hit a boundary ' 'Start in window centre x = gw/2 y = gh/2 'Zero initial velocity u = 0 v = 0 start = Clock.Second spin = 0.0 'Ball spin rate (Positive is anticlockwise) angle = 0 hits = 0 While (hits < 50) 'Update position if a key is currently down If (keyLeft = 1) Then u = u-1 EndIf If (keyRight = 1) Then u = u+1 EndIf If (keyUp = 1) Then v = v-1 ' The pixes for the window increase downwards from the top EndIf If (keyDown = 1) Then v = v+1 EndIf 'Update position - divide by 500 to stop the acceleration being too extreme 'we can do gravity, friction etc here if we want x = x+u/500 y = y+v/500 'Check for ball leaving screen - bounce the ball this time - and spin it If (x < radius) Then u = -u spin = spin+v hits = hits+1 EndIf If (x > gw-radius) Then u = -u spin = spin-v hits = hits+1 EndIf If (y < radius) Then v = -v spin = spin-u hits = hits+1 EndIf If (y > gh-radius) Then v = -v spin = spin+u hits = hits+1 EndIf 'Move the ball to the new position Shapes.Move(ball,x-radius,y-radius) 'Rotate the ball with the current spin direction Shapes.Rotate(ball,angle) angle = angle+0.0005*spin 'Put a small delay in - the computer is too quick - this controls the update rate (frames per second) 'This is not the true fps since it doesn't account for the time drawing etc fps = 500 Program.Delay(1000/fps) EndWhile ' 'Create an array of 10 randomly sized and coloured rotating boxes, then delete them when clicked with the mouse ' GraphicsWindow.Clear() 'Create arrays of boxes and their positions and sizes For i = 1 To 10 xi = 20+Math.GetRandomNumber(gw-60) ' not too close the the screen edge yi = 20+Math.GetRandomNumber(gh-60) wi = 10+Math.GetRandomNumber(30) hi = 10+Math.GetRandomNumber(30) GraphicsWindow.BrushColor = GraphicsWindow.GetRandomColor() GraphicsWindow.PenColor = "Black" box = Shapes.AddRectangle(wi,hi) 'Note xi,yi are top left of box, not its centre Shapes.Move(box,xi,yi) boxesi = box displayi = 1 ' flag that box is displayed EndFor 'Start a mouse click event GraphicsWindow.MouseDown = OnMouseDown 'Write the mouse click event to get coordinates of mouse click and set a flag that the mouse was clicked clicked = 0 Sub OnMouseDown xm = GraphicsWindow.MouseX ym = GraphicsWindow.MouseY clicked = 1 EndSub 'Continue while boxes remain nboxes = Array.GetItemCount(boxes) angle = 0 While (nboxes > 0) 'Mouse was clicked If (clicked = 1) Then 'Check each box For i = 1 To Array.GetItemCount(boxes) 'Only look for remaining displayed boxes If (displayi = 1) Then box = boxesi 'Since the boxes are rotating use the maximum size to check for click region 'This is not exactly correct for rotating boxes but often in games efficient is more important than absolute correctness dmax = Math.Max(wi,hi) If (xm >= xi And xm <= xi+dmax And ym >= yi And ym <= yi+dmax) Then 'Delete this box from display and reduce the box count by 1 'Note the original arrays are not deleted since we are keeping track of box status using displayi Shapes.Remove(box) nboxes = nboxes-1 displayi = 0 Sound.PlayClick() EndIf EndIf EndFor 'Reset clicked flag to off since we have done everything with it clicked = 0 EndIf 'Rotate the boxes (even i anticlockwise, odd i clockwise - negative angle) For i = 1 To Array.GetItemCount(boxes) If (displayi = 1) Then box = boxesi Shapes.Rotate(box,angle*(1-2*Math.Remainder(i,2))) EndIf EndFor angle = angle+1 Program.Delay(10) ' Small delay to keep the rotation smooth EndWhile ' 'Finish up ' image = ImageList.LoadImage("http://www.smallbasic.cn/template/sns/image/logo.jpg") GraphicsWindow.Clear() GraphicsWindow.FontSize = 100 GraphicsWindow.FontBold = "True" GraphicsWindow.FontName = "Rockwell" GraphicsWindow.DrawResizedImage(image,0,0,gw,gh) R = 255 G = 0 B = 0 dR = -1 dG = 2 dB = 3 clicked = 0 While (clicked = 0) 'Change the red, green, blue components of the colour at different rates to get changing colours If (R < 0 Or R > 255) Then dR = -dR R = R+dR EndIf If (G < 0 Or G > 255) Then dG = -dG G = G+dG EndIf If (B < 0 Or B > 255) Then dB = -dB B = B+dB EndIf colour = GraphicsWindow.GetColorFromRGB(R,G,B) GraphicsWindow.BrushColor = colour GraphicsWindow.DrawText(200,160,"All Done") GraphicsWindow.DrawText(100,340,"Click to Exit") GraphicsWindow.PenWidth = 10 GraphicsWindow.PenColor = colour GraphicsWindow.DrawLine(50,gh-50,gw-50,gh-50) GraphicsWindow.DrawLine(gw-50,gh-50,gw-50,50) GraphicsWindow.DrawLine(gw-50,50,50,50) GraphicsWindow.DrawLine(50,50,50,gh-50) R = R+dR G = G+dG B = B+dB Program.Delay(20) EndWhile Program.End() 复制代码 发表于 2018-11-20 10:06:25 | 显示全部楼层
 代码有错误啊，运行不了

 本版积分规则 回帖后跳转到最后一页

GMT+8, 2019-12-14 23:23 , Processed in 0.207591 second(s), 8 queries , File On.