Miten saisin ohjelmani toimimaan niin, että kun sen päälle drag&droppaa tiedoston, se näyttäisi sen nimen ja polun?
Esim drag&droppaan formille c:/desktopista vaikka filu.filin niin vaikka label1:n captioniksi tulisi C:\Desktop\filu.fil ?
Kokeile seuraavaa...
Private Sub Form_OLEDragDrop(Data As DataObject, _ Effect As Long, _ Button As Integer, _ Shift As Integer, _ X As Single, _ Y As Single) On Error GoTo TheEnd Label1.Caption = Data.Files.Item(1) TheEnd: End Sub
En viitti samasta aiheesta uutta ketjua aloittaa joten kysyn tähän että mitenkäs tuon saman saa kuvakkeeksi formille?
Haluatko kuvakkeen siis PictureBox:n formille vai formin vasempaan ylänurkkaan? Formille sen saat seuraavalla koodilla, josta soveltamalla sen saa myös sinne ylänurkkaan...
Option Explicit Private Const MARGINAL = 60 Private Declare Function DrawIcon Lib "user32" _ (ByVal hdc As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal hIcon As Long) As Long Private Declare Function ExtractIcon Lib "shell32.dll" _ Alias "ExtractIconA" _ (ByVal hInst As Long, _ ByVal lpszExeFileName As String, _ ByVal nIconIndex As Long) As Long Private PicIndex As Integer Private Sub Form_OLEDragDrop(Data As DataObject, _ Effect As Long, _ Button As Integer, _ Shift As Integer, _ x As Single, _ y As Single) On Error GoTo TheEnd Dim res As Long res = ExtractIcon(Me.hWnd, Data.Files.Item(1), 0) 'etsitään ikoni If res > 1 Then 'jos ikoni löytyy, niin... PicIndex = PicIndex + 1 Load Picture1(PicIndex) Picture1(PicIndex).Picture = LoadPicture() Picture1(PicIndex).AutoRedraw = True Picture1(PicIndex).AutoSize = True Picture1(PicIndex).Visible = True 'varmistetaan, että ikoni näkyy käyttäjälle oikein res = DrawIcon(Picture1(PicIndex).hdc, 0, 0, res) 'ladataan ikoni sille varattuun PictureBox:in Picture1(PicIndex).Move _ MARGINAL + ((PicIndex - 1) Mod 5) * Picture1(0).Width, _ MARGINAL + ((PicIndex - 1) \ 5) * Picture1(0).Height Else 'virhe ikonin suhteen MsgBox "Wrong file-type or no icons were found in the file.", vbInformation End If TheEnd: If Err.Number <> 0 Then Err.Clear End Sub
Kiitos.. :) tuosta on apua :)
Juu. Kiitos paljon!
Aihe on jo aika vanha, joten et voi enää vastata siihen.