MAJ drag and drop

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

MAJ drag and drop

Message par Mesa »

Mise à jour d'un code de drag and drop du forum uk.

Code : Tout sélectionner

;An example of the new Drag and Drop library for Purebasic 5.60.
;==============================================================
;Uses a DragCallback to display an image whilst an item of text is being dragged between
;two listicons.

;   Example by netmaestro with the image drag added by srod.
;   Created with Purebasic 4.1 (beta 1) for Windows.
;   Date:  May 2007.
;   Platforms:  Windows.

;Update by Mesa, March 2017
; Drag to copy and Shift+drag to move
; PureBasic 5.60
; Platform: Should be multiplatform


EnableExplicit

Declare DragCallBack(Action)
Declare DropCallback(Handle, State, Format, Action, x, y)
Declare RefreshGadget(ID) ; sans api

Structure _drag
  n.l
  hdc.l
  x.l
  y.l
  width.l
  height.l
EndStructure


Global gDrag._drag
Global ev

Define draggadget, dragrow, dragtxt.s


OpenWindow(0,0,0,480,400,"Faites glisser pour copier | MAJ + Glisser pour déplacer",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 

ListIconGadget(0,20,20,200,300,"Gadget 0", 195, #PB_ListIcon_FullRowSelect) 
ListIconGadget(1,250,20,200,300,"Gadget 1", 195, #PB_ListIcon_FullRowSelect) 

AddGadgetItem(0, -1, "Arthur") 
AddGadgetItem(0, -1, "Beryl") 
AddGadgetItem(0, -1, "Charles") 
AddGadgetItem(0, -1, "Daniel") 
AddGadgetItem(0, -1, "Ernest") 
AddGadgetItem(0, -1, "Francis") 
AddGadgetItem(0, -1, "Gordon") 
AddGadgetItem(0, -1, "Harold") 
AddGadgetItem(0, -1, "Ian") 
AddGadgetItem(0, -1, "John") 

EnableGadgetDrop(0,#PB_Drop_Text, #PB_Drag_Move|#PB_Drag_Copy) 
EnableGadgetDrop(1,#PB_Drop_Text, #PB_Drag_Move|#PB_Drag_Copy) 

SetDropCallback(@DropCallback())

Repeat 
  ev = WaitWindowEvent() 
  Select ev 
    Case #PB_Event_GadgetDrop 
      If EventDropAction() = #PB_Drag_Move
        RemoveGadgetItem(draggadget, dragrow)
      EndIf
      If draggadget <> EventGadget() Or dragrow <> GetGadgetState(EventGadget())
        AddGadgetItem(EventGadget(), GetGadgetState(EventGadget()), EventDropText()) 
      EndIf
      ;FreeGadget(gDrag\hdc):gDrag\n=0; Si vous ne voulez pas utiliser un dropcallback
      
    Case #PB_Event_Gadget 
      If EventType() = #PB_EventType_DragStart 
        
        dragrow = GetGadgetState(EventGadget()) 
        dragtxt = GetGadgetItemText(EventGadget(), dragrow) 
        draggadget = EventGadget() 
        ;Create drag gadgettext
        If gDrag\n=1; Si la touche ESC a été enfoncée pendant un glisser-glisser, alors détruir l'ancien gadgettext 
          If IsGadget(gDrag\hdc) <> 0
            FreeGadget(gDrag\hdc)
            RefreshGadget(0); Marche pas bien ;(
          EndIf  
        EndIf
        gDrag\hdc = TextGadget(#PB_Any,0,0,0,0,dragtxt)
        gDrag\n=1
        gDrag\width =GadgetWidth(gDrag\hdc,#PB_Gadget_RequiredSize)
        gDrag\height =  GadgetHeight(gDrag\hdc,#PB_Gadget_RequiredSize)
        ResizeGadget(gDrag\hdc, #PB_Ignore, #PB_Ignore,gDrag\width,gDrag\height)
        SetGadgetColor(gDrag\hdc,#PB_Gadget_BackColor,$FFFFFF)
        HideGadget(gDrag\hdc,1)
        gDrag\x = -1 : gDrag\y = -1
        SetDragCallback(@DragCallBack())
        DragText(dragtxt, #PB_Drag_Move|#PB_Drag_Copy) 
        
      EndIf 
  EndSelect 
Until ev = #PB_Event_CloseWindow 


Procedure DragCallBack(Action)
  
  If gDrag\x>-1 And gDrag\y>-1
    HideGadget(gDrag\hdc,0)
  EndIf
  
  If action<>#PB_Drag_None
    
    gDrag\x = WindowMouseX(0)
    gDrag\y = WindowMouseY(0)
    ResizeGadget(gDrag\hdc,gDrag\x-(gDrag\width/2),gDrag\y-(gDrag\height/2),#PB_Ignore,#PB_Ignore)
    
  Else
    gDrag\x = -1 : gDrag\y = -1
    HideGadget(gDrag\hdc,1)
  EndIf
  ProcedureReturn 1
EndProcedure

Procedure DropCallback(targetID, State, Format, Action, x, y)
  If targetID=WindowID(0)
    If state = #PB_Drag_Finish 
      ;Debug "dd fini" 
      
      If IsGadget(gDrag\hdc) <> 0
        FreeGadget(gDrag\hdc)
        gDrag\n=0
      EndIf
      
    EndIf
  EndIf
  ProcedureReturn #True
  
EndProcedure

Procedure RefreshGadget(ID)
  AddGadgetItem(ID, -1, " ") 
  While WindowEvent() : Wend
  RemoveGadgetItem(ID, CountGadgetItems(ID)-1)
  
EndProcedure
M.
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: MAJ drag and drop

Message par Micoute »

Bonsoir Mesa et merci pour le partage.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Répondre