hatte ein bischen Zeit übrig um ein Subclassing für
"CustomCaptionButtons" zu programmieren.
Mit der AddCaptionButton-Funktion könnt ihr zusätzliche
Buttons in der Titelleiste unterbringen. Seht den Source durch -
sollte eigentlich selbsterklärend sein.
Screenshot:
Source:
Code: Alles auswählen
;******************************************************************************
;* Beispiel für zusätzliche Buttons in der Titlebar *
;******************************************************************************
;* Anregung von http://www.catch22.net/tuts/titlebar.asp *
;* PB Portierung von FGK 04/2006 *
;******************************************************************************
#MAX_CAPTION_BUTTONS = 8
#B_EDGE = 2
Global CCPropName.s = "FGK_Subclass"
Dim BM_Handle(#MAX_CAPTION_BUTTONS)
Structure CaptionButton
lpProc.l ;Adresse zu der Gesprungen wird!
nRightBorder.w ;Pixels between this button and buttons to the right
hBmp.l ;Bitmap to display
fPressed.l ;Is the button pressed in or out?.
EndStructure
Structure CustomCaption
nButtons.CaptionButton[#MAX_CAPTION_BUTTONS+1];
nNumButtons.w ;
fMouseDown.l ;is the mouse button being clicked?
wpOldProc.l ;old window procedure
iActiveButton.l ;the button index being clicked.
EndStructure
Declare.l Caption_NCPaint(*ctp.CustomCaption,hwnd,HRGN)
Procedure DebugRect(*r.RECT)
With *r
Debug "ButtonRect..............................."
Debug "L:"+Str(\left)+ " T:"+Str(\top)+ " R:"+ Str(\right)+ " B:"+Str(\bottom)
Debug "........................................."
EndWith
EndProcedure
Procedure.l MakeLong(low,high)
ProcedureReturn low + (high << 16)
EndProcedure
Procedure.l HIWORD(Value)
ProcedureReturn (Value >> 16) & $FFFF
EndProcedure
Procedure.l LOWORD(Value)
ProcedureReturn Value & $FFFF
EndProcedure
Procedure.l GetCustomCaption(hwnd)
ProcedureReturn GetProp_(hwnd,CCPropName)
EndProcedure
Procedure.l CalcTopEdge(hwnd)
dwStyle = GetWindowLong_(hwnd, #GWL_STYLE)
If (dwStyle & #WS_THICKFRAME)
ProcedureReturn GetSystemMetrics_(#SM_CYSIZEFRAME);
Else
ProcedureReturn GetSystemMetrics_(#SM_CYFIXEDFRAME);
EndIf
EndProcedure
Procedure.l CalcRightEdge(hwnd)
dwStyle = GetWindowLong_(hwnd, #GWL_STYLE);
If (dwStyle & #WS_THICKFRAME)
ProcedureReturn GetSystemMetrics_(#SM_CXSIZEFRAME);
Else
ProcedureReturn GetSystemMetrics_(#SM_CXFIXEDFRAME);
EndIf
EndProcedure
Procedure.l GetRightEdgeOffset(*ctp.CustomCaption,hwnd)
dwStyle = GetWindowLong_(hwnd, #GWL_STYLE);
dwExStyle = GetWindowLong_(hwnd, #GWL_EXSTYLE);
nButSize = 0;
nSysButSize.l;
If(dwExStyle & #WS_EX_TOOLWINDOW)
nSysButSize = GetSystemMetrics_(#SM_CXSMSIZE) - #B_EDGE;
If(dwStyle & #WS_SYSMENU)
nButSize + nSysButSize + #B_EDGE;
ProcedureReturn nButSize + CalcRightEdge(hwnd);
EndIf
Else
nSysButSize = GetSystemMetrics_(#SM_CXSIZE) - #B_EDGE;
;// Window has close [x] button. This button has a 2-pixel
;// border on either Size
If(dwStyle & #WS_SYSMENU)
nButSize + nSysButSize + #B_EDGE;
EndIf
If(dwStyle & (#WS_MINIMIZEBOX | #WS_MAXIMIZEBOX) )
nButSize + #B_EDGE + nSysButSize * 2
EndIf
;// a Window can have a question-mark button, but only
;// If it doesn't have any min/max buttons
If(dwExStyle & #WS_EX_CONTEXTHELP)
nButSize + #B_EDGE + nSysButSize;
EndIf
;// Now calculate the Size of the border...aggghh!
ProcedureReturn nButSize + CalcRightEdge(hwnd);
EndIf
EndProcedure
Procedure CenterBitmap(hdc,*rc.RECT,hBitmap.l)
; //
; // If hBitmap is MONOCHROME then
; // whites will be drawn transparently,
; // blacks will be drawn normally
; // So, it will look just like a caption button
; //
; // If hBitmap is > 2 colours, then no transparent
; // drawing will take place....i.e. DIY!
; //
; {
bm.BITMAP
rcDest.RECT
With rcDest
\left = *rc\left
\top = *rc\top
\right = *rc\right
\bottom = *rc\bottom
EndWith
p.POINT ;
; int cx;
; int cy;
; hdc memdc;
; hBitmap hOldBM;
; Size delta;
colorOld.l ;COLORREF
;
If hBitmap
; // center BITMAP in caller's rectangle
GetObject_(hBitmap, SizeOf(bm),bm)
cx = bm\bmWidth
cy = bm\bmHeight
delta_cx = (*rc\right-*rc\left - cx) / 2;
delta_cy = (*rc\bottom-*rc\top - cy) / 2;
If *rc\right-*rc\left > cx
SetRect_(rcDest, *rc\left+delta_cx, *rc\top + delta_cy, 0, 0);
rcDest\right = rcDest\left + cx;
rcDest\bottom = rcDest\top + cy;
p\x = 0;
p\y = 0;
Else
p\x = -delta_cx;
p\y = -delta_cy;
EndIf
; // Select checkmark into memory DC
memdc = CreateCompatibleDC_(hdc)
hOldBM = SelectObject_(memdc, hBitmap)
colorOld = SetBkColor_(hdc, GetSysColor_(#COLOR_3DFACE))
BitBlt_(hdc, rcDest\left, rcDest\top, rcDest\right-rcDest\left, rcDest\bottom-rcDest\top, memdc, p\x, p\y, #SRCCOPY)
SetBkColor_(hdc, colorOld)
SelectObject_(memdc, hOldBM)
DeleteDC_(memdc)
EndIf
EndProcedure
Procedure GetButtonRect(*ctp.CustomCaption,hwnd,idx,*rect.RECT,fWindowRelative.l)
If(GetWindowLong_(hwnd, #GWL_EXSTYLE) & #WS_EX_TOOLWINDOW)
cxBut = GetSystemMetrics_(#SM_CXSMSIZE);
cyBut = GetSystemMetrics_(#SM_CYSMSIZE);
Else
cxBut = GetSystemMetrics_(#SM_CXSIZE);
cyBut = GetSystemMetrics_(#SM_CYSIZE);
EndIf
re_start = GetRightEdgeOffset(*ctp, hwnd);
GetWindowRect_(hwnd, *rect);
If(fWindowRelative)=#True
OffsetRect_(*rect, -*rect\left, -*rect\top);
EndIf
For i = 0 To idx
re_start+*ctp\nButtons[i]\nRightBorder + cxBut - #B_EDGE
Next
With *rect
\left = \right - re_start
\top = \top + CalcTopEdge(hwnd) + #B_EDGE
\right = \left + cxBut - #B_EDGE
\bottom = \top + cyBut - #B_EDGE*2
EndWith
EndProcedure
Procedure RedrawNC(hwnd)
SetWindowPos_(hwnd, 0, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE | #SWP_NOZORDER | #SWP_NOACTIVATE | #SWP_DRAWFRAME)
EndProcedure
Procedure.l Caption_Wrapper(*ctp.CustomCaption,hwnd,msg,wParam,lParam)
;//
;// This is a generic message handler used by WM_SETTEXT And WM_NCACTIVATE.
;// It works by turning off the WS_VISIBLE style, calling
;// the original window Procedure, then turning WS_VISIBLE back on.
;//
;// This prevents the original wndproc from redrawing the caption.
;// Last of all, we paint the caption ourselves With the inserted buttons
ret.l
dwStyle.l
dwStyle = GetWindowLong_(hwnd, #GWL_STYLE);
;//Turn off WS_VISIBLE, so that WM_NCACTIVATE does Not
;//paint our window caption...
SetWindowLong_(hwnd, #GWL_STYLE, dwStyle & ~#WS_VISIBLE);
;//Do the Default thing..
ret = CallWindowProc_(*ctp\wpOldProc, hwnd, msg, wParam, lParam)
;//Restore the original style
SetWindowLong_(hwnd, #GWL_STYLE, dwStyle)
;//paint the whole window frame + caption
Caption_NCPaint(*ctp, hwnd,1);
ProcedureReturn ret;
EndProcedure
Procedure.l Caption_NCLButtonDown(*ctp.CustomCaption,hwnd,msg,wParam,lParam)
rect.RECT
pt.POINT
If wParam = #HTBORDER
pt\x = LOWORD(lParam);
pt\y = HIWORD(lParam);
For i = 0 To *ctp\nNumButtons-1
GetButtonRect(*ctp, hwnd, i, @rect, #False)
InflateRect_(rect, 0,#B_EDGE)
If PtInRect_(rect, pt\x,pt\y)
With *ctp
\iActiveButton = i
\nButtons[i]\fPressed = #True
\fMouseDown = #True
EndWith
RedrawNC(hwnd)
ProcedureReturn 0
EndIf
Next
EndIf
ProcedureReturn CallWindowProc_(*ctp\wpOldProc, hwnd, msg, wParam, lParam)
EndProcedure
Procedure.l Caption_LButtonUp(*ctp.CustomCaption ,hwnd,wParam,lParam)
rect. rect
pt.POINT
pt\x = LOWORD(lParam)
pt\y = HIWORD(lParam)
;ClientToScreen_(hwnd, pt)
If *ctp\fMouseDown
GetButtonRect(*ctp, hwnd, *ctp\iActiveButton,@rect, #False);
InflateRect_(rect, 0, 2);
If PtInRect_(rect, pt\x,pt\y)
*lpProc = *ctp\nButtons[*ctp\iActiveButton]\lpProc
EndIf
*ctp\nButtons[*ctp\iActiveButton]\fPressed = #False
*ctp\fMouseDown = #False
RedrawNC(hwnd)
If *lpProc
CallFunctionFast(*lpProc)
EndIf
ProcedureReturn 0
EndIf
ProcedureReturn CallWindowProc_(*ctp\wpOldProc, hwnd, #WM_LBUTTONUP, wParam, lParam)
EndProcedure
Procedure.l Caption_MouseMove(*ctp.CustomCaption,hwnd,wParam,lParam)
rect.RECT
pt.POINT
fPressed.l
pt\x =LOWORD(lParam)
pt\y =HIWORD(lParam)
ClientToScreen_(hwnd, pt)
If *ctp\fMouseDown
GetButtonRect(*ctp, hwnd, *ctp\iActiveButton,@rect, #False)
InflateRect_(rect, 0, 2)
fPressed = PtInRect_(rect, pt\x,pt\y)
If Not(fPressed) = *ctp\nButtons[*ctp\iActiveButton]\fPressed
*ctp\nButtons[*ctp\iActiveButton]\fPressed =#False
RedrawNC(hwnd);
EndIf
ProcedureReturn 0;
EndIf
ProcedureReturn CallWindowProc_(*ctp\wpOldProc, hwnd, #WM_MOUSEMOVE, wParam, lParam)
EndProcedure
Procedure.l Caption_NCActivate(*ctp.CustomCaption ,hwnd,wParam,lParam)
ProcedureReturn Caption_Wrapper(*ctp, hwnd, #WM_NCACTIVATE, wParam, lParam)
EndProcedure
Procedure.l Caption_SetText(*ctp.CustomCaption ,hwnd,wParam,lParam)
ProcedureReturn Caption_Wrapper(*ctp, hwnd, #WM_SETTEXT, wParam, lParam)
EndProcedure
Procedure.l Caption_NCPaint(*ctp.CustomCaption,hwnd,HRGN)
rect.RECT
rect1.RECT
fRegionOwner.l = #False;
i.l
hdc.l
uButType.l;
hrgn1.l
;
GetWindowRect_(hwnd, @rect)
x = rect\left;
y = rect\top;
;
If(HRGN = 1 );|| HRGN = 0)
HRGN = CreateRectRgnIndirect_(rect)
fRegionOwner = #True;
EndIf
For i = 0 To *ctp\nNumButtons-1
GetButtonRect(*ctp, hwnd, i, @rect1, #False)
hrgn1 = CreateRectRgnIndirect_(rect1)
CombineRgn_(HRGN, HRGN, hrgn1, #RGN_XOR)
DeleteObject_(hrgn1);
Next i
CallWindowProc_(*ctp\wpOldProc, hwnd, #WM_NCPAINT, HRGN, 0)
hdc = GetWindowDC_(hwnd);
For i = 0 To *ctp\nNumButtons-1
GetButtonRect(*ctp, hwnd, i, @rect1, #True)
uButType = #DFCS_BUTTONPUSH;
If *ctp\nButtons[i]\fPressed
DrawFrameControl_(hdc, rect1, #DFC_BUTTON, uButType | #DFCS_PUSHED)
Else
DrawFrameControl_(hdc, rect1, #DFC_BUTTON, uButType)
EndIf
If *ctp\nButtons[i]\hBmp
InflateRect_(rect1, -2, -2);
rect1\right-1
rect1\bottom-1
If *ctp\nButtons[i]\fPressed
OffsetRect_(rect1, 1, 1)
EndIf
CenterBitmap(hdc, rect1, *ctp\nButtons[i]\hBmp)
EndIf
Next i
ReleaseDC_(hwnd, hdc);
If(fRegionOwner)
DeleteObject_(HRGN);
EndIf
ProcedureReturn 0;
EndProcedure
Procedure.l Caption_NCHitTest(*ctp.CustomCaption ,hwnd, wParam,lParam)
rect.RECT
pt.POINT
i.l
ret.l
ret = CallWindowProc_(*ctp\wpOldProc, hwnd, #WM_NCHITTEST, wParam, lParam);
If ret = #HTCAPTION
pt\x = LOWORD(lParam)
pt\y = HIWORD(lParam)
For i = 0 To *ctp\nNumButtons-1
GetButtonRect(*ctp, hwnd, i, @rect, #False);
InflateRect_(rect, 0, #B_EDGE);
If PtInRect_(rect, pt\x,pt\y)
;Debug "Button "+Str(i)
ProcedureReturn #HTBORDER
EndIf
Next
EndIf
ProcedureReturn ret
EndProcedure
Procedure.l CustomCaptionProc(hwnd,msg,wParam,lParam)
*ctp.CustomCaption = GetCustomCaption(hwnd)
Select msg
Case #WM_NCDESTROY
SetWindowLong_(hwnd,#GWL_WNDPROC,*ctp\wpOldProc)
FreeMemory(*ctp)
ProcedureReturn
Case #WM_NCHITTEST
ProcedureReturn Caption_NCHitTest(*ctp,hwnd, wParam,lParam)
Case #WM_NCACTIVATE
ProcedureReturn Caption_NCActivate(*ctp, hwnd, wParam, lParam)
Case #WM_SETTEXT
ProcedureReturn Caption_SetText(*ctp, hwnd, wParam, lParam)
Case #WM_NCPAINT
ProcedureReturn Caption_NCPaint(*ctp, hwnd, wParam)
Case #WM_NCLBUTTONDOWN
ProcedureReturn Caption_NCLButtonDown(*ctp, hwnd, msg, wParam, lParam)
Case #WM_NCLBUTTONUP
ProcedureReturn Caption_LButtonUp(*ctp, hwnd, wParam, lParam)
Case #WM_MOUSEMOVE
ProcedureReturn Caption_MouseMove(*ctp, hwnd, wParam, lParam)
EndSelect
ProcedureReturn CallWindowProc_(*ctp\wpOldProc,hwnd,msg,wParam,lParam)
EndProcedure
Procedure.l AddCaptionButton(hwnd.l,*Proc.l,nBorder.l,hBmp.l)
*ctp.CustomCaption = GetCustomCaption(hwnd)
Result=#False
If *ctp=0 ;Erster Button? Dann Speicher holen und init!
*ctp=AllocateMemory(SizeOf(CustomCaption))
If *ctp
With *ctp
\nNumButtons=0
\fMouseDown = #False
\wpOldProc=SetWindowLong_(hwnd,#GWL_WNDPROC,@CustomCaptionProc())
EndWith
SetProp_(hwnd,CCPropName,*ctp)
Result=#True
EndIf
EndIf
With *ctp
idx = \nNumButtons
If idx<#MAX_CAPTION_BUTTONS
\nButtons[idx]\hBmp = hBmp
\nButtons[idx]\nRightBorder = nBorder
\nButtons[idx]\lpProc = *Proc
\nButtons[idx]\fPressed = fPressed
\nNumButtons+1
Result=#True
EndIf
EndWith
RedrawNC(hwnd)
ProcedureReturn Result
EndProcedure
Procedure.l RemoveCaptionButton(hwnd.l)
*ctp.CustomCaption = GetCustomCaption(hwnd)
If(*ctp = 0)
ProcedureReturn #False
EndIf
If *ctp\nNumButtons > 0
*ctp\nNumButtons-1
RedrawNC(hwnd)
EndIf
ProcedureReturn #True
EndProcedure
Procedure.l DummyProc_0()
MessageRequester("CustomCaption","CaptionButton 1")
EndProcedure
Procedure.l DummyProc_1()
MessageRequester("CustomCaption","CaptionButton 2")
EndProcedure
Procedure.l DummyProc_2()
MessageRequester("CustomCaption","CaptionButton 3")
EndProcedure
*hwnd=OpenWindow(0,100,300,400,200,"Testfenster",#PB_Window_SystemMenu|#PB_Window_MaximizeGadget)
If CreateGadgetList(WindowID(0))
ButtonGadget (1, 10, 10, 200, 20, "Click me")
CheckBoxGadget(2, 10, 40, 200, 20, "Check me")
EndIf
BM_Handle(0)=Loadbitmap_(0,#OBM_CHECK)
AddCaptionButton(WindowID(0),@DummyProc_0(),2,BM_Handle(0))
BM_Handle(1)=Loadbitmap_(0,#OBM_LFARROW)
AddCaptionButton(WindowID(0),@DummyProc_1(),2,BM_Handle(1))
BM_Handle(2)=Loadbitmap_(0,#OBM_COMBO )
AddCaptionButton(WindowID(0),@DummyProc_2(),2,BM_Handle(2))
Repeat
Event = WaitWindowEvent()
Delay(1)
Until Event = #PB_Event_CloseWindow
For i = 0 To #MAX_CAPTION_BUTTONS
If BM_Handle(i)>0
RemoveCaptionButton(WindowID(0))
DeleteObject_(BM_Handle(i))
EndIf
Next i
End
Grüße
FGK
.
