changing main windowcolor using API

[ly47]

Hi again
Sorry I did not understand TI-994A note...

Now I'm trying to add ToolTip.
As usual I translate FreeBasic API code to PB.(previously I had translate asm code to FreeBasic)
It does not run !
[ERROR] Invalid memory access. (write error at address 7116392)
Any suggestion ?
Thanks
ly

Code: Select all

;Declare SetWinColor(hWnd, clr)

Declare EnumChild(hwnd, lPrm)

Global wc.WNDCLASSEX, hInstance, msg.MSG,b.LOGBRUSH
Global hStatush, Btn1, hBtn2, hBtn3
Global tipsH, insH, ti.TOOLINFO, toolTipText$

b\lbStyle = #BS_SOLID

hInstance = GetModuleHandle_( null )

Global Dim Parts(3)
Parts(0) = 100
Parts(1) = 280
Parts(2) = 380

Enumeration
   #Button_1
   #Button_2
   #Button_3
EndEnumeration

; #Style = #WS_OVERLAPPEDWINDOW | #WS_VISIBLE
#Style = #WS_VISIBLE | #WS_DLGFRAME | #WS_SYSMENU | #WS_MINIMIZEBOX

Procedure WindowCallback(hWnd, uMsg, wParam, lParam) 

   Select uMsg 
         
      Case #WM_CREATE
                  
         hBtn1 = CreateWindowEx_(0, "Button", "Exit", #WS_CHILD | #WS_VISIBLE, 520, 328, 60, 25, hWnd, #Button_1, hInstance, 0)
         hBtn2 = CreateWindowEx_(0, "Button", "RED", #WS_CHILD | #WS_VISIBLE, 440, 328, 60, 25, hWnd, #Button_2,hInstance, 0)
         hBtn3 = CreateWindowEx_(0, "Button", "BLUE", #WS_CHILD | #WS_VISIBLE, 360, 328, 60, 25, hWnd, #Button_3, hInstance, 0)
         
         hStatus = CreateWindowEx_(0,
                                   #STATUSCLASSNAME,0, 
                                   #SBARS_SIZEGRIP | #WS_CHILD | #WS_VISIBLE,
                                   0, 0, 0, 0,
                                   hWnd , idStatus,hInstance,#Null)
         SendMessage_(hStatus, #SB_SETPARTS, 3, @Parts())
         
;          -------------------- Tooltip -------------------------------------------------------

            tipsH = CreateWindowEx_(#Null, 
                                "Tooltips_class32",#Null,
                                #TTS_ALWAYSTIP,
                                #CW_USEDEFAULT,#CW_USEDEFAULT,
                                #CW_USEDEFAULT,#CW_USEDEFAULT,
                                #Null,#Null,
                                insH,#Null)

                                ti\cbSize=SizeOf(TOOLINFO)
                                ti\uFlags=#TTF_SUBCLASS

             EnumChildWindows_(hWnd, @EnumChild, @ti)
         
      Case #WM_COMMAND
         
         Select wParam
            
            Case #Button_1
               
               Debug "#Button_1 EXIT"
               
               PostQuitMessage_(0)
               
            Case #Button_2               
;                Debug "#Button_2"   
               b\lbColor = $0000FF
               DeleteObject_(hBrush)
               hBrush = CreateBrushIndirect_(b)
               SetClassLongPtr_(hWnd, #GCL_HBRBACKGROUND, hBrush)
               InvalidateRect_(hWnd, 0, 1)
               
               	Define statusText$ = "RED"
				Debug statusText$
							
    			SendMessage_(hStatus,#SB_SETTEXT,0, @statusText$)
    			SendMessage_(hStatus, #SB_SETTEXT, 1, "  #Button_2 clicked")
    			
            Case  #Button_3               
;                Debug "#Button_3"
               b\lbColor = $FF0000
               DeleteObject_(hBrush)
               hBrush = CreateBrushIndirect_(b)
               SetClassLongPtr_(hWnd, #GCL_HBRBACKGROUND, hBrush)
               InvalidateRect_(hWnd, 0, 1)
               
               Define statusText$ = "BLUE"
			   Debug statusText$
							
				SendMessage_(hStatus,#SB_SETTEXT,0, @statusText$ )
				SendMessage_(hStatus, #SB_SETTEXT, 1, "  #Button_3 clicked")
				
         EndSelect

     Case #WM_CLOSE 
         DestroyWindow_(hWnd) 
         Result  = 0 
      Case #WM_DESTROY 
         PostQuitMessage_(0) 
         Result  = 0 
      Default 
         Result  = DefWindowProc_(hWnd, uMsg, wParam, lParam) 
   EndSelect 
   ProcedureReturn Result 
EndProcedure  

Define.s appName = "Win32"

With wc
	\cbsize  = SizeOf(WNDCLASSEX) 
	\style         = #CS_HREDRAW | #CS_VREDRAW 
	\lpfnWndProc  = @WindowCallback() 
	\hInstance     = hInstance 
; 	\hIcon         = LoadIcon_(0, #IDI_APPLICATION ) 
	\hIcon         =LoadImage_(0,"icon-.ico",#IMAGE_ICON,32,32,#LR_LOADFROMFILE)
	\hCursor  = LoadCursor_(0,#IDC_ARROW)
	\hbrBackground  = #COLOR_WINDOW + 1
	\lpszMenuName  = 0
	\lpszClassName  = @appName
EndWith
  
If ( RegisterClassEx_( @wc ) = false ) 
	MessageBox_( null, "Failed to register wc!", appName, #MB_ICONERROR )
	End 1
EndIf 

hWnd  = CreateWindowEx_(0, appName, "Simple", #Style, 100, 100, 600, 450, 0, 0, hInstance, 0) 

ShowWindow_(hWnd,  #SW_SHOWDEFAULT) 
UpdateWindow_(hWnd)
SetForegroundWindow_(hWnd)

While GetMessage_(msg, 0, 0, 0 ) 
   TranslateMessage_(msg) 
   DispatchMessage_(msg) 
Wend

; @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

Procedure EnumChild(hwnd, lPrm)
    Static id

    ti\uId = hWnd
    id = GetDlgCtrlID_(ti\uId)

	Select  id

		Case #Button_1
			toolTipText$ = "Exit"
			ti\lpszText = @toolTipText$
		Case #Button_2
			toolTipText$ = "RED"
	    	ti\lpszText=@toolTipText$
	    Case #Button_3
	    	toolTipText$ = "BLUE"
	   		ti\lpszText=@toolTipText$
	   	Default
	   		toolTipText$ = ""
	    	ti\lpszText=@toolTipText$
		EndSelect

    	ti\uFlags = ti\uFlags | #TTF_IDISHWND
    	SendMessage_(tipsH,#TTM_ADDTOOL,#Null,lPrm)

    ProcedureReturn tipsH

EndProcedure

; @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

; Procedure SetWinColor(hWnd, clr)
;    Static obj, hbr
; 
;    hbr = CreateSolidBrush_(clr)
;    obj  = SetClassLongPtr_(hWnd ,#GCL_HBRBACKGROUND ,hbr)
;    DeleteObject_(obj)
;    RedrawWindow_(hWnd, 0, 0, 0)
;    
;    ProcedureReturn 0
; EndProcedure

[ly47]

There are several advantages to program directly in PureBasic and prevent the direct use of APIs, even if the code is (slightly) bigger and even if we do program for Windows Only.

- The code is much more readable (Think of the potential code maintenance in a few months or years.)
- There is no need to have access to MSDN to find the syntax of a command, simply press F1
- PB commands are adapted to the API, even if API change over time, there is often no need to change the PB code.

Hi
I agree with you, but I want to learn more deeply API coding.
I have written a more complex app. both in PB native and API, both works fine PB native 87k , PB API 35k...
Yes the native one is much easier to write.
ly

[RASHAD]

Code: Select all

;          -------------------- Tooltip -------------------------------------------------------

            tipsH = CreateWindowEx_(#Null, 
                                "Tooltips_class32",#Null,
                                #TTS_ALWAYSTIP,
                                #CW_USEDEFAULT,#CW_USEDEFAULT,
                                #CW_USEDEFAULT,#CW_USEDEFAULT,
                                #Null,#Null,
                                insH,#Null)

                                ti\cbSize=SizeOf(TOOLINFO)
                                ti\uFlags=#TTF_SUBCLASS
                                
              EnumChildWindows_(hWnd,@Enumchild(),@ti)
             ;EnumChildWindows_(hWnd, @EnumChild, @ti)

[ly47]

Hi again RASHAD
Thanks a lot
I forgot that EnumChild is actually a procedure so it needs (), in FreeBasic you don't need ()...
ly