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
create a BS_COMMANDLINK button
-
- Posts: 18
- Joined: Nov 30, 2014 12:37
- Location: FRANCE
Re: create a BS_COMMANDLINK button
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)
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>
Re: create a BS_COMMANDLINK button
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.
-
- Posts: 18
- Joined: Nov 30, 2014 12:37
- Location: FRANCE
Re: create a BS_COMMANDLINK button
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.
I tried and it works perfectly. My problem is no rule, thanks again for the help.