پیام ها

%MAX_TITLE_BUTTONS=8

%B_EDGE=2

 GLOBAL szPropName As String * 255? Or Byte

TYPE CaptionButton

uCmd AS LONG 'command to send when clicked

nRightBorder AS LONG 'Pixels between this button and buttons to the right

hBmp AS LONG 'Bitmap to display

fPressed AS LONG 'Private

END TYPE 

TYPE CustomCaption buttons(%MAX_TITLE_BUTTONS) AS CaptionButton

nNumButtons AS LONG

fMouseDown AS LONG

wpOldProc AS LONG

iActiveButton AS LONG

END TYPE

FUNCTION GetCustomCaption(hwnd) AS  Long

'CustomCaption

FUNCTION=GetProp(hwnd,szPropName) END FUNCTION

FUNCTION MakShort(BYVAL n AS LONG) AS LONG

IF n<=32768 THEN

MakeShort=n:EXIT FUNCTION

MakeShort=-1 *(65535-n) 

End Function

Sub RedrawNC(hwnd) As Long

SetWindowPos hwnd,0,0,0,0,0, SWP_NOMOVE OR SWP_NOSIZE OR SWP_NOZORDER OR SWP_NOACTIVATE OR SWP_DRAWFRAME) 

END SUB

FUNCTION CalcTopEdge(hwnd) AS LONG DIM dwStyle AS Long

dwStyle=GetWindowLong(hwnd,GWL_STYLE)

IF(dwStyle AND  WS_THICKFRAME)

THEN 

FUNCTION=GetSystemMetrics(SM_CYSIZEFRAME)

ELSE

FUNCTION=GetSystemMetrics(SM_CYFIXEDFRAME)

END IF

END FUNCTION

FUNCTION CalcRightEdge(hwnd) AS LONG

DIM dwStyle AS Long

dwStyle=GetWindowLong(hwnd,GWL_STYLE)

IF(dwStyle AND WS_THICKFRAME) THEN

FUNCTION=GetSystemMetrics(SM_CXSIZEFRAME)

ELSE

FUNCTION=GetSystemMetrics(SM_CXFIXEDFRAME)

END IF

END FUNCTION 

GetRightEdgeOffset(ctp * CustomCaption,hwnd) AS LONG

DIM dwStyle As Long

DIM dwExStyle AS Long

DIM nButSize AS LONG

DIM nSysButSize AS LONG

dwStyle=GetWindowLong(hwnd,GWL_STYLE)

dwExStyle=GetWindowLong(hwnd,GWL_EXSTYLE)

nButSize = 0 

nSysButSize=GetSystemMetrics(SM_CXSIZE)-B_EDGE

IF(dwStyle AND WS_SYSMENU) THEN nButSize=nButSize+nSysButSize+B_EDGE

END IF

IF (dwStyle AND (WS_MINIMIZEBOX OR WS_MAXIMIZEBOX) ) THEN

nButSize=nButSize+B_EDGE+nSysButSize * 2 

End if 

FUNCTION=nButSize+CalcRightEdge(hwnd)

GetButtonRect(ctp*CustomCaption, hwnd,idx,rct RECT,fWindowRelative AS LONG)

DIM i AS LONG,re_start AS LONG 

DIM cxBut AS LONG,cyBut AS LONG

DIM xLeft AS LONG,yTop AS LONG

cxBut=GetSystemMetrics(SM_CXSIZE) cyBut=GetSystemMetrics(SM_CYSIZE)

' right-edge starting point of inserted buttons

re_start=GetRightEdgeOffset(ctp,hwnd) 

GetWindowRect hwnd,rct

IF fWindowRelative=True THEN

OffsetRect rct,-1 * rct.Left, -1*rct.Top 

END IF

'Find the correct button - but take into 'account all other buttons. 

LOCAL nRightBorder AS LONG

FOR i = 0 To idx

re_start=re_start+nRightBorder+cxBut -B_EDGE

NEXT

rct.nLeft=rct.nRight-re_start

rct.nTop=rct.nTop+CalcTopEdge(hwnd)+ B_EDGE

rct.nRight=rct.nLeft+cxBut-B_EDGE

rct.nBottom=rct.nTop+cyBut-B_EDGE * 2 END SUB

FUNCTION Caption_NCHitTest(ctp AS CustomCaption PTR, hwnd,wParam, lParam) AS LONG

DIM rct AS RECT

DIM pt AS POINTAPI

DIM i AS LONG

DIM ret AS LONG

pt.x=LOWRD(lParam)

pt.y=HIWRD(lParam)

ret=CallWindowProc(ctp.wpOldProc,hwnd,WM_NCHITTEST,wParam,lParam)

'If the mouse is in the caption, then check to 'see if it is over one of our buttons 

IF (ret=HTCAPTION) THEN

FOR i=0 TO ctp.nNumButtons-1 

GetButtonRect ctp,hwnd,i,rct,FALSE

InflateRect rct,0,B_EDGE

'If the mouse is in any custom button, then 'We need to override the default behaviour.

IF PtInRect(rct,pt.x,pt.y) THEN

Caption_NcHitTest=HTBORDER

END IF

NEXT

END IF

Caption_NcHitTest=ret

END FUNCTION 

FUNCTION Caption_NCPaint(ctp AS CustomCaption,hwnd, hrgn) AS LONG 

DIM rct AS RECT,rct1 AS RECT

DIM fRegionOwner AS LONG

DIM i AS LONG

DIM hdc AS Long

DIM uButType AS LONG

DIM x AS LONG,y AS LONG

DIM hrgn1 AS Long

LOCAL nNumButtons AS LONG 

fRegionOwner=FALSE

GetWindowRect hwnd,rct

x=rct.left

y =rct.top

'Create a region which covers the whole window. This'

must be in screen coordinates'

IF hrgn=1 OR hrgn=0 THEN

(hrgn=CreateRectRgnIndirect(rct

fRegionOwner=TRUE

END IF

FOR i = 0 TO ctp.nNumButtons-1

Get button rectangle in screen coords '

GetButtonRect ctp,hwnd,i,rct1,FALSE 

(hrgn1=CreateRectRgnIndirect(rct1

Cut out a button-shaped hole'

CombineRgn hrgn,hrgn,hrgn,RGN_XOR 

DeleteObject hrgn1

NEXT 

(hdc=GetWindowDC(hwnd

Draw buttons in a loop'
FOR i = 0 TO ctp.nNumButtons-1
Get Button rect in window coords '
GetButtonRect ctp,hwnd,i,rct1,TRUE
uButType=DFCS_BUTTONPUSH
IF ctp.buttons(i).fPressed=True THEN DrawFrameControl hdc,rct,DFC_BUTTON, uButType OR DFCS_PUSHED
ELSE
DrawFrameControl hdc,rct,DFC_BUTTON, uButType
END IF
InflateRect rct1,-2,-2
rct1.Right=rct1.nRight-2
rct1.Bottom=rct1.Bottom-2
IF ctp.buttons(i).fPressed=True THEN OffsetRect rct1,1,1
END IF
NEXT
ReleaseDC hwnd,hdc
IF fRegionOwner=True THEN

DeleteObject hrg

Caption_NCPaint=0

END FUNCTION 

FUNCTION Caption_NCLButtonDown(ctp AS CustomCaption, hwnd,msg, wParam, lParam) AS Long
 'LRESULT
DIM i AS LONG
DIM rct AS RECT
DIM pt AS POINTAPI
pt.x=LOWRD(lParam)
pt.y=HIWRD(lParam)
 'If mouse has been clicked in caption
IF wParam=HTCAPTION THEN
FOR i=0 TO ctp.nNumButtons-1
GetButtonRect ctp,hwnd,i,rct,FALSE
InflateRect rct,0,2
'if clicked in a custom button
IF PtInRect(rct, pt.x,pt.y)=True THEN ctp.iActiveButton=i
ctp.buttons(i).fPressed= TRUE
ctp.fMouseDown=TRUE
SetCapture hwnd
RedrawNC hwnd
FUNCTION= 0:EXIT FUNCTION
END IF
NEXT
END IF
Caption_NCLButtonDown= CallWindowProc(ctp.wpOldProc,hwnd,msg,wParam,lParam)
END FUNCTION

FUNCTION Caption_LButtonUp(ctp AS CustomCaption, hwnd,wParam,lParam) AS LONG
'LRESULT
DIM rct AS RECT
DIM pt AS POINTAPI
DIM uCmd AS LONG
pt.x=LOWRD(lParam)
pt.y= HIWRD(lParam)
ClientToScreen hwnd,pt
IF ctp.fMouseDown=True THEN
ReleaseCapture
GetButtonRect(ctp,hwnd, ctp.iActiveButton,rct,FALSE)
InflateRect rct, 0,2
'if clicked in a custom button
IF PtInRect(rct, pt.x, pt.y)=True THEN
uCmd=ctp.buttons(ctp.iActiveButton).uCmd
SendMessage hwnd,WM_COMMAND, uCmd,MAKDWD(pt.x,pt.y)
END IF ctp.buttons(ctp.iActiveButton).fPressed=FALSE
ctp.fMouseDown=FALSE
RedrawNC hwnd
FUNCTION=0
EXIT FUNCTION
END IF
FUNCTION = CallWindowProc(ctp.wpOldProc,hwnd, WM_LBUTTONUP,wParam,lParam)
END FUNCTION 

FUNCTION Caption_MouseMove(ctp AS CustomCaption,hwnd, wParam, lParam) AS LONG
'LRESULT
DIM rct AS RECT
DIM pt AS POINTAPI
DIM fPressed AS LONG
pt.x=LOWRD(lParam)
pt.y=HIWRD(lParam)
ClientToScreen hwnd,pt
IF ctp.fMouseDown=True THEN
GetButtonRect ctp,hwnd,ctp.iActiveButton,rct,FALSE
InflateRect rct,0,2
fPressed=PtInRect(rct, pt.x,pt.y)
IF fPressed <> ctp.buttons(ctp.iActiveButton).fPressed THEN ctp.buttons(ctp.iActiveButton).fPressed= ctp.buttons(ctp.iActiveButton).fPressed XOR 1
RedrawNC hwnd
END IF
Caption_MouseMove=0:EXIT FUNCTION
END IF
Caption_MouseMove = CallWindowProc(ctp.wpOldProc,hwnd, WM_MOUSEMOVE,wParam,lParam)
END FUNCTION 

FUNCTION Caption_LButtonUp(ctp AS CustomCaption, hwnd,wParam,lParam) AS LONG
'LRESULT
DIM rct AS RECT
DIM pt AS POINTAPI
DIM uCmd AS LONG
pt.x=LOWRD(lParam)
pt.y= HIWRD(lParam)
ClientToScreen hwnd,pt
IF ctp.fMouseDown=True THEN
ReleaseCapture
GetButtonRect(ctp,hwnd, ctp.iActiveButton,rct,FALSE)
InflateRect rct, 0,2
'if clicked in a custom button
IF PtInRect(rct, pt.x, pt.y)=True THEN
uCmd=ctp.buttons(ctp.iActiveButton).uCmd
SendMessage hwnd,WM_COMMAND, uCmd,MAKDWD(pt.x,pt.y)
END IF ctp.buttons(ctp.iActiveButton).fPressed=FALSE
ctp.fMouseDown=FALSE
RedrawNC hwnd
FUNCTION=0
EXIT FUNCTION
END IF
FUNCTION = CallWindowProc(ctp.wpOldProc,hwnd, WM_LBUTTONUP,wParam,lParam)
END FUNCTION