Hier nun die überarbeitete Version mit Move und Unterstützung der Alt Taste
Dies ist eigentlich die letzte Betaversion, darum Mainschleife inclusive.
Der Code ist natürlich erheblich umfangreicher, denn gerade Move hat so seine Problemchen.
Kommentare und Verbesserungsvorschläge wären erwünscht und erfreulich
Das Forum lebt davon und animiert eventuell andere User ebenfalls Ihre Codes zu posten,
dann hat man was zu lesen und lernt daraus und davon.
Danke im voraus !
Code:
;LVDragDrop2020-1200.pbi - Juli.2020 - by HJBremer
;Version 1.20 - 01.07.2020
;Aufruf: ListIcon_EnableGadgetDrop(pbnr)
; Entspricht PB Befehl EnableGadgetDrop() aber festgelegt auf #PB_Drop_Text und alle #PB_Drag_Typen
;Hinweis: wenn von Fremdprogramm, sollte Spalte Null sichtbar sein, sonst via Alttaste draggen.
; Feldtrenner im Fremdprogramm ist oft ein Tab$, darum hier ebenfalls
;Hinweis: Mit der Alt-Taste kann ein Feld kopiert werden oder ganze Zeile, abhängig wann Alt gedrückt wird.
; erst Alt und dann linke Maustaste kopiert Feld in anderes Feld auf das der Cursor zeigt.
; erst Maustaste und dann Alt kopiert Zeile. Die Zeile beginnt im Ziel ab dem Feld wo Cursor ist.
; das Ziel kann auch Quelle sein.
;Wichtig: !!! wenn von Fremdprogramm, nur wenn dies Alttaste unterstützt, z.B. WebSeiten, OfficeProgramme !!!
;Hinweis: Beim verlassen des Programms wird der Cursor oft nicht wieder hergestellt. siehe DragCallBack()
; hängt mit WindowMouseX() zusammen und überlappenden Fenstern, Macke ? das ist hier die Frage
DeclareModule LvDragDrop
Declare.i ListIcon_EnableGadgetDrop(pbnr)
Declare.i Drag_SetColor(pbnr, typ, wert)
EndDeclareModule
Module LvDragDrop
EnableExplicit
Structure LVINSERTMARK ;muß Long sein !
cbSize.l
dwFlags.l
iItem.l
dwReserved.l
EndStructure
;- Start
#PB_Drag_Typ = #PB_Drag_Copy|#PB_Drag_Move|#PB_Drag_Link
#itemEnd = #CRLF$ ;sollte nie nur #CR$ sein, wegen MultiLine-Items
#copyChr = "+" ;Plus Zeichen für CreateDragImage()
#moveChr = Chr($F0) ;Pfeil Zeichen für CreateDragImage() von Wingdings
#linkChr = Chr($c8) ;Link Zeichen für CreateDragImage() von Wingdings
Define infofontid = FontID(LoadFont(#PB_Any, "Wingdings", 11)) ;für CreateDragImage()
Define dragfontid = FontID(LoadFont(#PB_Any, "Arial", 11)) ;für CreateDragImage()
Define cursorHand = LoadCursor_(0, #IDC_HAND) ;für anderen Cursor
Define sourceGadget = -1 ;Quelle
Define dragdropText$ ;DragText
Define dragAltkey ;Alttaste gedrückt
Define dragLineFlag ;Balken oben oder unten
Define dragImageflag ;steuert Image Update
Define showanzchr = 100 ;Anz Char im Image
Define colorText = #Black ;Farben vom DragWindow
Define colorFrame = #Gray
Define colorWindow = #Yellow
;werden einmalig festgelegt in ListIcon_EnableGadgetDrop()
Define mainwindow ;
Define dragwindow = -1 ;wird bewegt, enthält Image. -1 bedeutet gibts noch nicht
Define dragGadget ;PbNr vom ImageGadget im dragwindow
;- Allgemein
Procedure.i LV_GetHover(pbnr, *p.Point = 0)
;wo ist die Maus im ListIconGadget ?
;https://docs.microsoft.com/de-de/windows/win32/controls/lvm-subitemhittest
;https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-mapwindowpoints
If IsGadget(pbnr) = 0 : ProcedureReturn : EndIf
Protected hwnd = GadgetID(pbnr)
Protected lvhit.LVHITTESTINFO
Protected point.point
If Not *p: *p = @point.point: EndIf ;nur für Returnwert
GetCursorPos_(*p) ;wo ist Maus
MapWindowPoints_(0, hwnd, *p, 1) ;point Bildschirmkoordinaten zu Lv
lvhit\pt\x = *p\x
lvhit\pt\y = *p\y
SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, lvhit) ;welche row col ?
*p\y = lvhit\iItem ;row ab 0
*p\x = lvhit\iSubItem ;col ab 0
ProcedureReturn *p\x ;Spalte
EndProcedure
Procedure.i LV_CutState(pbnr)
;setzt #LVIS_CUT State-Markierung aller selected Items
;https://docs.microsoft.com/de-de/windows/win32/controls/lvm-getnextitem
;https://docs.microsoft.com/de-de/windows/win32/controls/lvm-setitemstate
If IsGadget(pbnr) = 0 : ProcedureReturn : EndIf
Protected hwnd = GadgetID(pbnr)
Protected item = -1 ;Startwert für #LVM_GETNEXTITEM
Protected lvitem.LVITEM
lvitem\mask = #LVIF_STATE
lvitem\state = #LVIS_CUT ; State setzen
lvitem\statemask = #LVIS_CUT ; nur diese State-Markierung
Repeat
item = SendMessage_(hwnd, #LVM_GETNEXTITEM, item, #LVNI_SELECTED) :Debug item
If item <> -1
SendMessage_(hwnd, #LVM_SETITEMSTATE, item, lvitem)
EndIf
Until item = -1 ;Ende mit Suchen
EndProcedure
Procedure.i LV_CutStateRemove(pbnr)
;löscht vorhandene #LVIS_CUT State-Markierung aller Items
If IsGadget(pbnr) = 0 : ProcedureReturn : EndIf
Protected hwnd = GadgetID(pbnr)
Protected item = -1 ;Startitem für #LVM_GETNEXTITEM
Protected lvitem.LVITEM
lvitem\mask = #LVIF_STATE
lvitem\state = 0 ; State löschen
lvitem\statemask = #LVIS_CUT ; nur diese State-Markierung
Repeat
item = SendMessage_(hwnd, #LVM_GETNEXTITEM, item, #LVNI_CUT)
If item <> -1
SendMessage_(hwnd, #LVM_SETITEMSTATE, item, lvitem)
EndIf
Until item = -1
EndProcedure
Procedure.i LV_CutStateRemoveItems(pbnr)
;Remove Items with CutState
If IsGadget(pbnr) = 0 : ProcedureReturn : EndIf
Protected hwnd = GadgetID(pbnr)
Protected item = -1 ;Startwert für #LVM_GETNEXTITEM
SendMessage_(hwnd, #WM_SETREDRAW, 0,0) ;Redraw aus, optisch besser
Repeat
item = SendMessage_(hwnd, #LVM_GETNEXTITEM, item, #LVNI_CUT)
If item <> -1
RemoveGadgetItem(pbnr, item)
item - 1 ; 1 zurück sonst geht es nicht
EndIf
Until item = -1
SendMessage_(hwnd, #WM_SETREDRAW, 1,0)
EndProcedure
Procedure.s LV_GetSelectedItems(pbnr)
Protected hwnd = GadgetID(pbnr)
Protected item = -1 ;Startwert für #LVM_GETNEXTITEM
Protected j
Protected txt$ = ""
Protected hdid = SendMessage_(hwnd, #LVM_GETHEADER, 0, 0)
Protected cols = SendMessage_(hdid, #HDM_GETITEMCOUNT, 0, 0) -1
Repeat
item = SendMessage_(hwnd, #LVM_GETNEXTITEM, item, #LVNI_SELECTED)
If item <> -1
For j = 0 To cols
txt$ + GetGadgetItemText(pbnr, item, j) + #TAB$ ; Tab für z.B. Excel
Next
txt$ + #CRLF$
EndIf
Until item = -1
ProcedureReturn txt$
EndProcedure
;- Drag/Drop
Procedure.i Drag_AddSelectedItems(pbnr, posi)
;kopiert Items ins ZielGadget (pbnr) ;wird von DropEvent() aufgerufen
Shared dragAltkey ;Alt Taste bei Dragstart oder Drop gedrückt
Protected j
Protected item$ ;einzelne Itemzeile
Protected point.Point ;für GetHover
Protected drop$ = EventDropText() ;auch von fremden Programm
Protected action = EventDropAction() ;copy move oder link
Protected count = CountString(drop$, #itemEnd) ;wieviele Items
If Right(drop$, 2) <> #itemEnd ;wenn von fremden Programm fehlt ev. am Ende
drop$ + #itemEnd: count + 1 ; ev. nur cr oder lf oder nix
EndIf
ReplaceString(drop$, #TAB$, #LF$, #PB_String_InPlace) ;aus #Tab wird #LF
If action = #PB_Drag_Link ;um Feld oder Zeile in/ab Spalte zu kopieren
LV_GetHover(pbnr, point) ;hover subitem + row im Ziel holen
If point\y = -1 ;y ist row, wenn Maus im Leeren Ende
AddGadgetItem(pbnr, -1, "") ;Leeritem anhängen
point\y = CountGadgetItems(pbnr) - 1;point auf Leeritem setzen
EndIf
;dragAltkey wird gesetzt wenn beim Dragstart vorher die Alt-Taste gedrückt wurde (Link)
;wird Altkey erst im ZielGadget gedrückt, dann ganze Itemzeile ab subitem einsetzen
If dragAltkey ;subitem wurde mit AltKey geholt
drop$ = ReplaceString(drop$, #LF$, "") ;LF entfernen
drop$ = ReplaceString(drop$, #CR$, " ") ;CR ersetzen
SetGadgetItemText(pbnr, point\y, drop$, point\x) ;im Ziel NUR subitem setzen
Else ;Alt-Taste nach Dragstart gedrückt
drop$ = ReplaceString(drop$, #CR$, " ") ;CR ersetzen, LF bleibt als Feldtrenner
For j = 1 To CountString(drop$, #LF$) ;point\x ist Start-Subitem
SetGadgetItemText(pbnr, point\y, StringField(drop$,j,#LF$), point\x+j-1)
Next
EndIf
Protected lvInsertMark.LVINSERTMARK
lvInsertMark\cbSize = SizeOf(LVINSERTMARK)
lvInsertMark\iItem = -1
SendMessage_(GadgetID(pbnr), #LVM_SETINSERTMARK, 0, lvInsertMark) ;InsertMark weg
Else ;DragCopy oder Move
SetGadgetState(pbnr, -1)
For j = 1 To count
item$ = StringField(drop$, j, #itemEnd) ;in #itemEnd ist ein #CR$, also dies zuerst
item$ = ReplaceString(item$, #CR$, " ") ;mehrzeilig aus #CR$ wird Space
AddGadgetItem(pbnr, posi, item$) ;wenn posi -1 dann bleibt posi -1 = ans Ende
SetGadgetItemState(pbnr, posi, #PB_ListIcon_Selected)
If posi <> -1 : posi + 1 : EndIf ; sonst posi + 1
Next
If posi = -1 ;additems ans Ende
posi = SendMessage_(GadgetID(pbnr), #LVM_GETITEMCOUNT, 0, 0) - 1
EndIf
SendMessage_(GadgetID(pbnr), #LVM_ENSUREVISIBLE, posi, #False) ;mal ja mal nein = auch egal
EndIf
EndProcedure
Procedure.i Drag_SetColor(pbnr, typ, wert)
Shared colorWindow, colorText, colorFrame
Select typ
Case #COLOR_WINDOW: colorWindow = wert
Case #COLOR_WINDOWTEXT: colorText = wert
Case #COLOR_WINDOWFRAME: colorFrame = wert
EndSelect
EndProcedure
Procedure.i Drag_CreateImage(i$, text$)
;i$ = Plus oder Pfeil
Shared colorWindow, colorText, colorFrame
Shared showanzchr
Shared infofontid, dragfontid
Shared dragwindow, dragGadget
Protected colorAction = #Red ;Char Plus, Pfeil, Link = Copy, Move, Link
Protected colorLines = #Blue ;ab 3 Zeilen erscheint ein Pfeil da nur 2 angezeigt werden
Protected countlines = CountString(text$, #itemEnd) ;wieviele Zeilen
Protected imgw, imgh, th, ab = 22 ;ab ist Abstand Text vom Zeichen i$
Protected t1$, t2$, tw1, tw2
Protected maxlg = showanzchr
Static dragImageNumber ;für FreeImage, muß Static sein
ReplaceString(text$, #TAB$, " ", #PB_String_InPlace)
t1$ = RTrim(StringField(text$, 1, #itemEnd))
t2$ = RTrim(StringField(text$, 2, #itemEnd))
ReplaceString(t1$, #CR$, " ", #PB_String_InPlace)
ReplaceString(t2$, #CR$, " ", #PB_String_InPlace)
If Len(t1$) > maxlg: t1$ = Left(t1$, maxlg) + "...": EndIf
If Len(t2$) > maxlg: t2$ = Left(t2$, maxlg) + "...": EndIf
If IsImage(dragImageNumber): FreeImage(dragImageNumber): EndIf
;Größe vom Image
dragImageNumber = CreateImage(#PB_Any, 1, 1)
StartDrawing(ImageOutput(dragImageNumber))
DrawingFont(dragfontid)
tw1 = TextWidth(t1$): tw2 = TextWidth(t2$): th = TextHeight(text$)
imgw = tw1: If tw2 > tw1: imgw = tw2: EndIf
imgw = imgw + 6 + ab
imgh = th + 6
If countlines > 1: imgh + th: EndIf
StopDrawing()
ResizeImage(dragImageNumber, imgw, imgh)
ResizeWindow(dragwindow, 0, 0, imgw, imgh)
;Image
StartDrawing(ImageOutput(dragImageNumber))
Box(0, 0, imgw, imgh, colorFrame)
Box(1, 1, imgw-2, imgh-2, colorWindow)
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(infofontid)
If countlines > 2: DrawText(3, 4+th, Chr($f2), colorLines): EndIf ;Pfeil unten
If i$ <> "+": DrawText(4, 4, i$, colorAction) : EndIf ;Pfeil rechts oder Link
DrawingFont(dragfontid)
If i$ = "+": DrawText(5, 2, i$, colorAction) : EndIf ;Pluszeichen
DrawText(ab, 2, t1$, colorText) ;1.Zeile
DrawText(ab, 3+th, t2$, colorText) ;2.Zeile
StopDrawing()
;wenn Farbtiefe 24, Image nach SetGadgetState() nicht löschen
SetGadgetState(dragGadget, ImageID(dragImageNumber))
EndProcedure
Procedure.i Drag_Event()
;für #PB_Event_Gadget + #PB_EventType_DragStart
Shared sourceGadget, dragdropText$
Shared dragAltkey, dragImageflag
sourceGadget = EventGadget()
dragdropText$ = LV_GetSelectedItems(sourceGadget)
LV_CutState(sourceGadget) ;Cut-State setzen falls Shift für DragMove gedrückt wird
dragAltkey = 0 ;Flag
If GetAsyncKeyState_(#VK_MENU) & $8000 = $8000 ;bei Dragstart Alt-Taste gedrückt
Protected p.point
LV_GetHover(sourceGadget, p)
dragAltkey = 1 ;für LvAddSelectedItems()
dragdropText$ = GetGadgetItemText(sourcegadget, p\y, p\x) ;nur subitem holen
SetGadgetState(sourcegadget, p\y) ;ev.Multiselect entfernen
EndIf
Protected ok = DragText(dragdropText$, #PB_Drag_Typ) ;Startet Drag & Drop !!!!!
If ok = 0 ;Drag abgebrochen
LV_CutStateRemove(sourceGadget) ;alle Cut-States entfernen wenn abgebrochen
dragImageflag = #PB_Drag_None ;Reset flag, sonst wird Image nicht aktualisiert
sourceGadget = -1
EndIf
EndProcedure
Procedure.i Drop_Event()
;für #PB_Event_GadgetDrop
;Add DropItems ins ZielGadget + Remove Items im sourceGadget falls #PB_Drag_Move
Shared dragLineFlag, sourceGadget
Protected dropGadget = EventGadget() ;PbNr Ziel
Protected dropAction = EventDropAction()
Protected dropitem = -1
dropitem = SendMessage_(GadgetID(dropGadget), #LVM_GETNEXTITEM, dropitem, #LVNI_FOCUSED)
If dropitem <> -1
If dragLineFlag: dropitem + 1: EndIf ;wenn #true unter dem DropItem einsetzen
EndIf
Drag_AddSelectedItems(dropGadget, dropitem) ;AddItems im Ziel
Select dropAction
Case #PB_Drag_Move: LV_CutStateRemoveItems(sourceGadget) ;Items mit #LVNI_CUT State entfernen
Default: LV_CutStateRemove(sourceGadget) ;#LVNI_CUT State entfernen wenn Copy / Link
EndSelect
sourceGadget = -1 ;letzte Drag/Drop Aktion, darum hier auf -1 wichtig falls Daten vom Fremdprogramm
EndProcedure
Procedure.i Drag_CallBack(action)
Shared mainwindow
Protected x, y
If action ;Copy, Move oder Link
x = WindowMouseX(mainwindow) ;wo ist Cursor in diesem Programm
y = WindowMouseY(mainwindow) ;:Debug x:Debug y
If Bool(x = -1 And y = -1) ;Maus ausserhalb vom Mainwindow
SetCursor_(0) ;eigenen Cursor löschen
ProcedureReturn 1 ;PB setzt den Standard-Cursor
Else
ProcedureReturn 0 ;Standard-Cursor ist weg, eigener Cursor wird
EndIf ; in DropCallback()/#PB_Drag_Enter gesetzt
EndIf
ProcedureReturn 1
EndProcedure
Procedure.i Drop_Callback(gadgethwnd, status, format, action, mouseX, mouseY)
;gadgethwnd = Quelle und/oder Ziel
Shared sourceGadget, cursorHand
Shared dragwindow, dragdropText$
Shared dragImageflag, dragLineFlag
;Variablen werden in #PB_Drag_Enter und in #PB_Drag_Update gebraucht darum Static
Static firstitem, lastitem ;für Scroll LineUp/Down
Static listhh ;für Scroll Down
Static rect.rect, hwndhead, headhh, itemhh ;für INSERTMARK-Line
Protected mousePos.POINT ;für INSERTMARK-Line
Protected lvInsertMark.LVINSERTMARK ;für INSERTMARK-Line
Protected x, y ;für ImageWindow anzeigen
Select status
Case #PB_Drag_Enter ;:Debug "#PB_Drag_Enter"
;Vorgaben
firstitem = 0
lastitem = SendMessage_(gadgethwnd, #LVM_GETITEMCOUNT, 0, 0) - 1 ;ab null gezählt
hwndhead = SendMessage_(gadgethwnd, #LVM_GETHEADER, 0, 0)
SendMessage_(hwndhead, #HDM_GETITEMRECT , 0, rect):
headhh = rect\bottom - rect\top
GetWindowRect_(gadgethwnd, rect) :
listhh = rect\bottom - rect\top ;Quelle oder Ziel
rect\left = #LVIR_BOUNDS
SendMessage_(gadgethwnd, #LVM_GETITEMRECT, 0, rect)
itemhh = rect\bottom - rect\top
SetCursor_(cursorHand)
ShowWindow_(WindowID(dragwindow), #SW_SHOWNOACTIVATE) ;das Mainwindow bleibt aktiv
Case #PB_Drag_Update
;-- Liste scrollen up/down
If mouseY < 10
SendMessage_(gadgethwnd, #WM_VSCROLL, #SB_PAGEUP , 0) ;returns #false = null
ElseIf mouseY < 25
SendMessage_(gadgethwnd, #WM_VSCROLL, #SB_LINEUP , 0)
;wenn firstitem ganz oder teilweise sichtbar, dann ganz sichtbar machen
If SendMessage_(gadgethwnd, #LVM_ISITEMVISIBLE, firstitem , 0) = #True
SendMessage_(gadgethwnd, #LVM_ENSUREVISIBLE, firstitem , #False)
EndIf
ElseIf mouseY > listhh - 20
SendMessage_(gadgethwnd, #WM_VSCROLL, #SB_PAGEDOWN , 0)
ElseIf mouseY > listhh - 35
SendMessage_(gadgethwnd, #WM_VSCROLL, #SB_LINEDOWN , 0)
;wenn lastitem ganz oder teilweise sichtbar, dann ganz sichtbar machen
If SendMessage_(gadgethwnd, #LVM_ISITEMVISIBLE, lastitem , 0) = #True
SendMessage_(gadgethwnd, #LVM_ENSUREVISIBLE, lastitem , #False)
EndIf
EndIf
;-- Insert-Line anzeigen
lvInsertMark\cbSize = SizeOf(LVINSERTMARK)
mousePos\x = mousex ;pos innerhalb des Gadgets
mousePos\y = mousey
SendMessage_(gadgethwnd, #LVM_SETINSERTMARKCOLOR, 0, #Black) ;oder #red
SendMessage_(gadgethwnd, #LVM_INSERTMARKHITTEST, mousePos, lvInsertMark)
SendMessage_(gadgethwnd, #LVM_SETINSERTMARK, 0, lvInsertMark)
dragLineFlag = 0 ;ist shared für DropEvent()
If (mousePos\y - headhh) % itemhh > itemhh / 2 : dragLineFlag = 1 : EndIf
;-- Image Create/ändern + anzeigen
;wenn Daten von Fremdprogramm ist sourceGadget = -1
If IsGadget(sourcegadget) = 0: dragdropText$ = "?": action = #PB_Drag_Copy : EndIf
If action <> #PB_Drag_None
Select action
Case #PB_Drag_Copy
If dragImageflag <> action ;verhindert mehrfaches Erstellen des Image
dragImageflag = action
Drag_CreateImage(#copyChr, dragdropText$)
EndIf
Case #PB_Drag_Move
If dragImageflag <> action
dragImageflag = action
Drag_CreateImage(#moveChr, dragdropText$)
EndIf
Case #PB_Drag_Link
If dragImageflag <> action
dragImageflag = action
Drag_CreateImage(#linkChr, dragdropText$)
EndIf
EndSelect
x = DesktopMouseX() + 20 ;Pluswerte gross genug, damit kein Leave entsteht, wenn
y = DesktopMouseY() + 14 ; Maus schnell bewegt wird. Cursor berührt ImageWindow
ResizeWindow(dragwindow, x, y, #PB_Ignore, #PB_Ignore)
EndIf
Case #PB_Drag_Leave: ;Debug "Leave"
HideWindow(dragwindow, 1)
lvInsertMark\cbSize = SizeOf(LVINSERTMARK)
lvInsertMark\iItem = -1
SendMessage_(gadgethwnd, #LVM_SETINSERTMARK, 0, lvInsertMark) ;InsertMark weg
Case #PB_Drag_Finish: ;Debug "Finish "
HideWindow(dragwindow, 1)
dragImageflag = #PB_Drag_None ;Flag Reset (ist static), sonst wird Image nicht aktualisiert
EndSelect
ProcedureReturn #True
EndProcedure
;-
Procedure.i ListIcon_EnableGadgetDrop(pbnr)
;Drag/Drop Start
Shared mainwindow, dragwindow, dragGadget
Protected mainWinId = GetAncestor_(GadgetID(pbnr), #GA_ROOT)
mainwindow = GetProp_(mainWinId, "PB_WINDOWID") - 1
EnableGadgetDrop(pbnr, #PB_Drop_Text, #PB_Drag_Typ)
SetDragCallback(@Drag_Callback())
SetDropCallback(@Drop_Callback())
BindEvent(#PB_Event_Gadget, @Drag_Event(), mainwindow, pbnr, #PB_EventType_DragStart)
BindEvent(#PB_Event_GadgetDrop, @Drop_Event(), mainwindow, pbnr)
Protected flags, old
If IsWindow(dragwindow) = 0 ;ist null wenn noch nicht existiert da Vorgabe -1
;hier erstellen sonst Error im DropCallback, wenn Quelle fremdes Programm
flags = #PB_Window_BorderLess|#PB_Window_NoGadgets|#PB_Window_Invisible|#PB_Window_NoActivate
dragwindow = OpenWindow(#PB_Any, 0, 0, 0, 0, "", flags, WindowID(mainwindow))
old = GetWindowLongPtr_(WindowID(dragwindow),#GWL_EXSTYLE)
SetWindowLongPtr_(WindowID(dragwindow),#GWL_EXSTYLE, old | #WS_EX_LAYERED)
SetLayeredWindowAttributes_(WindowID(dragwindow), 0, 200, #LWA_ALPHA)
old = UseGadgetList(WindowID(dragwindow))
dragGadget = ImageGadget(#PB_Any,0,0,0,0,0)
UseGadgetList(old)
EndIf
EndProcedure
EndModule
UseModule LvDragDrop
;-
;-Test---------------------------------
Procedure.i ListIcon_SetItemRows(pbnr, rows=2)
;für mehrzeilige Items im ListIconGadget, #LVM_GETITEMSPACING falls noch keine Items
Protected oldhh = SendMessage_(GadgetID(pbnr), #LVM_GETITEMSPACING, 1, 0) >> 16
Protected newhh = oldhh * rows
Protected imageList = ImageList_Create_(1, newhh, #ILC_COLORDDB, 0, 0)
SendMessage_(GadgetID(pbnr), #LVM_SETIMAGELIST, #LVSIL_SMALL, imageList)
EndProcedure
Enumeration
#window
#list1
#list2
#cont1
#button1
EndEnumeration
Import "UxTheme.lib" ;für ohne Unicode executable in Compilereinstellungen
SetWindowTheme(hwnd, classname.p-unicode, titlename)
EndImport
LoadFont(1,"Consolas", 12)
OpenWindow(#window,0,0,1200,700,"Multiselect Drag/Drop",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
w = 600: h = 660
ContainerGadget(#cont1, 10, 20, w, h, #PB_Container_Flat)
flags = #PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#PB_ListIcon_MultiSelect|#PB_ListIcon_AlwaysShowSelection
ListIconGadget(#list1, 10, 20, w-20, h-55,"Nr", 40, flags)
ListIcon_EnableGadgetDrop(#list1)
CloseGadgetList()
AddGadgetColumn(#list1, 1, "Vorname", 100)
AddGadgetColumn(#list1, 2, "Nachname", 100)
AddGadgetColumn(#list1, 3, "", 130)
AddGadgetColumn(#list1, 4, "", 90)
AddGadgetColumn(#list1, 5, "", 90)
SetGadgetColor(#list1, #PB_Gadget_BackColor, $cFFFFF)
SetGadgetFont(#list1,FontID(1))
SetWindowTheme(GadgetID(#list1), "Explorer", 0)
ListIcon_SetItemRows(#list1, 2)
ListIconGadget(#list2, 650, 30, 400, 300, "Nr", 40, flags)
AddGadgetColumn(#list2, 1, "", 110)
AddGadgetColumn(#list2, 2, "", 110)
AddGadgetColumn(#list2, 3, "", 110)
ListIcon_EnableGadgetDrop(#list2)
ButtonGadget(#button1, 650, 350, 88, 22, "tut nix")
Procedure Daten(liste)
HideGadget(liste, 1)
For j = 1 To 8
AddGadgetItem(liste, -1, #LF$ + "Hugo" + #CR$ + "Meier" + #LF$ + "Hauptstrasse 2")
AddGadgetItem(liste, -1, #LF$ + "Bernd" + #CR$ + "Niegel" + #LF$ + "Naaaaaaagel")
AddGadgetItem(liste, -1, #LF$ + "Beryl" + #CR$ + "Schulz" + #LF$ + "Schulz" + #LF$)
AddGadgetItem(liste, -1, #LF$ + "Charles" + #CR$ + "Müller" + #LF$ + "Müller" + #LF$ + "Müller")
AddGadgetItem(liste, -1, #LF$ + "Daniel" + #CR$ + " " + #LF$ + "Hauser" + #CR$ + " " + #LF$ + "Text ist oben")
AddGadgetItem(liste, -1, #LF$ + "Ernest" + #LF$ + "Mayer")
AddGadgetItem(liste, -1, #LF$ + "Francis" + #LF$ + "Brücke")
AddGadgetItem(liste, -1, #LF$ + "Gordon" + #LF$ + "Meier")
AddGadgetItem(liste, -1, #LF$ + "Harold" + #LF$ + "Glaser")
AddGadgetItem(liste, -1, #LF$ + "Otto" + #LF$ + "Hagel")
AddGadgetItem(liste, -1, #LF$ + "John" + #LF$ + "Lebnitz")
AddGadgetItem(liste, -1, #LF$ + "Ernest" + #LF$ + "Brücke")
AddGadgetItem(liste, -1, #LF$ + "Bernd" + #LF$ + "Müller")
AddGadgetItem(liste, -1, #LF$ + "Charles" + #LF$ + "Raben")
AddGadgetItem(liste, -1, #LF$ + "Beryl" + #LF$ + "Lebnitz")
AddGadgetItem(liste, -1, #LF$ + "John" + #LF$ + "Hauser")
AddGadgetItem(liste, -1, #LF$ + "Charles" + #LF$ + "Lebnitz")
AddGadgetItem(liste, -1, #LF$ + "Gordon" + #LF$ + "Glaser")
AddGadgetItem(liste, -1, #LF$ + "Beryl" + #LF$ + "Lebnitz")
Next
For j = 1 To CountGadgetItems(liste)
SetGadgetItemText(liste, j-1, Str(j-1), 0)
Next
HideGadget(liste, 0)
EndProcedure
Daten(#list1)
Daten(#list2)
Repeat
event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case #button1 :
EndSelect
EndSelect
Until event = #PB_Event_CloseWindow
PS: ein jeder darf diesen Code benutzen
FAQ
Suche
Registrieren
Anmelden
