Bonjour au membres du forum.
Je voudrais pouvoir récupérer du texte via drag'n drop d'une appli non Purebasic, vers PureBasic.
Ex: IE6 vers PureBasic ( Icone dans le Systray)
Ceci afin de réaliser un convertisseur €/F
Merci d'avance
Drag & Drop
J'ai trouvé ce code sur le Forum
J'aimerais la même chose avec drag & Drop de Texte et non de fichier
----------------------------------------------------------------------------------
; Original source code by James L.Boyd;
; Cleaned and reposted be LarsG
Procedure.l DropFiles()
ProcedureReturn EventwParam()
EndProcedure
Procedure GetNumDropFiles(*dropFiles)
ProcedureReturn DragQueryFile_(*dropFiles, $FFFFFFFF, temp$, 0)
EndProcedure
Procedure.s GetDropFile(*dropFiles, index)
bufferNeeded = DragQueryFile_(*dropFiles, index, 0, 0)
For a = 1 To bufferNeeded: buffer$ + " ": Next ; Short by one character!
DragQueryFile_(*dropFiles, index, buffer$, bufferNeeded+1)
ProcedureReturn buffer$
EndProcedure
Procedure FreeDropFiles(*dropFiles)
DragFinish_(*dropFiles)
EndProcedure
If OpenWindow(0, 200, 200, 300, 100, #PB_Window_SystemMenu, "Drag 'n' drop")
DragAcceptFiles_(WindowID(), 1)
Repeat
Select WaitWindowEvent()
Case #WM_DROPFILES
*dropped = DropFiles()
num.l = GetNumDropFiles(*dropped)
f$ = ""
For files = 0 To num - 1
f$ + GetDropFile(*dropped, files) + Chr (13)
Next
MessageRequester("Drag 'n' Drop", Str (num) + " file (s) dropped:" + Chr (13) + Chr (13) + f$)
FreeDropFiles(*dropped)
Case #PB_EventCloseWindow
Quit = 1
EndSelect
Until Quit = 1
EndIf
End
J'aimerais la même chose avec drag & Drop de Texte et non de fichier
----------------------------------------------------------------------------------
; Original source code by James L.Boyd;
; Cleaned and reposted be LarsG
Procedure.l DropFiles()
ProcedureReturn EventwParam()
EndProcedure
Procedure GetNumDropFiles(*dropFiles)
ProcedureReturn DragQueryFile_(*dropFiles, $FFFFFFFF, temp$, 0)
EndProcedure
Procedure.s GetDropFile(*dropFiles, index)
bufferNeeded = DragQueryFile_(*dropFiles, index, 0, 0)
For a = 1 To bufferNeeded: buffer$ + " ": Next ; Short by one character!
DragQueryFile_(*dropFiles, index, buffer$, bufferNeeded+1)
ProcedureReturn buffer$
EndProcedure
Procedure FreeDropFiles(*dropFiles)
DragFinish_(*dropFiles)
EndProcedure
If OpenWindow(0, 200, 200, 300, 100, #PB_Window_SystemMenu, "Drag 'n' drop")
DragAcceptFiles_(WindowID(), 1)
Repeat
Select WaitWindowEvent()
Case #WM_DROPFILES
*dropped = DropFiles()
num.l = GetNumDropFiles(*dropped)
f$ = ""
For files = 0 To num - 1
f$ + GetDropFile(*dropped, files) + Chr (13)
Next
MessageRequester("Drag 'n' Drop", Str (num) + " file (s) dropped:" + Chr (13) + Chr (13) + f$)
FreeDropFiles(*dropped)
Case #PB_EventCloseWindow
Quit = 1
EndSelect
Until Quit = 1
EndIf
End
OK j'ai fait avec le copier / Coller
mais ça aurait été mieux en Drag and Drop
Voici le code si ça interesse quelqu'un
--------------------------------------------------------
;{ Declaration des procedures
Declare.s Nom_et_CheminEXE()
Declare LancementviaCleRUN (etat)
Declare ChangeIcone()
;}
;{ Déclaration des Constantes
#HKEY_CURRENT_USER=2147483649
#AutoRun =0
#Quitter=1
;}
;{ Declaration des Variables Globales
Global LecteurActif
;}
;{ Lecture des images, depuis les labels
CatchImage(0,?image0)
;}
;{ Création du Visuel ( Invisible )
OpenWindow(0,0,100,100,100,#PB_Window_Invisible,"")
CreateGadgetList(WindowID(0))
AddSysTrayIcon(0,WindowID(0),UseImage(0))
;}
;{ Création du PopUpMenu ( Nb Variable car Nb de CDROm = ? )
CreatePopupMenu(0)
MenuItem(#AutoRun,"AutoRun")
MenuItem(#Quitter,"Quitter")
;}
;{- Initialisation du Programme depuis la base de registre
; Si Execution dans Clé RUN --> Cocher case à Cocher AutoRun
If GetRegKey(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Run","Euro")<>""
SetMenuItemState(0,#AutoRun,1)
EndIf
;}
;{ Gestion des Evenements
Repeat
a=WaitWindowEvent()
Select a
; On Clique sur l'icone du Systray
Case #PB_Event_SysTray
If EventType()=#PB_EventType_LeftClick
Euro.s=StrF((ValF(GetClipboardText())*6.55957))
Euro.s=Left(Euro,(FindString(Euro,".",1)+2))
MessageRequester("Convertiseur €/F",GetClipboardText()+"€ = "+Euro+"F")
EndIf
; Si on clic droit sur SysTray --> Ouvrir le menu Contextuel
If EventType()=#PB_EventType_RightClick
DisplayPopupMenu(0,WindowID(0))
EndIf
; On clique sur un Menu
Case #PB_Event_Menu
Select EventMenuID()
Case #AutoRun
If GetMenuItemState(0,#AutoRun)=0
SetMenuItemState(0,#AutoRun,1)
LancementviaCleRUN(1)
Else
SetMenuItemState(0,#AutoRun,0)
LancementviaCleRUN(0)
EndIf
; Clic sur Quitter
Case #Quitter
End
EndSelect
EndSelect
ForEver
;}
Procedure.s Nom_et_CheminEXE()
; Nom de l'Executable
a$=Space(255) : GetModuleFileName_(0,@a$,255) : appname$=GetFilePart(a$)
; Chemin d'où est lancé l'exécutable
appdir$=Space(255) : GetCurrentDirectory_(255,@appdir$) : If Right(appdir$,1)<>"\" : appdir$+"\" : EndIf
ProcedureReturn appdir$+appname$
EndProcedure
Procedure LancementviaCleRUN (etat)
; Incorpore l'exe dans la clé RUN ( 1 oui / 0 non )
If etat=1
SetRegKey(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Run","Euro",Nom_et_CheminEXE())
Else
DeleteValuefromRegistry(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Run","Euro")
EndIf
EndProcedure
;{ Incorporation des icones
DataSection
; Include des Icones
image0: IncludeBinary "euro.ico"
EndDataSection
;}
mais ça aurait été mieux en Drag and Drop
Voici le code si ça interesse quelqu'un
--------------------------------------------------------
;{ Declaration des procedures
Declare.s Nom_et_CheminEXE()
Declare LancementviaCleRUN (etat)
Declare ChangeIcone()
;}
;{ Déclaration des Constantes
#HKEY_CURRENT_USER=2147483649
#AutoRun =0
#Quitter=1
;}
;{ Declaration des Variables Globales
Global LecteurActif
;}
;{ Lecture des images, depuis les labels
CatchImage(0,?image0)
;}
;{ Création du Visuel ( Invisible )
OpenWindow(0,0,100,100,100,#PB_Window_Invisible,"")
CreateGadgetList(WindowID(0))
AddSysTrayIcon(0,WindowID(0),UseImage(0))
;}
;{ Création du PopUpMenu ( Nb Variable car Nb de CDROm = ? )
CreatePopupMenu(0)
MenuItem(#AutoRun,"AutoRun")
MenuItem(#Quitter,"Quitter")
;}
;{- Initialisation du Programme depuis la base de registre
; Si Execution dans Clé RUN --> Cocher case à Cocher AutoRun
If GetRegKey(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Run","Euro")<>""
SetMenuItemState(0,#AutoRun,1)
EndIf
;}
;{ Gestion des Evenements
Repeat
a=WaitWindowEvent()
Select a
; On Clique sur l'icone du Systray
Case #PB_Event_SysTray
If EventType()=#PB_EventType_LeftClick
Euro.s=StrF((ValF(GetClipboardText())*6.55957))
Euro.s=Left(Euro,(FindString(Euro,".",1)+2))
MessageRequester("Convertiseur €/F",GetClipboardText()+"€ = "+Euro+"F")
EndIf
; Si on clic droit sur SysTray --> Ouvrir le menu Contextuel
If EventType()=#PB_EventType_RightClick
DisplayPopupMenu(0,WindowID(0))
EndIf
; On clique sur un Menu
Case #PB_Event_Menu
Select EventMenuID()
Case #AutoRun
If GetMenuItemState(0,#AutoRun)=0
SetMenuItemState(0,#AutoRun,1)
LancementviaCleRUN(1)
Else
SetMenuItemState(0,#AutoRun,0)
LancementviaCleRUN(0)
EndIf
; Clic sur Quitter
Case #Quitter
End
EndSelect
EndSelect
ForEver
;}
Procedure.s Nom_et_CheminEXE()
; Nom de l'Executable
a$=Space(255) : GetModuleFileName_(0,@a$,255) : appname$=GetFilePart(a$)
; Chemin d'où est lancé l'exécutable
appdir$=Space(255) : GetCurrentDirectory_(255,@appdir$) : If Right(appdir$,1)<>"\" : appdir$+"\" : EndIf
ProcedureReturn appdir$+appname$
EndProcedure
Procedure LancementviaCleRUN (etat)
; Incorpore l'exe dans la clé RUN ( 1 oui / 0 non )
If etat=1
SetRegKey(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Run","Euro",Nom_et_CheminEXE())
Else
DeleteValuefromRegistry(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Run","Euro")
EndIf
EndProcedure
;{ Incorporation des icones
DataSection
; Include des Icones
image0: IncludeBinary "euro.ico"
EndDataSection
;}