AllowLVEdits Version 2.2

Developed or developing a new product in PureBasic? Tell the world about it.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

AllowLVEdits Version 2.2

Post by netmaestro »

* Note: This library was originally released in an earlier form in a compiled version only. Now it's as you see it, a .pbi include and all source shown here in this thread. So some of the replies might not make complete sense here in the fall of 2011.

This library is completely rewritten from the ground up, with a much more intuitive user interface and more powerful options. You can edit cells in the columns of your choosing, mask other columns from editing, specify currency formatting if desired and get automatic input masking, all seamlessly as though you were using Excel or such. (I know that claim's going to come back and bite me...)

The source code is included and written .pbi-friendly, as is a threadsafe version, comprehensive help .chm and an 80-line example program that is a fully functioning cashflow spreadsheet. It isn't quite commercial quality, but it's a very useful little tool.

Here is the .PBI:

Code: Select all

;======================================================================================================================
; Library:           AllowLVEdits 2.20
; Author:            netmaestro  
; Date:              June 19, 2007 last update Nov 28, 2011
; Target OS:         Microsoft Windows All
; Target Compiler:   PureBasic version 4.0+
; License:           Free, unrestricted, no warranty
;
; This library allows the user to edit the contents of ListIcon cells
; by right-clicking on them.
;
; EXPORTED COMMANDS:
; 
; StartEditing(WindowNumber, GadgetNumber); Make ListIcon gadget cells editable
;
; StopEditing(); Take ListIcon gadget out of editable mode
;
; SetMoneyColumn(Column, Width) ; Width is number of digits before the decimal place
;
; DecimalMask(char) ; Char is the character you wish to use for decimal point, usually '.' or ',' (46 or 44)
;
; MaskColumn(Column) ; Disallows edits for the passed column
;
; Ale_RowChanged() ; Returns the row of the last-edited item
;
; Ale_ColumnChanged() ; Returns the column of the last-edited item
;
; Ale_OriginalText() ; Returns a string containing the original item text before the edit
;
; DETECTING CHANGES:
;
; When this library detects an edit to a listicon cell, it will send a #PB_Event_Gadget message
; to your WaitWindowEvent() loop with the EventType() of #Ale_Cellcontents_Changed. When you receive 
; this message, three commands are available to you: 
;
;   - Ale_RowChanged()
;   - Ale_ColumnChanged()
;   - Ale_OriginalText()
;
; These commands may only be called after receiving #PB_Event_Gadget with event type = #Ale_Cellcontents_Changed.
; Additionally, they may only be called once as calling them clears their contents. So if you need them later you
; must save their return values in a variable of your own. 
;
; Using these three commands and a linked-list or array of stored changes, you can easily provide a user with
; the option of cancelling all changes or stepping through an undo list. 
; 
;======================================================================================================================

Import ""
  PB_Gadget_SendGadgetCommand(hWnd, EventType)
EndImport

#Ale_Cellcontents_Changed = 72000

Global _edits210_oldlist,_edits210_EditActive, _edits210_oldstring, _edits210_string, _edits210_decimal, _edits210_container
Global _edits210_itemrect.RECT, _edits210_window, _edits210_item, _edits210_subitem, _edits210_gadget
Global Dim MoneyColumn(100)
Global Dim Masked(100)
Declare.s GetNewText()

ProcedureDLL Ale_ColumnChanged(cell = -1)
  Static cellchanged
  If cell<> -1
    cellchanged = cell
    ProcedureReturn
  Else
    result = cellchanged
    cellchanged = -1
    ProcedureReturn result
  EndIf
EndProcedure

ProcedureDLL Ale_RowChanged(Item = -1)
  Static Itemchanged
  If Item<> -1
    Itemchanged = Item
    ProcedureReturn
  Else
    result = Itemchanged
    Itemchanged = -1
    ProcedureReturn result
  EndIf
EndProcedure

ProcedureDLL.s Ale_OriginalText(orig$ = "")
  Static originaltext$
  If orig$ <> ""
    originaltext$ = orig$
    ProcedureReturn
  Else
    result$ = originaltext$
    originaltext$ = ""
    ProcedureReturn result$
  EndIf
EndProcedure

Procedure SaveAndExit()
  tmp$ = GetGadgetText(_edits210_string)
  orig$ = GetGadgetItemText(_edits210_gadget,_edits210_item,_edits210_subitem)
  If Trim(tmp$) <> Trim(orig$)
    SendChange = #True
    Ale_OriginalText(orig$)
  Else
    SendChange = #False
  EndIf
  If _edits210_item >= 0
    SetGadgetState(_edits210_gadget, _edits210_item)
  EndIf
  crlf = FindString(tmp$, #CRLF$, 1)
  If crlf
    SetGadgetText(_edits210_string,ReplaceString(tmp$,#CRLF$,""))
    SendMessage_(sg,#EM_SETSEL,crlf-1,crlf-1)
  EndIf 
  If Moneycolumn(_edits210_subitem)
    tmpout.s  = Trim(GetGadgetText(_edits210_string))
    ploc = FindString(tmpout,Chr(_edits210_decimal),1)
    If ploc
      If ploc = 1
        tmpout = "0" + tmpout
      EndIf
      While Len(tmpout) - FindString(tmpout,Chr(_edits210_decimal),1) < 2
        tmpout+"0"
        SetGadgetText(_edits210_string, tmpout)
      Wend   
    Else
      If tmpout <> ""
        tmpout + Chr(_edits210_decimal) + "00"
        SetGadgetText(_edits210_string, tmpout)
      EndIf
    EndIf
    If Val(tmpout) = 0
      tmpout= ""
    EndIf
    SetGadgetItemText(_edits210_gadget,_edits210_item, RSet(Trim(tmpout),Moneycolumn(_edits210_subitem)+3," "), _edits210_subitem)
  Else
    SetGadgetItemText(_edits210_gadget,_edits210_item, GetGadgetText(_edits210_string), _edits210_subitem)
  EndIf
  FreeGadget(_edits210_string)
  FreeGadget(_edits210_container)
  _edits210_EditActive = #False
  If SendChange
    Ale_ColumnChanged(_edits210_subitem)
    Ale_RowChanged(_edits210_item)
    PB_Gadget_SendGadgetCommand(GadgetID(_edits210_gadget), #Ale_Cellcontents_Changed)
  EndIf
EndProcedure

Procedure SubClass_String(hwnd, Message, wparam, lparam) 
  Protected blocking=0, ploc, tmpout.s
  result = CallWindowProc_(_edits210_oldlist, hwnd, Message, wparam, lparam) 
  Select Message
    Case #WM_KEYDOWN
      Select wparam
        Case #VK_RETURN
          SaveAndExit()
          _edits210_item + 1
          If _edits210_item < CountGadgetItems(_edits210_gadget)
            RtlZeroMemory_(@_edits210_itemrect,SizeOf(RECT))
            _edits210_itemrect\top = _edits210_subitem
            SendMessage_(GadgetID(_edits210_gadget), #LVM_GETSUBITEMRECT, _edits210_item, @_edits210_itemrect)
            GetNewText()
          EndIf   
          
        Case #VK_ESCAPE
          FreeGadget(_edits210_string)
          FreeGadget(_edits210_container)
          _edits210_EditActive = #False
          
        Case #VK_LEFT
          SendMessage_(hwnd, #EM_GETSEL, @first.l, @last.l)
          If first = 0
            SaveAndExit()
            currentsubitem = _edits210_subitem
            _edits210_subitem - 1 
            If _edits210_subitem >= 1
              While masked(_edits210_subitem) And _edits210_subitem >= 0
                _edits210_subitem - 1
                If _edits210_subitem < 1
                  _edits210_subitem = currentsubitem
                EndIf
              Wend
            Else
              _edits210_subitem + 1
            EndIf
            RtlZeroMemory_(@_edits210_itemrect,SizeOf(RECT))
            _edits210_itemrect\top = _edits210_subitem
            SendMessage_(GadgetID(_edits210_gadget), #LVM_GETSUBITEMRECT, _edits210_item, @_edits210_itemrect)
            GetNewText()
          EndIf
          
        Case #VK_RIGHT
          SendMessage_(hwnd, #EM_GETSEL, @first.l, @last.l)
          If Len(GetGadgetText(_edits210_string)) = last
            headerhWnd=SendMessage_(GadgetID(_edits210_gadget),#LVM_GETHEADER,0,0) 
            numcolumns = SendMessage_(headerhWnd, #HDM_GETITEMCOUNT,0,0)
            If _edits210_subitem < numcolumns-1
              SaveAndExit()
              currentsubitem = _edits210_subitem
              _edits210_subitem + 1 
              If _edits210_subitem < numcolumns
                While masked(_edits210_subitem) And _edits210_subitem <= numcolumns
                  _edits210_subitem + 1
                  If _edits210_subitem >= numcolumns
                    _edits210_subitem = currentsubitem
                  EndIf
                Wend
              Else
                _edits210_subitem -1
              EndIf
              RtlZeroMemory_(@_edits210_itemrect,SizeOf(RECT))
              _edits210_itemrect\top = _edits210_subitem
              SendMessage_(GadgetID(_edits210_gadget), #LVM_GETSUBITEMRECT, _edits210_item, @_edits210_itemrect)
              GetNewText()
            EndIf
          EndIf
          
        Case #VK_UP
          SaveAndExit()
          _edits210_item - 1 : If _edits210_item <= 0 : _edits210_item = 0 : EndIf
          RtlZeroMemory_(@_edits210_itemrect,SizeOf(RECT))
          _edits210_itemrect\top = _edits210_subitem
          SendMessage_(GadgetID(_edits210_gadget), #LVM_GETSUBITEMRECT, _edits210_item, @_edits210_itemrect)
          GetNewText()
          
        Case #VK_DOWN
          SaveAndExit()
          _edits210_item + 1:If _edits210_item >= CountGadgetItems(_edits210_gadget):_edits210_item - 1 : EndIf
          RtlZeroMemory_(@_edits210_itemrect,SizeOf(RECT))
          _edits210_itemrect\top = _edits210_subitem
          SendMessage_(GadgetID(_edits210_gadget), #LVM_GETSUBITEMRECT, _edits210_item, @_edits210_itemrect)
          GetNewText()
          
      EndSelect
      
    Case #WM_CHAR
      If MoneyColumn(_edits210_subitem)
        blocking = 1
        Select wparam
          Case _edits210_decimal, 48 To 57
            tmpout.s = GetGadgetText(_edits210_string)
            If FindString(tmpout, Chr(_edits210_decimal), 1) = 0
              If Len(tmpout) > MoneyColumn(_edits210_subitem)
                If wparam <> _edits210_decimal
                  SendMessage_(hwnd, #EM_GETSEL, 0, @pos) 
                  SetGadgetText(_edits210_string, Left(tmpout,Len(tmpout)-1)) 
                  SendMessage_(hwnd, #EM_SETSEL, pos-1, pos-1) 
                EndIf
              EndIf
            EndIf  
            If wparam = _edits210_decimal
              If CountString(tmpout, Chr(_edits210_decimal)) > 1
                SendMessage_(hwnd, #EM_GETSEL, 0, @pos) 
                SetGadgetText(_edits210_string, Left(tmpout,Len(tmpout)-1)) 
                SendMessage_(hwnd, #EM_SETSEL, pos-1, pos-1) 
              EndIf        
            EndIf
            If FindString(tmpout,Chr(_edits210_decimal),1)
              If Len(tmpout) - FindString(tmpout,Chr(_edits210_decimal),1) > 2
                SendMessage_(hwnd, #EM_GETSEL, 0, @pos) 
                SetGadgetText(_edits210_string, Left(tmpout,Len(tmpout)-1)) 
                SendMessage_(hwnd, #EM_SETSEL, pos-1, pos-1) 
              EndIf        
            EndIf
          Default
            If wparam <> 8 And wparam <> 13
              tmpout.s = GetGadgetText(_edits210_string)
              SendMessage_(hwnd, #EM_GETSEL, 0, @pos) 
              SetGadgetText(_edits210_string, Left(tmpout,Len(tmpout)-1)) 
              SendMessage_(hwnd, #EM_SETSEL, pos-1, pos-1) 
            EndIf
        EndSelect
      EndIf
      
    Case #WM_PASTE
      If MoneyColumn(_edits210_subitem)
        tmpout.s = GetGadgetText(_edits210_string)
        If FindString(tmpout,Chr(_edits210_decimal),1)
          validlength = MoneyColumn(_edits210_subitem)+3
        Else
          validlength = MoneyColumn(_edits210_subitem)
        EndIf
        If Len(tmpout)<=validlength
          ok = #True
          *cc.CHARACTER = @tmpout
          While *cc\c
            Select *cc\c
              Case '0' To '9', _edits210_decimal
              Default
                ok = #False
            EndSelect
            *cc+1
          Wend
        Else
          ok = #False
        EndIf
        If Not ok
          SetGadgetText(_edits210_string, "")
        EndIf
      EndIf
  EndSelect
  
  ProcedureReturn result 
EndProcedure 

Procedure.s GetNewText()
  _edits210_EditActive = #True
  Protected grect.rect
  twleft  =   _edits210_itemrect\left+6
  twtop   =   _edits210_itemrect\top
  winwidth =  _edits210_itemrect\right-_edits210_itemrect\left-8
  winheight = _edits210_itemrect\bottom-_edits210_itemrect\top-1
  oldgadgetlist = UseGadgetList(GadgetID(_edits210_gadget))
  _edits210_container = ContainerGadget(#PB_Any, twleft-2,twtop-2,winwidth+4,winheight+4)
  HideGadget(_edits210_container, 1)
  SetGadgetColor(_edits210_container,#PB_Gadget_BackColor, #Black)
  If MoneyColumn(_edits210_subitem)
    _edits210_string  = StringGadget(#PB_Any,2,2,winwidth,winheight,RemoveString(GetGadgetItemText(_edits210_gadget,_edits210_item,_edits210_subitem)," "),#PB_String_BorderLess|#ES_MULTILINE|#ES_AUTOVSCROLL) 
  Else
    _edits210_string  = StringGadget(#PB_Any,2,2,winwidth,winheight,GetGadgetItemText(_edits210_gadget,_edits210_item,_edits210_subitem),#PB_String_BorderLess|#ES_MULTILINE|#ES_AUTOVSCROLL)
  EndIf   
  CloseGadgetList()   
  SetGadgetFont(_edits210_string, GetGadgetFont(_edits210_gadget))
  UseGadgetList(oldgadgetlist)
  SetActiveGadget(_edits210_string) 
  _edits210_oldstring=SetWindowLong_(GadgetID(_edits210_string), #GWL_WNDPROC, @SubClass_String()) 
  SendMessage_(GadgetID(_edits210_string),#EM_SETSEL,0,-1)
  HideGadget(_edits210_container, 0)
  GetWindowRect_(GadgetID(_edits210_gadget), @gr.RECT)
  GetWindowRect_(GadgetID(_edits210_container), @cr.RECT)
  GetClientRect_(GadgetID(_edits210_gadget), @grc.RECT)
  If cr\top - gr\top < winheight
    SendMessage_(GadgetID(_edits210_gadget), #WM_VSCROLL, #SB_LINEUP ,0)
  ElseIf cr\top - gr\top > grc\bottom-grc\top-winheight
    SendMessage_(GadgetID(_edits210_gadget), #WM_VSCROLL, #SB_LINEDOWN ,0)
  EndIf
  If GadgetWidth(_edits210_gadget)-twleft < winwidth
    SendMessage_(GadgetID(_edits210_gadget), #WM_HSCROLL, #SB_RIGHT, 0)
  ElseIf twleft<0
    SendMessage_(GadgetID(_edits210_gadget), #WM_HSCROLL, #SB_LEFT, 0)
  EndIf
EndProcedure 

Procedure ResizeEdit(hwnd)
  RtlZeroMemory_(@_edits210_itemrect,SizeOf(RECT)) 
  _edits210_itemrect\top = _edits210_subitem
  SendMessage_(hwnd, #LVM_GETSUBITEMRECT, _edits210_item, @_edits210_itemrect)      
  twleft    = _edits210_itemrect\left+6
  twtop     = _edits210_itemrect\top
  winwidth  = _edits210_itemrect\right-_edits210_itemrect\left-8
  winheight = _edits210_itemrect\bottom-_edits210_itemrect\top-1
  ResizeGadget(_edits210_container,twleft-2,twtop-2,winwidth+4,winheight+4)
  ResizeGadget(_edits210_string, 2,2, GadgetWidth(_edits210_container)-4, GadgetHeight(_edits210_container)-4)
  InvalidateRect_(GadgetID(_edits210_container),0,1) 
  If GadgetY(_edits210_container) < winheight
    HideGadget(_edits210_container, 1)
  Else
    HideGadget(_edits210_container, 0)
    SetActiveGadget(_edits210_string)
  EndIf          
EndProcedure

Procedure SubClass_LV(hwnd, Message, wparam, lparam) 
  
  result = CallWindowProc_(_edits210_oldlist, hwnd, Message, wparam, lparam) 
  
  If message = #WM_KEYUP
    If wparam = #VK_TAB
      If GetAsyncKeyState_(#VK_SHIFT) & 32768
        SaveAndExit()
        currentsubitem = _edits210_subitem
        _edits210_subitem - 1 
        If _edits210_subitem >= 1
          While masked(_edits210_subitem) And _edits210_subitem >= 0
            _edits210_subitem - 1
            If _edits210_subitem < 1
              _edits210_subitem = currentsubitem
            EndIf
          Wend
        Else
          _edits210_subitem + 1
        EndIf
        RtlZeroMemory_(@_edits210_itemrect,SizeOf(RECT))
        _edits210_itemrect\top = _edits210_subitem
        SendMessage_(GadgetID(_edits210_gadget), #LVM_GETSUBITEMRECT, _edits210_item, @_edits210_itemrect)
        GetNewText()       
      Else
        If IsGadget(_edits210_string) 
          headerhWnd=SendMessage_(GadgetID(_edits210_gadget),#LVM_GETHEADER,0,0) 
          numcolumns = SendMessage_(headerhWnd, #HDM_GETITEMCOUNT,0,0)
          SaveAndExit()
          currentsubitem = _edits210_subitem
          _edits210_subitem + 1 
          If _edits210_subitem < numcolumns
            While masked(_edits210_subitem) And _edits210_subitem <= numcolumns
              _edits210_subitem + 1
              If _edits210_subitem >= numcolumns
                _edits210_subitem = currentsubitem
              EndIf
            Wend
          Else
            _edits210_subitem -1
          EndIf
          RtlZeroMemory_(@_edits210_itemrect,SizeOf(RECT))
          _edits210_itemrect\top = _edits210_subitem
          SendMessage_(GadgetID(_edits210_gadget), #LVM_GETSUBITEMRECT, _edits210_item, @_edits210_itemrect)
          GetNewText()
        EndIf
      EndIf
    EndIf
  EndIf
  
  If message = #WM_VSCROLL Or message = #WM_HSCROLL
    If IsGadget(_edits210_container) And _edits210_container <> 0
      ResizeEdit(hwnd)
    EndIf
  EndIf
  
  If message=#WM_NOTIFY 
    If IsGadget(_edits210_container) And _edits210_container <> 0
      *nmHEADER.HD_NOTIFY = lParam 
      Select *nmHEADER\hdr\code 
        Case #HDN_ITEMCHANGING 
          ResizeEdit(hwnd)
      EndSelect 
    EndIf
  EndIf
  
  If Message = #WM_RBUTTONDOWN 
    If Not _edits210_EditActive
      GetCursorPos_(@cp.POINT)
      MapWindowPoints_(0,hwnd,@cp,1)
      HitInfo.LVHITTESTINFO 
      Hitinfo\pt\x = cp\x
      HitInfo\pt\y = cp\y
      SendMessage_(hwnd,#LVM_SUBITEMHITTEST ,0,@HitInfo)
      SetGadgetState(_edits210_gadget, hitinfo\iitem)
      If hitinfo\isubitem > 0 And HitInfo\iItem >= 0
        RtlZeroMemory_(@_edits210_itemrect,SizeOf(RECT))
        _edits210_itemrect\top = hitinfo\iSubItem
        SendMessage_(hwnd,#LVM_GETSUBITEMRECT, hitinfo\iitem, @_edits210_itemrect)
        _edits210_item = hitinfo\iitem
        _edits210_subitem = hitinfo\iSubItem
        If Not Masked(_edits210_subitem)
          GetNewText() 
        EndIf
      EndIf
    Else
      FreeGadget(_edits210_string)
      FreeGadget(_edits210_container)
      _edits210_EditActive = #False
    EndIf
  EndIf 
  
  If Message = #WM_LBUTTONDOWN
    If _edits210_EditActive
      FreeGadget(_edits210_string)
      FreeGadget(_edits210_container)
      _edits210_EditActive = #False
    EndIf
  EndIf 
  ProcedureReturn result 
EndProcedure 

ProcedureDLL StopEditing(); Take ListIcon gadget out of editable mode
  _edits210_editactive = #False
  If _edits210_string
    If IsGadget(_edits210_string) : FreeGadget(_edits210_string) : EndIf
  EndIf
  If _edits210_container
    If IsGadget(_edits210_container) : FreeGadget(_edits210_container) : EndIf
  EndIf
  If _edits210_oldlist
    If IsGadget(_edits210_gadget)
      SetWindowLong_(GadgetID(_edits210_gadget), #GWL_WNDPROC, _edits210_oldlist) 
      _edits210_oldlist = 0
    EndIf
  EndIf
EndProcedure

ProcedureDLL StartEditing(WindowNumber, GadgetNumber); Make ListIcon gadget cells editable
  StopEditing()
  _edits210_window=WindowNumber
  Protected cn$ = Space(100)
  GetClassName_(GadgetID(GadgetNumber),@cn$,99)
  If UCase(Trim(cn$)) = "SYSLISTVIEW32" And _edits210_oldlist = 0
    _edits210_oldlist=SetWindowLong_(GadgetID(GadgetNumber), #GWL_WNDPROC, @SubClass_LV()) 
    _edits210_gadget = GadgetNumber
    Global Dim Masked(100)
    Global Dim MoneyColumn(100)
    _edits210_decimal = 46
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

ProcedureDLL SetMoneyColumn(Column, Width) ; Width is number of digits before the decimal place
  If _edits210_oldlist
    With lvc.LV_COLUMN
      \Mask = #LVCF_FMT 
      \fmt=#LVCFMT_RIGHT
    EndWith
    SendMessage_(GadgetID(_edits210_gadget),#LVM_SETCOLUMN,column,@lvc)
    If width >= 1
      MoneyColumn(Column) = width
    Else
      MoneyColumn(Column) = 1
    EndIf
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

ProcedureDLL DecimalMask(char) ; Char is the character you wish to use for decimal point, usually '.' or ',' (46 or 44)
  _edits210_decimal = char
EndProcedure

ProcedureDLL MaskColumn(Column) ; Disallows edits for the passed column
  If _edits210_oldlist
    Masked(Column) = 1
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

;And a useful testcode here:
;Code:
;=======================================================
; Program:        AllowLVEdits 2.2 Demo program
; Author:         netmaestro
;=======================================================
;
If #PB_Compiler_IsMainFile = 0
  End
EndIf
  
Structure editrecord
  row.i 
  col.i
  newtext$
  oldtext$
EndStructure

Global NewList edits.editrecord()
AddElement(edits())

Procedure$ DayStr(day)
  ProcedureReturn Mid("SunMonTueWedThuFriSat", day*3+1, 3)
EndProcedure 

Procedure Recalc()
  runningtotal.d = 0
  For i = 0 To CountGadgetItems(0)-1
    tmp$ = GetGadgetItemText(0,i,2)
    If tmp$<>"" : runningtotal+ValD(tmp$) : EndIf
    tmp$ = GetGadgetItemText(0,i,3)
    If tmp$<>"" : runningtotal-ValD(tmp$) : EndIf
    If runningtotal < 0
      txtout.s="("+StrD(runningtotal,2)+")"
    Else
      txtout.s = StrD(runningtotal,2)
    EndIf
    If runningtotal < 0
      SetGadgetItemColor(0,i,#PB_Gadget_FrontColor, #Red, 4)
    Else
      SetGadgetItemColor(0,i,#PB_Gadget_FrontColor, #Black, 4)
    EndIf
    SetGadgetItemText(0,i,txtout,4)
  Next
EndProcedure

Procedure Load()
  If ReadFile(0, "cashflow.dat")
    SendMessage_(GadgetID(0), #WM_SETREDRAW, 0,0)
    While Not Eof(0)
      AddGadgetItem(0, -1, ReplaceString(ReadString(0),"|",Chr(10)))
    Wend
    CloseFile(0)
    SendMessage_(GadgetID(0), #WM_SETREDRAW, 1, 0)
  Else     
    SendMessage_(GadgetID(0), #WM_SETREDRAW, 0,0)
    For i=0 To 365*5
      date = AddDate(ParseDate("%mm/%dd/%yyyy","11/01/2011") , #PB_Date_Day, i)
      date$ = DayStr(DayOfWeek(date))+FormatDate("%mm/%dd/%yyyy", date)
      AddGadgetItem(0, -1, Chr(10)+RSet(date$,14," ")+Chr(10)+Space(0)+Chr(10)+Space(0)+Chr(10)+Space(0)+Chr(10)+Space(0)+Chr(10))
    Next
    SendMessage_(GadgetID(0), #WM_SETREDRAW, 1,0)
  EndIf
  For i=0 To CountGadgetItems(0)-1
    SetGadgetItemColor(0,i,#PB_Gadget_BackColor,RGB(240,240,240),1)
    If FindString(GetGadgetItemText(0,i,4), "(", 1) 
      SetGadgetItemColor(0,i,#PB_Gadget_FrontColor,#Red,4)
    EndIf
    SetGadgetItemColor(0,i,#PB_Gadget_BackColor,RGB(240,240,240),4)  
  Next
EndProcedure

Procedure Save()
  Dim t.s(5)
  If CreateFile(0, "CashFlow.dat")
    For i = 0 To CountGadgetItems(0)-1
      For j=1 To 5
        t(j) = GetGadgetItemText(0,i,j)
      Next
      WriteStringN(0, "|"+t(1)+"|"+t(2)+"|"+t(3)+"|"+t(4)+"|"+t(5)+"|" )
    Next
    CloseFile(0)
  EndIf
EndProcedure

LoadFont(0, "Courier New",9)
w = OpenWindow(0,0,0,840,700,"Cash Flow Budget",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)

CreateToolBar(0, WindowID(0))
ToolBarStandardButton(0, #PB_ToolBarIcon_Save)
ToolBarStandardButton(1, #PB_ToolBarIcon_Undo)
ToolBarStandardButton(2, #PB_ToolBarIcon_Redo)

ListIconGadget(0,0,ToolBarHeight(0),840,700-ToolBarHeight(0),"",0,#PB_ListIcon_GridLines)
SetGadgetColor(0, #PB_Gadget_LineColor, RGB(210,210,210))
AddGadgetColumn(0,1,"Date",        150)
AddGadgetColumn(0,2,"Income",      130)
AddGadgetColumn(0,3,"Expense",     130)
AddGadgetColumn(0,4,"Balance",     130)
AddGadgetColumn(0,5,"Description", 275)
SetGadgetFont(0,FontID(0))

StartEditing(0,0)
SetMoneyColumn(2,12)
SetMoneyColumn(3,12)
SetMoneyColumn(4,12)
MaskColumn(1)
MaskColumn(4)

Load()

Repeat
  EventID = WaitWindowEvent()
  Select EventID
    Case #PB_Event_Gadget
      If EventGadget() = 0
        Select EventType() 
          Case #Ale_Cellcontents_Changed
            
            ; store undo infos
            AddElement(edits())
            With edits()
              \col = Ale_ColumnChanged()
              \row = Ale_RowChanged()
              \oldtext$ = Ale_OriginalText()
              \newtext$ = GetGadgetItemText(0, edits()\row, edits()\col)
            EndWith
            current=ListIndex(edits())
            LastElement(edits())
            While ListIndex(edits())<>current
              DeleteElement(edits())
            Wend
            
            ; recalculate the worksheet
            Recalc()
            
          Case #PB_EventType_LeftDoubleClick
            GetCursorPos_(@cp.POINT)
            MapWindowPoints_(0,GadgetID(0),@cp.POINT,1)
            HitInfo.LVHITTESTINFO\pt = cp.POINT
            SendMessage_(GadgetID(0),#LVM_SUBITEMHITTEST ,0,@HitInfo)
            If hitinfo\isubitem = 1
              AddGadgetItem(0, hitinfo\iItem+1, Chr(10)+GetGadgetItemText(0,hitinfo\iItem,1))
              SetGadgetItemColor(0, hitinfo\iItem+1, #PB_Gadget_BackColor, RGB(240,240,240), 1)
              SetGadgetItemColor(0, hitinfo\iItem+1, #PB_Gadget_BackColor, RGB(240,240,240), 4)
              recalc()
            EndIf
            
          Case #PB_EventType_RightDoubleClick
            GetCursorPos_(@cp.POINT)
            MapWindowPoints_(0,GadgetID(0),@cp.POINT,1)
            HitInfo.LVHITTESTINFO\pt = cp.POINT
            SendMessage_(GadgetID(0),#LVM_SUBITEMHITTEST ,0,@HitInfo)
            If hitinfo\isubitem = 1
              If GetGadgetItemText(0, hitinfo\iItem, 1) = GetGadgetItemText(0, hitinfo\iItem-1, 1)
                RemoveGadgetItem(0, hitinfo\iItem)
                recalc()
              EndIf
            EndIf
            
        EndSelect
      EndIf
      
    Case #PB_Event_Menu
      Select EventMenu()
        Case 0
          Save()
          
        Case 1
          If ListIndex(edits())>0
            SetGadgetItemText(0, edits()\row, edits()\oldtext$, edits()\col)
            PreviousElement(edits())
            recalc()
          EndIf
          
        Case 2
          NextElement(edits())
          SetGadgetItemText(0, edits()\row, edits()\newtext$, edits()\col)
          recalc()
          
      EndSelect
  EndSelect
Until EventID = #PB_Event_CloseWindow
Save()
StopEditing()

Last edited by netmaestro on Wed Jul 29, 2015 10:00 pm, edited 17 times in total.
BERESHEIT
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

That's pretty cool!

I like the way you've clipped the cursor there. :)

Can't seem to edit the zero column though.
I may look like a mule, but I'm not a complete ass.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

No, sorry, I should have mentioned it - The label column is off-limits. You'd use the standard LVS_EDITLABELS, etc. stuff for that. Or, if you didn't want to mess with that, you can just make the label column width = 0 and all your columns are editable.
BERESHEIT
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Sorry - I left a tiny bug in that would mess up the coloring if more than one listicon was set editable. I can never get anything out the door clean the first time. Anyways, it's fixed now.
BERESHEIT
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

This morning brings an update to this library:

-Command is changed to StartEditing(#gadget, leavecolored)

-New command StopEditing(#gadget) is added

-Only one listicon gadget can be editable at a time

-Editing is a bit more intuitive

The leavecolored flag is either 0 or 1, depending upon whether you would like the cell to be highlighted after the edit. It is useful for cases where you have edits made to the gadget that are not yet committed to the database. It shows the user that a save is required. Once they are committed, you can issue one SetGadgetColor command for the background of the listicon and all highlights will be removed.

-Sourcecode is included in the zip for those who prefer includes
BERESHEIT
TerryHough
Enthusiast
Enthusiast
Posts: 781
Joined: Fri Apr 25, 2003 6:51 pm
Location: NC, USA
Contact:

Post by TerryHough »

Thanks! What a great idea. That is twice in one week you have helped me out.

Suggestion: Sometimes you want to edit the existing data in a cell. As is, you can't see the existing data. Could you preload the new gadget with the existing data so it could be edited without total reentry?
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Yes, good suggestion! Changes are uploaded.
BERESHEIT
TerryHough
Enthusiast
Enthusiast
Posts: 781
Joined: Fri Apr 25, 2003 6:51 pm
Location: NC, USA
Contact:

Post by TerryHough »

You are fast!

IMHO, a slight refinement suggestion that allows easier editing...

Now that you are bringing the existing data from the cell, make that data "selected" with the cursor at the beginning of the data in the stringgadget. Then, if the user just starts typing, the data erases and he is starting with a blank field. If he clicks on the field somewhere or uses the arrow keys to move the cursor, the "selection" is removed and he can delete or insert characters, etc. till he clicks OK or presses Enter.

I appreciate that you have already integrated the Enter and Esc keys in this. Makes it much more usable.

Thanks,
Terry
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

OK. The text comes up selected now, change is uploaded. Thanks for the good suggestions.
BERESHEIT
TerryHough
Enthusiast
Enthusiast
Posts: 781
Joined: Fri Apr 25, 2003 6:51 pm
Location: NC, USA
Contact:

Post by TerryHough »

Greeting old maestro!

I believe there is an unintended action here. Do this:
1) Create a list icon with several lines of entry
2) Somewhere in the blank space (after all the entries), right click.
3) A LVEdit gadget will pop over the column's heading line, display the column's heading. and any data entered/edit will ovelay the column's heading plus the entire column's data will be marked as updated.

Here is some code to test with (stolen from gnozal's PureLVSort example and modified for this use).

Code: Select all

#Window_0 = 0
#ListIcon_0 = 0
If OpenWindow(#Window_0, 216, 0, 602, 302, "PureLVSORT Test",  #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If CreateGadgetList(WindowID(#Window_0))
    ListIconGadget(#ListIcon_0, 5, 5, 590, 285, "", 0, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
    AddGadgetColumn(#ListIcon_0, 1, "String", 110)
    AddGadgetColumn(#ListIcon_0, 2, "Numeric", 110)
    AddGadgetColumn(#ListIcon_0, 3, "Float", 110)
    AddGadgetColumn(#ListIcon_0, 4, "DateDDMMYYYY", 120)
    AddGadgetColumn(#ListIcon_0, 5, "DateMMDDYYYY", 120)
    AddGadgetItem(#ListIcon_0, -1, Chr(10) + "ABCDE" + Chr(10) + "514" + Chr(10) + "0.9" + Chr(10) + "31/12/2004" + Chr(10) + "12/31/2004")
    AddGadgetItem(#ListIcon_0, -1, Chr(10) + "ACDEF" + Chr(10) + "118" + Chr(10) + "1.9" + Chr(10) + "11/12/2004" + Chr(10) + "12/11/2004")
    AddGadgetItem(#ListIcon_0, -1, Chr(10) + "ZABCD" + Chr(10) + "-414" + Chr(10) + "7.0" + Chr(10) + "21/01/2003" + Chr(10) + "01/21/2003")
    AddGadgetItem(#ListIcon_0, -1, Chr(10) + "DEFGH" + Chr(10) + "524" + Chr(10) + "900" + Chr(10) + "10/06/2001" + Chr(10) + "06/10/2001")
    StartEditing (#ListIcon_0, #True)
  EndIf
;   ; ListIcon Sort Setup (PureLVSort Library)
;   If PureLVSORT_SelectGadgetToSort(#ListIcon_0, #PureLVSORT_ShowClickedHeader_IconLeft) = #PureLVSORT_Ok
;     PureLVSORT_SetFilter(#ListIcon_0)
;     PureLVSORT_SetColumnType(#ListIcon_0, 0, #PureLVSORT_String) ; default, not necessary
;     PureLVSORT_SetColumnType(#ListIcon_0, 1, #PureLVSORT_Numeric)
;     PureLVSORT_SetColumnType(#ListIcon_0, 2, #PureLVSORT_Float)
;     PureLVSORT_SetColumnType(#ListIcon_0, 3, #PureLVSORT_DateDDMMYYYY)
;     PureLVSORT_SetColumnType(#ListIcon_0, 4, #PureLVSORT_DateMMDDYYYY)
;   EndIf
  ;
  Repeat
    Event = WaitWindowEvent()
    If EventType() = #PB_EventType_LeftDoubleClick
;       PureLVSORT_ClearGadget(#ListIcon_0)
    EndIf
  Until Event = #PB_Event_CloseWindow
EndIf
End
If you have the PureLVSort library installed, you can reactivate those lines and see how the action described above affects the heading and where the LVEdit gadget pops up over the filter portion of the header.

Terry
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Thanks for the good report. Fixed and uploaded. Also changed the style of the editing window to WS_EX_TOOLWINDOW so it no longer shows on the taskbar when you do an edit.
BERESHEIT
blackborg
User
User
Posts: 38
Joined: Thu Nov 02, 2006 8:20 pm

Is the allowlvedits library still available:

Post by blackborg »

if so, where can we download it.. the link included doesn't seem to work?
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

I dunno what happened to it, it must've gotten deleted by accident somehow. It's back in there now, so it should be working again. Sorry for the inconvenience.
BERESHEIT
blackborg
User
User
Posts: 38
Joined: Thu Nov 02, 2006 8:20 pm

Thanks

Post by blackborg »

netmaestro wrote:I dunno what happened to it, it must've gotten deleted by accident somehow. It's back in there now, so it should be working again. Sorry for the inconvenience.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Update: Complete rewrite, now in version 2.0. See first post for link.
BERESHEIT
Post Reply