PureBasic Forums - English

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

PureBasic Listview Pro++

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

Page 1 of 2

PureBasic Listview Pro++

Posted: Mon Apr 13, 2009 6:13 am
by RASHAD

Code: Select all

; Most of the credit goes to :El Choni ,Danilo ,Netmaestro ,Sparkie ,Srod ,Fluid Byte
; And all the other members of the forum
; 
; This source need to be cleand and optimized
; But be careful there ,It is not that easy, I assure you
;
; More bugs are fixed - New System detection (Compatibility with Other OS refined as possible as I can) - Can now edit column 0
;
; RASHAD

Global Column_0_W,WinX,WinY,XX,YY,SS,StdColor,AltColor,ColColor,Item_Sp
Global OldCallback,OldEditProc,hEdit,rct.RECT,CellSelectOn,CurItem,CurSubItem,CurSelItem,CurSelSubItem,EditColor,WState,Sortflag,Editflag,HCFlag
Global rfont,hfont,hfonth,rfonth,AnsiString.s,UniString.s,RFontS,HFontS,STCbcolor.l,STCfcolor.l,Oddbrush,Evenbrush,index,Coln,LI_size
Global Dim AlignColumn(0),Dim MaskedColumn(0),Dim FixedColumn(0)

#CDDS_ITEMPREPAINT = #CDDS_ITEM|#CDDS_PREPAINT 
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
  
 
Procedure LoWord(value)
 
    ProcedureReturn value & $FFFF
   
EndProcedure
 

Procedure HiWord(value)
 
    ProcedureReturn value >> 16 & $FFFF
   
EndProcedure


Procedure RAddColumn(LiID.l,Title$,Colw.l,Align.l,Editmask.l,Fixedmask.l)

    Coln = Coln + 1
    ReDim AlignColumn(Coln)
    ReDim MaskedColumn(Coln)
    ReDim FixedColumn(Coln)     
    AddGadgetColumn(LiID,Coln,Title$,Colw)
    liColumn.LV_COLUMN
    liColumn\mask = #LVCF_FMT
    Select align
        Case 0: liColumn\fmt = #LVCFMT_LEFT
        Case 1: liColumn\fmt = #LVCFMT_CENTER
        Case 2: liColumn\fmt = #LVCFMT_RIGHT
    EndSelect
    SendMessage_(GadgetID(LiID), #LVM_SETCOLUMN,coln, liColumn)
    AlignColumn(Coln) = Align.l
    MaskedColumn(Coln) = Editmask
    FixedColumn(Coln) = Fixedmask

EndProcedure


ProcedureDLL.l Ansi2Uni(string.s)
 
    *out = AllocateMemory(Len(string)*2 * 2) 
    MultiByteToWideChar_(#CP_ACP, 0, string, -1, *out, Len(string))  
    ProcedureReturn *out
      
EndProcedure 
  
Procedure EndEdit()
 
    If hEdit
      SetGadgetItemText(1, CurItem, GetGadgetText(2)+Chr(10), CurSubItem)
      If CurSubItem = 0
      SetGadgetItemText(4, CurItem, GetGadgetText(2)+Chr(10), 0)
      EndIf 
      FreeGadget(2) 
      hEdit = 0 
    EndIf
   
EndProcedure


Procedure EditFocus(hwnd, *rc.RECT) 
    hDC = GetDC_(hwnd) 
    OldPen = SelectObject_(hDC, CreatePen_(#PS_INSIDEFRAME,1,$0000FF)) 
    OldBrush = SelectObject_(hDC, GetStockObject_(#NULL_BRUSH)) 
    Rectangle_(hDC, *rc\left+1, *rc\top+1, *rc\right-1, *rc\bottom-1) 
    SelectObject_(hDC, OldBrush) 
    SelectObject_(hDC, OldPen) 
    ReleaseDC_(hwnd, hDC) 
EndProcedure
 

Procedure EditProc(hwnd, uMsg, wParam, lParam) 
  result = 0 
  Select uMsg 
    Case #WM_KEYDOWN ,#WM_MENUSELECT
      result = CallWindowProc_(OldEditProc, hwnd, uMsg, wParam, lParam)
       RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE)      
      If wParam=#VK_RETURN                          
        EndEdit() 
      EndIf         
        
    Default
    result = CallWindowProc_(OldEditProc, hwnd, uMsg, wParam, lParam)
        
  EndSelect
  ProcedureReturn result 
EndProcedure 


Procedure LIcallback(hwnd, msg, wparam, lparam)
If IsGadget(4)
   ShowScrollBar_(GadgetID(4),#SB_BOTH,0)
EndIf
    
Protected hdi.hd_item
  result = CallWindowProc_(oldCallback, hwnd, msg, wparam, lparam)  
  
  Select msg
  
    Case #WM_NOTIFY
         If HCFlag = 0
            Goto nohcolor
         EndIf
      *NMHDR.NMHDR = lparam
        If *NMHDR\code = #NM_CUSTOMDRAW
        *pnmcd.NMCUSTOMDRAW = lparam
            Select *pnmcd\dwDrawStage
              Case #CDDS_PREPAINT
                result = #CDRF_NOTIFYITEMDRAW
              Case #CDDS_ITEMPREPAINT
                text$=GetGadgetItemText(GetDlgCtrlID_(hWnd),-1,*pnmcd\dwItemSpec)
                If *pnmcd\uItemState & #CDIS_SELECTED
                  DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH|#DFCS_PUSHED)
                  InflateRect_(*pnmcd\rc,-1,-1)
                Else
                  DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH)
                EndIf
                *pnmcd\rc\bottom-1 : *pnmcd\rc\right-1
                SetBkMode_(*pnmcd\hdc,#TRANSPARENT)
                If *pnmcd\dwItemSpec&1
                  FillRect_(*pnmcd\hdc, *pnmcd\rc,Oddbrush)
                  SetTextColor_(*pnmcd\hdc, #Blue)
                Else
                  FillRect_(*pnmcd\hdc, *pnmcd\rc,Evenbrush)
                  SetTextColor_(*pnmcd\hdc, #Red)
                EndIf
                *pnmcd\rc\top+1
                InflateRect_(*pnmcd\rc,-5,0)
                If *pnmcd\rc\right>*pnmcd\rc\left
                  DrawText_(*pnmcd\hdc, @text$, Len(text$), *pnmcd\rc,AlignColumn(*pnmcd\dwItemSpec)|#DT_VCENTER|#DT_END_ELLIPSIS)
                EndIf
                result = #CDRF_SKIPDEFAULT
            EndSelect
        EndIf
nohcolor:       

  
    Case #WM_RBUTTONDOWN
          For i=1 To coln
          SendMessage_(GadgetID(1), #LVM_SETCOLUMNWIDTH, i,#LVSCW_AUTOSIZE)
          Next
          SendMessage_(GadgetID(1), #LVM_SETCOLUMNWIDTH, coln,#LVSCW_AUTOSIZE_USEHEADER)
     
    Case #WM_RBUTTONDBLCLK
          For i=1 To coln
          SendMessage_(GadgetID(1), #LVM_SETCOLUMNWIDTH, i,#LVSCW_AUTOSIZE_USEHEADER & #LVSCW_AUTOSIZE)
          Length1=SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH, i, 0)
          StartDrawing(WindowOutput(0))
          DrawingFont(hfont)
          Length2 = TextWidth(GetGadgetItemText(1,-1,i))+2*hfonth
          StopDrawing()
          If Length2 > Length1
          SendMessage_(hwnd, #LVM_SETCOLUMNWIDTH, i,Length2)
          EndIf
          Next  
  
  
    Case #WM_LBUTTONDBLCLK
          If Editflag = 0
            Goto noedit
          EndIf
          If hwnd<>hEdit 
            EndEdit() 
            pInfo.LVHITTESTINFO 
            pInfo\pt\x = LoWord(lParam) 
            pInfo\pt\y = HiWord(lParam) 
            SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, pInfo) 
            rc.RECT 
            rc\top = pInfo\iSubItem 
            rc\left = #LVIR_BOUNDS 
            SendMessage_(hwnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc) 
            If hEdit=0
              UseGadgetList(hwnd) 
              CurItem = pInfo\iItem
              CurSubItem = pInfo\iSubItem
              If CurItem < 0 Or MaskedColumn(CurSubItem) = 1 Or GetDlgCtrlID_(hWnd) = 4
                Goto noedit
              EndIf  
              Text$ = GetGadgetItemText(1, CurItem, CurSubItem)
              If CurSubItem=0 
                rc\right = rc\left+SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH, 0, 0) 
              EndIf 
              hEdit = StringGadget(2, rc\left+1, rc\top+1, rc\right-rc\left-2, rc\bottom-rc\top-2, Text$,#PB_String_BorderLess) 
              ;If CurSubItem=0 
                SendMessage_(hEdit, #WM_SETFONT, rfont, #True) 
              ;Else 
                ;SendMessage_(hEdit, #WM_SETFONT, rfont, #True) 
              OldEditProc = SetWindowLong_(hEdit, #GWL_WNDPROC, @EditProc()) 
              SetFocus_(hEdit) 
            EndIf 
          Else 
            result = CallWindowProc_(oldCallback, hwnd, uMsg, wParam, lParam)
noedit:
         EndIf
     
    Case #WM_LBUTTONDOWN                
          If hwnd<>hEdit 
            EndEdit()
            pInfo.LVHITTESTINFO 
            pInfo\pt\x = LoWord(lParam) 
            pInfo\pt\y = HiWord(lParam) 
            SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, pInfo) 
            rc.RECT 
            rc\top = pInfo\iSubItem 
            rc\left = #LVIR_BOUNDS
            SendMessage_(hwnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc) 
            rc\left+1 
            rc\bottom-1 
            If CellSelectOn
              InvalidateRect_(hwnd, rct, #True) 
            EndIf 
            CellSelectOn = 1 
            CurSelItem = pInfo\iItem 
            CurSelSubItem = pInfo\iSubItem 
            If CurSelSubItem=0 
              rc\right = rc\left+SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH, 0, 0) 
            EndIf
            If CurSelItem < 0 Or Editflag = 0 Or GetDlgCtrlID_(hWnd) = 4
            RedrawWindow_(GadgetID(1),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW)
            CellSelectOn = 0
            Goto norect
            EndIf 
            EditFocus(hwnd, rc)
norect: 
            CopyMemory(rc, rct, SizeOf(RECT))
          Else  
            SetFocus_(hEdit) 
            result = CallWindowProc_(oldCallback, hwnd, uMsg, wParam, lParam)
          EndIf    
       
    Case #WM_CTLCOLOREDIT 
          If GetFocus_()=lParam 
            SetBkMode_(wParam, #TRANSPARENT) 
            If CurItem&1=0 
              TextBkColor = $FFFFFF
              ;If CurSubItem=3
                EditColor = $0000FF 
              ;EndIf 
            Else 
              TextBkColor = $FFFFFF
              ;If CurSubItem=3
                EditColor = $0000FF 
              ;EndIf 
            EndIf 
            SetTextColor_(wParam, EditColor) 
            result = CreateSolidBrush_(TextBkColor) 
          Else 
            result = CallWindowProc_(oldCallback, hwnd, uMsg, wParam, lParam)
          EndIf
       
    Case #WM_VSCROLL
          Item_Sp = SendMessage_(GadgetID(1), #LVM_GETITEMSPACING, #True, 0) >> 16 
          SelItem = GetScrollPos_(GadgetID(1),#SB_VERT) - GetScrollPos_(GadgetID(4),#SB_VERT)  
          SendMessage_(GadgetID(4), #LVM_SCROLL, 0, SelItem * Item_Sp)          
          UpdateWindow_(GadgetID(4))
          rc.RECT 
          TopVisibleItem = SendMessage_(hwnd, #LVM_GETTOPINDEX, 0, 0) 
          If CellSelectOn 
            rc\top = CurSelSubItem
            rc\left = #LVIR_BOUNDS
            SendMessage_(hwnd, #LVM_GETSUBITEMRECT, CurSelItem, rc) 
            rct\top = rc\top 
            rct\bottom = rc\bottom
            If TopVisibleItem <= CurSelItem 
              EditFocus(hwnd, rct) 
            EndIf 
          EndIf 
          If hEdit 
            If TopVisibleItem<=CurItem 
              ResizeGadget(2,#PB_Ignore, rc\top,#PB_Ignore,#PB_Ignore) 
              HideGadget(2, #False) 
              RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
            Else 
              HideGadget(2, #True) 
            EndIf 
            SetFocus_(hEdit) 
          EndIf
          If OSVersion() > 65 And IsThemeActive_() = 0
          InvalidateRect_(WindowID(0),0,#True)
          InvalidateRect_(WindowID(2),0,#True)
          EndIf
          
          
;        
    Case #WM_HSCROLL 
          rc.RECT 
          TopVisibleItem = SendMessage_(hwnd, #LVM_GETTOPINDEX, 0, 0) 
          If CellSelectOn 
            rc\top = CurSelSubItem 
            rc\left = #LVIR_BOUNDS
            SendMessage_(hwnd, #LVM_GETSUBITEMRECT, CurSelItem, rc) 
            rct\left = rc\left 
            rct\right = rc\right 
            If TopVisibleItem<=CurSelItem 
              EditFocus(hwnd, rct) 
            EndIf 
          EndIf 
          If hEdit 
            If TopVisibleItem<=CurItem 
              ResizeGadget(2, rc\left+2,#PB_Ignore,#PB_Ignore,#PB_Ignore) 
              HideGadget(2, #False) 
              RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
            Else 
              HideGadget(2, #True) 
            EndIf 
            SetFocus_(hEdit) 
          EndIf
            
            
    Case #WM_KEYDOWN ,#WM_MENUSELECT
          If wParam=#VK_NEXT                       
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_PAGEDOWN,0)
          ElseIf wParam=#VK_PRIOR
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_PAGEUP,0)
          ElseIf wParam=#VK_UP
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_LINEUP,0)
          ElseIf wParam=#VK_DOWN
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_LINEDOWN,0)
          ElseIf wParam=#VK_HOME
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_TOP,0)
          ElseIf wParam=#VK_END
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_BOTTOM,0)
          ElseIf lParam=#VK_LEFT
            SendMessage_(GadgetID(1),#WM_HSCROLL,#SB_LINELEFT,0)
          ElseIf lParam=#VK_RIGHT
            SendMessage_(GadgetID(1),#WM_HSCROLL,#SB_LINERIGHT,0)
          EndIf

   EndSelect

  ProcedureReturn result
EndProcedure


Procedure SortingUpd(ListIconGadget,columns) 
      
      ItemCount = SendMessage_(ListIconGadget, #LVM_GETITEMCOUNT, 0, 0)
      lvi.LV_ITEM
      lvi\mask = #LVIF_PARAM
      lvi\iItem = 0
      While ItemCount>0
        lvi\lParam = lvi\iItem
        For SubItem = 0 To columns-1
          lvi\iSubItem = SubItem
          SendMessage_(ListIconGadget, #LVM_SETITEM, 0, @lvi)
        Next SubItem
        lvi\iItem +1
        ItemCount -1
      Wend
      
EndProcedure


Procedure ListIconSortFunction(lParam1,lParam2,lParamSort)
      A$ = Space(200)
      B$ = Space(200)
      result = 0
      lvi.LV_ITEM
      lvi\iSubItem = lParamSort&$FFFF
      lvi\pszText = @A$
      lvi\cchTextMax = 200
      lvi\mask = #LVIF_TEXT
      SendMessage_(GadgetID(1), #LVM_GETITEMTEXT,lParam1,@lvi)
      lvi\pszText = @B$
      SendMessage_(GadgetID(1), #LVM_GETITEMTEXT,lParam2,@lvi)
    
      If A$ = B$
        ProcedureReturn 0 ; equal
      EndIf
    
      x = (lParamSort>>16)&$FFFF
      If x
        If A$ > B$
          ProcedureReturn  1
        Else
          ProcedureReturn -1
        EndIf
      Else
        If A$ > B$
          ProcedureReturn -1
        Else
          ProcedureReturn  1
        EndIf
      EndIf
      ProcedureReturn result
EndProcedure


Procedure RTrimColumn(LiID.l,Coln,Title$,align,Editmask.l)
    If Title$ = ""
        Title$ = GetGadgetItemText(LiID,-1,Coln)
    EndIf
    SetGadgetItemText(LiID,-1,Title$,Coln)
    liColumn.LV_COLUMN
    liColumn\mask = #LVCF_FMT
    Select align
        Case 0: liColumn\fmt = #LVCFMT_LEFT
        Case 1: liColumn\fmt = #LVCFMT_CENTER
        Case 2: liColumn\fmt = #LVCFMT_RIGHT
    EndSelect
    SendMessage_(GadgetID(LiID), #LVM_SETCOLUMN,coln, liColumn)
    MaskedColumn(Coln) = Editmask

EndProcedure
   


Procedure RHR_F_St_Sz( hfontn$,hh.l,hfflag.l,rfontn$,rh.l,rfflag.l)
      
      hfonth = hh
      rfonth = rh
      rfont = LoadFont(0, rfontn$, rfonth,rfflag)
      SendMessage_(GadgetID(1), #WM_SETFONT, rfont, 1)
      SendMessage_(GadgetID(4), #WM_SETFONT, rfont, 1)
      If hfonth = 0
      SetWindowLong_(GadgetID(1), #GWL_STYLE, GetWindowLong_(GadgetID(1), #GWL_STYLE)|#LVS_NOCOLUMNHEADER)
      SetWindowLong_(GadgetID(4), #GWL_STYLE, GetWindowLong_(GadgetID(4), #GWL_STYLE)|#LVS_NOCOLUMNHEADER)
      Goto noheader
      EndIf
      Header_1 = SendMessage_(GadgetID(1), #LVM_GETHEADER, 0, 0)
      Header_4 = SendMessage_(GadgetID(4), #LVM_GETHEADER, 0, 0)
      SetWindowTheme_(Header_1, @null.w, @null.w)
      SetWindowTheme_(Header_4, @null.w, @null.w) 
      hfont = LoadFont(1, hfontn$, hfonth,hfflag)
      SendMessage_(Header_1, #WM_SETFONT, hfont, 1)
      SendMessage_(Header_4, #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")
            CallFunctionFast(newth, Header_4, @null.w, "HEADER")
            CompilerElse
            CallFunctionFast(newth, Header_1, @null.w, Ansi2Uni("HEADER"))
            CallFunctionFast(newth, Header_4, @null.w, Ansi2Uni("HEADER"))
            CompilerEndIf
          EndIf     
       EndIf
      CloseLibrary(0)
    noheader:
        
EndProcedure

Procedure WndProc(hwnd, uMsg, wParam, lParam)

      If GetActiveGadget() = 4
        SetActiveGadget(1)
      EndIf
      WinX = WindowWidth(0)
      WinY = WindowHeight(0)
      GetWindowRect_(WindowID(0), wr.RECT)
      GetWindowRect_(GadgetID(1), gr.RECT)
      XX = gr\left - wr\left - 2
      YY = gr\top - wr\top - 2      
      result = #PB_ProcessPureBasicEvents 

 Select uMsg
   
   Case #WM_NOTIFY
   
    *NMHDR.NMHDR = lParam
       ; Sort by Column       
       If *NMHDR\hWndFrom = GetDlgItem_(hwnd,wParam) And Sortflag = 1
        If *NMHDR\code = #LVN_COLUMNCLICK
          *NMLV.NMLISTVIEW = lParam
          column = *NMLV\iSubItem
          index = index!1
          SendMessage_(GadgetID(1),#LVM_SORTITEMS,column|((index)<<16),@ListIconSortFunction())
          For i=0 To LI_size
          SetGadgetItemText(4,i,GetGadgetItemText(1,i ,0),0)
          Next
          SortingUpd(GadgetID(1),coln) 
        EndIf                 ;  
       EndIf      
      ; Fixed Column Length
       If *NMHDR\hWndFrom = GetWindow_(GadgetID(1),#GW_CHILD) And *NMHDR\code = #HDN_FIRST
          *phdn.NMHEADER = lParam                       
          If FixedColumn(*phdn\Iitem) = 1
              ProcedureReturn 1
          ElseIf *phdn\Iitem = 0 And FixedColumn(0) = 0
              Column_0_W = SendMessage_(GadgetID(1),#LVM_GETCOLUMNWIDTH,0,0) + 5               
          EndIf
       EndIf
    
      Select *NMHDR\code 
        Case #NM_CUSTOMDRAW 
          *LVCDHeader.NMLVCUSTOMDRAW = lParam 
          If *LVCDHeader\nmcd\hdr\hWndFrom = GadgetID(1)
            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
                  ; Odd Row Color
                  If Row&1=1
                    If GetDlgItem_(hwnd,wParam) = GadgetID(1)
                      *LVCDHeader\clrTextBk = ColColor
                    Else
                      *LVCDHeader\clrTextBk = AltColor
                    EndIf
                    ;If Col=2 
                    ;*LVCDHeader\clrText = $0000FF 
                    ;Else 
                     ; *LVCDHeader\clrText = $000000 
                    ;EndIf
                  ; Even Row Color 
  ;                 Else 
  ;                   *LVCDHeader\clrTextBk = ColColor
                    ;If Col=2 
                      ;*LVCDHeader\clrText = $FF0000 
                    ;Else 
                     ; *LVCDHeader\clrText = $000000 
                    ;EndIf 
                  EndIf                
                  If  Right(GetGadgetItemText(1,Row,Col), 1)=Chr(10)
                      *LVCDHeader\clrText = $0000FF
                  Else
                      *LVCDHeader\clrText = $000000
                  EndIf
                      result = #CDRF_NEWFONT 
            EndSelect 
          EndIf 
      EndSelect 

             
      *nmHEADER.HD_NOTIFY = lParam
      Gadget_ID = *nmHEADER\hdr\hwndFrom  
      Select *nmHEADER\hdr\code 
        Case #HDN_ITEMCHANGING
         Select GetParent_(Gadget_ID)
            Case GadgetID(1)
                SendMessage_(GadgetID(1),#LVM_GETITEMRECT,0,r.Rect)                                             
                If (r\right - r\left + 40) > WinX
                   MoveWindow_(WindowID(2),WindowX(0)+XX ,WindowY(0)+YY,Column_0_W,WinY-76,1)
                Else
                   MoveWindow_(WindowID(2),WindowX(0)+XX ,WindowY(0)+YY,Column_0_W,WinY-56,1)
                EndIf      
                If CellSelectOn = 1
                FreeGadget(2) 
                hEdit = 0 
                InvalidateRect_(GadgetID(1),0,#True)
                CellSelectOn = 0
                EndIf                
                
            Case GadgetID(4)
             
         EndSelect      

      EndSelect
      
    
      
        Case #WM_SIZE,#WM_MOVE,#WM_PAINT

          MoveWindow_(GadgetID(1),10,10,WinX-20,WinY-60,1)          
          SendMessage_(GadgetID(1),#LVM_GETITEMRECT,0,r.Rect)
          If (r\right - r\left + 40) > WinX
          MoveWindow_(WindowID(2),WindowX(0)+XX ,WindowY(0)+YY,Column_0_W,WinY-76,1)
          Else
          MoveWindow_(WindowID(2),WindowX(0)+XX ,WindowY(0)+YY,Column_0_W,WinY-56,1)
          EndIf
          MoveWindow_(GadgetID(4),2,2,Column_0_W-4,WinY-60,1)
          SendMessage_(GadgetID(4), #LVM_SETCOLUMNWIDTH, 0,Column_0_W)
          MoveWindow_(GadgetID(5),10,WinY-35,100,25,1)
          MoveWindow_(GadgetID(6),120,WinY-35,100,25,1)
          MoveWindow_(GadgetID(7),230,WinY-35,100,25,1)
          MoveWindow_(GadgetID(8),340,WinY-35,100,25,1)
          MoveWindow_(GadgetID(9),450,WinY-35,100,25,1)
 
             
   EndSelect
   
  ProcedureReturn result 
EndProcedure

Procedure RAdd_0_Column(Align.l,Editmask.l,Fixedmask.l,STCbcolor.l,STCfcolor.l)
    
    SendMessage_(WindowID(0),#LVM_GETITEMRECT,0,r.Rect)
    OpenWindow(2,r\left+10 ,r\top+10,Column_0_W,r\bottom-78,"FixedIconGadget Test",#WS_POPUP,WindowID(0))
    ListIconGadget(4,0,0,Column_0_W-2,r\bottom-80,"Column 0", Column_0_W,#PB_ListIcon_GridLines)
    oldCallback = SetWindowLong_(GadgetID(4), #GWL_WNDPROC, @LIcallback())
    liColumn.LV_COLUMN
    liColumn\mask = #LVCF_FMT
    Select align
        Case 0: liColumn\fmt = #LVCFMT_LEFT
        Case 1: liColumn\fmt = #LVCFMT_CENTER
        Case 2: liColumn\fmt = #LVCFMT_RIGHT
    EndSelect
    SendMessage_(GadgetID(4), #LVM_SETCOLUMN,0,liColumn)
    AlignColumn(0) = Align
    MaskedColumn(0) = Editmask
    FixedColumn(0) = Fixedmask
    SetGadgetColor(4,#PB_Gadget_BackColor,STCbcolor)
    SetGadgetColor(4,#PB_Gadget_FrontColor,STCfcolor)
    SetActiveGadget(1)

EndProcedure

Procedure Start()
    
    ColColor = StdColor
    HideWindow(2,1)

EndProcedure


  AnsiString.s = "HEADER" 
  UniString.s = Space (13)
  index = 1 
  
  WinX = 1024
  WinY = 768
  LI_size = 1000
  Column_0_W = 240                                                                      ;Default Column Width  
  StdColor = $E6FFFF                                                                    ;Default Row Color
  AltColor = $BAEEE8                                                                    ;Alternate Row Color
  Oddbrush=CreateSolidBrush_($00FFFF)                                                   ;Odd Header Style Back Color
  Evenbrush=CreateSolidBrush_($00FFFF)                                                  ;Even Header Style Back Color                                                                   
  ;HSOcolor = $FF0000                                                                   ;Header Style Text Odd Color
  ;HSEcolor = $0000FF                                                                   ;Header Style Text Even Color 
  HFontS=18                                                                             ;New Header Font Size
  RFontS=12                                                                             ;New Item Font Size
  Sortflag = 1                                                                          ;Sorting Flag (1 = Sort , 0 = No Sort)


new:
coln = 0


OpenWindow(0,0,0,WinX,WinY,"RASHAD ListView Pro",#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered)
If WState = #PB_Window_Maximize
SetWindowState(0,#PB_Window_Maximize) 
EndIf

ListIconGadget(1,10,10,WinX-20,WinY-60,"Column 0", Column_0_W-5,#PB_ListIcon_GridLines)
oldCallback = SetWindowLong_(GadgetID(1), #GWL_WNDPROC, @LIcallback())
HideGadget(1,1)
SetGadgetColor(1,#PB_Gadget_BackColor,StdColor)

ButtonGadget(5,10,WinY - 35,100,25,"Fr/Unfreeze C0" ,#PB_Button_Toggle)
ButtonGadget(6,120,WinY - 35,100,25,"En/Disable Edit" ,#PB_Button_Toggle)
ButtonGadget(7,230,WinY - 35,100,25,"Font and Size" ,#PB_Button_Toggle)
ButtonGadget(8,340,WinY - 35,100,25,"Header Style" ,#PB_Button_Toggle)
ButtonGadget(9,450,WinY - 35,100,25,"Columns Color" ,#PB_Button_Toggle)

;RAddColumn(ListIconID, Title$, Column_Width, Column_Alignment(0=Left 1=Center 2=Right), Column_Edit_Mask(1=Masked 0=Non Masked), Column_Width_Fixed(1=Masked 0=Non Masked)
RAddColumn(1,"Column 1",200,1,0,0)
RAddColumn(1,"Column 2",200,1,0,1)
RAddColumn(1,"Column 3",200,0,0,0)
RAddColumn(1,"Column 4",200,0,1,1)
RAddColumn(1,"Column 5",200,0,0,0)
RAddColumn(1,"Column 6",200,2,0,0)
RAddColumn(1,"Column 7",200,2,0,0)

;First Column RAdd_0_Column(Align.l,Editmask.l,Fixedmask.l,Column_0 Backcolor,Column_0 Frontcolor)
;Align.l : 0 = Left aligned 1 = Center aligned 2 = Right aligned
;Editmask.l : 1 = noedit / 0 = editable
;Fixedmask.l : 1 = Fixed width / 0 = Resizeable

;To edit Column 0 : 1- Make Editmask = 1 2- Unfreeze C0 3- Edit the subitems 4- Freeze it again
RAdd_0_Column(0,0,0,$CFFECD,$000000)

;Remember to add the data of column 0 of Gadget(1) to column 0 of Gadget(4)
For i=0 To LI_size
  ;First
  AddGadgetItem(1, -1, "Line "+Str(i)+" column number zero"+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")
  ;Second
  AddGadgetItem(4, -1, "Line "+Str(i)+" column number zero")
Next

SortingUpd(GadgetID(1),Coln)                                                         ;For Sorting 

;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,16,"Microsoft Sans Serif",RFontS,0)

HideGadget(1,0)

SetWindowCallback(@WndProc())

Start()


Repeat ; Start of the event loop

  
  Event = WaitWindowEvent() ; This line waits until an event is received from Windows

  WindowID = EventWindow() ; The Window where the event is generated, can be used in the gadget procedures
 
  GadgetID = EventGadget() ; Is it a gadget event?
 
  EventType = EventType() ; The event type
 

Select Event
 
  Case #PB_Event_Gadget
  
    Select EventGadget()
      
      Case 5
            If GetGadgetState(5) = 1            
            HideWindow(2,0)
            SetActiveGadget(1)
            Else            
            HideWindow(2,1)            
            EndIf
      
      Case 6
            Editflag = Editflag!1
            For i = 1 To LI_size
            SetGadgetItemText(4,i,GetGadgetItemText(1,i,0),0)
            Next
      
      Case 7
            Fontflag = Fontflag!1
           If Fontflag = 1
            HFontS = 30
            RFontS = 14
           Else
            HFontS = 18
            RFontS = 12
           EndIf            
            WState = GetWindowState(0)
            Goto new
      
      Case 8
            HCFlag = HCFlag!1
            InvalidateRect_(WindowID(0),0,#True)
        
      Case 9
          If GetGadgetState(9) = 1
            ColColor = AltColor  
          Else
            ColColor = StdColor
          EndIf
            RedrawWindow_(GadgetID(1), 0, 0, #RDW_INTERNALPAINT|#RDW_INVALIDATE)
            SetActiveGadget(1)


   EndSelect
EndSelect 

Until event = #PB_Event_CloseWindow
No more update

More bugs are fixed
New System detection (Compatibility with Other OS refined as possible as I can)
Can now edit column 0

RASHAD

Posted: Mon Apr 13, 2009 8:36 am
by Michael Vogel
Hmm... some problems here with PB4.3 and the Callbacks:

Line 620 (or so)...
Callback starts accessing the Gadget(4) which has not been inititalized

The code SetWindowCallback(0) is also not allowed, I fear

Michael

Posted: Mon Apr 13, 2009 8:48 am
by cas
Michael Vogel wrote: Callback starts accessing the Gadget(4) which has not been inititalized
Easy fix:

replace this line:

Code: Select all

ShowScrollBar_(GadgetID(4),#SB_BOTH,0)
with this:

Code: Select all

If IsGadget(4) : ShowScrollBar_(GadgetID(4),#SB_BOTH,0) : EndIf

Posted: Mon Apr 13, 2009 12:13 pm
by RASHAD
It works here fine with me
But
Fixed as cas suggested

RASHAD

Posted: Mon Apr 13, 2009 12:23 pm
by rsts
RASHAD wrote:It works here fine with me
But
Fixed as cas suggested

RASHAD
does it work fine for you if you actually go to a routine where setWindowCallback(0) is invoked?

cheers

Posted: Mon Apr 13, 2009 12:40 pm
by srod
Interesting code.

Yep crashes here on SetWindowCallback(0); I thought this was allowed as a way of clearing a callback?

For some reason I cannot edit cells in column 0 here on Vista (or column 4); the other columns are okay although there are some redrawing issues if you start scrolling whilst editing a cell etc.

That's a novel way of freezing column zero! :)

However, when frozen, if you scroll the main listicon here on Vista, you get a few stray lines of pixels at the bottom of column zero which are the main listicon showing through etc.

Posted: Mon Apr 13, 2009 1:02 pm
by RASHAD
srod:
You can not edit column 0 because editmask is set to 1 in
RAdd_0_Column(0,1,0,$CFFECD,$000000)
For column 4 it is set as 1 in
RAddColumn(1,"Column 4",200,0,1,1)
You can change that of course as you like

About novel way to freeze column 0 it is better than nothing to take every thing into acount specially resizing
Look at the diffeculty of netmaestro way

srod:
Take your time I need your full comments
and look please at the way to change the header height
it is better than mr mat way

other things are minor and can be fixed later on

and I will wait for your magic

RASHAD

Posted: Mon Apr 13, 2009 1:25 pm
by srod
Ah yes I see. :)

I cannot see where you change the header height so I cannot comment at the moment. I see you switching themes on and off for the header control, but nothing about the height.

A more serious bug for you to consider however. Freeze column 0 and set editable. Now edit a cell in column 0 and whilst doing it, move the horizontal scrollbar. On Vista, you get a right royal mess! :) Sorry.

Posted: Mon Apr 13, 2009 2:49 pm
by RASHAD
srod:
At the beginning of the post I said that the code need to be cleaned and optimized
The purpose to deal with this task is:
Look at PurePi method at the german forum what you think about it?
You told Kwaï chang caïne before that you will not do it why?
With netmaestro method we are about 24k of code and still needs more 24k of pro code to solve its problems
look at the listicon gadget where there is no need to the horizontal scrollbar

I am a Structural Engineer I used to know that the shortest distance between two points is the straight line.
Beside at the end the user will see an exe file he will not care if it is novel or pro code

Later on I will try to fix more and more bugs I allready fixed some right now
But we have to make it work the fine way

If you can improve it or add more functions just do it that is your share
thanks in advance

RASHAD

Posted: Mon Apr 13, 2009 4:45 pm
by netmaestro
One problem with approaching the fixed column 0 in that way is that when you press the button on its header your main window loses focus.

Also - my FixedIconGadget isn't finished yet, so until I release a 1.0 for it there's really no point in taking shots at it. That won't stop srod though, that.. that.. uggh!!!

Posted: Mon Apr 13, 2009 6:04 pm
by RASHAD
netmaestro:
No offence
Please do not be upset
I am just try to make somthing handy and very easy in the time being

In the matter of fact I need your suggestions and your help to make it at least fast enough
About srod he was in a hurry to comment

Again netmaestro please do not take it seriously
You Are No.1 do doubt about that
Your work is your witness

RASHAD

Posted: Mon Apr 13, 2009 7:31 pm
by srod
Rashad, I do not understand what you are getting at here?

By saying you had a novel approach to freezing column 0, I was not having a dig; that was supposed to be a compliment! I most certainly was not comparing your method with netmaestro's which is also very novel.

You seem to be taking offence at my pointing out a bug; well, why exactly are you posting this 'unifinished' code then (or in your words, 'unoptimised') if you do not want bugs pointed out etc?

Your reference to KCC has escaped me as I do not understand what you mean exactly?

I will make no further post then in this thread.

Posted: Mon Apr 13, 2009 8:24 pm
by RASHAD
srod:
I am very sorry
Please read the first line of the post to get from where I got my ideas
I think I lost my mind

I loved PureBasic 30% because of the compiler itself and 70% because of the spirit of the members of the forum

Remember my friend I am not a Programmer ,It is my hobby to solve puzzels

Agian I am sorry for you all
Yours

RASHAD

Posted: Mon Apr 13, 2009 8:30 pm
by srod
No worries mate.

My pointing out bugs only ever follows when I like the code that I am looking at! :wink:

Posted: Tue Apr 14, 2009 9:31 pm
by RASHAD
Last update
More bugs are fixed
Compatibility with other Os are refined
Column 0 can now be edited
No last row stray


No more Posting
RASHAD
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited