Make a ComboboxGadget Flat

Share your advanced PureBasic knowledge/code with the community.
nicolaus
Enthusiast
Enthusiast
Posts: 456
Joined: Tue Aug 05, 2003 11:30 pm
Contact:

Make a ComboboxGadget Flat

Post by nicolaus »

Ok here a small example how you can make a Combobox flat.
I hope you like it :wink:

Code: Select all

; Make a Combobox Flat
; for PureBasic 4.x
; by Nico Grüner, forum-nick: "nicolaus"
; 27.05.2007 for german and English PureBasic forum


Global OldComboProc, hdc
Global ps.PAINTSTRUCT
Global rect.RECT
Global rect2.RECT
Global pt.POINT
Global fMouseDown
Global fButtonDown
fMouseDown   = #False
fButtonDown  = #False



Macro LOWORD(Value)
  Value & $FFFF
EndMacro
Macro HIWORD(Value)
  (Value >> 16) & $FFFF
EndMacro
 
Procedure FlatComboProc( hwnd,  msg, wParam,  lParam)
  OldComboProc = GetWindowLong_(hwnd, #GWL_USERDATA)
  
  Select msg
    Case #WM_PAINT
      If wParam = 0		
        hdc = BeginPaint_(hwnd, ps)
      Else
        hdc = wParam
      EndIf
      
      GetClientRect_(hwnd, rect)
      InflateRect_(rect, -GetSystemMetrics_(#SM_CXEDGE), -GetSystemMetrics_(#SM_CYEDGE))
      rect\right = rect\right - GetSystemMetrics_(#SM_CXVSCROLL)
      IntersectClipRect_(hdc, rect\left, rect\top, rect\right, rect\bottom)
      
      CallWindowProc_(OldComboProc, hwnd, msg, hdc, lParam)
      
      SelectClipRgn_(hdc, null)
      rect\right = rect\right + GetSystemMetrics_(#SM_CXVSCROLL)
      
      ExcludeClipRect_(hdc, rect\left, rect\top, rect\right, rect\bottom)
      
      GetClientRect_(hwnd, rect2)
      FillRect_(hdc, rect2, GetSysColorBrush_(#COLOR_3DSHADOW))
      
      SelectClipRgn_(hdc, #Null)
      rect\left = rect\right - GetSystemMetrics_(#SM_CXVSCROLL)
      
      If fButtonDown
        DrawFrameControl_(hdc, rect, #DFC_SCROLL, #DFCS_SCROLLCOMBOBOX|#DFCS_FLAT|#DFCS_PUSHED)
      Else
        DrawFrameControl_(hdc, rect, #DFC_SCROLL, #DFCS_SCROLLCOMBOBOX|#DFCS_FLAT)
      EndIf
        
      If wParam = 0
        EndPaint_(hwnd, ps)
      EndIf
      ProcedureReturn 0
    Case #WM_LBUTTONDOWN
      
      pt\x = LOWORD(lParam)
      pt\y = HIWORD(lParam)
      
      GetClientRect_(hwnd, rect)
      
      InflateRect_(rect, -GetSystemMetrics_(#SM_CXEDGE), -GetSystemMetrics_(#SM_CYEDGE))
      rect\left = rect\right - GetSystemMetrics_(#SM_CXVSCROLL)
      
      If PtInRect_(@rect, pt\x, pt\y)
        fMouseDown = #True
        fButtonDown = #True
        InvalidateRect_(hwnd, 0, 0)
      EndIf

    Case #WM_LBUTTONUP
      If fMouseDown
        fMouseDown = #False
        fButtonDown = #False
        InvalidateRect_(hwnd, 0, 0)
      EndIf
      
    Case #WM_MOUSEMOVE
      
      pt\x = LOWORD(lParam)
      pt\y = HIWORD(lParam)
      
      If (fMouseDown = (wParam & #MK_LBUTTON))
        GetClientRect_(hwnd, rect)
        InflateRect_(rect, -GetSystemMetrics_(#SM_CXEDGE), -GetSystemMetrics_(#SM_CYEDGE))
        rect\left = rect\right - GetSystemMetrics_(#SM_CXVSCROLL)
        
        If (fButtonDown <> PtInRect_(@rect, pt\x, pt\y))
          fButtonDown = PtInRect_(@rect, pt\x, pt\y)
          InvalidateRect_(hwnd, 0, 0)
        EndIf
      EndIf
      
    Case #WM_LBUTTONUP
      
      If fMouseDown 
        fMouseDown = #False
        fButtonDown = #False
        InvalidateRect_(hwnd, 0, 0)
      EndIf
  EndSelect
  
  ProcedureReturn CallWindowProc_(OldComboProc, hwnd, msg, wParam, lParam)
EndProcedure
Procedure FlatCombobox(hwndCombo)
  OldComboProc = GetWindowLong_(hwndCombo, #GWL_WNDPROC)
  SetWindowLong_(hwndCombo, #GWL_USERDATA, OldComboProc)
  SetWindowLong_(hwndCombo, #GWL_WNDPROC, @FlatComboProc())
EndProcedure


OpenWindow(0,0,0,400,100,"Flat Combobox",#PB_Window_SystemMenu)
CreateGadgetList(WindowID(0))
ComboBoxGadget(0,5,5,300,100)
FlatCombobox(GadgetID(0))

AddGadgetItem(0,-1,"item 1")
AddGadgetItem(0,-1,"item 2")
AddGadgetItem(0,-1,"item 3")
AddGadgetItem(0,-1,"item 4")
AddGadgetItem(0,-1,"item 5")
AddGadgetItem(0,-1,"item 6")
AddGadgetItem(0,-1,"item 7")


Repeat
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Nice one!

Yes, I like it :D

cheers
User avatar
electrochrisso
Addict
Addict
Posts: 980
Joined: Mon May 14, 2007 2:13 am
Location: Darling River

Post by electrochrisso »

Nice

Very helpful for me, since I am getting to know API.

Thanks
Post Reply