Page 1 of 1

Fancy ListIcon (Windows)

Posted: Thu Sep 29, 2011 9:24 am
by RASHAD
XP Skin must be enabled

1- Fancy Header
2- Enable-Disable Header without affecting Z-Order

Header Hight tech. by MrMat

Tested with PB 4.6 - x86 Win 7 x64 - XP SP2 x86

Have fun

Code: Select all


Global Header,HHeader,r.RECT,oldproc, newheight

Procedure WndProc(hwnd, uMsg, wParam, lParam)
  If IsWindow(0)
    SetActiveWindow(0)
  EndIf
  GetClientRect_(WindowID(0),r.RECT)
  ClientToScreen_(WindowID(0),p.POINT)
  result = #PB_ProcessPureBasicEvents
  Select uMsg
  
   Case #WM_SIZE,#WM_MOVE;,#WM_PAINT
      ResizeGadget(0,r\left+10,r\top+10,r\right-r\left-20,r\bottom-r\top-45)
      ResizeGadget(1,10,r\bottom-30,80,22) 
      ResizeWindow(1,p\x+11,p\y+11,r\right-r\left-22,HHeader) 
             
  EndSelect
   
  ProcedureReturn result 
EndProcedure

Procedure.l WinProc(hWnd.l, Msg.l, wParam.l, lParam.l)
  result.l = 0
  If Msg = #HDM_LAYOUT
    result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
    *hdlayout.HD_LAYOUT = lParam
    If *hdlayout\prc <> 0
        *rect.RECT = *hdlayout\prc
        *rect\top = HHeader
    EndIf
    If *hdlayout\pwpos <> 0
        *windowpos.WINDOWPOS = *hdlayout\pwpos
        *windowpos\cy = HHeader
    EndIf
  Else
     result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
  EndIf
  ProcedureReturn result
EndProcedure


HHeader = 30

If OpenWindow(0, 0, 0, 640, 300, "ListIconGadgets", #PB_Window_SystemMenu |#PB_Window_SizeGadget| #PB_Window_ScreenCentered)
    
  ListIconGadget(0,  10,  10, 620,255, "Column 0", 100,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
  ButtonGadget(1,10,270,80,22,"Ena\Dis",#PB_Button_Toggle)
    Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
    oldproc = SetWindowLongPtr_(header, #GWL_WNDPROC, @WinProc())
  
    Import "Uxtheme.lib"
        SetWindowTheme(Window.l, Body.p-unicode, Title.p-unicode)                                                  
    EndImport        

    SetWindowTheme(Header,"", "EXPLORERBAR")
    ClientToScreen_(WindowID(0),p.POINT)
    OpenWindow(1,p\x+10,p\y+10,620,30,"",#WS_POPUP|#PB_Window_BorderLess|#PB_Window_Invisible,Header)
    SetWindowLong_(WindowID(1),#GWL_EXSTYLE,#WS_EX_LAYERED)
    SetLayeredWindowAttributes_(WindowID(1),0,140,#LWA_ALPHA)
    
    For x = 1 To 4
        AddGadgetColumn(0, x, "Column " + Str(x), 100)
    Next
    For x = 0 To 2 
      AddGadgetItem(0, x, "Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4")
    Next
    
    hImg = ImageList_Create_(1, 24, #ILC_COLORDDB, 0, 0)
    SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL,hImg)
    ImageList_Destroy_(hImg)
    
    SetWindowCallback(@WndProc())        
    Repeat
     Select WaitWindowEvent()
      
       Case #PB_Event_CloseWindow
           Quit = 1
      
       Case #PB_Event_Gadget
          Select EventGadget()
            Case 1
              If GetGadgetState(1) = 0
                HideWindow(1,1)
              Else
                HideWindow(1,0)
              EndIf

          EndSelect
     EndSelect 
 Until Quit = 1
 EndIf

Re: Fancy ListIcon (Windows)

Posted: Thu Sep 29, 2011 11:13 am
by Alireza
Very Very Nice RASHAD, Thanks :D

Re: Fancy ListIcon (Windows)

Posted: Thu Sep 29, 2011 2:20 pm
by GG
Nice one.

Snippet must be inserted into Pb Contributions >> Here <<.
What do you think about it RASHAD ?

Re: Fancy ListIcon (Windows)

Posted: Thu Sep 29, 2011 6:01 pm
by RASHAD
@Alireza
Thanks mate

@GG
Thanks mate
I will be glad to do it
You can do it for me and thanks again

Re: Fancy ListIcon (Windows)

Posted: Thu Sep 29, 2011 7:03 pm
by sphinx
Good.

Rashad, Did you get back to Egypt?!
If so then we can meet ;)

Re: Fancy ListIcon (Windows)

Posted: Fri Sep 30, 2011 7:14 am
by RASHAD
@sphinx Hi Egyptian
Thanks man
I was very busy last summer so i could not get into Egypt
But soon I hope we can see each other
Take care

Re: Fancy ListIcon (Windows)

Posted: Sat Oct 01, 2011 7:41 pm
by Kwai chang caine
Thanks for sharing 8)