DragDrop mais avec du texte ?!

Question

Salut all

Je voudrai "draguer" (...) un texte, qui provien par exemple d'internet explorer sur mon app mais a ce que j'ai vu, le drag ne peux prendre que des fichiers (OLE DragDrop). Avez une une solution?

 @Z3RtY25 ==

Xav88 · Answer

Salut,
Ce code n'est pas de moi mais en tout cas tu peut draguer du texte dedans à partir d'internet explorer entre autre...


Option Explicit

Private Declare Function RegisterClipboardFormat Lib "user32.dll" Alias "RegisterClipboardFormatA" (ByVal lpszFormat As String) As Integer
Dim MonFormat As Integer

'---- Initialisations
Private Sub Form_Load()
    ' Initialise les modes
    ' Glisser
    txtSource.OLEDragMode = vbOLEDragAutomatic
    txtDest.OLEDragMode = vbOLEDragManual
    ' Poser
    txtSource.OLEDropMode = vbOLEDropAutomatic
    txtDest.OLEDropMode = vbOLEDropManual
    
    ' Créé un format particulier
    MonFormat = RegisterClipboardFormat("Chaîne codée")
End Sub

'---- Demande initiale des données
Private Sub txtSource_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
    ' Texte de la source
    Dim txt As String
    txt = txtSource.SelText
    
    ' Supprime les données placées automatiquement
    Data.Clear
    
    ' Construit un tableau de bytes pour les données :
    ' 1er caractère = nombre de caractères (limité à 255)
    ' caractères suivants : caractères de la chaîne, augmentés de 1 (codage)
    Dim t() As Byte
    ReDim t(1 To Len(txt) + 1) As Byte
    Dim i, l
    ' Longueur
    l = Len(txt)
    ' Limite à 255
    If l > 255 Then l = 155
    ' Stocke la longueur
    t(1) = l
    ' Ajoute les caractères +1
    For i = 1 To l
        t(i + 1) = Asc(Mid(txt, i, 1)) + 1
    Next
    ' Donne le tableau construit pour le glisser-poser
    Data.SetData t, MonFormat
End Sub

'---- Passage sur la destination
Private Sub txtDest_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
    ' Indique si le dépôt est possible
    If Data.GetFormat(MonFormat) Then
        ' Copie ou déplacement, selon touche CTRL
        Effect = IIf(Shift And vbCtrlMask, vbDropEffectCopy, vbDropEffectMove)
    Else
        ' Refuse toute autres données (on pourrait laisser passer le texte...)
        Effect = vbDropEffectNone
    End If
End Sub

'---- Dépôt des dennées sur la destination
Private Sub txtDest_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim t() As Byte
    Dim txt As String
    Dim l As Integer
    Dim i
    ' Les données sont-elles dans notre format ?
    If Data.GetFormat(MonFormat) Then
        ' Indique si copie ou déplacement, pour le OLECompleteDrag qui suit
        Effect = IIf(Shift And vbCtrlMask, vbDropEffectCopy, vbDropEffectMove)
        ' Récupère les données
        t = Data.GetData(MonFormat)
        ' Longueur
        l = t(1)
        For i = 1 To l
            ' Place chaque octet dans la chaîne après l'avoir décodé (-1)
            txt = txt & Chr(t(i + 1) - 1)
        Next
    
        ' Met dans la sélection
        txtDest.SelText = txt
    End If
End Sub

'---- Fin du poser pour la source
Private Sub txtSource_OLECompleteDrag(Effect As Long)
    ' Si déplacement, supprime les données de la source
    If Effect And vbDropEffectMove Then txtSource.SelText = ""
End Sub


Tu dois mettre 2 textbox : txtSource et txtDest

Voilà en espérant que ça t'aidera

 :) Xavier :)

cs_azerty25 · Answer

Sa fonctionne nickel, mici bicoup ;)

 @Z3RtY25 ==

DragDrop mais avec du texte ?!

2 réponses

Discussions similaires