At the PowerBASIC archives there are very few posts using this API and all of them, including me, employ it within WM_INITDIALOG.
However, I am using José Roca's WinFBX where WM_INITDIALOG, being a dialog message, does not pass muster. Since I am extremely ignorant of SDK programming I dropped SetWindowSubclass into WM_CREATE instead. With dialog programming we show the dialog at the last minute so WM_INITDIALOG knows everything about the dialog. What I did not know was that when we create a window in SDK the WndProc kicks in immediately so WM_CREATE is totally ignorant of any controls we add after the window creation. So, WM_CREATE had no idea what I was talking about when I referred to any controls. I cannot use then SetWindowSubclass in WM_CREATE.
I decided to put SetWindowSubclass at the end of WinMain just before DoEvents. SetWindowSubclass is returning TRUE so it is installing correctly and I am getting a GetLastError of zero so all seems well.
I am geting into DragDropProc because I am getting "Yep, I am here" on the first pass. However, DrafDropProc is not getting any WM_DropFiles messages.
I have had a look in the FreeBASIC archives but cannot find anything to help me out; with most folk using it in WM_INITDIALOG.
I have not coded any buttons yet and clicking on them will simply acknowledge the click. At the bottom of DragDropProc are commented statements which have not been rewritten in FreeBASIC yet and have no bearing on the Drag&Drop functionality.
Can anyone help me on this? Once the Drag&Drop is working then I can steam ahead with the idea behind this little app.
There is no point in posting snippets so here is the 'full monty' so far. The code will compile and a window will appear.
Code: Select all
'#Console On
#Define UNICODE
#Define _WIN32_WINNT &h0602
#Include Once "Afx/CWindow.inc"
#Include Once "Afx/CFileSys.inc"
#Include Once "Windows.bi"
Using Afx
Const IDC_FRAME1 = 1001
Const IDC_Encrypt = 1002
Const IDC_Decrypt = 1003
Const IDC_TEXTBOX1 = 1005
Const IDC_Execute = 1007
Dim Shared szFileName() As Zstring * Max_Path
Dim Shared sPassword As String
Type DragDropType
Title As Zstring * 20
hHandle As Dword
End Type
Declare Function WinMain (Byval hInstance As HINSTANCE, _
Byval hPrevInstance As HINSTANCE, _
Byval szCmdLine As Zstring Ptr, _
Byval nCmdShow As Long) As Long
End WinMain(GetModuleHandleW(NULL), NULL, Command(), SW_NORMAL)
Declare Function WndProc( As HWND, As UINT, As WPARAM, As LPARAM ) As LRESULT
Declare Function DragDropProc( As hwnd, As Uint, As wparam, As lParam, As Uint_ptr, As Dword_Ptr ) As winbool
Dim Shared As Long xWindow, yWindow
Dim Shared pFileSys As CFileSys
Function WinMain (Byval hInstance As HINSTANCE, _
Byval hPrevInstance As HINSTANCE, _
Byval szCmdLine As Zstring Ptr, _
Byval nCmdShow As Long) As Long
Dim As Long f
' // Set process DPI aware
AfxSetProcessDPIAware
Dim pWindow As CWindow
pWindow.SetFont("Tahoma", 10, FW_NORMAL, , , , DEFAULT_CHARSET)
pWindow.Create(NULL, "Encryption/Decryption", @WndProc, ,,,, WS_SYSMENU Or WS_CAPTION, WS_EX_TOPMOST)
pWindow.SetClientSize(334, 220)
' Open at last position
Dim hwnd As Hwnd = pWindow.hWindow
If pFileSys.Fileexists("Position.dat") Then
f = Freefile
Open "Position.dat" For Binary As #f
Get #f, , xWindow
Get #f, , yWindow
Close #f
SetWindowPos( HWnd, HWND_NOTOPMOST, xWindow, yWindow, 0, 0, SWP_NOSIZE )
Else
pWindow.Center
End If
pWindow.AddControl("GroupBox", , IDC_FRAME1, "Drag && Drop Or Left Click To browse ", 24, 16, 286, 100)
pWindow.AddControl("Button", , IDC_Encrypt, "Encrypt a file", 40, 40, 120, 60, , WS_Ex_AcceptFiles)
pWindow.AddControl("Button", , IDC_Decrypt, "Decrypt a file", 174, 40, 120, 60, , WS_Ex_AcceptFiles)
pWindow.AddControl("Edit", , IDC_TEXTBOX1, "", 35, 128, 266, 23 )
Edit_SetReadOnly( GetDlgItem( hwnd, IDC_TEXTBOX1 ), true )
pWindow.AddControl("Button", , IDC_Execute, "Execute", 130, 166, 80, 40 )
Dim DragDrop As DragDropType
Dim ptrDragDrop As DragDropType Ptr = @DragDrop
DragDrop.Title = "Drag And Drop"
DragDrop.hHandle = Cast(Dword, hWnd )
Dim lResult As Boolean
lResult = SetWindowSubclass(GetDlgItem( Hwnd, IDC_Encrypt), Procptr(DragDropProc), 1, Cast( DWORD_PTR, ptrDragDrop ) )
Print lresult, getlasterror
lResult = SetWindowSubclass(GetDlgItem( hWnd, IDC_Decrypt), Procptr(DragDropProc), 2, Cast( DWORD_PTR, ptrDragDrop ) )
Print lresult, getlasterror
Function = pWindow.DoEvents(nCmdShow)
End Function
Function WndProc(Byval hwnd As HWND, Byval uMsg As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM) As LRESULT
Dim lResult As Boolean
Select Case uMsg
Case WM_COMMAND
' Process control notifications
Select Case GET_WM_COMMAND_ID(wParam, lParam)
Case IDC_Encrypt
If GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED Then
MessageBox hWnd, "IDC_Encrypt", "Test",MB_TASKMODAL
End If
Case IDC_Decrypt
If GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED Then
MessageBox hWnd, "IDC_Decrypt", "Test",MB_TASKMODAL
End If
Case IDC_Execute
If GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED Then
MessageBox hWnd, "IDC_Execute", "Test",MB_TASKMODAL
End If
End Select
Case WM_DESTROY
' // Ends the application by sending a WM_QUIT message
lResult = RemoveWindowSubclass(GetDlgItem( hWnd, IDC_Encrypt ), Procptr(DragDropProc), 1)
lResult = RemoveWindowSubclass(GetDlgItem( HWnd, IDC_Decrypt ), Procptr(DragDropProc), 2)
PostQuitMessage(0)
Exit Function
Case WM_SYSCOMMAND
If Loword(wParam) = SC_CLOSE Then ' Close message
Dim As Long x, y, f
Dim rc As RECT
GetWindowRect( hWnd, @rc )
' If Window has moved Then save current position
If xWindow <> rc.Left Orelse yWindow <> rc.top Then
f = Freefile
Open "Position.dat" For Binary Access Write As #f
Put #f, , rc.Left
Put #f, , rc.top
Close #f
End If
End If
End Select
' // Default processing of Windows messages
Function = DefWindowProcW(hWnd, uMsg, wParam, lParam)
End Function
Function DragDropProc( hWnd As hwnd, wMsg As Uint, wParam As wparam, _
lParam As lParam, uIDSubclass As Uint_ptr, RefData As Dword_Ptr ) As WINBOOL
Static As Boolean FirstPass = True
Static As Dword hDlg
Static As String MsgTitle
Dim As Dword dwRes
Dim As Zstring * MAX_PATH szFName
If FirstPass Then
Print "Yep, I am here"
hDlg = Cast(DragDropType Ptr, RefData)->hHandle
MsgTitle = Cast(DragDropType Ptr, RefData)->Title
FirstPass = False
End If
Select Case wMsg
Case WM_DropFiles
Print "... And I am here As well"
dwRes = DragQueryFile( Cast( hDrop, wParam ), -1, Byval Null, 0 ) ' Get number Of dropped files
If dwRes Then
If dwRes > 1 Then
MessageBox Cast( hWnd, hDlg ), "Only one file may be dropped.", _
MsgTitle, MB_IconError Or MB_TaskModal Or MB_Topmost
DragFinish Cast( hDrop, wParam )
Exit Function
End If
Else
DragFinish Cast( hDrop, wParam )
Exit Function
End If
dwRes = DragQueryFile( Cast( hDrop, wParam ), 0, szFName, Max_Path )
If dwRes Then
szFName = Left$( szFName, dwRes )
If ( GetFileAttributes( szFName ) And FileAttribute_Directory ) <> 0 Then
MessageBox Cast( hWnd, hDlg ), "Only a file may be dropped, Not folders.", _
MsgTitle, MB_IconError Or MB_TaskModal Or MB_Topmost
DragFinish Cast( hDrop, wParam )
Exit Function
End If
Else
DragFinish Cast( hDrop, wParam )
Exit Function
End If
' szFileName(spID) = szFName
' If spID = 1 Then
' GetSHA512Password
' Control Disable hDlg, KeyFileButton
' Control Enable hDlg, EnableKeyFile
' Control Set Text hDlg, KeyFileText, PathName$( Namex, szFilename(1) )
' Else
' Control Disable hDlg, TargetFileButton
' Control Enable hDlg, EnableTargetFile
' Control Set Text hDlg, TargetFileText, szFileName(2)
' End If
' If szFileName(1) <> "" And szFileName(2) <> "" Then
' Control Enable hDlg, ExecuteButton
' End If
DragFinish Cast( hDrop, wParam )
End Select
Function = DefSubclassProc( hwnd, wMsg, wParam, lParam )
End Function