PB 5.20 Listicongadget simples Edit als Modul
Verfasst: 08.09.2013 18:39
Hier mal als Modul, only Windows wegen der vielen Api Befehle, die nötig sind, da in PB immer noch sehr viel fehlt. 
Doppelclick auf eine Zelle = Edit
Taste entf + einfg mit/ohne Shift werden unterstützt
ebenfalls externes auswerten der Eingaben
Das ganze läßt sich natürlich erweitern, aber das bleibt bei Bedarf jedem selbst überlassen
Ist dann aber nicht mehr Simpel
__________________________________________________
Thread verschoben
Windows>Code, Tipps und Tricks
09.09.2013
RSBasic
Doppelclick auf eine Zelle = Edit
Taste entf + einfg mit/ohne Shift werden unterstützt
ebenfalls externes auswerten der Eingaben
Das ganze läßt sich natürlich erweitern, aber das bleibt bei Bedarf jedem selbst überlassen
Ist dann aber nicht mehr Simpel
Code: Alles auswählen
; 07.09.2013 - PB 5.20 beta 17 Windows x86
DeclareModule ListIconGadgetEdit
; Alle Elemente in diesem Abschnitt sind für den Zugriff von außerhalb verfügbar
Declare ListIconGadgetEdit(lvnr, window, ptr = 0)
#my_EventType_EditEnd = #PB_Event_FirstCustomValue + 10
EndDeclareModule
Module ListIconGadgetEdit
; Alle Elemente in diesem Abschnitt sind privat. Alle Namen können ohne
; Namenskonflikt auch woanders verwendet werden.
Structure EditStruktur
lvnr.i ;ListIconGadget PBnr
lvpt.i ;Pointer Ori WndProc
item.i ;Zeile
subitem.i ;Spalte
header.i ;Header Id
strgnr.i ;Stringgadget PBnr
strgid.i
strgpt.i ;Pointer Ori WndProc
editflag.i ;wenn 1 im Editmode
oldtext.s
newtext.s
checktext.i ; einen Pointer; 0 für keinen Check; 1 für Eventtype
StructureUnion ;um lParam in Hi + Loword zu zerlegen, nur für Mouseposi
lparam.i ; lParam vom Callback
points.points ; aufgeteiltes lParam in x + y
EndStructureUnion
EndStructure
Prototype p_checktext(nr, item, subitem, old$, new$)
Global CheckText.p_checktext
EnableExplicit
Macro Edit_End(p)
If p\editflag
p\editflag = 0
p\oldtext = GetGadgetItemText(p\lvnr, p\item, p\subitem)
p\newtext = GetGadgetText(p\strgnr)
SetGadgetItemText(p\lvnr, p\item, p\newtext, p\subitem)
HideGadget(p\strgnr, 1)
SetGadgetState(p\lvnr, p\item)
;Check
If p\checktext = 1
PostEvent(#PB_Event_Gadget, EventWindow(), p\lvnr, #my_EventType_EditEnd)
ElseIf p\checktext > 1
CheckText = p\checktext
If CheckText(p\lvnr, p\item, p\subitem, p\oldtext, p\newtext) = #False
SetGadgetItemText(p\lvnr, p\item, p\oldtext, p\subitem)
EndIf
EndIf
EndIf
EndMacro
Macro Edit_Esc(p)
If p\editflag
p\editflag = 0
HideGadget(p\strgnr, 1)
SetGadgetState(p\lvnr, p\item)
EndIf
EndMacro
Procedure.s ListIconGadgetGetItem(lvnr, iitem)
Protected j
Protected head = SendMessage_(GadgetID(lvnr), #LVM_GETHEADER, 0, 0)
Protected cols = SendMessage_(head, #HDM_GETITEMCOUNT, 0, 0)
Protected item$ = GetGadgetItemText(lvnr, iitem, 0)
For j = 1 To cols -1
item$ + #TAB$ + GetGadgetItemText(lvnr, iitem, j)
Next
item$ + #CR$
ProcedureReturn item$
EndProcedure
Procedure.i CallBackLv(hwnd, msg, wParam, lParam)
;hwnd ist die ID vom Gadget
Protected *lv.EditStruktur = GetWindowLongPtr_(hwnd, #GWL_USERDATA)
With *lv
Protected hitinfo.LVHITTESTINFO
Protected rect.RECT
Protected *nm.NMHDR
Protected j, x, y, br, hh, txt$, txtbr
Protected index, shift
Protected itemcount
Protected lvwidth = GadgetWidth(\lvnr) - 6 ;Rahmen abziehen
;Scrollbar vorhanden ?
If GetWindowLongPtr_(hwnd, #GWL_STYLE) & #WS_VSCROLL
lvwidth - GetSystemMetrics_(#SM_CXVSCROLL)
EndIf
Static item$ ;für Insert
Select msg
Case #WM_MOUSEMOVE
;#WM_MOUSEMOVE Abfrage extra für F2
;sonst könnte man lparam von #WM_LBUTTONDBLCLK nehmen
If \editflag = 0
\lparam = lparam ;Mouseposi: Hi+Loword stehen in \points\x + y
EndIf
Case #WM_LBUTTONDBLCLK
;zuerst Endemacro aufrufen
Edit_End(*lv)
;LBUTTONDBLCLK auf welches Subitem (points kommt von #WM_MOUSEMOVE)
hitinfo\pt\x = \points\x ;von #WM_MOUSEMOVE siehe EditStruktur
hitinfo\pt\y = \points\y
SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, hitinfo)
\item = hitinfo\iitem
\subitem = hitinfo\iSubItem
;Subitem Größe holen
rect\top = \subitem
rect\left = #LVIR_LABEL
SendMessage_(hwnd, #LVM_GETSUBITEMRECT, \item, rect)
;verschieben horizontal?
If rect\left < 0
SendMessage_(hwnd, #LVM_SCROLL, rect\left - 4, 0)
ElseIf rect\right > lvwidth
SendMessage_(hwnd, #LVM_SCROLL, Abs(lvwidth - rect\right), 0)
EndIf
;rect wieder abfragen, falls verschoben
rect\top = \subitem
rect\left = #LVIR_LABEL
SendMessage_(hwnd, #LVM_GETSUBITEMRECT, \item, rect)
;Posi vom Stringgadget + Größe + anzeigen
x = rect\left + 1
y = rect\top + 0
br = rect\right - rect\left - 1
hh = rect\bottom - rect\top - 0
txt$ = GetGadgetItemText(\lvnr, \item, \subitem)
txtbr = SendMessage_(hwnd, #LVM_GETSTRINGWIDTH, 0, @txt$) + 15
If txtbr > br: br = txtbr: EndIf
If x + br > lvwidth: br = lvwidth - x: EndIf
ResizeGadget(\strgnr, x, y, br, hh)
SetGadgetText(\strgnr, txt$)
SendMessage_(GadgetID(\strgnr), #EM_SETSEL, Len(txt$), -1) ;Cursor ans Ende
HideGadget(\strgnr, 0)
SetActiveGadget(\strgnr)
SetGadgetState(\lvnr, -1)
\editflag = 1
Case #WM_VSCROLL, #WM_HSCROLL, #WM_RBUTTONDOWN, #WM_LBUTTONDOWN ;, #WM_NCMOUSELEAVE
Edit_End(*lv)
Case #WM_NOTIFY ;vom Header
*nm = lparam
If *nm\hwndFrom = \header: Edit_End(*lv): EndIf
Case #WM_KEYDOWN ;: Debug wParam
Select wParam
Case #VK_F2: PostMessage_(hwnd, #WM_LBUTTONDBLCLK, 0, 0)
Case #VK_DELETE
shift = #False
If GetKeyState_(#VK_SHIFT) > 1: shift = #True: EndIf
If shift = #True: item$ = "": EndIf
index = -1
itemcount = SendMessage_(hwnd, #LVM_GETSELECTEDCOUNT, 0, 0)
For j = 1 To itemcount
index = SendMessage_(hwnd, #LVM_GETNEXTITEM, index, #LVNI_SELECTED)
If shift = #True
item$ + ListIconGadgetGetItem(\lvnr, index)
SetClipboardText(item$)
EndIf
RemoveGadgetItem(\lvnr, index)
index - 1
Next
SetGadgetState(\lvnr, index + 1)
Case #VK_INSERT
shift = #False
If GetKeyState_(#VK_SHIFT) > 1: shift = #True: EndIf
index = GetGadgetState(\lvnr)
If shift = #False
If index = -1
AddGadgetItem(\lvnr, index, "")
index = CountGadgetItems(\lvnr) - 1
Else
AddGadgetItem(\lvnr, index, "")
EndIf
Else
If index = -1: index = CountGadgetItems(\lvnr): EndIf
itemcount = CountString(item$, #CR$)
ReplaceString(item$, #TAB$, #LF$, #PB_String_InPlace)
For j = 1 To itemcount
AddGadgetItem(\lvnr, index + j - 1, StringField(item$, j, #CR$))
Next
SetGadgetState(\lvnr, -1)
EndIf
SetGadgetState(\lvnr, index)
EndSelect
EndSelect
ProcedureReturn CallWindowProc_(\lvpt, hwnd, msg, wParam, lParam)
EndWith
EndProcedure
Procedure.i CallBackStrg(hwnd, msg, wParam, lParam)
Protected *lv.EditStruktur = GetWindowLongPtr_(hwnd, #GWL_USERDATA)
If msg = #WM_CHAR
Select wparam
Case #VK_RETURN: Edit_End(*lv)
Case #VK_ESCAPE: Edit_Esc(*lv)
EndSelect
ElseIf msg = #WM_KEYDOWN
Select wparam
Case #VK_DOWN, #VK_UP: ProcedureReturn 0
EndSelect
ElseIf msg = #WM_KILLFOCUS
Edit_End(*lv)
EndIf
ProcedureReturn CallWindowProc_(*lv\strgpt, hwnd, msg, wParam, lParam)
EndProcedure
Procedure.i ListIconGadgetEdit(lvnr, window, ptr = 0)
Protected *lv.EditStruktur = AllocateMemory(SizeOf(EditStruktur))
Protected lvid, oldlist, null.w
With *lv
;LV
\lvnr = lvnr: lvid = GadgetID(lvnr)
\lvpt = GetWindowLongPtr_(lvid, #GWL_WNDPROC) ;Ori WindowProcPointer holen
SetWindowLongPtr_(lvid, #GWL_USERDATA, *lv) ;Memory setzen
SetWindowLongPtr_(lvid, #GWL_WNDPROC, @CallBackLv()) ;WindowProc setzen
\header = SendMessage_(lvid, #LVM_GETHEADER, 0, 0)
;StringGadget
oldlist = UseGadgetList(WindowID(window))
\strgnr = StringGadget(#PB_Any, 0, 0, 0, 0, "")
\strgid = GadgetID(\strgnr)
\strgpt = GetWindowLongPtr_(\strgid, #GWL_WNDPROC)
SetGadgetFont(\strgnr, GetGadgetFont(lvnr))
HideGadget(\strgnr, 1)
SetParent_(\strgid, lvid)
SetWindowLongPtr_(\strgid, #GWL_USERDATA, *lv)
SetWindowLongPtr_(\strgid, #GWL_WNDPROC, @CallBackStrg())
If oldlist: UseGadgetList(oldlist): EndIf
;div
\checktext = ptr
Setwindowtheme_(\strgid, @null, @null)
SendMessage_(\strgid, #EM_SETMARGINS, #EC_LEFTMARGIN, 3)
EndWith
EndProcedure
EndModule
UseModule ListIconGadgetEdit
; -Test
CompilerIf #PB_Compiler_IsMainFile
Import "UxTheme.lib"
SetWindowTheme(hwnd, classname.p-unicode, titlename)
EndImport
Enumeration
#window
#liste1
#liste2
EndEnumeration
Procedure.i MainEditCheck(nr, item, subitem, old$, new$)
Debug "nr " + nr
Debug "iitem " + item
Debug "subitem " + subitem
Debug "oldtext " + old$
Debug "newtext " + new$
ProcedureReturn #True
EndProcedure
Procedure.i Mainwindow()
Protected j, event
Protected flags = #PB_Window_SystemMenu|#PB_Window_MinimizeGadget
OpenWindow(#window, 150, 150, 700, 600, "", flags)
flags = #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect
flags | #PB_ListIcon_MultiSelect
ListIconGadget(#liste1, 20, 5, 290, 500, "0", 40, flags)
ListIconGadget(#liste2, 320, 5, 290, 500, "0", 40, flags)
For j = 1 To 3
AddGadgetColumn(#liste1, j, Str(j), 90)
AddGadgetColumn(#liste2, j, Str(j), 80)
Next
For j = 0 To 27
AddGadgetItem(#liste1, -1, Str(j)+#LF$+"Hans"+#LF$+"Meiereisung"+#LF$+Str(Random(999)))
AddGadgetItem(#liste2, -1, Str(j)+#LF$+"Otto"+#LF$+"Leier"+#LF$+Str(Random(999)))
Next
ListIconGadgetEdit(#liste1, #window, @MainEditCheck())
ListIconGadgetEdit(#liste2, #window, @MainEditCheck())
SetActiveGadget(#liste1)
SetWindowTheme(GadgetID(#liste1), "explorer", 0)
Repeat: event = WaitWindowEvent()
Until event = #PB_Event_CloseWindow
EndProcedure
Mainwindow()
CompilerEndIf
Thread verschoben
Windows>Code, Tipps und Tricks
09.09.2013
RSBasic
