0

我正在尝试在当前鼠标位置 FileType PNG(总是)“放置”一个图像文件。

“放置”是指与单击并按住图像,然后在按下热键时将其放置到另一个位置相同类型的功能。

这样,我可以粘贴我刚刚“剪切”的图像并将其粘贴,就好像它是具有适当文件名的文件一样。(这主要用于粘贴到 wordpress 中,并且没有可用的插件来执行此操作)

我已经编写了代码来从剪贴板中抓取图像并保存它。但现在我想抓住这张图片,并在按下热键时将其放在鼠标位置。

热键正在“异步”工作,而我的应用程序没有焦点(按预期),但现在我被困在按下热键时实际删除此文件。

我的表格(2020 年 1 月 27 日更新):

Option Explicit

Private Sub Command1_Click()
'Placeholder:   a button so i can control when the file is grabbed from
'               the clipboard.
'The inputbox is required to enter a filename for this image. This is important
'since we only want to drop a file that has an appropriate filename.

Dim ImageName$

Picture1.Picture = Clipboard.GetData    'Grab image from the clipboard
''Clipboard.Clear
ImageName$ = InputBox("Provide filename") 'Enter filename for the image
FileName$ = ImageName$
Text1.Text = FileName$

End Sub

Sub On_Event_Keypress(FileName$)

'When the F9 key is pressed

Dim FilePath$, MouseX&, MouseY&

FilePath$ = App.Path + "\" 'Save the image to the current App.Path root

SavePicture Picture1.Image, FilePath$ & FileName$ & ".png" 'Save picture to Disk
FileName$ = FilePath$ & FileName$ & ".png"


Call PasteIt(FileName$) 'Load image from Imagelocation and DragAndDrop it where mouse currently is.


End Sub

Public Sub PasteIt(ByVal FileName As String)

'When F9 is pressed, the previous saved file is loaded to the OLE object.

'Then a drag action is started, but because this action will make the mouse
'jump back to the OLE control, i record the mouse position and move it back
'to where the drop action should take place.

'Not sure wheter to use OLE but this seems to reflect an actual drag action while i
'was testing. It's very much possible that this can be done using a filehandle or somesort
'im just not sure where to start to achieve the Drop action like a DragAndDrop sequence.


'Load the saved file to a control
OLE1.SourceDoc = FileName

'Get current mouse position. So the program knows where to 'drop' the dragged picture
Call GetCursorPos(Mpos)


OLE1.Drag vbBeginDrag 'Start the DragAndDrop action

    SetCursorPos Mpos.X, Mpos.Y 'Mouse the mousecursor back to where the F9 key was pressed


Stop 'This is where i'm stuck and know im close. The mousecursor is holding an item, but i can't drop
     'it like i was dragging it myself

End Sub

Private Sub OLE1_DragDrop(Source As Control, X As Single, Y As Single)

Stop

End Sub

Private Sub Timer1_Timer()

'Checks if the picturebox is loaded with an image
'Then listens to the F9 keypress

If Picture1.Picture Then
    If GetAsyncKeyState(vbKeyF9) Then
        'Hotkey pressed,do dragdrop at mousepos

        Call On_Event_Keypress(Text1.Text)

    End If
End If
End Sub

我的模块(2020 年 1 月 27 日更新):

Option Explicit

Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer


Public Type POINTAPI
    X As Long
    Y As Long
End Type
Public Mpos As POINTAPI
Public FileName$

我试图用以下方法模拟这个,但这没有成功..:

Public ssfDESKTOP As Variant
Public FILE As Variant

Public Sub PasteIt(ByVal FileName As String)
ssfDESKTOP = 0
FILE = FileName

With CreateObject("Shell.Application").NameSpace(ssfDESKTOP)
    With .ParseName(FILE)
        .InvokeVerb "copy" 'This is a canonical verb and should work for any
                           'regional and language settings.
    End With
End With

End Sub

copy并没有发生。当我之后手动单击粘贴按钮时,它会将文件粘贴到资源管理器中,但这不是我所追求的拖放功能。

我只是更改了标题以更好地反映我要解决的最终问题。

在为同一个问题提出不同的措辞后,我再次发现自己陷入了死胡同,只是因为我还不明白该对象的OLEdrag工作原理。image这个对象实际上有 OLedragdrop 但我不确定调用它需要什么,startdrag并通过单击我想要放置它的任何位置用鼠标完成它。

4

0 回答 0