PureBasic Forums - English

Code: Select all

; PureBasic-Lounge.de 
; Author: Hroudtwolf
; Date: 18. October 2007
; OS: Windows
; Demo: No

Prototype.l pCallOldProc (hWnd.l , lMsgID.l , wParam.l , lParam.l)

Structure tGADGET
   lColor    .l
   lBackColor.l
   sText     .s
   lState    .l
   *OProc    .pCallOldProc
EndStructure 

Procedure.l _ColorTextButton_Callback (hWnd.l , lMsgID.l , wParam.l , lParam.l)
   Protected *GadgetData.tGADGET
   Protected PS         .PAINTSTRUCT
   Protected RC         .RECT
   Protected RC2        .RECT
   Protected lptm       .TEXTMETRIC
   Protected lTextWidth .l
   Protected lTextHeight.l
   Protected hBrush     .l
   
   *GadgetData = GetProp_(hWnd , "ctb_data")
   If Not *GadgetData
      ProcedureReturn #Null
   EndIf
   Select lMsgID
      Case #WM_PAINT
      If Not BeginPaint_(hWnd , PS)
         ProcedureReturn *GadgetData\OProc (hWnd , lMsgID , wParam , lParam)
      EndIf
      
      GetClientRect_(hWnd , RC)
      
      DrawFrameControl_(PS\hDc , RC , #DFC_BUTTON , #DFCS_BUTTONPUSH | *GadgetData\lState)
          
      RC2\left   = GetSystemMetrics_(#SM_CXEDGE)
      RC2\top    = GetSystemMetrics_(#SM_CYEDGE)
      RC2\right  = RC\right - GetSystemMetrics_(#SM_CXEDGE)
      RC2\bottom = RC\bottom - GetSystemMetrics_(#SM_CYEDGE)
      hBrush = CreateSolidBrush_(*GadgetData\lBackColor)      
      FillRect_(PS\hDc , RC2 , hBrush)
      DeleteObject_(hBrush)
      
      
      
      SelectObject_(PS\hDc , GetStockObject_(#SYSTEM_FONT))   
      GetTextMetrics_(PS\hDc , lptm)  
      lTextWidth  = lptm\tmAveCharWidth * Len (*GadgetData\sText)
      lTextHeight = lptm\tmHeight
      SetBkMode_(PS\hDc , #TRANSPARENT)
      SetTextColor_(PS\hDc , *GadgetData\lColor)
      TextOut_(PS\hDc , (RC\right / 2) - (lTextWidth / 2) , (RC\bottom / 2) - (lTextHeight / 2) , *GadgetData\sText , Len (*GadgetData\sText))
            
      EndPaint_(hWnd , PS)
      
      Case #WM_LBUTTONDOWN , #WM_MOUSEMOVE
      If wParam = #MK_LBUTTON
         SetCapture_(hWnd)
         *GadgetData\lState = #DFCS_PUSHED
         InvalidateRect_(hWnd , #Null , #False)
      EndIf
      
      Case #WM_LBUTTONUP
      ReleaseCapture_()
      *GadgetData\lState = #Null
      InvalidateRect_(hWnd , #Null , #False)

   EndSelect
   
   ProcedureReturn *GadgetData\OProc (hWnd , lMsgID , wParam , lParam)
EndProcedure

Procedure.l ColorTextButton (lGadgedID.l , lX.l , lY.l , lWidth.l , lHeight.l , sText.s , lColor.l , lBackColor.l)
   Protected *GadgetData.tGADGET
   Protected hGadget    .l
   Protected lResult    .l
   
   *GadgetData = AllocateMemory (SizeOf (tGADGET))
   If Not *GadgetData
      ProcedureReturn #Null
   EndIf
   
   *GadgetData\sText      = sText
   *GadgetData\lColor     = lColor
   *GadgetData\lBackColor = lBackColor
   
   If lGadgedID = #PB_Any
      lResult = ImageGadget (#PB_Any , lX.l , lY.l , lWidth.l , lHeight , #Null)
      hGadget = GadgetID (lResult)
   Else
      hGadget = ImageGadget (lGadgedID , lX.l , lY.l , lWidth.l , lHeight , #Null)
      lResult = hGadget
   EndIf
   
   SetWindowLong_(hGadget , #GWL_STYLE , GetWindowLong_(hGadget , #GWL_STYLE) & (~#SS_BITMAP))
   
   SetProp_(hGadget , "ctb_data" , *GadgetData)
   
   *GadgetData\OProc = SetWindowLong_(hGadget , #GWL_WNDPROC , @_ColorTextButton_Callback ())
   
   InvalidateRect_(hGadget , #Null , #True)
   
   ProcedureReturn lResult
EndProcedure

;---- Test ---------------------------------------------------------------

If OpenWindow(0, 0, 0, 220, 160, "ColorTextButton", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   
   CreateGadgetList(WindowID(0))  
   ColorTextButton (1 , 10 , 10  , 200 , 20 , "Test-Button" , $A68759 , $780301)
   ColorTextButton (2 , 10 , 40  , 200 , 20 , "Test-Button" , $656DFF , $000679)
   ColorTextButton (3 , 10 , 70  , 200 , 20 , "Test-Button" , $70E9F5 , $0A7F8A)
   ColorTextButton (4 , 10 , 100 , 200 , 40 , "Test-Button" , $9DFAC7 , $307F54)
      
   Repeat
      Select WaitWindowEvent()
         Case #PB_Event_CloseWindow
         End
         Case #PB_Event_Gadget
         Debug "Gadget: " + Str(EventGadget ())
      EndSelect
   ForEver
EndIf