PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PureBasic Listview Deluxe

https://www.purebasic.fr/english/viewtopic.php?t=37113

Page 1 of 1

PureBasic Listview Deluxe

Posted: Thu Apr 16, 2009 5:47 pm
by RASHAD
Another implementation to the Listview fixed column arena

Remember to disable the bloody debugger

Code: Select all

If OSVersion() < 50
MessageRequester("Error","Window 2000 and higher only", #MB_ICONERROR)
End
EndIf

DataSection 
Image2:
  IncludeBinary "Close.bmp"
Image3:
  IncludeBinary "Max.bmp"
Image4:
  IncludeBinary "Min.bmp"
Image5:
  IncludeBinary "Rest.bmp"
EndDataSection

LoadFont(0, "Marlett", 16)
LoadFont(1, "Arial", 14)
cursor0 = LoadCursor_(0,#IDC_SIZEALL)
cursor1 = LoadCursor_(0,#IDC_HAND)

Global rfont,hfont,hfonth,rfonth,AnsiString.s,UniString.s,RFontS,HFontS,Turn
Global WinX,WinY,WinW,WinH,WinXX,WinYY,WinWW,WinHH,maxflag,bw,color
Global Image2,Image3,Image4,Image5
Global Dim ColW(0)

#CDDS_ITEMPREPAINT = #CDDS_ITEM|#CDDS_PREPAINT 
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 


Procedure IsMouseOver(wnd)                                    ;Mouse over gadget
        GetWindowRect_(wnd,re.RECT) 
        GetCursorPos_(pt.POINT) 
        Result = PtInRect_(re,pt\y<<32+pt\x) 
    ProcedureReturn Result 
EndProcedure

ProcedureDLL.l Ansi2Uni(string.s) ; Converts normal (Ansi) string To Unicode 
  *out = AllocateMemory(Len(string)*4) 
  MultiByteToWideChar_(#CP_ACP, 0, string, -1, *out, Len(string))  
  ProcedureReturn *out  
EndProcedure

Procedure RHR_F_St_Sz( hfontn$,hh.l,hfflag.l,rfontn$,rh.l,rfflag.l)
      
      hfonth = hh
      rfonth = rh
      rfont = LoadFont(2, rfontn$, rfonth,rfflag)
      SendMessage_(GadgetID(10), #WM_SETFONT, rfont, 1)
      If hfonth = 0
      SetWindowLong_(GadgetID(10), #GWL_STYLE, GetWindowLong_(GadgetID(10), #GWL_STYLE)|#LVS_NOCOLUMNHEADER)
      Goto noheader
      EndIf
      Header_1 = SendMessage_(GadgetID(10), #LVM_GETHEADER, 0, 0)
      SetWindowTheme_(Header_1, @null.w, @null.w)
      hfont = LoadFont(3, hfontn$, hfonth,hfflag)
      SendMessage_(Header_1, #WM_SETFONT, hfont, 1)
       If OpenLibrary(0, "UxTheme.dll") = 0
           MessageRequester("Error", "Couldn't open UxTheme.dll")
       Else
          *f = GetFunction(0, "IsThemeActive") 
          If *f
            newth = GetFunction(0, "SetWindowTheme")
            CompilerIf #PB_Compiler_Unicode
            CallFunctionFast(newth, Header_1, @null.w, "HEADER")
            CompilerElse
            CallFunctionFast(newth, Header_1, @null.w, Ansi2Uni("HEADER"))
            CompilerEndIf
          EndIf     
       EndIf
      CloseLibrary(0)
    noheader:
        
EndProcedure  

Procedure NewSize()
    
        ResizeWindow(hWnd,WinX,WinY,WinW,WinH)
        ResizeGadget(1,bw/2,bw/2,WinW-bw,WinH-bw)      
        ResizeGadget(2,WinW-bw-30,5, 25, 25)
        ResizeGadget(3,WinW-bw-54,5, 25, 25)
        ResizeGadget(4,WinW-bw-78,5, 25, 25)
        ResizeGadget(6,WinW/2-bw/2-155, 5,290,25)
        ResizeGadget(10,10,40,WinW-bw-20,WinH-bw-120)
        ResizeGadget(30,WinW/2-80,WinH-50,30,22)
        ResizeGadget(31,WinW/2+40,WinH-50,30,22)        
                
EndProcedure

Procedure WinCallback(hWnd, msg, wParam, lParam)
    ShowScrollBar_(GadgetID(10),#SB_HORZ,0)
  
  result = #PB_ProcessPureBasicEvents
        
    Select msg
    
       Case #WM_NOTIFY
   
            *NMHDR.NMHDR = lParam    
              Select *NMHDR\code 
                Case #NM_CUSTOMDRAW 
                  *LVCDHeader.NMLVCUSTOMDRAW = lParam 
                  If *LVCDHeader\nmcd\hdr\hWndFrom = GadgetID(10)
                    Select *LVCDHeader\nmcd\dwDrawStage 
                      Case #CDDS_PREPAINT
                         ;result = #CDRF_NOTIFYITEMDRAW               
                      Case #CDDS_ITEMPREPAINT
                         result = #CDRF_NOTIFYSUBITEMDRAW
                      Case #CDDS_SUBITEMPREPAINT 
                          Row = *LVCDHeader\nmcd\dwItemSpec 
                          Col = *LVCDHeader\iSubItem 
                          If Col=0 
                            SelectObject_(*LVCDHeader\nmcd\hDC, rfont) 
                          Else 
                            SelectObject_(*LVCDHeader\nmcd\hDC, rfont) 
                          EndIf
                          If (Row/2) * 2 = Row 
                            *LVCDHeader\clrTextBk = $D6FFFF 
                            If Col = 2 
                              *LVCDHeader\clrText = $FF0000
                            EndIf 
                          Else 
                            *LVCDHeader\clrTextBk = $CEF6F5
                            If Col = 2 
                              *LVCDHeader\clrText = $FF0000
                            EndIf 
                          EndIf           
                              result = #CDRF_NEWFONT
                    EndSelect
               EndIf
              EndSelect
             
             
      Case  #WM_SIZE,#WM_MOVE,#WM_PAINT
            WinW = WindowWidth(0) 
            WinH = WindowHeight(0)
            WinX = WindowX(0)
            WinY = WindowY(0)        
            NewSize()
            InvalidateRect_(GadgetID(10),0,#True)
              
                  
      Case #WM_SETTINGCHANGE               ;Maximum Mode Considering Taskbar Position        
         If Maxflag = 1
            SystemParametersInfo_(#SPI_GETWORKAREA, 0, @desk.RECT, 0)
            WinW = desk\right - desk\left
            WinH = desk\bottom - desk\top
            WinX = desk\left
            WinY = desk\top
            NewSize()
          EndIf
          
          
      Case #WM_GETMINMAXINFO
            GetWindowRect_(hWnd,r.RECT)
            *pMinMax.MINMAXINFO = lParam
            *pMinMax\ptMinTrackSize\x=648
            *pMinMax\ptMinTrackSize\y=488
            *pMinMax\ptMaxTrackSize\x=GetSystemMetrics_(#SM_CXSCREEN)
            *pMinMax\ptMaxTrackSize\y=GetSystemMetrics_(#SM_CYSCREEN)
            
    
        EndSelect
              
  ProcedureReturn result
  
EndProcedure

WinW = 640
WinH = 480
WinX = 0
WinY = 0
Maxflag = 0
AnsiString.s = "HEADER" 
UniString.s = Space (13)
HFontS=32                                                                             ;New Header Font Size
RFontS=14
Turn = 1 

If OSVersion() = #PB_OS_Windows_XP Or OSVersion() = #PB_OS_Windows_2000 Or OSVersion() = #PB_OS_Windows_Server_2003 Or (OSVersion() > 65 And IsThemeActive_() = 0)
bw = 8
color = GetSysColor_(#COLOR_ACTIVECAPTION	)              ;Get ActiveCaption Color
Else 
bw = 0
color = $D0FEFE
EndIf

hWnd = OpenWindow(0,0,0,WinW,WinH,"No Window Icon",#PB_Window_BorderLess|#PB_Window_ScreenCentered|#WS_THICKFRAME)
hBrush = CreateSolidBrush_(color)                                                                 ;Make it the background color for OS demand
SetClassLong_(hWnd, #GCL_HBRBACKGROUND, hBrush)
ContainerGadget(1,0,0,0,0,#PB_Container_BorderLess)
ButtonImageGadget(2,0,0,0,0,CatchImage(2, ?Image2))
ButtonImageGadget(3,0,0,0,0,CatchImage(3, ?Image3))
ButtonImageGadget(4,0,0,0,0,CatchImage(4, ?Image4))
TextGadget(6,0,0,0,0, "PureBasic Listview Deluxe",#SS_CENTERIMAGE | #SS_CENTER| #WS_BORDER)
SetGadgetFont(6, FontID(1))                                                                       ; Set the loaded Arial 16 font as new standard
SetGadgetColor(6, #PB_Gadget_FrontColor, $0102FE)
SetGadgetColor(6, #PB_Gadget_BackColor, $B5FFFE)
ListGadget = ListIconGadget(10,0,0,0,0,"",0,#PB_ListIcon_FullRowSelect |#PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_GridLines)
SetGadgetColor(10,#PB_Gadget_BackColor,$E3FFFF)
AddGadgetColumn(10,1,"Column 1",250)
AddGadgetColumn(10,2,"Column 2",250)
AddGadgetColumn(10,3,"Column 3",250)
AddGadgetColumn(10,4,"Column 4",250)
AddGadgetColumn(10,5,"Column 5",250)
AddGadgetColumn(10,6,"Column 6",250)
AddGadgetColumn(10,7,"Column 7",250)
ReDim ColW(7)

For i=0 To 100
  AddGadgetItem(10, -1, "Line "+Str(i)+" First gadget column 0"+Chr(10)+"Line "+Str(i)+" col 1"+Chr(10)+"Line "+Str(i)+" col 2"+Chr(10)+"Line "+Str(i)+" col 3"+Chr(10)+"Line "+Str(i)+" col 4"+Chr(10)+"Line "+Str(i)+" col 5"+Chr(10)+"Line "+Str(i)+" col 6"+Chr(10)+"Line "+Str(i)+" col 7")
Next

ButtonGadget(30,WinW/2-80,415,30,25,Chr(51))
SetGadgetFont(30, FontID(0))
ButtonGadget(31,WinW/2+40,415,30,25,Chr(52))
SetGadgetFont(31, FontID(0))

CloseGadgetList()

;RHR_F_St_St(Header_Font_name ,Header_Font_Height ,Header_Font_Style ,Row_Font_name ,Row_Font_Height ,Row_Font_Style)
;Header_Font_Height : HFontS = 0 No Header
;Header_Font_Style / Row_Font_Style : Bold = 256 ,Default = 0 ,Heigh Quality = 16 ,Italic = 512 ,StrikeOut = 8 ,Underline = 4
RHR_F_St_Sz("Tahoma",HFontS,4,"Microsoft Sans Serif",RFontS,0)

HideWindow(0,0)

SetWindowCallback(@WinCallback())

Repeat
 
  Select WaitWindowEvent()   
            

    Case #PB_Event_Gadget
      Select EventGadget()
       
       Case 2                                                 ;Exit Windows
           quit = 1
       
       Case 3                                                 ;Maximum Mode / Restore Mode                              
         If maxflag = 0
           Maxflag = 1
           SetWindowLong_(WindowID(0), #GWL_STYLE, GetWindowLong_(WindowID(0), #GWL_STYLE)&~#WS_THICKFRAME)
           SetGadgetAttribute(3,#PB_Button_Image,CatchImage(3,?Image5)) 
           WinWW = WindowWidth(0)           
           WinHH = WindowHeight(0)
           WinXX = WindowX(0)
           WinYY = WindowY(0)            
           SystemParametersInfo_(#SPI_GETWORKAREA, 0, @desk.RECT, 0)
           WinW = desk\right - desk\left
           WinH = desk\bottom - desk\top - 2
           WinX = desk\left
           WinY = desk\top
           NewSize()           
          ElseIf maxflag = 1
           Maxflag = 0
           SetWindowLong_(WindowID(0), #GWL_STYLE, GetWindowLong_(WindowID(0), #GWL_STYLE)|#WS_THICKFRAME)
           SetGadgetAttribute(3,#PB_Button_Image,CatchImage(3,?Image3))           
           WinW = WinWW
           WinH = WinHH
           WinX = WinXX
           WinY = WinYY
           NewSize()           
           RedrawWindow_(hwnd,#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW)           
          EndIf
       
       Case 4
           SetWindowState(0, #PB_Window_Minimize)
           
       Case 30
          If Turn = 6
          Goto noplus
          EndIf
          Turn = Turn + 1          
          ColW(Turn) = SendMessage_(GadgetID(10),#LVM_GETCOLUMNWIDTH,Turn,0)
          For i = Colw(Turn) To 0 Step - 5   
          SendMessage_(GadgetID(10), #LVM_SETCOLUMNWIDTH, Turn,i)
          ;Delay(2)
          Next
noplus:
       
       Case 31           
           If Turn = 1
           Goto nominus
           EndIf
           For i = 0 To ColW(Turn) Step 5
           SendMessage_(GadgetID(10), #LVM_SETCOLUMNWIDTH, Turn,i)
           ;Delay(2)
           Next
           Turn =Turn -1
 nominus:
          
       
       
      EndSelect       
    
    Case #PB_Event_CloseWindow
      End 
      
    Case  #WM_LBUTTONDOWN                                       ;Move Borderless Windows / Resize Capture         
       If IsMouseOver(GadgetID(2)) <> 1 And IsMouseOver(GadgetID(3)) <> 1 And IsMouseOver(GadgetID(4)) <> 1 And IsMouseOver(GadgetID(10)) <> 1 And maxflag = 0        
        SetCursor_(cursor0)
        SendMessage_(hWnd, #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
       EndIf
              
 
  EndSelect 
   
Until quit
Remember to disable the debugger

RASHAD

Posted: Thu Apr 16, 2009 6:42 pm
by RASHAD
I am sorry for that miss fellows
just put any 4 bmp 24 x 24 pixels
and name it as

1- Close.bmp
2- Max.bmp
3- Min.bmp
4- Rest.bmp

any 4 pictures it does not matter for now

I am sorry again


RASHAD

Posted: Thu Apr 16, 2009 6:57 pm
by RASHAD
I am very sorry fellows
This is a quick solution I do not have the images right now

Please forgive me

Code: Select all

If OSVersion() < 50
MessageRequester("Error","Window 2000 and higher only", #MB_ICONERROR)
End
EndIf

LoadFont(0, "Marlett", 16)
LoadFont(1, "Arial", 14)
cursor0 = LoadCursor_(0,#IDC_SIZEALL)
cursor1 = LoadCursor_(0,#IDC_HAND)

Global rfont,hfont,hfonth,rfonth,AnsiString.s,UniString.s,RFontS,HFontS,Turn
Global WinX,WinY,WinW,WinH,WinXX,WinYY,WinWW,WinHH,maxflag,bw,color
Global Image2,Image3,Image4,Image5
Global Dim ColW(0)

#CDDS_ITEMPREPAINT = #CDDS_ITEM|#CDDS_PREPAINT 
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 


Procedure IsMouseOver(wnd)                                    ;Mouse over gadget
        GetWindowRect_(wnd,re.RECT) 
        GetCursorPos_(pt.POINT) 
        Result = PtInRect_(re,pt\y<<32+pt\x) 
    ProcedureReturn Result 
EndProcedure

ProcedureDLL.l Ansi2Uni(string.s) ; Converts normal (Ansi) string To Unicode 
  *out = AllocateMemory(Len(string)*4) 
  MultiByteToWideChar_(#CP_ACP, 0, string, -1, *out, Len(string))  
  ProcedureReturn *out  
EndProcedure

Procedure RHR_F_St_Sz( hfontn$,hh.l,hfflag.l,rfontn$,rh.l,rfflag.l)
      
      hfonth = hh
      rfonth = rh
      rfont = LoadFont(2, rfontn$, rfonth,rfflag)
      SendMessage_(GadgetID(10), #WM_SETFONT, rfont, 1)
      If hfonth = 0
      SetWindowLong_(GadgetID(10), #GWL_STYLE, GetWindowLong_(GadgetID(10), #GWL_STYLE)|#LVS_NOCOLUMNHEADER)
      Goto noheader
      EndIf
      Header_1 = SendMessage_(GadgetID(10), #LVM_GETHEADER, 0, 0)
      SetWindowTheme_(Header_1, @null.w, @null.w)
      hfont = LoadFont(3, hfontn$, hfonth,hfflag)
      SendMessage_(Header_1, #WM_SETFONT, hfont, 1)
       If OpenLibrary(0, "UxTheme.dll") = 0
           MessageRequester("Error", "Couldn't open UxTheme.dll")
       Else
          *f = GetFunction(0, "IsThemeActive") 
          If *f
            newth = GetFunction(0, "SetWindowTheme")
            CompilerIf #PB_Compiler_Unicode
            CallFunctionFast(newth, Header_1, @null.w, "HEADER")
            CompilerElse
            CallFunctionFast(newth, Header_1, @null.w, Ansi2Uni("HEADER"))
            CompilerEndIf
          EndIf     
       EndIf
      CloseLibrary(0)
    noheader:
        
EndProcedure  

Procedure NewSize()
    
        ResizeWindow(hWnd,WinX,WinY,WinW,WinH)
        ResizeGadget(1,bw/2,bw/2,WinW-bw,WinH-bw)      
        ResizeGadget(2,WinW-bw-30,5, 25, 25)
        ResizeGadget(3,WinW-bw-54,5, 25, 25)
        ResizeGadget(4,WinW-bw-78,5, 25, 25)
        ResizeGadget(6,WinW/2-bw/2-155, 5,290,25)
        ResizeGadget(10,10,40,WinW-bw-20,WinH-bw-120)
        ResizeGadget(30,WinW/2-80,WinH-50,30,22)
        ResizeGadget(31,WinW/2+40,WinH-50,30,22)        
                
EndProcedure

Procedure WinCallback(hWnd, msg, wParam, lParam)
    ShowScrollBar_(GadgetID(10),#SB_HORZ,0)
  
  result = #PB_ProcessPureBasicEvents
        
    Select msg
    
       Case #WM_NOTIFY
   
            *NMHDR.NMHDR = lParam    
              Select *NMHDR\code 
                Case #NM_CUSTOMDRAW 
                  *LVCDHeader.NMLVCUSTOMDRAW = lParam 
                  If *LVCDHeader\nmcd\hdr\hWndFrom = GadgetID(10)
                    Select *LVCDHeader\nmcd\dwDrawStage 
                      Case #CDDS_PREPAINT
                         ;result = #CDRF_NOTIFYITEMDRAW               
                      Case #CDDS_ITEMPREPAINT
                         result = #CDRF_NOTIFYSUBITEMDRAW
                      Case #CDDS_SUBITEMPREPAINT 
                          Row = *LVCDHeader\nmcd\dwItemSpec 
                          Col = *LVCDHeader\iSubItem 
                          If Col=0 
                            SelectObject_(*LVCDHeader\nmcd\hDC, rfont) 
                          Else 
                            SelectObject_(*LVCDHeader\nmcd\hDC, rfont) 
                          EndIf
                          If (Row/2) * 2 = Row 
                            *LVCDHeader\clrTextBk = $D6FFFF 
                            If Col = 2 
                              *LVCDHeader\clrText = $FF0000
                            EndIf 
                          Else 
                            *LVCDHeader\clrTextBk = $CEF6F5
                            If Col = 2 
                              *LVCDHeader\clrText = $FF0000
                            EndIf 
                          EndIf           
                              result = #CDRF_NEWFONT
                    EndSelect
               EndIf
              EndSelect
             
             
      Case  #WM_SIZE,#WM_MOVE,#WM_PAINT
            WinW = WindowWidth(0) 
            WinH = WindowHeight(0)
            WinX = WindowX(0)
            WinY = WindowY(0)        
            NewSize()
            InvalidateRect_(GadgetID(10),0,#True)
              
                  
      Case #WM_SETTINGCHANGE               ;Maximum Mode Considering Taskbar Position        
         If Maxflag = 1
            SystemParametersInfo_(#SPI_GETWORKAREA, 0, @desk.RECT, 0)
            WinW = desk\right - desk\left
            WinH = desk\bottom - desk\top
            WinX = desk\left
            WinY = desk\top
            NewSize()
          EndIf
          
          
      Case #WM_GETMINMAXINFO
            GetWindowRect_(hWnd,r.RECT)
            *pMinMax.MINMAXINFO = lParam
            *pMinMax\ptMinTrackSize\x=648
            *pMinMax\ptMinTrackSize\y=488
            *pMinMax\ptMaxTrackSize\x=GetSystemMetrics_(#SM_CXSCREEN)
            *pMinMax\ptMaxTrackSize\y=GetSystemMetrics_(#SM_CYSCREEN)
            
    
        EndSelect
              
  ProcedureReturn result
  
EndProcedure

WinW = 640
WinH = 480
WinX = 0
WinY = 0
Maxflag = 0
AnsiString.s = "HEADER" 
UniString.s = Space (13)
HFontS=32                                                                             ;New Header Font Size
RFontS=14
Turn = 1 

If OSVersion() = #PB_OS_Windows_XP Or OSVersion() = #PB_OS_Windows_2000 Or OSVersion() = #PB_OS_Windows_Server_2003 Or (OSVersion() > 65 And IsThemeActive_() = 0)
bw = 8
color = GetSysColor_(#COLOR_ACTIVECAPTION	)              ;Get ActiveCaption Color
Else 
bw = 0
color = $D0FEFE
EndIf

hWnd = OpenWindow(0,0,0,WinW,WinH,"No Window Icon",#PB_Window_BorderLess|#PB_Window_ScreenCentered|#WS_THICKFRAME)
hBrush = CreateSolidBrush_(color)                                                                 ;Make it the background color for OS demand
SetClassLong_(hWnd, #GCL_HBRBACKGROUND, hBrush)
ContainerGadget(1,0,0,0,0,#PB_Container_BorderLess)
ButtonGadget(2,0,0,0,0, Chr(114))
SetGadgetFont(2, FontID(0))
ButtonGadget(3,0,0,0,0, Chr(49))
SetGadgetFont(3, FontID(0))
ButtonGadget(4,0,0,0,0, Chr(48))
SetGadgetFont(4, FontID(0))
; ButtonImageGadget(2,0,0,0,0,CatchImage(2, ?Image2))
; ButtonImageGadget(3,0,0,0,0,CatchImage(3, ?Image3))
; ButtonImageGadget(4,0,0,0,0,CatchImage(4, ?Image4))
TextGadget(6,0,0,0,0, "PureBasic Listview Deluxe",#SS_CENTERIMAGE | #SS_CENTER| #WS_BORDER)
SetGadgetFont(6, FontID(1))                                                                       ; Set the loaded Arial 16 font as new standard
SetGadgetColor(6, #PB_Gadget_FrontColor, $0102FE)
SetGadgetColor(6, #PB_Gadget_BackColor, $B5FFFE)
ListGadget = ListIconGadget(10,0,0,0,0,"",0,#PB_ListIcon_FullRowSelect |#PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_GridLines)
SetGadgetColor(10,#PB_Gadget_BackColor,$E3FFFF)
AddGadgetColumn(10,1,"Column 1",250)
AddGadgetColumn(10,2,"Column 2",250)
AddGadgetColumn(10,3,"Column 3",250)
AddGadgetColumn(10,4,"Column 4",250)
AddGadgetColumn(10,5,"Column 5",250)
AddGadgetColumn(10,6,"Column 6",250)
AddGadgetColumn(10,7,"Column 7",250)
ReDim ColW(7)

For i=0 To 100
  AddGadgetItem(10, -1, "Line "+Str(i)+" First gadget column 0"+Chr(10)+"Line "+Str(i)+" col 1"+Chr(10)+"Line "+Str(i)+" col 2"+Chr(10)+"Line "+Str(i)+" col 3"+Chr(10)+"Line "+Str(i)+" col 4"+Chr(10)+"Line "+Str(i)+" col 5"+Chr(10)+"Line "+Str(i)+" col 6"+Chr(10)+"Line "+Str(i)+" col 7")
Next

ButtonGadget(30,WinW/2-80,415,30,25,Chr(51))
SetGadgetFont(30, FontID(0))
ButtonGadget(31,WinW/2+40,415,30,25,Chr(52))
SetGadgetFont(31, FontID(0))

CloseGadgetList()

;RHR_F_St_St(Header_Font_name ,Header_Font_Height ,Header_Font_Style ,Row_Font_name ,Row_Font_Height ,Row_Font_Style)
;Header_Font_Height : HFontS = 0 No Header
;Header_Font_Style / Row_Font_Style : Bold = 256 ,Default = 0 ,Heigh Quality = 16 ,Italic = 512 ,StrikeOut = 8 ,Underline = 4
RHR_F_St_Sz("Tahoma",HFontS,4,"Microsoft Sans Serif",RFontS,0)

HideWindow(0,0)

SetWindowCallback(@WinCallback())

Repeat
 
  Select WaitWindowEvent()   
            

    Case #PB_Event_Gadget
      Select EventGadget()
       
       Case 2                                                 ;Exit Windows
           quit = 1
       
       Case 3                                                 ;Maximum Mode / Restore Mode                              
         If maxflag = 0
           Maxflag = 1
           SetWindowLong_(WindowID(0), #GWL_STYLE, GetWindowLong_(WindowID(0), #GWL_STYLE)&~#WS_THICKFRAME)
           ;SetGadgetAttribute(3,#PB_Button_Image,CatchImage(3,?Image5)) 
           WinWW = WindowWidth(0)           
           WinHH = WindowHeight(0)
           WinXX = WindowX(0)
           WinYY = WindowY(0)            
           SystemParametersInfo_(#SPI_GETWORKAREA, 0, @desk.RECT, 0)
           WinW = desk\right - desk\left
           WinH = desk\bottom - desk\top - 2
           WinX = desk\left
           WinY = desk\top
           NewSize()           
          ElseIf maxflag = 1
           Maxflag = 0
           SetWindowLong_(WindowID(0), #GWL_STYLE, GetWindowLong_(WindowID(0), #GWL_STYLE)|#WS_THICKFRAME)
           ;SetGadgetAttribute(3,#PB_Button_Image,CatchImage(3,?Image3))           
           WinW = WinWW
           WinH = WinHH
           WinX = WinXX
           WinY = WinYY
           NewSize()           
           RedrawWindow_(hwnd,#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW)           
          EndIf
       
       Case 4
           SetWindowState(0, #PB_Window_Minimize)
           
       Case 30
          If Turn = 6
          Goto noplus
          EndIf
          Turn = Turn + 1          
          ColW(Turn) = SendMessage_(GadgetID(10),#LVM_GETCOLUMNWIDTH,Turn,0)
          For i = Colw(Turn) To 0 Step  -10   
          SendMessage_(GadgetID(10), #LVM_SETCOLUMNWIDTH, Turn,i)
          Next
noplus:
       
       Case 31           
           If Turn = 1
           Goto nominus
           EndIf
           For i = 0 To ColW(Turn) Step 10
           SendMessage_(GadgetID(10), #LVM_SETCOLUMNWIDTH, Turn,i)
           ;Delay(2)
           Next
           Turn =Turn -1
 nominus:
          
       
       
      EndSelect       
    
    Case #PB_Event_CloseWindow
      End 
      
    Case  #WM_LBUTTONDOWN                                       ;Move Borderless Windows / Resize Capture         
       If IsMouseOver(GadgetID(2)) <> 1 And IsMouseOver(GadgetID(3)) <> 1 And IsMouseOver(GadgetID(4)) <> 1 And IsMouseOver(GadgetID(10)) <> 1 And maxflag = 0        
        SetCursor_(cursor0)
        SendMessage_(hWnd, #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
       EndIf
              
 
  EndSelect 
   
Until quit
Sorry again boys

RASHAD

Posted: Thu Apr 16, 2009 8:20 pm
by RASHAD
Quick correction :

Replace with

Code: Select all

       Case 30
          If Turn = 6
          Goto noplus
          EndIf
          Turn = Turn + 1          
          ColW(Turn) = SendMessage_(GadgetID(10),#LVM_GETCOLUMNWIDTH,Turn,0)
          For i = Colw(Turn) To 0 Step  -10   
          SendMessage_(GadgetID(10), #LVM_SETCOLUMNWIDTH, Turn,i)
          Next
          SendMessage_(GadgetID(10), #LVM_SETCOLUMNWIDTH, Turn,0)
noplus:
       
       Case 31           
           If Turn = 1
           Goto nominus
           EndIf
           For i = 0 To ColW(Turn) Step 10
           SendMessage_(GadgetID(10), #LVM_SETCOLUMNWIDTH, Turn,i)
           ;Delay(2)
           Next
           SendMessage_(GadgetID(10), #LVM_SETCOLUMNWIDTH, Turn,ColW(Turn))           
           Turn =Turn -1
 nominus:
Step rate for XP could be 10
For Vista make it 50 or more


RASHAD
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited