Code archives/Graphics/SetGfx( )
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| Here some routines to select the graphic 3d resolution Check the buttons routines 3 only commands 1) AddButton to create a button 2) Update Button to show them 3) getSimpleButton to retrieve the pressed one BTW the 2 and 3 can be one only code to optimize... If you need just tell me... Ciao Gianluca (BitmaniaK) | |||||
Global info1$="GUI Demo for Blitz Community"
SetGfx()
;***********************************************************
Function SetGfx()
If info1$<>""
AppTitle info1$,"Exit "+info1$+" ?"
EndIf
FlushKeys()
mode_cnt=CountGfxModes3D()
If Not mode_cnt RuntimeError "Can't find any 3D graphics modes"
mode=0
If Not Windowed3D()
mode=1
Else
For t=1 To mode_cnt
If GfxModeWidth(t)=1024 And GfxModeHeight(t)=768 And GfxModeDepth(t)=32 Then mode=t
Next
End If
Graphics 320,240,16,2
SetBuffer BackBuffer()
font = LoadFont("",17)
SetFont font
;PakInit("Resources.Pak", "IWRULEZ", gTempDir$, $MYCODE)
;image=LoadImage( pak("back.jpg") )
;ResizeImage image,GraphicsWidth(), GraphicsHeight()
;DLPak()
tx=320+160
nx=-160
ty=-32
url$=" www.intensiveworks.tk "
url_x=6;300-StringWidth( url$ )
url_y=210
;******** MY BUTTONS ARE THERE *******
button("<<",60,ty+FontHeight()*5,30,24)
button(">>",230,ty+FontHeight()*5,30,24)
button("OK",272,202,40,32)
button(url$,url_x,url_y,StringWidth( url$ ),24)
;******** MY BUTTONS ARE THERE *******
Repeat
ClsColor 0,0,64
Cls
;******** UPDATE BUTTONS THERE *******
;DrawBlock image,0,0
updateSimpleButtons()
;******** GET THE BUTTON RETURNED STRING (the same of the text) *******
b$=getSimpleButton(MouseX(), MouseY())
Color 0,255,0
; Text tx,ty+FontHeight()*0,info1$,True
; Text nx,ty+FontHeight()*1,info2$,True
; Text tx,ty+FontHeight()*2,info3$,True
; Text nx,ty+FontHeight()*3,info4$,True
Text 0,0,"Select screen resolution..."
Color 255,255,255
If mode=0
Text tx,ty+FontHeight()*5,"Windowed",True
Else
Text tx,ty+FontHeight()*5,GfxModeWidth( mode )+","+GfxModeHeight( mode )+","+GfxModeDepth( mode ),True
EndIf
Color 255,255,0
Text nx,ty+FontHeight()*7,"[Return] to begin",True
Text tx,ty+FontHeight()*8,"[Arrows] change mode",True
Text nx,ty+FontHeight()*9,"[Escape] to exit",True
; Color 0,255,255
; Text url_x,url_y,url$
If KeyHit( 1 ) End
;***********************************************************
;******** IF BUTTON RETURNS "OK" *******
If KeyHit( 28 ) Or b$="OK" ;******** EXIT *********
Cls:Flip
Cls:Flip
FreeFont font
:FreeImage image
EndGraphics
If mode
Graphics3D GfxModeWidth(mode),GfxModeHeight(mode),GfxModeDepth(mode),1
Else
Graphics3D 640,480,0,2
EndIf
SetBuffer BackBuffer()
Return
EndIf
;***********************************************************
If MouseDown(2) Then
mode=0
If (Not Windowed3D())
mode=mode_cnt
EndIf
FlushMouse()
Goto NEXT_CTRL
End If
;******** IF BUTTON RETURNS "<<" *******
If KeyHit( 203 ) Or b$="<<"
mode=mode-1
If mode<0 Or (mode=0 And (Not Windowed3D()))
mode=mode_cnt
EndIf
;******** IF BUTTON RETURNS ">>" *******
Else If KeyHit( 205 ) Or b$=">>"
mode=mode+1
If mode>mode_cnt
mode=0
If Not Windowed3D() mode=1
EndIf
EndIf
;******** IF BUTTON RETURNS the url string *******
If b$=url$ Then
ExecFile("http:\\www.intensiveworks.tk")
End
End If
.NEXT_CTRL
If tx>160 tx=tx-32
If nx<160 nx=nx+32
Flip
Forever
End Function
;***********************************************************
Type SimpleButton
Field x1,y1,x2,y2
Field txt$
Field pressed
End Type
;***********************************************************
;*** Add a button and then when is pressed the title is
;*** returned
;***********************************************************
Function button.SimpleButton(a$,x,y,w,h,HILITE=False)
b.SimpleButton= New SimpleButton
b\x1=x
b\y1=y
b\x2=w
b\y2=h
b\txt$=a$
Return b
End Function
;***********************************************************
;*** Update loop for hilites needed to show the buttons
;***********************************************************
Function updateSimpleButtons()
For b.SimpleButton= each SimpleButton
If b\pressed Then Color 160,160,192 Else Color 128,128,160
x=b\x1
y=b\y1
w=b\x2
h=b\y2
a$=b\txt$
Rect x,y,w,h,True
If b\pressed=False Then Color 192,192,240 Else Color 240,240,255
Line x,y,x+w-1,y
Line x,y,x,y+h-1
If b\pressed=False Then Color 80,80,128 Else Color 92,92,148
Line x+1,y+h,x+w,y+h
Line x+w,y+1,x+w,y+h
Color 0,0,0
Text x+(w/2)+1,y+(h/2)+1,a$,True,True
If b\pressed Then Color 255,255,0 Else Color 255,255,255
Text x+(w/2),y+(h/2),a$,True,True
yy=y+(h/2) + StringHeight(a$)/2
If b\pressed Then Line x+5,yy,x+w-5,yy
b\x1=x
b\y1=y
b\x2=w
b\y2=h
b\txt$=a$
Next
End Function
;***********************************************************
;*** retrieve the button title pressed
;***********************************************************
Function getSimpleButton$(winmx,winmy)
res$=""
For b.SimpleButton=Each SimpleButton
b\pressed=0
If RectsOverlap(winmx,winmy,1,1,b\x1,b\y1,b\x2,b\y2) Then
b\pressed=True
If MouseHit(1) Then
b\pressed=0
res$=b\txt$
End If
End If
Next
FlushMouse
Return res$
End Function
;*********************************************************** |
Comments
None.
Code Archives Forum