GUI Central is the correct place for this post? :)
Anyway, Have someone already tried to use DWM (Desktop Window Manager)?
http://msdn.microsoft.com/en-us/library/aa969540(v=vs.85).aspx (http://msdn.microsoft.com/en-us/library/aa969540(v=vs.85).aspx)
(supported only on Windows Vista and Windows 7 operating systems, excluding 7 Starter).
Here's a small example. It seems to work well, but the problem is the rendering of controls. The button in the non-client area loses the 3-D effect and the text becomes transparent. Any clue about this? So far, I've found only explanations, but no solution.
$INCLUDE "windowssdk.inc"
$INCLUDE "dwmapi.inc"
' ------------------------------------------------------------------------------------
' DECLARES - VARIABLES - CONTROLS
' ------------------------------------------------------------------------------------
DECLARE winProc(INT hWnd, INT uMsg, INT wParam, INT lParam), INT
DECLARE OnInit()
DECLARE OnFinish()
INT leftWidth = 10
INT rightWidth = 10
INT topWidth = 100
INT bottomWidth = 10
INT aeroEnabled = 0
int oldproc
window w1
CONST BUTTON_1 = 1
CONST BUTTON_2 = 2
OPENWINDOW w1,0,0,645,399,@CAPTION,0,"DWM sample",&win_handler
CONTROL w1,@SYSBUTTON,"Close",13,7,70,20,0x50000000,BUTTON_1
CONTROL w1,@SYSBUTTON,"Close",13,200,70,20,0x50000000,BUTTON_2
OnInit()
' ------------------------------------------------------------------------------------
' MAIN LOOP - WINDOW PROCEDURE
' ------------------------------------------------------------------------------------
WAITUNTIL w1=0
END
SUB win_handler
SELECT @MESSAGE
CASE @IDCLOSEWINDOW
OnFinish()
CASE @IDCONTROL
SELECT @CONTROLID
CASE BUTTON_1
IF @NOTIFYCODE = 0
/*button clicked*/
SENDMESSAGE w1, WM_CLOSE, 0 , 0
ENDIF
ENDSELECT
ENDSELECT
RETURN
ENDSUB
SUB winProc(INT hWnd, INT uMsg, INT wParam, INT lParam), INT
INT dwmHandled
INT result
IF aeroEnabled THEN
dwmHandled = DwmDefWindowProc(hWnd, uMsg, wParam, lParam, result)
ENDIF
SELECT uMsg
CASE WM_PAINT
RETURN OnPaint(w1.hwnd)
ENDSELECT
RETURN CallWindowProc(oldproc,hWnd,uMsg,wParam,lParam)
ENDSUB
' ------------------------------------------------------------------------------------
' EVENTS
' ------------------------------------------------------------------------------------
SUB OnInit()
CENTERWINDOW w1
aeroEnabled = SetGlassEffect(w1.hwnd, leftWidth, topWidth, rightWidth, bottomWidth)
oldproc = SetWindowLong(w1.hwnd, GWL_WNDPROC, &winProc)
ENDSUB
SUB OnFinish()
SetWindowLong(w1.hwnd, GWL_WNDPROC, oldproc)
CLOSEWINDOW w1
ENDSUB
SUB OnPaint( INT hWin), INT
IF aeroEnabled = 0 then RETURN 1
WINRECT rc
PAINTSTRUCT ptrstructc
HDC devc
HBRUSH brush, oldbrush
GetClientRect(hWin, &rc)
devc = BeginPaint(hWin, &ptrstructc)
' (transparent area)
brush = GetStockObject(BLACK_BRUSH)
oldbrush = SelectObject(devc, brush)
FillRect(devc, &rc, brush)
SelectObject(devc, oldbrush)
' (client area)
rc.left+= leftWidth
rc.top+= topWidth
rc.right-= rightWidth
rc.bottom-= bottomWidth
brush = GetStockObject(WHITE_BRUSH)
oldbrush = SelectObject(devc, brush)
FillRect(devc, &rc, brush)
SelectObject(devc, oldbrush)
EndPaint(hWin, &ptrstructc)
RETURN 0
ENDSUB
' ------------------------------------------------------------------------------------
' DESKTOP WINDOW MANAGER FUNCTIONS
' ------------------------------------------------------------------------------------
SUB IsGlassAvailable(), INT
' TODO: set vistaorAbove = 0 if the OS is xp or less
int vistaorAbove = 1
INT enabled = 0
IF vistaorAbove THEN
DwmIsCompositionEnabled(&enabled)
ENDIF
RETURN enabled
ENDSUB
SUB SetGlassEffect(int hWin, OPT INT left=0, OPT INT top=0, OPT INT right=0, OPT INT bottom=0), INT
IF IsGlassAvailable() = 1 AND hWin>0 THEN
DIM m as MARGINS
m.cxLeftWidth =left
m.cxRightWidth =right
m.cyTopHeight= top
m.cyBottomHeight=bottom
DwmExtendFrameIntoClientArea(hWin, &m)
RETURN 1
END IF
RETURN 0
ENDSUB
OK. When using DWM it seems that the only way to display a button in the non-client area is by subclassing the control and painting it by yourself ???.
I've extended the example using a button and a listview. However there are some points to fix yet:
(1) The text of the button remains transparent.
(2) The column of the listview is not rendered correctly.
I can't find any solution for these errors.
$INCLUDE "windowssdk.inc"
$INCLUDE "dwmapi.inc"
$INCLUDE "Uxtheme.inc"
$INCLUDE "vsstyle.inc"
$USE "Uxtheme.lib"
' ------------------------------------------------------------------------------------
' DECLARES - VARIABLES - CONTROLS
' ------------------------------------------------------------------------------------
DECLARE winProc(INT hWnd, INT uMsg, INT wParam, INT lParam), INT
DECLARE buttonProc(INT hWnd, INT uMsg, INT wParam, INT lParam), INT
DECLARE OnInit()
DECLARE OnFinish()
INT leftWidth = 10
INT rightWidth = 10
INT topWidth = 197
INT bottomWidth = 10
INT aeroEnabled = 0
int oldproc
int oldbuttonproc
int oldlistvproc
window w1
CONST BUTTON_1 = 1
CONST BUTTON_2 = 2
CONST LISTVIEW_3 = 3
CONST LISTVIEW_4 = 4
OPENWINDOW w1,0,0,645,399,@CAPTION|@HIDDEN,0,"DWM sample",&win_handler
CONTROL w1,@SYSBUTTON,"Close",13,7,70,20,0x50000000,BUTTON_1
CONTROL w1,@SYSBUTTON,"Close",13,200,70,20,0x50000000,BUTTON_2
CONTROL w1,@LISTVIEW,"",241,17,262,132,0x50800001,LISTVIEW_3
CONTROL w1,@LISTVIEW,"",241,200,262,132,0x50800001,LISTVIEW_4
OnInit()
SHOWWINDOW w1, @SWSHOW
' ------------------------------------------------------------------------------------
' MAIN LOOP - WINDOW PROCEDURE
' ------------------------------------------------------------------------------------
WAITUNTIL w1=0
END
SUB win_handler
SELECT @MESSAGE
CASE @IDCLOSEWINDOW
OnFinish()
CASE @IDCONTROL
SELECT @CONTROLID
CASE BUTTON_1
IF @NOTIFYCODE = 0
/*button clicked*/
SENDMESSAGE w1, WM_CLOSE, 0 , 0
ENDIF
CASE BUTTON_2
IF @NOTIFYCODE = 0
/*button clicked*/
SENDMESSAGE w1, WM_CLOSE, 0 , 0
ENDIF
CASE LISTVIEW_3
/* respond to control notifications here */
CASE LISTVIEW_4
/* respond to control notifications here */
ENDSELECT
ENDSELECT
RETURN
ENDSUB
SUB winProc(INT hWnd, INT uMsg, INT wParam, INT lParam), INT
INT dwmHandled
INT result
IF aeroEnabled THEN
dwmHandled = DwmDefWindowProc(hWnd, uMsg, wParam, lParam, result)
ENDIF
SELECT uMsg
CASE WM_PAINT
RETURN PaintWindow(w1.hwnd)
ENDSELECT
RETURN CallWindowProc(oldproc,hWnd,uMsg,wParam,lParam)
ENDSUB
SUB buttonProc(INT hWnd, INT uMsg, INT wParam, INT lParam), INT
SELECT uMsg
CASE WM_PAINT
RETURN PaintButton(hWnd)
ENDSELECT
RETURN CallWindowProc(oldbuttonproc,hWnd,uMsg,wParam,lParam)
ENDSUB
SUB listviewProc(INT hWnd, INT uMsg, INT wParam, INT lParam), INT
SELECT uMsg
CASE WM_PAINT
RETURN PaintListview(hWnd)
ENDSELECT
RETURN CallWindowProc(oldlistvproc,hWnd,uMsg,wParam,lParam)
ENDSUB
' ------------------------------------------------------------------------------------
' EVENTS
' ------------------------------------------------------------------------------------
' AFTER THE WINDOW IS CREATED
SUB OnInit()
CENTERWINDOW w1
HRESULT hr = BufferedPaintInit()
' comment the next line to run the window without glass
aeroEnabled = SetGlassEffect(w1.hwnd, leftWidth, topWidth, rightWidth, bottomWidth)
if aeroEnabled THEN
' subclass the window
oldproc = SetWindowLong(w1.hwnd, GWL_WNDPROC, &winProc)
' subclass the button
oldbuttonproc = SetWindowLong( GETCONTROLHANDLE(w1, BUTTON_1), GWL_WNDPROC, &buttonProc)
' subclass the listview
oldlistvproc = SetWindowLong( GETCONTROLHANDLE(w1, LISTVIEW_3), GWL_WNDPROC, &listviewProc)
ENDIF
' add some to the lists
CONTROLCMD w1, LISTVIEW_3, @LVINSERTCOLUMN, 0, "Items"
CONTROLCMD w1, LISTVIEW_3, @LVSETCOLWIDTH, 0, 260
CONTROLCMD w1, LISTVIEW_3, @LVINSERTITEM, 0, "Item #1"
CONTROLCMD w1, LISTVIEW_3, @LVINSERTITEM, 1, "Item #2"
CONTROLCMD w1, LISTVIEW_4, @LVINSERTCOLUMN, 0, "Items"
CONTROLCMD w1, LISTVIEW_4, @LVSETCOLWIDTH, 0, 260
CONTROLCMD w1, LISTVIEW_4, @LVINSERTITEM, 0, "Item #1"
CONTROLCMD w1, LISTVIEW_4, @LVINSERTITEM, 1, "Item #2"
ENDSUB
' BEFORE THE WINDOW IS CLOSED
SUB OnFinish()
BufferedPaintUnInit()
IF aeroEnabled THEN
' restore the procedures
SetWindowLong(w1.hwnd, GWL_WNDPROC, oldproc)
SetWindowLong( GETCONTROLHANDLE(w1, BUTTON_1), GWL_WNDPROC, oldbuttonproc)
SetWindowLong( GETCONTROLHANDLE(w1, LISTVIEW_3), GWL_WNDPROC, oldlistvproc)
ENDIF
CLOSEWINDOW w1
ENDSUB
' ------------------------------------------------------------------------------------
' DRAWING CONTROL FUNCTIONS
' ------------------------------------------------------------------------------------
' PAINT THE MAIN WINDOW
SUB PaintWindow(INT hWin), INT
WINRECT rc
PAINTSTRUCT ptrstructc
HDC devc
HBRUSH brush, oldbrush
GetClientRect(hWin, &rc)
devc = BeginPaint(hWin, &ptrstructc)
' (transparent area)
brush = GetStockObject(BLACK_BRUSH)
oldbrush = SelectObject(devc, brush)
FillRect(devc, &rc, brush)
SelectObject(devc, oldbrush)
' (client area)
rc.left+= leftWidth
rc.top+= topWidth
rc.right-= rightWidth
rc.bottom-= bottomWidth
brush = GetStockObject(WHITE_BRUSH)
oldbrush = SelectObject(devc, brush)
FillRect(devc, &rc, brush)
SelectObject(devc, oldbrush)
EndPaint(hWin, &ptrstructc)
RETURN 0
ENDSUB
' PAINT THE BUTTON
SUB PaintButton(INT hWnd), INT
WINRECT rcClient
GetClientRect(hWnd, &rcClient)
PAINTSTRUCT ps
HDC hdcPaint= BeginPaint(hWnd, &ps)
HTHEME hTheme = OpenThemeData(hWnd, L"Button")
LONG_PTR dwStyle = GetWindowLongPtr(hWnd, GWL_STYLE)
IF hTheme THEN
IF hdcPaint THEN
PatBlt(hdcPaint, 0, 0, rcClient.right-rcClient.left, rcClient.bottom-rcClient.top, BLACKNESS)
int iState = CBS_UNCHECKEDNORMAL
LRESULT dwCheckState = SendMessage(hWnd, BM_GETCHECK, 0, NULL)
POINT pt
WINRECT rc
GetWindowRect(hWnd, &rc)
GetCursorPos(&pt)
BOOL bHot = PtInRect(&rc, pt)
BOOL bFocus = FALSE
IF GetFocus() = hWnd THEN bFocus = TRUE
int iPartId = BP_PUSHBUTTON
INT c = FALSE
IF GetCapture()=hWnd then c = TRUE
iState = PBS_NORMAL
IF dwStyle&WS_DISABLED = WS_DISABLED THEN
iState = PBS_DISABLED
ELSE
IF dwStyle&BS_DEFPUSHBUTTON = BS_DEFPUSHBUTTON THEN
iState = PBS_DEFAULTED
ENDIF
IF c=TRUE AND bHot=TRUE THEN
iState = PBS_PRESSED
ELSEIF c=TRUE OR bHot=TRUE THEN
iState = PBS_HOT
ENDIF
ENDIF
WINRECT rcPaint = rcClient
DrawThemeBackground(hTheme, hdcPaint, iPartId, iState, &rcPaint, NULL)
GetThemeBackgroundContentRect(hTheme, hdcPaint, iPartId, iState, &rcPaint, &rc)
HFONT hFontOld = SendMessage(hWnd, WM_GETFONT, 0, 0)
if hFontOld THEN hFontOld = SelectObject(hdcPaint, hFontOld)
int iLen = GetWindowTextLength(hWnd)
IF iLen THEN
iLen+=5
LPWSTR szText = LocalAlloc(LPTR, LEN(WCHAR)*iLen)
IF szText THEN
iLen = GetWindowTextW(hWnd, szText, iLen)
IF iLen THEN
DWORD dwFlags = DT_SINGLELINE | DT_CENTER | DT_VCENTER
DrawThemeText(hTheme, hdcPaint, iPartId, iState, *<wstring>szText, -1, dwFlags, 0, &rc)
IF bFocus THEN
WINRECT rcDraw = rcClient
InflateRect(&rcDraw, -3, -3)
DrawFocusRect(&rcDraw, hdcPaint)
ENDIF
ENDIF
LocalFree(szText)
ENDIF
IF hFontOld THEN
SelectObject(hdcPaint, hFontOld)
hFontOld = NULL
ENDIF
ENDIF
ENDIF
ENDIF
CloseThemeData(hTheme)
EndPaint(hWnd, &ps)
RETURN 0
ENDSUB
' PAINT THE LISTVIEW
SUB PaintListview(INT hWnd), INT
WINRECT rc
GetWindowRect(hWnd, &rc)
MapWindowPoints(NULL, hWnd, &rc, 2)
PAINTSTRUCT ps
HDC dc= BeginPaint(hWnd, &ps)
HDC hdcPaint = 0
HPAINTBUFFER hBufferedPaint = BeginBufferedPaint(dc, rc, BPBF_TOPDOWNDIB, NULL, &hdcPaint)
IF hdcPaint THEN
BufferedPaintSetAlpha(hBufferedPaint, &rc, 0x00)
PatBlt(hdcPaint, 0, 0, rc.right-rc.left, rc.bottom-rc.top, BLACKNESS)
PatBlt(hdcPaint, 0, 0, rc.right-rc.left, rc.bottom-rc.top, PATCOPY)
InflateRect(rc, -1, -1)
' Tell the control to paint itself
SendMessage(hWnd, WM_PRINTCLIENT, hdcPaint, PRF_CLIENT|PRF_ERASEBKGND |PRF_NONCLIENT|PRF_CHECKVISIBLE)
' draw the border
InflateRect(rc, 1, 1)
FrameRect(hdcPaint, rc, GetStockObject(BLACK_BRUSH))
' Make every pixel opaque
BufferedPaintMakeOpaque(hBufferedPaint, rc)
EndBufferedPaint(hBufferedPaint, TRUE)
ENDIF
EndPaint(hWnd, &ps)
RETURN 0
ENDSUB
' ------------------------------------------------------------------------------------
' DESKTOP WINDOW MANAGER FUNCTIONS
' ------------------------------------------------------------------------------------
SUB IsGlassAvailable(), INT
' TODO: set vistaorAbove = 0 if the OS is xp or less
int vistaorAbove = 1
INT enabled = 0
IF vistaorAbove THEN
DwmIsCompositionEnabled(&enabled)
ENDIF
RETURN enabled
ENDSUB
SUB SetGlassEffect(int hWin, OPT INT left=0, OPT INT top=0, OPT INT right=0, OPT INT bottom=0), INT
IF IsGlassAvailable() = 1 AND hWin>0 THEN
DIM m as MARGINS
m.cxLeftWidth =left
m.cxRightWidth =right
m.cyTopHeight= top
m.cyBottomHeight=bottom
DwmExtendFrameIntoClientArea(hWin, &m)
RETURN 1
END IF
RETURN 0
ENDSUB