一、前言：
当引用Comctl32.dll版本6.0时，控件将会向上级窗口发送WM_NOTIFY消息，lParam参数为指向一个NMHDR的结构体地址，其中CODE包含NM_CUSTOMDRAW（自绘）通知码。
我们可以在NM_CUSTOMDRAW消息下，完成对控件的自绘。
那么如何在FreeBasic编程中实现按钮控件的自绘呢？在反复实验后终于实现了仿MT4按钮风格。其中部分细节与PB有些区别也暗藏技术坑。
二、实现代码：
1、创建XPTheme.xml文件，指定对Comctl32.dll版本6.0的引用
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly
xmlns="urn:schemas-microsoft-com:asm.v1"
manifestVersion="1.0">
<assemblyIdentity
name="CompanyName.ProductName.YourApplication"
processorArchitecture="*"
version="0.0.0.0"
type="win32"/>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="*"
publicKeyToken="6595b64144ccf1df"
language="*"
/>
</dependentAssembly>
</dependency>
</assembly>
2、创建资源文件dialog.rc，定义按钮控件ID
#define IDD_DIALOG1 101
#define IDC_BUTTON1 1003
#define IDC_BUTTON2 1004
#define IDC_BUTTON3 1005
//#FBForms Begin Manifest
1 24 XPTheme.xml
//#FBForms End Manifest3、程序头函数定义
#pragma once
#ifndef UNICODE
#define UNICODE
#endif
#lang "fb"
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "win/mmsystem.bi"
#INCLUDE ONCE "win/windowsx.bi"
#INCLUDE ONCE "win/commctrl.bi"
#INCLUDE ONCE "win/wingdi.bi"
#INCLUDE ONCE "win/uxtheme.bi"
#define IDD_DIALOG1 101
#define IDC_BUTTON1 1003
#define IDC_BUTTON2 1004
#define IDC_BUTTON3 1005
#define LRCF CHR(10,13)
declare function WinMain( byval hInstance as HINSTANCE, _
byval hPrevInstance as HINSTANCE, _
byval szCmdLine as zstring ptr, _
byval iCmdShow as integer ) as integer
end WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL )
declare function DIALOG_NEW ( byval hParent as HINSTANCE, _
byval WinProc as any ptr, _
byval ClassName as string, _
byval id as integer, _
byref title as string, _
byval w as integer, _
byval h as integer, _
byval styles as uinteger, _
byval exstyle as uinteger ) as HWND
declare function CONTROL_ADD ( byval hWndParent as HWND, _
byval ControlName as string, _
byval id as integer, _
byref text as string, _
byval x as integer, _
byval y as integer, _
byval w as integer, _
byval h as integer, _
byval styles as uinteger, _
byval exstyle as uinteger ) as HWND
declare sub FBFormsInitComCtls ( byval dwICC as DWORD )
declare sub DrawMtBottonControl ( byval lpdis as NMCUSTOMDRAW ptr, _
byval BottonBkColor as COLORREF, _
byval BottonFxColor as COLORREF )4、函数实现部分
'-------------------------------------------------------------------------------
' 创建主控窗口
'-------------------------------------------------------------------------------
function DIALOG_NEW ( byval hParent as HINSTANCE, _
byval WinProc as any ptr, _
byval ClassName as string, _
byval id as integer, _
title as string, _
byval w as integer, _
byval h as integer, _
byval dwStyle as uinteger, _
byval dwExStyle as uinteger ) as HWND
dim wcls as WNDCLASSEX
dim hWnd as HWND
dim appName as wstring * 256
function = 0
appName = ClassName
with wcls
.cbSize = SIZEOF( wcls )
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = WinProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = hParent
.hIcon = LoadIcon( NULL, IDI_APPLICATION )
.hCursor = LoadCursor( NULL, IDC_ARROW )
.hbrBackground = GetStockObject( WHITE_BRUSH )
.lpszMenuName = NULL
.lpszClassName = @appName
.hIconSm = LoadIcon ( NULL, IDI_APPLICATION )
end with
RegisterClassEx( @wcls )
hWnd = CreateWindowEx( dwExStyle, _ 'extended styles
appName, _ 'class name
title, _ 'window name
dwStyle, _
( GetSystemMetrics( SM_CXSCREEN ) - w ) / 2, _ 'default horizontal position
( GetSystemMetrics( SM_CYSCREEN ) - h ) / 2, _ 'default vertical position
w, _ 'default width
h, _ 'default height
NULL, _
NULL, _ 'cast ( HMENU, id ), _
hParent, _
NULL )
function = hWnd
end function
'-------------------------------------------------------------------------------
' 创建控件
'-------------------------------------------------------------------------------
function CONTROL_ADD ( byval hWndParent as HWND, _
byval ControlName as string, _
byval id as integer, _
byref text as string, _
byval x as integer, _
byval y as integer, _
byval w as integer, _
byval h as integer, _
byval styles as uinteger = 0, _
byval exstyle as uinteger = 0) as HWND
dim hWnd as HWND
'cast( HINSTANCE, GetWindowLong( hWndParent, GWLP_HINSTANCE ) )
dim hInstance as HINSTANCE = GetModuleHandle( NULL )
dim appName as wstring * 256
'WS_CHILD or WS_OVERLAPPED or WS_TABSTOP or WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT or BS_DEFPUSHBUTTON or BS_FLAT or BS_OWNERDRAW, _ '窗口风格
appName = ControlName
hWnd = CreateWindowEx( exstyle, _ '窗口的扩展风格
appName, _ '指向注册类名的指针
text, _ '指向窗口名称的指针
styles, _ '窗口风格
x, _ '窗口的水平位置
y, _ '窗口的垂直位置
w, _ '窗口的宽度
h, _ '窗口的高度
hWndParent, _ '父窗口或所有者窗口的句柄
cast ( HMENU, id ), _ '菜单的句柄或控件ID标识
hInstance, _ '要与窗口关联的模块实例的句柄
null )
function = hWnd
end function
'-------------------------------------------------------------------------------
' 绘制mt风格按钮
'-------------------------------------------------------------------------------
sub DrawMtBottonControl( byval lpdis as NMCUSTOMDRAW ptr, byval BottonBkColor as COLORREF, byval BottonFxColor as COLORREF)
dim rcRect as RECT
dim hTheme as HTHEME
dim iState AS LONG = 1
dim hBrushColor as HBRUSH
dim hPenColor as HPEN
dim bstrClassList as wstring * 256
dim ThemeName as Wstring * 10
'创建按钮字体
dim hFont as HFONT = CreateFont( 16, 0, 0, 0, FW_NORMAL, FALSE, FALSE, FALSE, DEFAULT_CHARSET, OUT_CHARACTER_PRECIS, _
CLIP_CHARACTER_PRECIS, DEFAULT_QUALITY, FF_DONTCARE, @Wstr("Arial Black") )
SendMessage lpdis->hdr.hwndFrom, WM_GETTEXT, sizeof( bstrClassList ), cast( LPARAM, @bstrClassList )
ThemeName = "Button" 'XP风格按钮
hTheme = OpenThemeData( lpdis->hdr.hwndFrom, @ThemeName )
IF ( lpdis->uItemState AND ODS_HotLight) THEN iState = 2
IF ( lpdis->uItemState AND ODS_SELECTED) THEN iState = 3
IF ( lpdis->uItemState AND ODS_Disabled) THEN iState = 4
IF ( lpdis->uItemState AND ODS_Inactive) THEN iState = 5
DrawThemeBackground( hTheme, lpdis->hdc, 1, iState, @lpdis->rc, NULL )
CloseThemeData( hTheme )
copyRect @rcRect, @lpdis->rc
hBrushColor = CreateSolidBrush( BottonBkColor )
SelectObject( lpdis->hdc, hBrushColor )
IF(lpdis->uItemState AND CDIS_HOT) THEN '按钮获得热点时，绘制长方形填充区
rcRect.Left += 4
rcRect.Top += 4
rcRect.Right -= 4
rcRect.Bottom -= 4
FillRect( lpdis->hdc, @rcRect, hBrushColor )
DrawFocusRect lpdis->hdc, @rcRect
ELSE '鼠标不在按钮上时，绘制圆角矩形
hPenColor = CreatePen( PS_SOLID, 1, BottonBkColor )
SelectObject( lpdis->hdc, hPenColor )
RoundRect lpdis->hdc, lpdis->rc.Left+3, lpdis->rc.Top+3, lpdis->rc.Right-3, lpdis->rc.Bottom-3, 2, 2
END IF
IF( lpdis->uItemState AND ODS_SELECTED) THEN '按钮被选中时
'FrameRect lpdis->hdc, @rcRect, hPenColor
DrawFocusRect lpdis->hdc, @rcRect '绘制一个帧框
END IF
DeleteObject hBrushColor
DeleteObject hPenColor
SETBKMODE lpdis->hdc, TRANSPARENT '文字背景为透明色
SETTEXTCOLOR lpdis->hdc, BGR( 0, 0, 0 ) '文字为黑色
SelectObject( lpdis->hdc, hFont ) '选入自定义字体
DRAWTEXT lpdis->hdc, bstrClassList, -1, @rcRect, DT_SINGLELINE OR DT_CENTER OR DT_VCENTER
DeleteObject hFont
END SUB
'----------------------------------------------------
'初始化控件类
'----------------------------------------------------
sub FBFormsInitComCtls ( byval dwICC as DWORD )
dim picce as INITCOMMONCONTROLSEX
picce.dwSize = sizeof ( INITCOMMONCONTROLSEX )
picce.dwICC = dwICC
InitCommonControlsEx ( @picce )
end sub5、主程序部分
'====================================================================
' main
'====================================================================
function WinMain ( byval hInstance as HINSTANCE, _
byval hPrevInstance as HINSTANCE, _
byval szCmdLine as zstring ptr, _
byval iCmdShow as integer ) as integer
'dim hFont as HFONT
'hFont = GetStockObject( SYSTEM_FIXED_FONT OR ANSI_CHARSET )
dim hDlg as HWND = DIALOG_NEW( hInstance, ProcPtr( WndProc ), "MainWClass", IDD_DIALOG1, "MT SERVER", 467, 361, _
WS_OVERLAPPEDWINDOW, _
WS_EX_DLGMODALFRAME OR WS_EX_CONTROLPARENT OR WS_EX_WINDOWEDGE )
'IF hFont THEN SendMessage hDlg, WM_SETFONT, Cast( wParam, hFont ), NULL
FBFormsInitComCtls ( ICC_WIN95_CLASSES OR ICC_DATE_CLASSES OR ICC_INTERNET_CLASSES )
'InitCommonControls( )
dim hBotton1 as HWND = CONTROL_ADD( hDlg, WC_BUTTON, IDC_BUTTON1, "于市价卖", 10, 20, 187, 25, _
WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_CENTER OR _
BS_VCENTER OR BS_FLAT, WS_EX_NOPARENTNOTIFY )
'IF hFont THEN SendMessage hBotton1, WM_SETFONT, Cast( wParam, hFont ), NULL
dim hBotton2 as HWND = CONTROL_ADD( hDlg, WC_BUTTON, IDC_BUTTON2, "于市价买", 217, 20, 187, 25, _
WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_CENTER OR _
BS_VCENTER OR BS_FLAT, WS_EX_NOPARENTNOTIFY )
'IF hFont THEN SendMessage hBotton2, WM_SETFONT, Cast( wParam, hFont ), 0
dim hBotton3 as HWND = CONTROL_ADD( hDlg, WC_BUTTON, IDC_BUTTON3, "平仓", 10, 55, 395, 25, _
WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_CENTER OR _
BS_VCENTER OR BS_FLAT, WS_EX_NOPARENTNOTIFY )
'IF hFont THEN SendMessage hBotton3, WM_SETFONT, Cast( wParam, hFont ), 0
'DeleteObject hFont
ShowWindow hDlg, iCmdShow
UpdateWindow hDlg
dim wMsg as MSG
while GetMessage( @wMsg, NULL, 0, 0 )
TranslateMessage( @wMsg )
DispatchMessage( @wMsg )
wend
function = wMsg.wParam
end function6、窗口过程处理
function WndProc ( byval hWnd as HWND, _
byval wMsg as UINT, _
byval wParam as WPARAM, _
byval lParam as LPARAM ) as LRESULT
dim wmId as integer, wmEvent as integer
select case( wMsg )
case WM_CREATE
case WM_PAINT
dim rct as RECT
dim pnt as PAINTSTRUCT
dim hDC as HDC = BeginPaint( hWnd, @pnt )
EndPaint( hWnd, @pnt )
function = true
case WM_MOUSELEAVE '移进
case WM_MOUSEHOVER '移出
case WM_MOUSEMOVE
case WM_DRAWITEM
'---------------------------------------------
' 控件自绘部分
'---------------------------------------------
case WM_NOTIFY
dim rcRect as RECT
dim hlvBrush as HBRUSH
dim pNmh as NMHDR PTR
dim lpdis as NMCUSTOMDRAW PTR
pNmh = cPtr ( NMHDR PTR, lParam )
select case pNmh->code
case NM_CUSTOMDRAW
lpdis = cPtr ( NMCUSTOMDRAW PTR, lParam )
IF lpdis->hdr.idFrom = IDC_BUTTON1 THEN
select case lpdis->dwDrawStage
case CDDS_PREERASE '系统绘制前执行自绘代码,绘制按钮1
'调用自定义绘图函数，绘制MT4风格按钮
DrawMtBottonControl ( lpdis, BGR( 255,128,128 ), BGR( 240, 112, 112 ) )
end select
END IF
IF lpdis->hdr.idFrom = IDC_BUTTON2 THEN
select case lpdis->dwDrawStage
case CDDS_PREERASE '系统绘制前执行自绘代码,绘制按钮2
'调用自定义绘图函数，绘制MT4风格按钮
DrawMtBottonControl ( lpdis, BGR( 160,192,255 ), BGR( 240, 112, 112 ) )
end select
END IF
IF lpdis->hdr.idFrom = IDC_BUTTON3 THEN
select case lpdis->dwDrawStage
case CDDS_PREERASE '系统绘制前执行自绘代码,绘制按钮3
'调用自定义绘图函数，绘制MT4风格按钮
DrawMtBottonControl ( lpdis, BGR( 255, 255, 160 ), BGR( 240, 112, 112 ) )
end select
END IF
FUNCTION = CDRF_SKIPDEFAULT '跳过系统默认绘制
EXIT FUNCTION '这里必须退出过程，否则无法完成自绘制
end select
case WM_COMMAND
wmId = loword( wParam )
wmEvent = hiword( wParam )
select case( wmId )
case IDC_BUTTON1
if wmEvent = BN_CLICKED or wMsg = 1 then
MessageBox( hwnd, str(wmId) + " " + str(wmEvent) , "提示窗口", MB_OK )
end if
case IDC_BUTTON2
if wmEvent = BN_CLICKED or wMsg = 1 then
MessageBox( hwnd, str(wmId) + " " + str(wmEvent) , "提示窗口", MB_OK )
end if
if wmEvent = BN_SETFOCUS then
MessageBox( hwnd, "BN_SETFOCUS" , "提示窗口", MB_OK )
end if
case IDC_BUTTON3
if wmEvent = BN_CLICKED or wMsg = 1 then
MessageBox( hwnd, str(wmId) + " " + str(wmEvent) , "提示窗口", MB_OK )
end if
end select
function = true
case WM_KEYDOWN
if( lobyte( wParam ) = 27 ) then
PostMessage( hWnd, WM_CLOSE, 0, 0 )
end if
case WM_CLOSE
if MessageBox( hwnd, "是否退出程序?", "MTSERVER", MB_YESNOCANCEL ) = IDYES then
DestroyWindow( hwnd )
else
function = 0
end if
case WM_DESTROY
PostQuitMessage( 0 )
exit function
end select
function = DefWindowProc( hWnd, wMsg, wParam, lParam )
end function三、与MT4对照运行效果
录像3
四、总结：
在api编程中对于颜色设置，由于RGB函数与FB内置函数冲突，一直无法得到指定的颜色，这里困惑了很久，后来在FB帮助文档中看见这么一行说明：
Note for Windows API programmers: The macro named RGB in the Windows references has been renamed BGR in the FB headers for Windows to avoid collisions.
Windows API程序员注意：Windows引用中名为RGB的宏已在Windows的FB头中重命名为BGR，以避免冲突。
到此才豁然开朗，原来FB下API编程对于RGB颜色的设置，应使用BGR函数。
3053
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
