by TISAproject » 2016年11月30日(水) 21:01
コード: 全て選択
'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
' 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
Dim ID As Integer
#include<api_mmsys.sbp>'PlaySound関数を使うとき必要!
open "./Plus_Actions/Operation.CPUCOMP" For Input As #1
'TreeViewで使用する追加定義。
Function TreeView_InsertItem( hWnd As Long, ByRef lpis As TVINSERTSTRUCT ) As Long
TreeView_InsertItem = SendMessage( hWnd, TVM_INSERTITEM, 0, VarPtr(lpis) )
EndFunction
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
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
Declare Function SetLayeredWindowAttributes Lib "user32" (hwnd As Long,crKey As Long, bAlpha As Byte,_
dwFlags As Long) As Long
Const LWA_ALPHA=&H2
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy()
Active120_DestroyObjects()
PostQuitMessage(0)
END
End Sub
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
SetWindowLong(hMainWnd, GWL_EXSTYLE, GetWindowLong(hMainWnd, GWL_EXSTYLE) or &H80000)
SetLayeredWindowAttributes(hMainWnd,0,1000,LWA_ALPHA)'200を変えると、透過度が変わります。
End Sub
SUB MainWnd_DropFiles(HDROP AS HANDLE)
DIM SUU AS Long
DIM IDX AS Long
DIM FILENAME AS string
Dim Clear As string
DIM PGMID As *Byte
SUU = DragQueryFile(HDROP,-1,NULL,0)
FOR IDX = 0 TO SUU - 1
DragQueryFile(HDROP,IDX,FILENAME,255)
Button=GetDlgItem(hMainWnd,TreeView1)
EnableWindow(Button,FALSE)
Button2=GetDlgItem(hMainWnd,TreeView1)
EnableWindow(Button2,FALSE)
SetWindowText(hMainWnd, "Fast-Deleter:削除処理中 (" & Onthefile )
cloud1 = DeleteFile (FILENAME)
If cloud1 <> 0 Then
SetWindowText(hMainWnd, " 削除完了しました。 FILE" )
EnableWindow(Button,TRUE)
present = "{ 削除完了しました }"
Onthefile = ""
Classter = 1
MessageBeep (MB_ICONASTERISK/* ここに型を入力*/)
Else
A1 = FILENAME
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(hMainWnd, "削除完了しました。FOLDER" )
present = "{ 削除処理END }"
Onthefile = ""
Classter = 1
MessageBeep (MB_ICONASTERISK/* ここに型を入力*/)
Else
SetWindowText(hMainWnd, "削除処理ERROR <もう一度処理するには再ドラッグアンドドロップ>" )
present = "{ 削除できませんでした。使用されているか、存在しない、またはこのappより上の権限がかかっています }"
MessageBeep (MB_ICONHAND/* ここに型を入力*/)
End If
End If
EnableWindow(Button,TRUE)
EnableWindow(Button2,TRUE)
FlashWindow(hMainWnd,TRUE) 'TRUEはオン、FALSEはオフ
Sleep (500)
FlashWindow(hMainWnd,TRUE) 'TRUEはオン、FALSEはオフ
Dim hAny As Long
Dim tvi As TVINSERTSTRUCT
Dim hTreeItem As Long
'ツリービューのハンドルを得る
hAny = GetDlgItem( hMainWnd, TreeView1 )
'ルートの項目(アイテム)を追加する。
tvi.hParent = TVI_ROOT
tvi.hInsertAfter = TVI_SORT
tvi.item.mask = TVIF_TEXT
Clear = FILENAME & present
tvi.item.pszText=StrPtr(FILENAME)
hTreeItem = TreeView_InsertItem( hAny , tvi )
FILENAME = ""
Sleep (600)
NEXT
DragFinish(HDROP)
END SUB
これで、ファイルかフォルダーをドラッグアンドドロップし、削除させると、何回かでAppが動作を停止してしまうのですが、どうすればいいでしょう?
[code]'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
' 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
Dim ID As Integer
#include<api_mmsys.sbp>'PlaySound関数を使うとき必要!
open "./Plus_Actions/Operation.CPUCOMP" For Input As #1
'TreeViewで使用する追加定義。
Function TreeView_InsertItem( hWnd As Long, ByRef lpis As TVINSERTSTRUCT ) As Long
TreeView_InsertItem = SendMessage( hWnd, TVM_INSERTITEM, 0, VarPtr(lpis) )
EndFunction
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
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
Declare Function SetLayeredWindowAttributes Lib "user32" (hwnd As Long,crKey As Long, bAlpha As Byte,_
dwFlags As Long) As Long
Const LWA_ALPHA=&H2
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy()
Active120_DestroyObjects()
PostQuitMessage(0)
END
End Sub
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
SetWindowLong(hMainWnd, GWL_EXSTYLE, GetWindowLong(hMainWnd, GWL_EXSTYLE) or &H80000)
SetLayeredWindowAttributes(hMainWnd,0,1000,LWA_ALPHA)'200を変えると、透過度が変わります。
End Sub
SUB MainWnd_DropFiles(HDROP AS HANDLE)
DIM SUU AS Long
DIM IDX AS Long
DIM FILENAME AS string
Dim Clear As string
DIM PGMID As *Byte
SUU = DragQueryFile(HDROP,-1,NULL,0)
FOR IDX = 0 TO SUU - 1
DragQueryFile(HDROP,IDX,FILENAME,255)
Button=GetDlgItem(hMainWnd,TreeView1)
EnableWindow(Button,FALSE)
Button2=GetDlgItem(hMainWnd,TreeView1)
EnableWindow(Button2,FALSE)
SetWindowText(hMainWnd, "Fast-Deleter:削除処理中 (" & Onthefile )
cloud1 = DeleteFile (FILENAME)
If cloud1 <> 0 Then
SetWindowText(hMainWnd, " 削除完了しました。 FILE" )
EnableWindow(Button,TRUE)
present = "{ 削除完了しました }"
Onthefile = ""
Classter = 1
MessageBeep (MB_ICONASTERISK/* ここに型を入力*/)
Else
A1 = FILENAME
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(hMainWnd, "削除完了しました。FOLDER" )
present = "{ 削除処理END }"
Onthefile = ""
Classter = 1
MessageBeep (MB_ICONASTERISK/* ここに型を入力*/)
Else
SetWindowText(hMainWnd, "削除処理ERROR <もう一度処理するには再ドラッグアンドドロップ>" )
present = "{ 削除できませんでした。使用されているか、存在しない、またはこのappより上の権限がかかっています }"
MessageBeep (MB_ICONHAND/* ここに型を入力*/)
End If
End If
EnableWindow(Button,TRUE)
EnableWindow(Button2,TRUE)
FlashWindow(hMainWnd,TRUE) 'TRUEはオン、FALSEはオフ
Sleep (500)
FlashWindow(hMainWnd,TRUE) 'TRUEはオン、FALSEはオフ
Dim hAny As Long
Dim tvi As TVINSERTSTRUCT
Dim hTreeItem As Long
'ツリービューのハンドルを得る
hAny = GetDlgItem( hMainWnd, TreeView1 )
'ルートの項目(アイテム)を追加する。
tvi.hParent = TVI_ROOT
tvi.hInsertAfter = TVI_SORT
tvi.item.mask = TVIF_TEXT
Clear = FILENAME & present
tvi.item.pszText=StrPtr(FILENAME)
hTreeItem = TreeView_InsertItem( hAny , tvi )
FILENAME = ""
Sleep (600)
NEXT
DragFinish(HDROP)
END SUB
[/code]
これで、ファイルかフォルダーをドラッグアンドドロップし、削除させると、何回かでAppが動作を停止してしまうのですが、どうすればいいでしょう?