Property Box [ Windows ]

[RASHAD]

As a start
Needs more work to do
Adapt it for your needs
Tested with PB 4.6 x86 - x64 & Win 7 x64

Code: Select all

Global *OldProc,PaintFlag,LineSpace,CB,SI

FontSize = 14
UsedFont = LoadFont(0,"Tahoma",FontSize)
LoadFont(1,"Tahoma",FontSize - 3)

hdc = GetDC_(0)
SelectObject_(hdc, UsedFont)    
GetTextMetrics_(hdc, @tm.TEXTMETRIC)

LineSpace = tm\tmheight + 2

CreateImage(0,250,1000) 

StartDrawing(ImageOutput(0))
  Box(0,0,250,1000,$E6FEFE)
  Box(0,0,22,1000,$A1A1A3)
  For i=LineSpace+1 To 1000
     Line(0,i,250,1,$A1A1A3)
     i + LineSpace
  Next 
StopDrawing()

CreateImage(1,250,800)

StartDrawing(ImageOutput(1))
  Box(0,0,250,800,$F3FEFE)
  For i=LineSpace+1 To 800
     Line(0,i,250,1,$A1A1A3)
     i + LineSpace
  Next 
StopDrawing() 

Procedure TreeGadgetSC(hWnd.l,uMsg.l,wParam.l,lParam.l)
   Select uMsg 
      Case #WM_PAINT 
        If  PaintFlag = 0
            PaintFlag = 1           
            BeginPaint_(hWnd,p.PAINTSTRUCT)            
            hDC = GetDC_(hWnd)            
            hbmTemp = CreateCompatibleBitmap_(hDC,250,800)
            hdcMem = CreateCompatibleDC_(hDC) 
            hbmOld = SelectObject_(hdcMem,hbmTemp)
            SendMessage_(hWnd,#WM_PAINT,hdcMem,0)
            If hWnd = GadgetID(1) 
             hBrushBack = CreatePatternBrush_(ImageID(0))
            ElseIf hWnd = GadgetID(2) 
             hBrushBack = CreatePatternBrush_(ImageID(1))
            EndIf
            hBrushOld = SelectObject_(hDC,hBrushBack)
            SetRect_(trc.RECT,0,0,250,800)
            FillRect_(hDC,trc,hBrushBack)
            SelectObject_(hDC,hBrushOld) 
            DeleteObject_(hBrushBack)
            TransparentBlt_(hDC,0,0,250,800,hdcMem,0,0,250,800,GetSysColor_(#COLOR_WINDOW))            
            SelectObject_(hdcMem,hbmOld)          
            DeleteObject_(hbmTemp)
            DeleteDC_(hdcMem) 
            ReleaseDC_(hWnd,hDC)
            EndPaint_(hWnd,p)
            PaintFlag = 0
            ProcedureReturn 0
        Else 
            ProcedureReturn CallWindowProc_(*OldProc,hWnd,uMsg,wParam,lParam) 
        EndIf
      
      
      Case #WM_LBUTTONDOWN
            t.TV_HITTESTINFO  
            GetCursorPos_(@t\pt)          
            ScreenToClient_(hWnd,@t\pt)
            SendMessage_(hWnd,#TVM_HITTEST,0,t)
            SendMessage_(hWnd,#TVM_SELECTITEM,#TVGN_CARET,t\hItem)
            r.RECT\left=t\hItem
            If GetGadgetItemAttribute(1,GetGadgetState(1),#PB_Tree_SubLevel) <> 0
              SendMessage_(hwnd,#TVM_GETITEMRECT,0,@r)
              If hWnd = GadgetID(1)
                 HideWindow(1,1)
                 ResizeGadget(CB,r\left+255,r\top+2,200,LineSpace)                 
              Else                              
                 ResizeGadget(CB,0,0,0,0)
                 HideWindow(1,0)                 
              EndIf
            Else
                 ResizeGadget(CB,0,0,0,0)
                 HideWindow(1,0)   
            EndIf
              
      Case #WM_LBUTTONUP
              SetGadgetState(2,-1)
       
      Case #WM_ERASEBKGND        
            ProcedureReturn #True 
       
      Case #WM_VSCROLL, #WM_MOUSEWHEEL   
            InvalidateRect_(hWnd,0,1)
            ProcedureReturn CallWindowProc_(*OldProc,hWnd,uMsg,wParam,lParam) 
       
      Case #WM_DESTROY 
            SetWindowLongPtr_(hWnd,#GWL_WNDPROC,*OldProc);        
            ProcedureReturn CallWindowProc_(*OldProc,hWnd,uMsg,wParam,lParam) 
;        
      Default; 
            ProcedureReturn CallWindowProc_(*OldProc,hWnd,uMsg,wParam,lParam)
            
   EndSelect 
EndProcedure

OpenWindow(0,0,0,500,600,"Property Box",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

ScrollAreaGadget(0, 10, 10, 480,580, 455, 800, 10,#PB_ScrollArea_BorderLess)
CB = ComboBoxGadget(#PB_Any,0,0,0,0 ,#PB_ComboBox_Editable)
SetGadgetFont(CB, FontID(1))
      For a = 1 To 5
        AddGadgetItem(CB, -1,"ComboBox item " + Str(a))
      Next
      
TreeGadget(1,0,0,255,1000)
SetWindowTheme_(GadgetID(1), @null.w, @null.w)
SetGadgetFont(1, FontID(0))
    
For j = 1 To 30 Step 5
  AddGadgetItem(1,-1,"Untitled Item #" + Str(j),0,0)
  For i=1 To 4 
     AddGadgetItem(1,-1,"Untitled Item #" + Str(i),0,1)
  Next
Next

TreeGadget(2,235,0,250,1000,#PB_Tree_NoLines)
SetWindowTheme_(GadgetID(2), @null.w, @null.w)
SetGadgetFont(2, FontID(0))
SetGadgetColor(2,#PB_Gadget_FrontColor,$101BFD)
SetWindowLongPtr_(GadgetID(2), #GWL_STYLE, GetWindowLongPtr_(GadgetID(2), #GWL_STYLE) | #WS_CLIPSIBLINGS)
SetWindowPos_(GadgetID(2), #HWND_BOTTOM, -1, -1, -1, -1, #SWP_NOSIZE | #SWP_NOMOVE)

For j = 1 To 30 Step 5
  AddGadgetItem(2,-1,"Required Item #" + Str(j),0,0)
  For i=1 To 4 
     AddGadgetItem(2,-1,"Choosen Item #" + Str(i),0,1)
  Next
Next
CloseGadgetList()

OpenWindow(1,270,5,200,580,"",#PB_Window_BorderLess)
SetParent_(WindowID(1),WindowID(0))

*OldProc = SetWindowLongPtr_(GadgetID(1),#GWL_WNDPROC,@TreeGadgetSC())
*OldProc = SetWindowLongPtr_(GadgetID(2),#GWL_WNDPROC,@TreeGadgetSC())

Repeat
 If GetActiveWindow() = 1
    SetActiveWindow(0)
 EndIf
   Select WaitWindowEvent()
   Case #PB_Event_CloseWindow
         Quit = 1
          
   Case #PB_Event_Gadget 
     Select EventGadget() 
      Case 1
           SI = GetGadgetState(1)
             SetGadgetItemState(2, SI,GetGadgetItemState(1,SI))      
;             
      Case CB
          If GetGadgetItemAttribute(1,GetGadgetState(1),#PB_Tree_SubLevel) <> 0
            If GetGadgetText(CB) <> ""
              SetGadgetItemText(2, SI , GetGadgetText(CB))
            EndIf
            ResizeGadget(CB,0,0,0,0)
            SetGadgetText(CB,"")
          EndIf

; 
     EndSelect     
   EndSelect 
Until Quit = 1

Edit : Code modified a little bit
Edit 2 : Updated

[electrochrisso]

Not bad start RASHAD
Any way to reduce the flickering when moving across the buttons.

[Kwai chang caine]

Cool works RASHAD

I found a little bug
When i select an item in listbox for changing value, and after i click another time on the listbox the listbox appear in the left top, on the "Untitled item #1"

[RASHAD]

- Previous post updated
- Next is a simple one

Code: Select all

Global LineSpace,CB,SI

FontSize = 12
UsedFont = LoadFont(0,"Tahoma",FontSize)
LoadFont(1,"Tahoma",FontSize - 3)

hdc = GetDC_(0)
SelectObject_(hdc, UsedFont)    
GetTextMetrics_(hdc, @tm.TEXTMETRIC)

LineSpace = tm\tmheight + 2

OpenWindow(0,0,0,400,500,"Property Box",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

ScrollAreaGadget(0, 10, 10, 380,480, 360, 475, 10,#PB_ScrollArea_Flat)
CB = ComboBoxGadget(#PB_Any,0,0,0,0 ,#PB_ComboBox_Editable)
SetGadgetFont(CB, FontID(1))
      For a = 1 To 5
        AddGadgetItem(CB, -1,"ComboBox item " + Str(a))
      Next

TreeGadget(1,-1,-1,185,1000)
SetGadgetFont(1, FontID(0))
SetGadgetColor(1,#PB_Gadget_BackColor,$E8FEFE)
SetGadgetColor(1,#PB_Gadget_LineColor,$101BFD)
    
For j = 1 To 30 Step 5
  AddGadgetItem(1,-1,"Untitled Item #" + Str(j),0,0)
  For i=1 To 4 
     AddGadgetItem(1,-1,"Untitled Item #" + Str(i),0,1)
  Next
Next

TreeGadget(2,183,-1,195,1000,#PB_Tree_NoButtons)
SetGadgetFont(2, FontID(0))
SetGadgetColor(2,#PB_Gadget_FrontColor,$161AFE)
SetGadgetColor(2,#PB_Gadget_BackColor,$F1F1F1)
SetWindowLongPtr_(GadgetID(2), #GWL_STYLE, GetWindowLongPtr_(GadgetID(2), #GWL_STYLE) | #WS_CLIPSIBLINGS)
SetWindowPos_(GadgetID(2), #HWND_BOTTOM, -1, -1, -1, -1, #SWP_NOSIZE | #SWP_NOMOVE)

For j = 1 To 30 Step 5
  AddGadgetItem(2,-1,"Required Item #" + Str(j),0,0)
  For i=1 To 4 
     AddGadgetItem(2,-1,"Choosen Item #" + Str(i),0,1)
  Next
Next
CloseGadgetList()

t.TV_HITTESTINFO
Repeat
  Select WaitWindowEvent()
   Case #PB_Event_CloseWindow
         Quit = 1        
          
   Case #PB_Event_Gadget 
    Select EventGadget() 
      Case 1
            GetCursorPos_(@t\pt)
            ScreenToClient_(GadgetID(1),@t\pt)
            SendMessage_(GadgetID(1),#TVM_HITTEST,0,t)
            SendMessage_(GadgetID(1),#TVM_SELECTITEM,#TVGN_CARET,t\hItem)
            SI = GetGadgetState(1)
            ResizeGadget(CB,0,0,0,0)
            SetGadgetItemState(2, SI,GetGadgetItemState(1,SI))
            r.RECT\left= GadgetItemID(1, SI)
            If GetGadgetItemAttribute(1,GetGadgetState(1),#PB_Tree_SubLevel) <> 0              
              SendMessage_(GadgetID(1),#TVM_GETITEMRECT,0,@r)
              ResizeGadget(CB,r\right+24,r\top+2,150,LineSpace)
            EndIf
            r.RECT\left= GadgetItemID(1, CountGadgetItems(1) - 1)            
            SendMessage_(GadgetID(1),#TVM_GETITEMRECT,0,@r)
            If r\bottom > 475
               SetGadgetAttribute(0,#PB_ScrollArea_InnerHeight,r\bottom)
            ElseIf r\bottom < 475
               SetGadgetAttribute(0,#PB_ScrollArea_InnerHeight,475)
            EndIf
            
      Case 2
            SI = GetGadgetState(2)
            SetGadgetItemState(1, SI,GetGadgetItemState(2,SI))
            r.RECT\left= GadgetItemID(2, CountGadgetItems(1) - 1)            
            SendMessage_(GadgetID(2),#TVM_GETITEMRECT,0,@r)
            If r\bottom > 475
               SetGadgetAttribute(0,#PB_ScrollArea_InnerHeight,r\bottom)
            ElseIf r\bottom < 475
               SetGadgetAttribute(0,#PB_ScrollArea_InnerHeight,475)
            EndIf      
;             
      Case CB
          If GetGadgetItemAttribute(1,GetGadgetState(1),#PB_Tree_SubLevel) <> 0
            If GetGadgetText(CB) <> ""
              SetGadgetItemText(2, SI , GetGadgetText(CB))
              ResizeGadget(CB,0,0,0,0)
            EndIf
            SetGadgetText(CB,"")
          EndIf 
    EndSelect     
  EndSelect 
Until Quit = 1

[Kwai chang caine]

The first code have always the flickering, but works better now.
Splendid the second code, much more fluid

Thanks a lot RASHAD for sharing it

[electrochrisso]

Good work RASHAD
The second example works good here too.
Plenty good learning, thanks.