nachdem ich mich mal wieder über mein altes Drag/Drop Modul geärgert habe
mußte ein Neues her.
Und zwar mit Image + Balken + Scrollen + alles viel besser
Leider mußte ich wieder feststellen, die Hilfe ist keine Hilfe was Drag Drop angeht.
Vor allem was da über die Callbacks steht ist mehr als mau, obermau, ja hypermau !!!!!!!
Allerdings die MSDN Hilfen sind auch nicht viel besser.
Zum Code. Wenn man den Teil mit dem Balken (InsertLine) + Scrollen etc weglässt, dann sollte man es auch CrossPlattform bekommen.
Aber das sollen andere machen.
Zuerst das Modul
Code: Alles auswählen
;LVDragDrop2020.pbi - Juni.2020 - by HJBremer
;Aufruf: ListIcon_EnableGadgetDrop(pbnr) pbnr vom ListIconGadget
; Entspricht PB Befehl EnableGadgetDrop() aber festgelegt auf #PB_Drop_Text und #PB_Drag_Copy
DeclareModule LvDragDrop
Declare.i ListIcon_EnableGadgetDrop(pbnr)
EndDeclareModule
Module LvDragDrop
EnableExplicit
Structure LVINSERTMARK ;muß Long sein !
cbSize.l
dwFlags.l
iItem.l
dwReserved.l
EndStructure
#PB_Drag_Typ = #PB_Drag_Copy
#itemEnd$ = #CRLF$ ;sollte nie nur #CR$ sein, wegen MultiLine-Items
Global dragfontid = FontID(LoadFont(#PB_Any, "Arial", 11)) ;für CreateDragImage()
Global cursorHand = LoadCursor_(0, #IDC_HAND) ;für anderen Cursor
Global sourceGadget = -1 ;Quelle
Global dragdropText$ ;DragText
Global dragLineFlag ;Balken oben oder unten
Global dragImageflag ;steuert Image Update
Global showanzchr = 100 ;Anz Char im Image
;werden einmalig festgelegt in ListIcon_EnableGadgetDrop()
Global mainwindow ;
Global dragwindow = -1 ;wird bewegt, enthält Image. -1 bedeutet gibts noch nicht
Global dragGadget ;PbNr vom ImageGadget im dragwindow
Procedure.i Drag_AddSelectedItems(pbnr, posi)
Protected j, item$
Protected drop$ = EventDropText()
Protected count = CountString(drop$, #itemEnd$)
ReplaceString(drop$, #TAB$, #LF$, #PB_String_InPlace) ;aus #Tab wird #LF
For j = 1 To count
item$ = StringField(drop$, j, #itemEnd$)
AddGadgetItem(pbnr, posi, item$) ;wenn posi -1 dann bleibt posi -1 = ans Ende
If posi <> -1 : posi + 1 : EndIf ; sonst posi + 1
Next
EndProcedure
Procedure.s Drag_GetSelectedItems(pbnr)
Protected item = -1, subitem, txt$ = ""
Protected hwnd = GadgetID(pbnr)
Protected hdid = SendMessage_(hwnd, #LVM_GETHEADER, 0, 0)
Protected cols = SendMessage_(hdid, #HDM_GETITEMCOUNT, 0, 0)
Repeat
item = SendMessage_(hwnd, #LVM_GETNEXTITEM, item, #LVNI_SELECTED)
If item <> -1
For subitem = 0 To cols
txt$ + GetGadgetItemText(pbnr, item, subitem) + #TAB$ ; Tab für z.B. Excel
Next
txt$ + #itemEnd$
EndIf
Until item = -1
ProcedureReturn txt$
EndProcedure
Procedure.i Drag_CreateImage(text$)
Protected imgw, imgh
Protected t1$, tw, th, ab = 22 ;ab ist Abstand Text vom PlusZeichen
Static dragImageNumber ;für FreeImage, muß Static sein
ReplaceString(text$, #TAB$, " ", #PB_String_InPlace)
t1$ = RTrim(StringField(text$, 1, #itemEnd$))
ReplaceString(t1$, #CR$, " ", #PB_String_InPlace)
If Len(t1$) > showanzchr: t1$ = Left(t1$, showanzchr) + "...": EndIf
If IsImage(dragImageNumber): FreeImage(dragImageNumber): EndIf
;Größe vom Image
dragImageNumber = CreateImage(#PB_Any, 1, 1)
StartDrawing(ImageOutput(dragImageNumber))
DrawingFont(dragfontid)
tw = TextWidth(t1$): th = TextHeight(text$)
imgw = tw + 6 + ab : imgh = th + 6
StopDrawing()
ResizeImage(dragImageNumber, imgw, imgh)
ResizeWindow(dragwindow, 0, 0, imgw, imgh)
;Image
StartDrawing(ImageOutput(dragImageNumber))
Box(0, 0, imgw, imgh, #Gray)
Box(1, 1, imgw-2, imgh-2, #Yellow)
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(dragfontid)
DrawText(5, 2, "+", #Red): DrawText(ab, 2, t1$, #Black)
StopDrawing()
SetGadgetState(dragGadget, ImageID(dragImageNumber))
EndProcedure
Procedure.i Drag_Event()
;für #PB_Event_Gadget + #PB_EventType_DragStart
sourceGadget = EventGadget()
dragdropText$ = Drag_GetSelectedItems(sourceGadget)
Protected ok = DragText(dragdropText$, #PB_Drag_Typ) ;Startet Drag & Drop !!!!!
If ok = 0 ;Drag 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
Protected dropGadget = EventGadget()
Protected dropitem = -1
dropitem = SendMessage_(GadgetID(dropGadget), #LVM_GETNEXTITEM, dropitem, #LVNI_FOCUSED)
If dropitem <> -1
If dragLineFlag: dropitem + 1: EndIf ;wenn #true unter dem markierten Item einsetzen
EndIf
Drag_AddSelectedItems(dropGadget, dropitem)
sourceGadget = -1 ;letzte Drag/Drop Aktion, darum hier auf -1
EndProcedure
Procedure.i Drag_CallBack(action)
If action
Protected x = WindowMouseX(mainwindow) ;wo ist Cursor in diesem Programm
Protected y = WindowMouseY(mainwindow)
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
;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
;Vorgaben
firstitem = 0: lastitem = SendMessage_(gadgethwnd, #LVM_GETITEMCOUNT, 0, 0) - 1
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)
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)
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_INSERTMARKHITTEST, mousePos, lvInsertMark)
SendMessage_(gadgethwnd, #LVM_SETINSERTMARK, 0, lvInsertMark)
dragLineFlag = 0
If (mousePos\y - headhh) % itemhh > itemhh / 2 : dragLineFlag = 1 : EndIf
;-- Image Create + 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(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
HideWindow(dragwindow, 1)
lvInsertMark\cbSize = SizeOf(LVINSERTMARK)
lvInsertMark\iItem = -1
SendMessage_(gadgethwnd, #LVM_SETINSERTMARK, 0, lvInsertMark) ;InsertMark weg
Case #PB_Drag_Finish
HideWindow(dragwindow, 1)
dragImageflag = #PB_Drag_None ;Flag Reset, sonst wird Image nicht aktualisiert
EndSelect
ProcedureReturn #True
EndProcedure
Procedure.i ListIcon_EnableGadgetDrop(pbnr)
Protected flags, old, 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)
If IsWindow(dragwindow) = 0 ;ist null wenn noch nicht existiert da Vorgabe -1
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 = UseGadgetList(WindowID(dragwindow))
dragGadget = ImageGadget(#PB_Any,0,0,0,0,0)
UseGadgetList(old)
EndIf
EndProcedure
EndModule
UseModule LvDragDrop
