Om jag vill kunna dra exempelvis en textfil till min exe fil
Och släppa den över programmet
För att sedan få upp det som står i textfilen i en text ruta i programmet
Hur gör man då ?




Sören

<code>
Option Explicit

Private Sub Form_Load()
'Set the ListBox to manually accept Drag 'N Drop actions.
List1.OLEDropMode = vbOLEDropManual
End Sub

Private Sub List1_OLEDragOver(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single, _
State As Integer)
'Check to see if the data is a list of files.
If Data.GetFormat(vbCFFiles) Then
'Dropping will result in the copying of data.
Effect = vbDropEffectCopy
Else
'Can't accept data.
Effect = vbDropEffectNone
End If
End Sub

Private Sub List1_OLEDragDrop(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)
Dim i As Integer

If Not Data.GetFormat(vbCFFiles) Then
'Can't accept the data.
Effect = vbDropEffectNone
Exit Sub
End If

'Add the dropped file name(s) to the ListBox.
With List1
.Clear
For i = 1 To Data.Files.Count
.AddItem Data.Files(i)
Next
End With

'Data has been copied - not altered.
Effect = vbDropEffectCopy
End Sub
</code>

Skrivit ett exempel som infogar filen på position man släpper texten:<code>
Option Explicit

Private Const EM_CHARFROMPOS As Long = &HD7&

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Function MAKELPARAM(ByVal wLow As Long, ByVal wHigh As Long) As Long
MAKELPARAM = (wLow And &HFFFF&) Or (&H10000 * (wHigh And &HFFFF&))
End Function

Private Function PosToChar(hwnd As Long, X As Long, Y As Long)
Dim lParm As Long
Dim lReturn As Long
lParm = MAKELPARAM(X, Y)
lReturn = SendMessage(hwnd, EM_CHARFROMPOS, 0&, ByVal lParm)
PosToChar = lReturn And &HFFFF&
End Function

Private Function OpenTextFile(ByVal FileName As String) As String
Dim FileNo As Long
FileNo = FreeFile()
Open FileName For Binary Access Read Shared As #FileNo
OpenTextFile = Space$(LOF(FileNo))
Get FileNo, , OpenTextFile
Close #FileNo
End Function

Private Sub Form_Load()
'Sätt dessa egenskap i designläge
'Text1.MultiLine = True
Text1.OLEDropMode = vbOLEDropManual
End Sub

Private Sub Form_Resize()
Text1.Move ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight
End Sub

Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim vFile As Variant
If Data.GetFormat(vbCFFiles) Then
If Effect And vbDropEffectCopy Then
For Each vFile In Data.Files
If vFile Like "*.txt" Then
Text1.SelStart = PosToChar(Text1.hwnd, ScaleX(X, vbTwips, vbPixels), ScaleY(Y, vbTwips, vbPixels))
Text1.SelText = OpenTextFile(vFile)
Exit For
End If
Next
End If
End If
End Sub

Private Sub Text1_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
Dim vFile As Variant
If Data.GetFormat(vbCFFiles) Then
Effect = vbDropEffectNone
Select Case State
Case vbEnter, vbOver
For Each vFile In Data.Files
If vFile Like "*.txt" Then
Effect = vbDropEffectCopy
Exit For
End If
Next
End Select
Else
Effect = vbDropEffectNone
End If
End Sub


</code>
Om det var det du ville ha. Är det bara att skippa API anropen:
<code>
Option Explicit

Private Function OpenTextFile(ByVal FileName As String) As String
Dim FileNo As Long
FileNo = FreeFile()
Open FileName For Binary Access Read Shared As #FileNo
OpenTextFile = Space$(LOF(FileNo))
Get FileNo, , OpenTextFile
Close #FileNo
End Function

Private Sub Form_Load()
'Sätt dessa egenskap i designläge
'Text1.MultiLine = True
Text1.OLEDropMode = vbOLEDropManual
End Sub

Private Sub Form_Resize()
Text1.Move ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight
End Sub

Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim vFile As Variant
If Data.GetFormat(vbCFFiles) Then
If Effect And vbDropEffectCopy Then
For Each vFile In Data.Files
If vFile Like "*.txt" Then
Text1.Text = OpenTextFile(vFile)
Exit For
End If
Next
End If
End If
End Sub

Private Sub Text1_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
Dim vFile As Variant
If Data.GetFormat(vbCFFiles) Then
Effect = vbDropEffectNone
Select Case State
Case vbEnter, vbOver
For Each vFile In Data.Files
If vFile Like "*.txt" Then
Effect = vbDropEffectCopy
Exit For
End If
Next
End Select
Else
Effect = vbDropEffectNone
End If
End Sub

</code>

Jag tackar för dom svaren

En annan sak i detta ämne
Med dessa script så måste jag ju släppa över Text rutan för att upp texten
Om jag vill bestämma att det ska komma i Text1 fast jag släpper det
var jag vill över exe filen...
Hur gör jad då?



Sören

Option Explicit

Private Sub Form1_Load()
'Set the Form to manually accept Drag 'N Drop actions.
Me.OLEDropMode = vbOLEDropManual
End Sub

Private Sub Form1_OLEDragOver(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single, _
State As Integer)
'Check to see if the data is a list of files.
If Data.GetFormat(vbCFFiles) Then
'Dropping will result in the copying of data.
Effect = vbDropEffectCopy
Else
'Can't accept data.
Effect = vbDropEffectNone
End If
End Sub

Private Sub Form1_OLEDragDrop(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)
Dim i As Integer

If Not Data.GetFormat(vbCFFiles) Then
'Can't accept the data.
Effect = vbDropEffectNone
Exit Sub
End If

'if it's only 1 file, add it to the textbox
If Data.Files.Count = 1 Then
textboxen.text = Data.Files(1)
End If

'Data has been copied - not altered.
Effect = vbDropEffectCopy
End Sub


----

Nu kan du dra filen till formuläret, om det bara är en fil så visas namnet i en textbox som heter textboxen.

Ja vet inte vad som är fel här
Jag får inte till det som det är tänkt...

Tack för allt, jag fick till det..................