PureBoard

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