ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2018年12月11日(火) 18:08

All times are UTC+09:00




トピックに返信する
ユーザー名:
件名:
メッセージ本文:
こちらにメッセージをご入力ください。60000 字まで入力できます。 

フォントサイズ:
フォントカラー
オプション:
BBCode: ON
[img]: ON
[flash]: OFF
[url]: ON
スマイリー: OFF
BBCode を無効にする
URL を自動的にパースしない
クイズ
お手数ですがカタカナで「エービー」と4文字を入力してください。:
答えを正確にご入力ください。答えられるかどうかでスパムボットか否かを判定します。
   

トピックのレビュー - ドロップアンドドラッグ
作成者 メッセージ
  記事の件名:  Re: ドロップアンドドラッグ  引用付きで返信する
なんかもう、こんな感じに...
画像
投稿記事 Posted: 2016年11月28日(月) 21:02
  記事の件名:  Re: ドロップアンドドラッグ  引用付きで返信する
引用:
自己解決いたしました
どのようにして解決されたのでしょうか?
投稿記事 Posted: 2016年11月27日(日) 20:53
  記事の件名:  Re: ドロップアンドドラッグ  引用付きで返信する
自己解決いたしました
投稿記事 Posted: 2016年11月26日(土) 20: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 をクリックするとプログラムが停止してしまいます。
どうすればよいですか?
画像
投稿記事 Posted: 2016年11月24日(木) 17:09

All times are UTC+09:00


ページ移動:  
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke