Oxygen Basic
Programming => Problems & Solutions => Topic started by: Frankolinox on March 26, 2013, 10:06:01 AM
-
hello all. I've done this little drag and drop (for files) example but something is missing there. any idea? the example doesn't work correct.
$ filename "t.exe"
'#include "../../inc/RTL32.inc"
'#include "../../inc/RTL64.inc"
#include "../../inc/MinWin.inc"
#lookahead ' for procedures
s=error()
'
if s then
print s
end
end if
Declare Function DragQueryFile Lib "shell32" Alias "DragQueryFileA" ( _
ByVal wHandle As SYS, _
ByVal NumFiles As SYS, _
ByVal NameBuffer As SYS, _
ByVal BufferLen As Long) As SYS
DECLARE SUB DragAcceptFiles LIB "SHELL32.DLL" ALIAS "DragAcceptFiles" ( _
BYVAL hWnd AS SYS _ ' __in HWND hWnd
, BYVAL fAccept AS SYS _ ' __in BOOL fAccept
) ' void
Declare Sub DragFinish Lib "shell32" Alias "DragFinish" (ByVal wHandle As Long)
'%WM_DROPFILES = &H0233???
%WM_DROPFILES = &H233
'=========
'MAIN CODE
'=========
dim cmdline as asciiz ptr, inst as sys
&cmdline=GetCommandLine
inst=GetModuleHandle 0
'
'WINDOWS START
'=============
'
WinMain inst,0,cmdline,SW_NORMAL
end
'--------------------------------------------------------------------
Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
'====================================================================
WndClass wc
MSG wm
sys hwnd, wwd, wht, wtx, wty, tax
wc.style = CS_HREDRAW or CS_VREDRAW
wc.lpfnWndProc = @WndProc
wc.cbClsExtra =0
wc.cbWndExtra =0
wc.hInstance =inst
wc.hIcon=LoadIcon 0, IDI_APPLICATION
wc.hCursor=LoadCursor 0,IDC_ARROW
wc.hbrBackground = GetStockObject WHITE_BRUSH
wc.lpszMenuName =null
wc.lpszClassName = strptr "Demo"
RegisterClass (@wc)
Wwd = 320 : Wht = 200
Tax = GetSystemMetrics SM_CXSCREEN
Wtx = (Tax - Wwd) /2
Tax = GetSystemMetrics SM_CYSCREEN
Wty = (Tax - Wht) /2
hwnd = CreateWindowEx 0,wc.lpszClassName,"Drag'n Drop File Test",WS_OVERLAPPEDWINDOW,Wtx,Wty,Wwd,Wht,0,0,inst,0
ShowWindow hwnd,SW_SHOW
UpdateWindow hwnd
'
sys bRet
'
do while bRet := GetMessage (@wm, 0, 0, 0)
if bRet = -1 then
'show an error message
else
TranslateMessage @wm
DispatchMessage @wm
end if
wend
End Function
dim as rect crect 'for WndProc and TimerProc
'--------------------------------------------------------------
function WndProc ( sys hWnd, wMsg, wParam, lparam ) as sys callback
'==============================================================
static as sys hdc
static as String txt,cr
string sFiles
sys pDrop
static as PaintStruct Paintst
'==========
select wMsg
'==========
'--------------
case WM_CREATE
'=============
GetClientRect hWnd,&cRect
CASE WM_DROPFILES
pDrop = wparam
sFiles=myDragFiles(pDrop)
DragFinish(wparam)
print "drag test"
'--------------
case WM_DESTROY
'===============
DragAcceptFiles hWnd, TRUE
PostQuitMessage 0
'------------
case WM_PAINT
'============
'TEXT
'http://msdn.microsoft.com/en-us/library/dd144821(v=VS.85).aspx
'DRAWING AND PAINTING
'http://msdn.microsoft.com/en-us/library/dd162760(v=VS.85).aspx
GetClientRect hWnd,&cRect
hDC=BeginPaint hWnd,&Paintst
'style
'0x20 DT_SINGLELINE
'0x04 DT_VCENTER
'0x01 DT_CENTER
'0x25
SetBkColor hdc,yellow
SetTextColor hdc,red
DrawText hDC,"Hello World!",-1,&cRect,0x25
EndPaint hWnd,&Paintst
'--------------
case WM_KEYDOWN
'==============
'============
Select wParam
'============
Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
End Select
'--------
case else
'========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
end function ' WndProc
'
'----------------------------------------------------
function mydragfiles (byval hDropParam as sys) as string
'----------------------------------------------------
sys i,retval 'hDropParam,
string sDropFiles,sFile,s
sDropFiles=""
for i = 0 to DragQueryFile(hDropParam, &HFFFFFFFF&, "", 0)-1
sFile = SPACE(DragQueryFile(hDropParam, i, "", 0)+1)
'DragQueryFile hDropParam, i, BYVAL STRPTR(sFile), LEN(sFile)
DragQueryFile hDropParam, i, str(sFile), LEN(sFile)
sFile = LEFT(sFile, LEN(sFile)-1)
'UCASE(RIGHT(sFile,4)) as command doesn't exist!
IF UCASE(LEFT(sFile, 4)) = ".LNK" THEN sFile = ""
'IF UCASE(RIGHT(sFile, 4)) = ".LNK" THEN sFile = "" 'GetLinkInfo(sFile, 1)
sDropFiles = sDropFiles + sFile '+ "|"
next
print "test here!"
'retval=RTRIM(sDropFiles)
function=RTRIM(sDropFiles)
END FUNCTION
regards, frank
X
-
I have the solution: only one line was missing!!! in winmain part :)
DragAcceptFiles(hwnd, TRUE)
oxygen drag example:
$ filename "t.exe"
'#include "../../inc/RTL32.inc"
'#include "../../inc/RTL64.inc"
#include "../../inc/MinWin.inc"
#lookahead ' for procedures
s=error()
'
if s then
print s
end
end if
'%WM_DROPFILES = &H0233???
'%WM_DROPFILES = &H233
% WM_DROPFILES = 0x0233
Dim myDroppedFiles(10) As String
Declare Function DragQueryFile Lib "shell32" Alias "DragQueryFileA" ( _
ByVal wHandle As sys, _
ByVal NumFiles As sys, _
ByVal NameBuffer As sys, _
ByVal BufferLen As Long) As sys
Declare Sub DragFinish Lib "shell32" Alias "DragFinish" (ByVal wHandle As Long)
DECLARE SUB DragAcceptFiles LIB "shell32.DLL" ALIAS "DragAcceptFiles" ( _
BYVAL hWnd AS SYS _ ' __in HWND hWnd
, BYVAL fAccept AS LONG _ ' __in BOOL fAccept
) ' void
'=========
'MAIN CODE
'=========
dim cmdline as asciiz ptr, inst as sys
&cmdline=GetCommandLine
inst=GetModuleHandle 0
'
'WINDOWS START
'=============
'
WinMain inst,0,cmdline,SW_NORMAL
end
'--------------------------------------------------------------------
Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
'====================================================================
WndClass wc
MSG wm
sys hwnd, wwd, wht, wtx, wty, tax
wc.style = CS_HREDRAW or CS_VREDRAW
wc.lpfnWndProc = @WndProc
wc.cbClsExtra =0
wc.cbWndExtra =0
wc.hInstance =inst
wc.hIcon=LoadIcon 0, IDI_APPLICATION
wc.hCursor=LoadCursor 0,IDC_ARROW
wc.hbrBackground = GetStockObject WHITE_BRUSH
wc.lpszMenuName =null
wc.lpszClassName = strptr "Demo"
RegisterClass (@wc)
Wwd = 420 : Wht = 300
Tax = GetSystemMetrics SM_CXSCREEN
Wtx = (Tax - Wwd) /2
Tax = GetSystemMetrics SM_CYSCREEN
Wty = (Tax - Wht) /2
hwnd = CreateWindowEx 0,wc.lpszClassName,"drag and Drop Test_go!",WS_OVERLAPPEDWINDOW,Wtx,Wty,Wwd,Wht,0,0,inst,0
ShowWindow hwnd,SW_SHOW
UpdateWindow hwnd
'---------------------------- this line is IMPORTANT ! ------
DragAcceptFiles(hwnd, TRUE)
'---------------------------- this line is IMPORTANT ! ------
'
sys bRet
'
do while bRet := GetMessage (@wm, 0, 0, 0)
if bRet = -1 then
'show an error message
else
TranslateMessage @wm
DispatchMessage @wm
end if
wend
End Function
Function Alternative_GetDropFiles(ByVal hDropParam As SYS) As String
Local sDropFiles As String, sFile As String, i As Long
for i = 1 To DragQueryFile(hDropParam, &HFFFFFFFF&, "", 0)-1
sFile = space(DragQueryFile(hDropParam, i, "", 0)+1)
'sFile = SPACE$(DragQueryFile(hDropParam, i, "", 0)+1)
'DragQueryFile(hDropParam, i, ByVal StrPtr(sFile), Len(sFile))
DragQueryFile(hDropParam, i, StrPtr(sFile), Len(sFile))
sFile = LEFT$(sFile, Len(sFile)-1)
' RIGHT(sFile,4) doesn't exists
If Ucase(LEFT$(sFile, 4)) = ".LNK" Then sFile = "" 'GetLinkInfo(sFile, 1)
sDropFiles = sDropFiles + sFile + "|"
next i
FUNCTION = RTrim(sDropFiles) ', "|")
End Function
dim as rect crect 'for WndProc and TimerProc
'--------------------------------------------------------------
function WndProc ( sys hWnd, wMsg, wParam, lparam ) as sys callback
'==============================================================
static as sys hdc
static as String txt
static as PaintStruct Paintst
'==========
select wMsg
'==========
'case WM_COMMAND
'--------------
case WM_CREATE
'=============
mbox "here I am"
Case WM_DROPFILES
mbox "here I am after dropfiled"
'
'test one
'
pDrop = wparam 'CBWPARAM
sFiles = Alternative_GetDropFiles(pDrop)
' Free handle...
DragFinish(wparam)
'
'test two
'
If Alternative_GetDropFiles(wparam) Then "" 'myListDroppedFiles(1)
DragFinish (wparam)
mbox "test: here's to drag something"
'MessageBox hwnd, "Files dropped onto the dialog: " + $CRLF + $CRLF + sFiles, "frankos_dragDrop_test", %MB_ICONINFORMATION
'--------------
case WM_DESTROY
'===============
PostQuitMessage 0
DragAcceptFiles(hwnd, TRUE)
'------------
case WM_PAINT
'============
'TEXT
'http://msdn.microsoft.com/en-us/library/dd144821(v=VS.85).aspx
'DRAWING AND PAINTING
'http://msdn.microsoft.com/en-us/library/dd162760(v=VS.85).aspx
GetClientRect hWnd,&cRect
hDC=BeginPaint hWnd,&Paintst
'style
'0x20 DT_SINGLELINE
'0x04 DT_VCENTER
'0x01 DT_CENTER
'0x25
SetBkColor hdc,yellow
SetTextColor hdc,red
DrawText hDC,"Hello World!",-1,&cRect,0x25
EndPaint hWnd,&Paintst
'--------------
case WM_KEYDOWN
'==============
'============
Select wParam
'============
Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
End Select
'--------
case else
'========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
end function ' WndProc
'print "test ok"
this example works as it should. you can drag a folder onto dialog and you can see the mouse with a plus sign. that's all for this example.
2) the command "RIGHT$" is here still missing for oxygen
3) sometimes oxygen doesn't like "FOR" in capitals so I am prefering always "for" ... "next"
best regards, frank
X
-
Thank you Frank, we could certainly use a drag and drop example. I will have a look when I get a moment to spare.
with regard to capitalised 'FOR', you will find that some OxygenBasic examples are partially case sensitive, so that they can use C headers. using #case capital causes fully-upper-case words to be distinguished from mixed-case words.
I may adopt right as a standard macro. It is derived from mid
macro right(s,i) mid(s,-i)
print right("hello",2) 'lo
Charles