ab.com コミュニティ https://www.activebasic.com/forum/ |
|
ドロップアンドドラッグ https://www.activebasic.com/forum/viewtopic.php?t=4608 |
ページ 1 / 1 |
作成者: | TISAproject [ 2016年11月24日(木) 17:09 ] |
記事の件名: | ドロップアンドドラッグ |
コード: ' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。 Dim DefEditProc As Long Dim Onthefile As string Dim Onput As string Dim strURL As string Dim Option1 As long Dim cloud1 As Long Dim fos As SHFILEOPSTRUCT Dim deletePath As String Dim A1 As String Dim Button As Long Dim Button2 As Long Dim lpMsgBuf As BytePtr Dim Classter As long Dim present As string FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, _ NULL, _ GetLastError(), _ LANG_USER_DEFAULT, _ VarPtr(lpMsgBuf), _ 0, _ NULL) SetWindowText(GetDlgItem(hMainWnd,EditBox1), lpMsgBuf ) LocalFree(lpMsgBuf) Function DropEditProc(hWnd As HWND, message As DWORD, wParam As DWORD, lParam As DWORD) As DWORD Select Case message Case WM_DROPFILES Dim hDrop As HDROP Dim FileName[MAX_PATH] As Byte Dim FileName2 As string hDrop=wParam As HDROP 'ドロップされたファイル名を取得 DragQueryFile(hDrop, 0, FileName, MAX_PATH) Onthefile = FileName SetWindowText(hMainWnd, "Fast-Deleter" ) SetWindowText(GetDlgItem(hMainWnd,EditBox1),"[ " & Onthefile & " ]: 削除しますか。" ) KillTimer(hMainWnd,0) DragFinish(hDrop) DropEditProc=0 Exit Function End Select DropEditProc=CallWindowProc(DefEditProc As VoidPtr, hWnd, message, wParam, lParam) End Function '----------------------------------------------------------------------------- ' ウィンドウメッセージを処理するためのコールバック関数 Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord ' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。 ' イベントプロシージャの呼び出しを行います。 MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam) End Function '----------------------------------------------------------------------------- ' ここから下は、イベントプロシージャを記述するための領域になります。 Sub MainWnd_Destroy() SetWindowLong(GetDlgItem(hMainWnd, CommandButton1), GWL_WNDPROC, DefEditProc) PostQuitMessage(0) END End Sub Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT) DefEditProc=SetWindowLong(GetDlgItem(hMainWnd, CommandButton1), GWL_WNDPROC, AddressOf(DropEditProc) As Long) End Sub Sub MainWnd_CommandButton1_Click() KillTimer(hMainWnd,0) If Onthefile = "" Then SetWindowText(GetDlgItem(hMainWnd,EditBox1), "まずはボタン枠内にドラックアンドドロップしてください" ) SetWindowText(hMainWnd, "Fast-Deleter" ) Else Button=GetDlgItem(hMainWnd,CommandButton1) EnableWindow(Button,FALSE) Button2=GetDlgItem(hMainWnd,CommandButton2) EnableWindow(Button2,FALSE) SetWindowText(hMainWnd, "Fast-Deleter : 削除処理中 (" & Onthefile ) cloud1 = DeleteFile (Onthefile) If cloud1 <> 0 Then SetWindowText(GetDlgItem(hMainWnd,EditBox1), "削除完了しました :( " & Onthefile ) SetWindowText(hMainWnd, "Fast-Deleter : 削除処理END" ) EnableWindow(Button,TRUE) present = "{ " & Onthefile & " : 削除処理END }" & present Onthefile = "" Classter = 1 MessageBeep (MB_ICONASTERISK/* ここに型を入力*/) Else A1 = Onthefile deletePath = A1 + Chr$(0) fos.wFunc = FO_DELETE fos.pFrom = StrPtr(deletePath) fos.fFlags = FOF_SILENT Or FOF_NOCONFIRMATION Or FOF_NOERRORUI If SHFileOperation(fos) = 0 And fos.fAnyOperationsAborted = FALSE Then fos.pFrom = StrPtr(deletePath) fos.fFlags = FOF_SILENT Or FOF_NOCONFIRMATION Or FOF_NOERRORUI SetWindowText(GetDlgItem(hMainWnd,EditBox1), "削除完了しました。:( " & Onthefile) SetWindowText(hMainWnd, "Fast-Deleter : 削除処理END" ) present = "{ " & Onthefile & " : 削除処理END }" & present Onthefile = "" Classter = 1 MessageBeep (MB_ICONASTERISK/* ここに型を入力*/) Else SetWindowText(GetDlgItem(hMainWnd,EditBox1), "削除できませんでした。使用されているか、存在しない、またはこのappより上の権限がかかっています :( " & Onthefile ) SetWindowText(hMainWnd, "Fast-Deleter : 削除処理ERROR <もう一度処理するには再クリック>" ) present = "{ " & Onthefile & " : 削除処理ERROR }" & present MessageBeep (MB_ICONHAND/* ここに型を入力*/) End If End If EnableWindow(Button,TRUE) EnableWindow(Button2,TRUE) FlashWindow(hMainWnd,TRUE) 'TRUEはオン、FALSEはオフ SetTimer(hMainWnd,0,500,0) End If End Sub Sub MainWnd_CommandButton3_Click() END End Sub Sub MainWnd_CommandButton2_Click() KillTimer(hMainWnd,0) If present = "" Then SetWindowText(GetDlgItem(hMainWnd,EditBox1), "まだ削除履歴はありません。") Else SetWindowText(hMainWnd, "削除履歴を表示しています" ) SetWindowText(GetDlgItem(hMainWnd,EditBox1), present ) End If End Sub 'タイマー処理 Sub MainWnd_Timer(TimerID AS DWord) FlashWindow(hMainWnd,FALSE) 'TRUEはオン、FALSEはオフ FlashWindow(hMainWnd,TRUE) 'TRUEはオン、FALSEはオフ SetTimer(hMainWnd,0,500,0) End Subでは何も問題なかったのですが、 69行目を SetWindowLong(hMainWnd, CommandButton1), GWL_WNDPROC, DefEditProc) 76行目を DefEditProc=SetWindowLong(hMainWnd, GWL_WNDPROC, AddressOf(DropEditProc) As Long) にしてコンパイルしたら、コンパイルではエラーは出ないのですが、 プログラムを実行し、Mainwind にドラッグアンドドロップして、CommandButton1 をクリックするとプログラムが停止してしまいます。 どうすればよいですか? |
作成者: | TISAproject [ 2016年11月26日(土) 20:09 ] |
記事の件名: | Re: ドロップアンドドラッグ |
自己解決いたしました |
作成者: | たかせ [ 2016年11月27日(日) 20:53 ] |
記事の件名: | Re: ドロップアンドドラッグ |
引用: 自己解決いたしました
どのようにして解決されたのでしょうか?
|
作成者: | TISAproject [ 2016年11月28日(月) 21:02 ] |
記事の件名: | Re: ドロップアンドドラッグ |
なんかもう、こんな感じに... |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |