Win32 Native GUI but...

With the help form kev in this topic: http://www.blitzbasic.com/Community/posts.php?topic=50175 I 've gotten some windows controls on a BlitzMax window.

This thing runs in debugmode, but exits silently in Non debugmode. Can somebody spot an error or two ?
[EDIT]: Try writing something in the textboxes to make it exit.

And yes, it's messy, I know... :)

Strict
Import "-luser32"
'Import "-lkernel32"
Extern 
	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 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

AppTitle = gApptitle 

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

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()


Print "oldproc " + oldproc


While Not KeyHit(key_escape)
'Repeat

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

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

	Flip

Wend


DebugLog "here it ends"
End



'
Function WinProc:Int(hWnd:Int,Msg:Int,wParam:Int,lParam:Int)
	
	
	Select Msg

		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
				
					If HIWORD(wparam)= EN_CHANGE 
				
						DebugLog "box " + lParam
									
						SendMessage lParam ,WM_GETTEXT,BankSize(textbank)-2,Int(BankBuf(textbank))

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

						

						
					
					EndIf
					
			
			End Select
			
		Default
			'DebugLog Msg
		
			
	End Select
	
	If oldproc<>0 Then Return CallWindowProc(oldproc, hwnd, Msg, Wparam, Lparam)   
	
End Function


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

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

Ouaou ! great !

works in debug and retail here

Hum ??? are you sure ??? Because in debug mode i can edit
the string box but not in normal mode

@{cYanide} : try writing something in the textboxes

Textboxes?

All I see is alot of coloured lines being drawn, there are no gadgets in sight.

@Shambler: what Windows version are you on?

peter looks like the problems with the way you subclassed blitzmax's winproc. what might be needed is in the while .. wend loop is to flip between our custom winproc and blitzmax own winproc. i will have a look and see if i can figure this out.

kev

no, I'm pretty sure that's not it. I 've subclassed before, and that was never needed.

[deleted] see below

For those with no controls, does this fix it?

Strict
Import "-luser32"
'Import "-lkernel32"
Extern 
	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

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()


Print "oldproc " + oldproc


While Not KeyHit(key_escape)
'Repeat

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

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

	Flip

Wend


DebugLog "here it ends"
End



'
Function WinProc:Int(hWnd:Int,Msg:Int,wParam:Int,lParam:Int)
	
	
	Select Msg

		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
				
					If HIWORD(wparam)= EN_CHANGE 
				
						DebugLog "box " + lParam
									
						SendMessage lParam ,WM_GETTEXT,BankSize(textbank)-2,Int(BankBuf(textbank))

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

						

						
					
					EndIf
					
			
			End Select
			
		Default
			'DebugLog Msg
		
			
	End Select
	
	If oldproc<>0 Then Return CallWindowProc(oldproc, hwnd, Msg, Wparam, Lparam)   
	
End Function


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

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

That's better, can see gadgets now, running XP.

Textboxes work fine, label is there, Ok and cancel buttons do nothing but not sure if they should be working.

Cool, thanks.

Ok and cancel do nothing, you can add a print satement or something to check that they work.

You can can't move the window in non debug mode can you?
That's the "new" error.

getting there, does not quit can type into textbox and notify on button ok now works. window can also be moved.

when typeing text in textbox its colour is the same as the background colour, to see highlight it with the mouse.

can you try this.

Strict
Import "-luser32"
'Import "-lkernel32"
Extern 
	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

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()


Print "oldproc " + oldproc


Global message:MSG = New MSG
Global messageADDR:Byte Ptr = Byte Ptr message
Global hwnd

While Not KeyHit(key_escape)
'Repeat

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

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

	Flip

	PeekMessageA(messageADDR,0,0,0,1)
	'GetMessageA(messageADDR,0,0,0)
	TranslateMessage(messageADDR)
	DispatchMessageA(messageADDR)

Wend


DebugLog "here it ends"
End



'
Function WinProc:Int(hWnd:Int,Msg:Int,wParam:Int,lParam:Int)
	
	
	Select Msg

		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
				
					If HIWORD(wparam)= EN_CHANGE 
				
						DebugLog "box " + lParam
									
						SendMessage lParam ,WM_GETTEXT,BankSize(textbank)-2,Int(BankBuf(textbank))

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

						

						
					
					EndIf
					
			
			End Select
			
		Default
			'DebugLog Msg
			Return DefWindowProcA(hWnd,Msg,wParam,lParam)
			
	End Select
	
	If oldproc<>0 Then Return CallWindowProc(oldproc, hwnd, Msg, Wparam, Lparam)   
	
End Function


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

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

Runs fine in debug mode, but strange in non debug. Typing is slow, then a lot of chars comes to the textbox.

text color is fine here.

But why are you putting

PeekMessageA(messageADDR,0,0,0,1)
TranslateMessage(messageADDR)
DispatchMessageA(messageADDR)

in there

Blitz should have it's own message pump to do that?

for some reason it stops blitz quiting? rem out the message handler and it quits.

umm im using win2000 and cant see the text its colour is the same ie. white i think flip is doing someting behind the scene's, move PeekMessageA(messageADDR,0,0,0,1) before flip and it quits still. GetMessageA(messageADDR,0,0,0) slows the display of chars but waits for events.

Fixed?? I think so, please test

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

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()


Try

Print "oldproc " + oldproc

While Not KeyHit(key_escape)
'Repeat

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

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

	Flip

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 And $FFFF
End Function

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

if so , misssing "win32" was the problem

working here tested debug/full :)

kev

cool. how about the font color, it was ok?

yes fonts color correct.

Works here, but shouldn't the 'And' be an '&' in LOWORD?

Like this:

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

lol, just posted that in the other topic, well spotted!

I just got menus working, and it's needed there

Another update: I've edited the code above to because I've learned that

Function WinProc:Int(hWnd:Int,Msg:Int,wParam:Int,lParam:Int) "win32"

needs the "win32" statement too.

quick question what does bbSystemPoll() do?

the low/hi word functions was pulled from winblitz3d, well spotted fredborg.

I've taken out bbSystemPoll(), it was an experiment. I don't know what it does:)

Is it possible to create a canvas or whatever it's called to allow you to mix a 2d/3d display in with the gui?

I.e using max2d.

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

Nice. We, or you should wrap it's functionality up in a oop style interface. A easy to use one. I'll give it a go, but I've never tried win32 before.

For those of us not willing to pay for a win32 wrapper.(Unless it's A million times better than bplus that is...and includes a form designer. (Hint mark.))