create a BS_COMMANDLINK button

Windows specific questions.
Post Reply
spartacus13012
Posts: 18
Joined: Nov 30, 2014 12:37
Location: FRANCE

create a BS_COMMANDLINK button

Post by spartacus13012 »

Hello

I have a little problem with creating a somewhat unusual button , "BS_COMMANDLINK".

I get very well create a normal button by a "CreateWindowEx".

I'm looking for a tip in freebasic.

Note that my PC is on WIN8.1.

I have recovered the SDK for microsoft to have the "#define" of "BS_COMMANDLINK", but has the ca creation gives an invisible box check and without text that becomes visible only when you click the.

Thanks in advance
SARG
Posts: 1757
Joined: May 27, 2005 7:15
Location: FRANCE

Re: create a BS_COMMANDLINK button

Post by SARG »

Hi,

Using the code below a grayed box is displayed and clicking on it displays just a small square on left.

As to use commandlink the version of comctl32 must at least 6.0, I have started the exe with fbdebugger to see the comctl32.dll loaded.It seems a 5.82 version (under W7).

In fact a manifest file is necessary to declare the use of a 6.0 version. See after the code.
Put all in a file and name the file <your exe>.manifest.
ie testcomlink.exe --> testcomlink.exe.manifest

As UTF-8 is defined you have to use a wstring (see wstrg in the code example)

Code: Select all

#Include Once "windows.bi"
#Include Once "win\commctrl.bi"

Dim Shared fb_szAppName As String
fb_szAppName="DEBUGGER"
Dim Shared windmain As HWND
Dim Shared fb_hinstance As HINSTANCE
#Define bs_commandlink &hE
#Define bs_settext &h1609

'========================================
Function fb_Form(Title As String,X As Integer,Y As Integer,W As Integer,H As Integer,Style As Integer,Exstyle As Integer) As HWND
   Dim  A As HWND
   If Style=0 Then
        Style= WS_MINIMIZEBOX  Or _
        WS_SIZEBOX      Or _
        WS_CAPTION      Or _
        WS_MAXIMIZEBOX  Or _
        WS_POPUP        Or _
        WS_SYSMENU      Or _
        WS_CLIPCHILDREN	'14/11/2013
   End If
   A = CreateWindowEx(Exstyle,fb_szAppName,title,Style,X,Y,W,H, _
   NULL,0,fb_hInstance,0)
   SendMessage(A,WM_SETFONT,Cast(WPARAM,GetStockObject(DEFAULT_GUI_FONT)),0)
   Return A
End Function

Function fb_button (Text As String,ByVal hWnd As HWND,ByVal id As Integer,ByVal X As Integer,ByVal Y As Integer,ByVal W As Integer,ByVal H As Integer, Style As Integer, Exstyle As Integer)  As HWND

 Dim A As HWND

 If Style=0 Then
     Style=(WS_CHILD Or WS_VISIBLE Or BS_MULTILINE Or BS_COMMANDLINK Or WS_TABSTOP)
 End If

 If Exstyle=-1 Then
     Exstyle=WS_EX_STATICEDGE
 End If
 
 A = CreateWindowEx(Exstyle,"button",Text,Style, X, Y, W, H,hWnd,Cast (HMENU,id) ,fb_hInstance,NULL)
 
 SendMessage(A,WM_SETFONT,Cast(WPARAM,GetStockObject(DEFAULT_GUI_FONT)),0)
 
 If W=0 Then
   Dim hdc As HDC
   hdc=GetDC(A)
   Dim vsize As SIZEL
   GetTextExtentPoint32(hdc,Text,Len(Text),@vsize)
   ReleaseDC(A,hdc)

 MoveWindow(A,X,Y,vsize.cx+(vsize.cx*0.5),vsize.cy+(vsize.cy*0.32),TRUE)
 End If
 Return A
End Function
Sub fb_show (hwnd As HWND)
RedrawWindow(hwnd,ByVal 0,0,0)
ShowWindow(hwnd,SW_SHOW)
End Sub
Sub fb_win()
	Dim  As Integer l,pstatus(4)={120,220,470,700,-1} '08/04/2014 520-->470 add 670
	Dim As UInteger tabstop=8
	windmain = fb_Form ( "DEBUG", 0, 0,800, 590,0,0)',WS_MINIMIZEBOX or WS_CAPTION Or WS_SYSMENU)
Dim As WString *15 wstrg="MY COMMAND"
	Var butcommand = fb_button("test",windmain, 100, 5, 15, 300, 260,0,0)
	SendMessage(butcommand,bs_settext,0,Cast(LPARAM,StrPtr(wstrg)))
	fb_show (butcommand)
	fb_show (windmain)
End Sub

Function WndProc ( ByVal hWnd As HWND, _
                   ByVal message As Integer, _
                   ByVal wParam As Integer, _
                   ByVal lParam As Integer ) As Integer
                   WndProc=0
            Select Case message
            	Case WM_DESTROY
               	PostQuitMessage 0            
            		Exit Function
            	Case Else
                  WndProc = DefWindowProc( hWnd, message, wParam, lParam )
            End Select
End Function

Function WinMain ( ByVal hInstance As HINSTANCE, _
                   ByVal hPrevInstance As Integer, _
                   szCmdLine As String, _
                   ByVal iCmdShow As Integer ) As Integer    
     
     Dim wMsg As MSG
     Dim wcls As WNDCLASS     

     Dim hWnd As Unsigned Integer

     
     WinMain = 0
     
     ''
     '' Setup window class
     ''
     fb_hinstance=hinstance
     With wcls
     	.style         = CS_HREDRAW Or CS_VREDRAW
     	.lpfnWndProc   = Cast(WndProc,@WndProc)
     	.cbClsExtra    = 0
     	.cbWndExtra    = 0
     	.hInstance     = hInstance
     	.hIcon         = LoadIcon( hInstance,MAKEINTRESOURCE(1))'LoadIcon( null, byval IDI_APPLICATION )
     	.hCursor       = LoadCursor( NULL, ByVal IDC_ARROW )
     	.hbrBackground = GetStockObject( WHITE_BRUSH )
     	.lpszMenuName  = NULL
     	.lpszClassName = StrPtr( fb_szAppName )
     End With
     
     
     ''
     '' Register the window class     
     ''     
     If ( RegisterClass( @wcls ) = FALSE ) Then
        MessageBox NULL, "Failed to register the window class", fb_szAppName, MB_ICONERROR               
        Exit Function
    End If
    ' -----------------------------------------------
   Dim iccex As INITCOMMONCONTROLSEX 
   iccex.dwSize = Len(INITCOMMONCONTROLSEX)
   iccex.dwICC = _
             ICC_LISTVIEW_CLASSES Or ICC_TREEVIEW_CLASSES Or ICC_BAR_CLASSES _
             Or ICC_TAB_CLASSES Or ICC_UPDOWN_CLASS Or ICC_PROGRESS_CLASS _
             Or ICC_USEREX_CLASSES Or ICC_DATE_CLASSES Or ICC_STANDARD_CLASSES
   InitCommonControlsEx(@iccex)
        
' --------------- call FB_WIN() for initialisation ------------------
   fb_win() 'create window, etc
' --------------------------------------------------------------------------------
    '' Process windows messages
   While ( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )    
      Dim hActiveWindow As HWND
      hActiveWindow = GetActiveWindow()
      If (IsWindow(hActiveWindow)=0) Or (IsDialogMessage(hActiveWindow,@wMsg)=0) Then
        TranslateMessage @wMsg
        DispatchMessage  @wMsg
    End If
    Wend

    WinMain = wMsg.wParam
End Function
End WinMain( Cast(HINSTANCE,GetModuleHandle( 0 )), NULL, Command, SW_NORMAL )

Code: Select all

<?xml version="1.0" encoding="UTF-8" standalone="yes"?> 

<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> 

<assemblyIdentity 

version="1.0.0.0" 

processorArchitecture="X86" 

name="CompanyName.ProductName.YourApp" 

type="win32" 

/> 

<description>Your application description here.</description> 

<dependency> 

<dependentAssembly> 

<assemblyIdentity 

type="win32" 

name="Microsoft.Windows.Common-Controls" 

version="6.0.0.0" 

processorArchitecture="X86" 

publicKeyToken="6595b64144ccf1df" 

language="*" 

/> 

</dependentAssembly> 

</dependency> 

</assembly> 

MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Re: create a BS_COMMANDLINK button

Post by MichaelW »

In my (32-bit) test under Windows 7-64 the structure setup and call to InitCommonControlsEx were not necessary, so the inclusion of "win\commctrl.bi" was not necessary.
spartacus13012
Posts: 18
Joined: Nov 30, 2014 12:37
Location: FRANCE

Re: create a BS_COMMANDLINK button

Post by spartacus13012 »

Thanks for the tip, i will use it immediately.

I tried and it works perfectly. My problem is no rule, thanks again for the help.
Post Reply