Win32 Native GUI but...

BlitzMax Forums/BlitzMax Programming/Win32 Native GUI but...

The forum is locked. These are the original blitzbasic.com forums, kept so they can still be read. No new topics, replies or edits can be made here. To join in, head over to the Blitz3D+ forums.

Kev
 #1
Antony, yes. 2d and 3d.

a little example of DreiDe - 3D Engine and gui, the codes a needs cleaning though.

DreiDe - 3D Engine
http://www.blitzbasic.com/Community/posts.php?topic=49211

Strict
Import "-luser32"
'Import "-lkernel32"
Extern "win32"
	Function GetSysColorBrush:Int(nIndex:Int) = "GetSysColorBrush@4"
	Function SendMessage:Int(hWnd:Int,MSG:Int,wParam:Int,lParam:Int) = "SendMessageA@16"
	Function CreateFontA:Int(nHeight,nWidth,nEscapement,nOrientation ,fnWeight, fdwItalic,dwUnderline , fdwStrikeOut,fdwCharSet, fdwOutputPrecision , fdwClipPrecision,fdwQuality, fdwPitchAndFamily, lpszFace:Byte Ptr) = "CreateFontA@56"
	Function GetLastError:Int() = "GetLastError@0"
	Function GetWindowDC:Int(hWnd) = "GetWindowDC@4"
	Function SelectObject:Int(hWnd,obj) = "SelectObject@8"
	Function FindWindow(lpClassName:Byte Ptr, lpWindowName:Byte Ptr) = "FindWindowA@8"
	
	
	Function GetWindowLong :Int(hWnd ,nIndex)= "GetWindowLongA@8"
	Function GetActiveWindow :Int()= "GetActiveWindow@0"
	
	Function SetWindowLong :Int(hWnd ,nIndex,lNewLong )= "SetWindowLongA@12"
	
	Function SetWindowLongPtr :Int(hWnd ,nIndex,lNewLong:Byte Ptr )= "SetWindowLongA@12"
	
	
	Function CallWindowProc:Int(lpPrevWndFunc,hWnd,uMsg,wParam,lParam) = "CallWindowProcA@20"

	Function GetSysColor:Int(index) = "GetSysColor@4"

	
End Extern

Const BN_CLICKED = 0
Const EN_CHANGE    = $300
Const ES_NUMBER      = $2000
Const COLOR_BTNFACE = 15

Const WS_CAPTION = $C00000
Const WS_SYSMENU = $80000
Const WS_VISIBLE = $10000000
Const WS_MINIMIZEBOX = $20000
Const WS_MAXIMIZEBOX = $10000

Const WS_CHILD           = $40000000



'Const WM_DESTROY = 2
'Const WM_GETTEXT = $D
'Const WM_SETFONT = $30
'Const WM_KEYDOWN = $100
'Const WM_COMMAND = $111



Global gApptitle$ = "My window"
AppTitle = gApptitle 
'Graphics 600,400,0,0
Global Mesh    : TMesh
Global Surface : TSurface
Global Camera  : TCamera

TDreiDe.Graphics3D(640, 480, 0, 0, False)


AppTitle = gApptitle 

'Global window = FindWindow("BBDX7Device Window Class",gApptitle )
'DebugLog "window "+ window 

Global window =GetActiveWindow ()
DebugLog "window "+ window 


If Not window RuntimeError "Can't get window handle"



Const GWL_STYLE      = -16
Const WS_CLIPCHILDREN    = $2000000
Local   winstyle = GetWindowLong(window , GWL_STYLE)

SetWindowLong(window , GWL_STYLE, WS_CLIPCHILDREN  | winstyle ) 'change the style so that controls are not overdrawn


Global  lpParamADDR:Byte Ptr
'Local window = CreateWindowExA( 0,Byte Ptr classname$,Byte Ptr windowTitle$,WS_CAPTION | WS_MINIMIZEBOX | WS_MAXIMIZEBOX | WS_SYSMENU | WS_VISIBLE,100,100,400,350,0,0,GetModuleHandleA(0),lpParamADDR )


Global  btnOk = CreateWindowExA( 0 ,Byte Ptr "BUTTON",Byte Ptr "Ok",WS_CHILD | WS_VISIBLE,250,250,100,20,window ,0,GetModuleHandleA(0),lpParamADDR)
Global  btnCancel = CreateWindowExA( 0 ,Byte Ptr "BUTTON",Byte Ptr "Cancel",WS_CHILD | WS_VISIBLE,250,250+24,100,20,window ,0,GetModuleHandleA(0),lpParamADDR)
Global  lblHeadline = CreateWindowExA( 0 ,Byte Ptr "STATIC",Byte Ptr "I am the label, I am spanning the top",WS_CHILD | WS_VISIBLE,10,10,300,20,window ,0,GetModuleHandleA(0),lpParamADDR)


Const WS_BORDER = $800000
Const  WS_THICKFRAME     = $40000
Const  WS_DLGFRAME        = $400000

Global  box  = CreateWindowExA( 0 ,Byte Ptr "EDIT",Byte Ptr "Only numbers here!",WS_CHILD | WS_VISIBLE | WS_BORDER | ES_NUMBER,10,10+40,300,20,window ,0,GetModuleHandleA(0),lpParamADDR)
Global  box2  = CreateWindowExA( 0 ,Byte Ptr "EDIT",Byte Ptr "I am box, I am",WS_CHILD | WS_VISIBLE | WS_BORDER ,10,10+40+40,300,20,window ,0,GetModuleHandleA(0),lpParamADDR)


'Global  myfont =  CreateFontA(-16,12,0,0 ,400, 0,0 , 0,0, 4 , 0,0, 0, Byte Ptr "Arial"  + Chr(0) ) 


Global  myfont  = GetStockObject(12) 'ANSI_VAR_FONT

SendMessage lblHeadline ,WM_SETFONT,myfont  ,1
SendMessage btnOk ,WM_SETFONT,myfont  ,1
SendMessage btnCancel ,WM_SETFONT,myfont  ,1
SendMessage box ,WM_SETFONT,myfont  ,1
SendMessage box2 ,WM_SETFONT,myfont  ,1


Global textBank:TBank = CreateBank(300)
Global thetext:String


Const GWL_WNDPROC    = -4

Global  backcolor

backcolor = GetSysColor(COLOR_BTNFACE )

Local r = backcolor & $FF
Local g =  (backcolor & $FF00) Shr 8
Local b = (backcolor & $FF0000) Shr  16 


SetClsColor r,g,b
Cls


Cls

DebugLog backcolor 

Global textbuffer$


Global oldproc= SetWindowLongPtr (window , GWL_WNDPROC,  WinProc)  
'DebugLog "GetLastError() " + GetLastError()


'Strict

Rem
	Use Key-ESC to exit
End Rem

'Framework Pub.DreiDe

'Global Mesh    : TMesh
'Global Surface : TSurface
'Global Camera  : TCamera

'TDreiDe.Graphics3D(640, 480, 0, 0, False)

Mesh = New TMesh
Surface = Mesh.CreateSurface()

Surface.CreateVertex(-0.5, -0.5, 0.0) ' Vertex 0
Surface.CreateVertex( 0.5, -0.5, 0.0) ' Vertex 1
Surface.CreateVertex( 0.0,  0.5, 0.0) ' Vertex 2

Surface.SetVertexColor(0, 1.0, 0.0, 0.0) ' Red
Surface.SetVertexColor(1, 0.0, 1.0, 0.0) ' Green
Surface.SetVertexColor(2, 0.0, 0.0, 1.0) ' Blue

Surface.CreateTriangle(0, 1, 2)

Surface.UpdateVertices()
Surface.UpdateTriangles()

Camera = New TCamera
Camera.SetPosition(0.0, 0.0, 2.0)
Camera.SetClearColor(0.4, 0.6, 0.8)

'While Not KeyDown(KEY_ESCAPE)
'	Camera.Render()
'	Flip()
'	FlushMem()
'Wend
'
'EndGraphics()
'End

Try

Print "oldproc " + oldproc
'bbSystemPoll()

While Not KeyHit(key_escape)
'Repeat

	Camera.Render()
Mesh.Turn(0,0,1)

	SetColor Rnd(255) , Rnd(255) ,Rnd(255)

	DrawLine Rand(1000),Rand(1000),Rand(1000),Rand(1000)

	Flip

	FlushMem()

	'bbSystemPoll()

Wend


DebugLog "here it ends"
End


Catch e$

	Print "I died because " + e$


EndTry



'
Function WinProc:Int(hWnd:Int,Msg:Int,wParam:Int,lParam:Int) "win32"
	
	
	Select Msg
	
		'Case WM_RESIZE
		'	Print "WM_RESIZE"
		Case WM_MOVE
			Print "MOVE"

		Case WM_CLOSE
		
		Case WM_DESTROY
				Print  "old proc restored"	
			SetWindowLong(hwnd,GWL_WNDPROC, oldproc) 
		

		Case WM_KEYDOWN
		
			'DebugLog "Keydown " + wParam + " " + lParam
			
			DebugLog "you pressed " + Chr$(wParam)
			
			
			Select wParam
				Case 27 ' ESC
				
				'	SendMessage hWnd,WM_CLOSE,0,0
			End Select
			
		Case WM_CREATE
			DebugLog "WM_CREATE"	
	
		Case WM_INITDIALOG
		
			DebugLog "WM_INITDIALOG"	
		
		Case WM_COMMAND
			DebugLog "command " + lParam
		
		
			Select lParam
				Case  btnOk
					
					If HIWORD(wparam)= BN_CLICKED
					'	notify does Not work in non debug mode
					' well it works, but you can't click it					
					'
					'	Notify "You clicked Ok"
					EndIf
			
				Case btnCancel
					If HIWORD(wparam)= BN_CLICKED
					'	notify does Not work in non debug mode
					' well it works, but you can't click it					

					'	Notify "You clicked cancel"
					EndIf
				Case box  ,box2
				
				
					Print "EN_CHANGE "
				
					If HIWORD(wparam)= EN_CHANGE 
				
						'DebugLog "box " + lParam
									
						SendMessage lParam ,WM_GETTEXT,BankSize(textbank)-2,Int(BankBuf(textbank))

						thetext$ = String.FromCString(BankBuf(textbank))
										
						Print  thetext
						

						'Return 0

						
					
					EndIf
					
			
			End Select
			
			
			DebugLog "HERE"
			
		Default
			'DebugLog Msg
		
			
	End Select
	
	If oldproc<>0 Then Return CallWindowProc(oldproc, hWnd, Msg, wParam, lParam)   
	
End Function


Function LOWORD(value)
	Return value & $FFFF
End Function

Function HIWORD(value)
	Return (value Shr 16)
End Function