PureBasic Forums - English

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

GridGadget (Rev. 4) - (El Choni style)

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

Page 1 of 1

GridGadget (Rev. 4) - (El Choni style)

Posted: Sun Dec 15, 2013 11:11 am
by Inner

Code: Select all

;#############################################################################
; TITLE:          tGrid
; ALTERATIONS:    T.J.Roughton (A.K.A) Inner
; Date:           15. Dec 2013
; DESCRIPTION:    Creates an Editable grid.
; VERSION:        Revision 4
;
; HISTORY: 
;
; AUTHOR:         El Choni    (Rev. 1)
; CREATION DATE:  09. May 2003
;      +:         Andre       (Rev. 2 updated for PB3.92+)
;      +:         blbltheworm (Rev. 3 updated for PB4.00)
;#############################################################################

;-  Revision 4
;              / T.J.Roughton
;
;   Removed: Global Veriables replaced with structure.
;   Added:   EnableExplicit
;   Added:   Comments and a bit of a code clean up.
;   FIXED:   #WM_LBUTTONDBLCLK
;            Symptom: if selecting an area of nothing by double click.
;                  =: [Error] Maximum supported gadget width is 32767 pixels.
;           Solution: By blocking if iItem / iSubItem = - 1

;#############################################################################
;-                                  Inits
;#############################################################################
EnableExplicit

;#############################################################################
;-                                 Constants
;#############################################################################
#NM_CUSTOMDRAW = #NM_FIRST-12 

#CDDS_ITEM = $10000 
#CDDS_SUBITEM = $20000 
#CDDS_PREPAINT = $1 
#CDDS_ITEMPREPAINT = #CDDS_ITEM|#CDDS_PREPAINT 
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
#CDRF_DODEFAULT = $0 
#CDRF_NEWFONT = $2 
#CDRF_NOTIFYITEMDRAW = $20 
#CDRF_NOTIFYSUBITEMDRAW = $20 

#LVM_SUBITEMHITTEST = #LVM_FIRST+57 
#LVM_GETSUBITEMRECT = #LVM_FIRST+56 

#CCM_SETVERSION = #CCM_FIRST+7 

;#############################################################################
;-                                 Structures
;#############################################################################
Structure TLUI_TGRID
  ; ListIcon Gadget  

  handle.l
  index.l
  lvproc.l
  
  item.l
  subitem.l

  ; String Gadget  
  hedit.l
  editidx.l
  editproc.l

  ; font
  fontreg.l
  fontbold.l

  ; Selection
  cellselecton.b
  curselitem.l
  curselsubitem.l

  rct.RECT
EndStructure

;#############################################################################
;-                                   Macros
;#############################################################################
Macro LoWord(value) 
  value & $FFFF 
EndMacro

Macro HiWord(value) 
  value >> 16 & $FFFF 
EndMacro

;#############################################################################
;-                                   Globals
;#############################################################################
Global gridgadget.TLUI_TGRID

;=============================================================================
; <name> (<args>)
; DESCRIPTION
;   .
; INPUTS
;   .
; RESULT
;   .
; SEE ALSO
;   .
;
Procedure DrawRectangle(hwnd, *rc.RECT) 
; <> Define
  ; - Veriables
  Define hdc = 0, pen = 0, brush = 0

  ; - Code
  hdc = GetDC_(hwnd) 
  pen = SelectObject_(hdc, GetStockObject_(#BLACK_PEN)) 
  brush = SelectObject_(hdc, GetStockObject_(#NULL_BRUSH)) 
  Rectangle_(hdc, *rc\left, *rc\top, *rc\right, *rc\bottom) 
  SelectObject_(hdc, brush) 
  SelectObject_(hdc, pen) 
  ReleaseDC_(hwnd, hdc) 
EndProcedure 

;=============================================================================
; <name> (<args>)
; DESCRIPTION
;   .
; INPUTS
;   .
; RESULT
;   .
; SEE ALSO
;   .
;
Procedure KillFocus() 
  If gridgadget\hedit 
    SetGadgetItemText(gridgadget\index,gridgadget\item, GetGadgetText(gridgadget\editidx),gridgadget\subitem) 
    FreeGadget(gridgadget\editidx) 
    gridgadget\hedit = 0 
  EndIf 
EndProcedure
 
;=============================================================================
; <name> (<args>)
; DESCRIPTION
;   .
; INPUTS
;   .
; RESULT
;   .
; SEE ALSO
;   .
;
Procedure EditProc(hwnd, uMsg, wParam, lParam) 
; <> Define
  ; - Veriables
  Define result = 0 
  ; - Code
  Select uMsg 
    Case #WM_KEYDOWN 
      result = CallWindowProc_(gridgadget\editproc, hwnd, uMsg, wParam, lParam) 
      If wParam=#VK_RETURN 
        KillFocus() 
      EndIf 
    Default 
      result = CallWindowProc_(gridgadget\editproc, hwnd, uMsg, wParam, lParam) 
  EndSelect 
  ProcedureReturn result 
EndProcedure

;=============================================================================
; <name> (<args>)
; DESCRIPTION
;   .
; INPUTS
;   .
; RESULT
;   .
; SEE ALSO
;   .
;

Procedure LViewProc_Callback(hwnd, uMsg, wParam, lParam)
; <> Define
  ; - Structures
  Define pInfo.LVHITTESTINFO
  Define rc.RECT 
  ; - Strings
  Define text.s = ""
  ; - Veriables
  Define result = 0
  Define tbkcolor.l = 0, tcolor = 0
  Define topvisibleitem = 0

  ; - Code
  Select uMsg
 
    ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ;- #WM_LBUTTONDBLCLK
    Case #WM_LBUTTONDBLCLK 
      If hwnd<>gridgadget\hedit 
        KillFocus() 
        pInfo.LVHITTESTINFO 
        pInfo\pt\x = LoWord(lParam) 
        pInfo\pt\y = HiWord(lParam) 
        SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, pInfo) 
        rc\top = pInfo\iSubItem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hwnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc) 

        If (gridgadget\hedit = 0) And (pInfo\iItem<>-1) Or (pInfo\iSubItem<>-1) 
          UseGadgetList(hwnd) 
          gridgadget\item = pInfo\iItem 
          gridgadget\subitem = pInfo\iSubItem

          text = GetGadgetItemText(gridgadget\index, gridgadget\item, gridgadget\subitem) 
          If gridgadget\subitem=0 
            rc\right = rc\left + SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH, 0, 0) 
          EndIf

          gridgadget\hedit = StringGadget(gridgadget\editidx, rc\left+1, rc\top, rc\right-rc\left-1, rc\bottom-rc\top-1, text, #PB_String_BorderLess) 
          If gridgadget\subitem=0 
            SendMessage_(gridgadget\hedit, #WM_SETFONT, gridgadget\fontbold, #True) 
          Else 
            SendMessage_(gridgadget\hedit, #WM_SETFONT, gridgadget\fontreg, #True) 
          EndIf
          ;BUG HERE SOMEWHERE
          gridgadget\editproc = SetWindowLong_(gridgadget\hedit, #GWL_WNDPROC, @EditProc()) 
          SetFocus_(gridgadget\hedit) 
        EndIf 
      Else 
        result = CallWindowProc_(gridgadget\lvproc, hwnd, uMsg, wParam, lParam) 
      EndIf

    ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ;- #WM_LBUTTONDOWN
    Case #WM_LBUTTONDOWN 
      If hwnd<>gridgadget\hedit 
        KillFocus()  
        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 gridgadget\cellselecton 
          InvalidateRect_(hwnd, gridgadget\rct, #True) 
        EndIf 
        gridgadget\cellselecton = 1 
        gridgadget\curselitem = pInfo\iItem 
        gridgadget\curselsubitem = pInfo\iSubItem 
        If gridgadget\curselsubitem=0 
          rc\right = rc\left + SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH, 0, 0) 
        EndIf 
        DrawRectangle(hwnd, rc) 
        CopyMemory(rc, gridgadget\rct, SizeOf(RECT)) 
      Else 
        SetFocus_(gridgadget\hedit) 
        result = CallWindowProc_(gridgadget\lvproc, hwnd, uMsg, wParam, lParam) 
      EndIf
 
    ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ;- #WM_CTLCOLOREDIT
    Case #WM_CTLCOLOREDIT 
      If GetFocus_()=lParam 
        SetBkMode_(wParam, #TRANSPARENT) 
        If gridgadget\item&1=0 
         tbkcolor = RGB(255, 255, 223) 
          If gridgadget\subitem=3 
            tcolor = RGB(255, 0, 0) 
          EndIf 
        Else 
          tbkcolor = RGB(208, 208, 176) 
          If gridgadget\subitem=3 
            tcolor = RGB(0, 0, 255) 
          EndIf 
        EndIf 
        SetTextColor_(wParam, tcolor) 
        result = CreateSolidBrush_(tbkcolor) 
      Else 
        result = CallWindowProc_(gridgadget\lvproc, hwnd, uMsg, wParam, lParam) 
      EndIf

    ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ;- #WM_VSCROLL
    Case #WM_VSCROLL 
      result = CallWindowProc_(gridgadget\lvproc, hwnd, uMsg, wParam, lParam)
      topvisibleitem = SendMessage_(hwnd, #LVM_GETTOPINDEX, 0, 0) 
      If gridgadget\cellselecton 
        rc\top = gridgadget\curselsubitem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hwnd, #LVM_GETSUBITEMRECT, gridgadget\curselitem, rc) 
        gridgadget\rct\top = rc\top 
        gridgadget\rct\bottom = rc\bottom-1 
        If topvisibleitem<=gridgadget\curselitem 
          DrawRectangle(hwnd, gridgadget\rct) 
        EndIf 
      EndIf 
      If gridgadget\hedit 
        If topvisibleitem<=gridgadget\item 
          ResizeGadget(gridgadget\hedit,#PB_Ignore, rc\top,#PB_Ignore,#PB_Ignore) 
          HideGadget(gridgadget\hedit, #False) 
          RedrawWindow_(gridgadget\hedit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
        Else 
          HideGadget(gridgadget\hedit, #True) 
        EndIf 
        SetFocus_(gridgadget\hedit) 
      EndIf
 
    ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ;- #WM_HSCROLL
    Case #WM_HSCROLL 
      result = CallWindowProc_(gridgadget\lvproc, hwnd, uMsg, wParam, lParam) 
      topvisibleitem = SendMessage_(hwnd, #LVM_GETTOPINDEX, 0, 0) 
      If gridgadget\cellselecton  
        rc\top = gridgadget\curselsubitem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hwnd, #LVM_GETSUBITEMRECT, gridgadget\curselitem, rc) 
        gridgadget\rct\left = rc\left+1 
        gridgadget\rct\right = rc\right 
        If topvisibleitem<=gridgadget\curselitem
          DrawRectangle(hwnd, gridgadget\rct) 
        EndIf 
      EndIf 
      If gridgadget\hedit 
        If topvisibleitem<=gridgadget\item 
          ResizeGadget(gridgadget\hedit, rc\left,#PB_Ignore,#PB_Ignore,#PB_Ignore) 
          HideGadget(gridgadget\hedit, #False) 
          RedrawWindow_(gridgadget\hedit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
        Else 
          HideGadget(gridgadget\hedit, #True) 
        EndIf 
        SetFocus_(gridgadget\hedit) 
      EndIf 
    Default 
      result = CallWindowProc_(gridgadget\lvproc, hwnd, uMsg, wParam, lParam) 
  EndSelect 

  ProcedureReturn result 
EndProcedure

;=============================================================================
; <name> (<args>)
; DESCRIPTION
;   .
; INPUTS
;   .
; RESULT
;   .
; SEE ALSO
;   .
;
Procedure WndProc_Callback(hwnd, uMsg, wParam, lParam) 
; <> Define
  ; - Structures
  Define *pnmh.NMHDR = lParam 
  Define *LVCDHeader.NMLVCUSTOMDRAW = lParam 

  ; - Veriables
  Define result = #PB_ProcessPureBasicEvents 
  Define row = 0, col = 0

  ; - Code
  Select uMsg 
    Case #WM_NOTIFY 
      Select *pnmh\code 
        Case #NM_CUSTOMDRAW 
          If *LVCDHeader\nmcd\hdr\hWndFrom=gridgadget\handle 
            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, gridgadget\fontbold) 
                Else 
                  SelectObject_(*LVCDHeader\nmcd\hDC, gridgadget\fontreg) 
                EndIf 
                If row&1=0 
                  *LVCDHeader\clrTextBk = RGB(255, 255, 223) 
                  If col=1 
                    *LVCDHeader\clrText = RGB(255, 0, 0) 
                  Else 
                    *LVCDHeader\clrText = RGB(0, 0, 0) 
                  EndIf 
                Else 
                  *LVCDHeader\clrTextBk = RGB(208, 208, 176) 
                  If col=1
                    *LVCDHeader\clrText = RGB(0, 0, 255) 
                  Else 
                    *LVCDHeader\clrText = RGB(0, 0, 0) 
                  EndIf 
                EndIf 
                result = #CDRF_NEWFONT 
            EndSelect 
          EndIf 
      EndSelect 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

;=============================================================================
; <name> (<args>)
; DESCRIPTION
;   .
; INPUTS
;   .
; RESULT
;   .
; SEE ALSO
;   .
;
Procedure TLUI_tGridGadget(gid,x,y,width,height,header.s)
  ; <> Define
  ; - Structures
  ;Define
  ; - Strings
  Define colmname.s = ""
  ; - Veriables
  Define lgad = 0, colwidth = 0, colms = 0, i = 0
  Define colmwidth = 0

  ; - Code
  gridgadget\fontreg = LoadFont(#PB_Any, "Tahoma", 9) 
  gridgadget\fontbold = LoadFont(#PB_Any, "Tahoma", 9, #PB_Font_Bold) 

  gridgadget\index = gid
  gridgadget\editidx = gridgadget\index + 1
  gridgadget\handle = ListIconGadget(gridgadget\index,x,y,width,height, "", 70, #PB_ListIcon_GridLines|#LVS_NOSORTHEADER) 
  SendMessage_(gridgadget\handle, #CCM_SETVERSION, 5, 0)

  colms = (CountString(header,"|"))

  For i=0 To colms
    colmname = StringField(StringField(header,1+i,"|"),1,",")
    colmwidth = Val(StringField(StringField(header,1+i,"|"),2,","))
    If i = 0 
      gridgadget\handle = ListIconGadget(gridgadget\index,x,y,width,height,colmname,colmwidth,#PB_ListIcon_GridLines|#LVS_NOSORTHEADER)
    Else
      AddGadgetColumn(gridgadget\index,i,colmname,colmwidth)
    EndIf
  Next

  For i=0 To colms
    SendMessage_(gridgadget\handle,#LVM_SETCOLUMNWIDTH,i,#LVSCW_AUTOSIZE_USEHEADER) 
  Next 
 
  gridgadget\lvproc = SetWindowLong_(gridgadget\handle, #GWL_WNDPROC, @LViewProc_Callback())
  SetWindowCallback(@WndProc_Callback())

  For i = 0 To 50
    AddGadgetItem(gridgadget\index, -1, "Yo"+Chr(10)+"Trippin'") 
  Next

EndProcedure

Re: GridGadget (Rev. 4) - (El Choni style)

Posted: Sun Dec 15, 2013 3:23 pm
by jack
there's a missing constant #NM_FIRST :?

Re: GridGadget (Rev. 4) - (El Choni style)

Posted: Mon Dec 16, 2013 12:44 pm
by Bisonte
No Error with PB5.21

But only x86.

To run this on x64 you have to change the structure TLUI_TGRID

Code: Select all

Structure TLUI_TGRID
  ; ListIcon Gadget 

  handle.i ; Its an oshandle: so Integer, not Long
  index.l
  lvproc.i ; Its an oshandle: so Integer, not Long
 
  item.l
  subitem.l

  ; String Gadget 
  hedit.i ; Its an oshandle: so Integer, not Long
  editidx.l
  editproc.i ; Its an oshandle: so Integer, not Long

  ; font
  fontreg.l
  fontbold.l

  ; Selection
  cellselecton.b
  curselitem.l
  curselsubitem.l

  rct.RECT
EndStructure

#NM_FIRST = 0 ; for older PB Versions....

Re: GridGadget (Rev. 4) - (El Choni style)

Posted: Mon Dec 16, 2013 5:48 pm
by Bisonte
I can't find a sample how to run it.

Code: Select all

Define Event, Quit
OpenWindow(0, 0, 0, 800, 600, "Test", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)


TLUI_tGridGadget(0,10,10,300,300,"Header")

Repeat
  
  Event = WaitWindowEvent()
  
  Select Event
    Case #PB_Event_CloseWindow
      Quit = 1
  EndSelect
  
Until Quit > 0

Re: GridGadget (Rev. 4) - (El Choni style)

Posted: Tue Dec 17, 2013 11:52 am
by Kwai chang caine
Thanks a lot for sharing
And also to BISONTE, for his example, who help to understand how use this splendid code 8)
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited