PT Forum

ESC_ Joined: 29th Aug 2003
Location: Mass.

Posted: 20th Oct 2003 0:54

created a simple demo showing the use of pop-up menus in DBP. Simply right-click to bring up the menu. I'm working on getting it to return values now (kind of useless without that )

+ Code Snippet

`creating pop-up menus in dbp
`by esc

sync on:sync rate 60
set window on
set window title "POP-UP MENU TESTS"

`----------------------
load dll "user32.dll",1
`----------------------
hwnd = call dll(1,"GetActiveWindow")
hmenu=call dll(1,"CreatePopupMenu")

null=call dll(1,"AppendMenuA",hmenu,0,0,"Hello!")
null=call dll(1,"AppendMenuA",hmenu,0,0,"Popup menus in DBP")
null=call dll(1,"AppendMenuA",hmenu,2048,0)
null=call dll(1,"AppendMenuA",hmenu,0,0,"Divided")
null=call dll(1,"AppendMenuA",hmenu,32,0,"Testing menubar break")
null=call dll(1,"AppendMenuA",hmenu,1,0,"Can't touch this!")
null=call dll(1,"AppendMenuA",hmenu,2,0,"Can't touch this either!")
null=call dll(1,"AppendMenuA",hmenu,8,0,"Checked off")
null=call dll(1,"AppendMenuA",hmenu,64,0,"Testing menu break")
null=call dll(1,"AppendMenuA",hmenu,128,0,"Highlighted")
null=call dll(1,"AppendMenuA",hmenu,15,0)

do
cls rgb(110,110,110)
if mouseclick()=2 then returnv=call dll(1,"TrackPopupMenu",hmenu,32,mousex(),mousey(),0,hwnd,0)

set cursor 0,0:print returnv
sync
loop

ESC_ Joined: 29th Aug 2003
Location: Mass.

Posted: 20th Oct 2003 4:19

Now it can return the item you click on based on it's id tag. I was trying to get it to position correctly by using GetCursorPos, but for some reason it just writes zeros to the memblock I'm using

+ Code Snippet

`creating pop-up menus in dbp
`by esc

sync on:sync rate 60
set window on
set window title "POP-UP MENU TESTS"

`----------------------
load dll "user32.dll",1
`----------------------
hwnd = call dll(1,"GetActiveWindow")
hmenu=call dll(1,"CreatePopupMenu")

null=call dll(1,"AppendMenuA",hmenu,0,0,"Hello!")
null=call dll(1,"AppendMenuA",hmenu,0,1,"Popup menus in DBP")
null=call dll(1,"AppendMenuA",hmenu,2048,2)
null=call dll(1,"AppendMenuA",hmenu,0,3,"Divided")
null=call dll(1,"AppendMenuA",hmenu,32,4,"Testing menubar break")
null=call dll(1,"AppendMenuA",hmenu,1,5,"Can't touch this!")
null=call dll(1,"AppendMenuA",hmenu,2,6,"Can't touch this either!")
null=call dll(1,"AppendMenuA",hmenu,8,7,"Checked off")
null=call dll(1,"AppendMenuA",hmenu,64,8,"Testing menu break")
null=call dll(1,"AppendMenuA",hmenu,128,9,"Highlighted")
null=call dll(1,"AppendMenuA",hmenu,15,10)




set text size 30

do
cls rgb(110,110,110)


if mouseclick()=2
returnv=call dll(1,"TrackPopupMenu",hmenu,256,mousex(),mousey(),0,hwnd,0)
endif

text 0,0,str$(returnv)
sync
loop

ESC_ Joined: 29th Aug 2003
Location: Mass.

Posted: 20th Oct 2003 5:45

proper positioning now:

+ Code Snippet

`creating pop-up menus in dbp
`by esc

sync on:sync rate 60
set window on
set window title "POP-UP MENU TESTS"

`----------------------
load dll "user32.dll",1
`----------------------
hwnd = call dll(1,"GetActiveWindow")
hmenu=call dll(1,"CreatePopupMenu")

null=call dll(1,"AppendMenuA",hmenu,0,0,"Hello!")
null=call dll(1,"AppendMenuA",hmenu,0,1,"Popup menus in DBP")
null=call dll(1,"AppendMenuA",hmenu,2048,2)
null=call dll(1,"AppendMenuA",hmenu,0,3,"Divided")
null=call dll(1,"AppendMenuA",hmenu,32,4,"Testing menubar break")
null=call dll(1,"AppendMenuA",hmenu,1,5,"Can't touch this!")
null=call dll(1,"AppendMenuA",hmenu,2,6,"Can't touch this either!")
null=call dll(1,"AppendMenuA",hmenu,8,7,"Checked off")
null=call dll(1,"AppendMenuA",hmenu,64,8,"Testing menu break")
null=call dll(1,"AppendMenuA",hmenu,128,9,"Highlighted")
null=call dll(1,"AppendMenuA",hmenu,15,10)




set text size 30
make memblock 1,8

do
cls rgb(110,110,110)
retval=call dll(1,"GetCursorPos",get memblock ptr(1))

if mouseclick()=2
returnv=call dll(1,"TrackPopupMenu",hmenu,256,memblock word(1,0),memblock word(1,4),0,hwnd,0)
endif

text 0,0,str$(returnv)
sync
loop

ESC_ Joined: 29th Aug 2003
Location: Mass.

Posted: 20th Oct 2003 5:46

and without the menu breaks:

+ Code Snippet

`creating pop-up menus in dbp
`by esc

sync on:sync rate 60
set window on
set window title "POP-UP MENU TESTS"

`----------------------
load dll "user32.dll",1
`----------------------
hwnd = call dll(1,"GetActiveWindow")
hmenu=call dll(1,"CreatePopupMenu")

null=call dll(1,"AppendMenuA",hmenu,0,0,"Hello!")
null=call dll(1,"AppendMenuA",hmenu,0,1,"Popup menus in DBP")
null=call dll(1,"AppendMenuA",hmenu,2048,2)
null=call dll(1,"AppendMenuA",hmenu,0,3,"Divided")
null=call dll(1,"AppendMenuA",hmenu,1,5,"Can't touch this!")
null=call dll(1,"AppendMenuA",hmenu,2,6,"Can't touch this either!")
null=call dll(1,"AppendMenuA",hmenu,8,7,"Checked off")
null=call dll(1,"AppendMenuA",hmenu,128,9,"Highlighted")
null=call dll(1,"AppendMenuA",hmenu,15,10)




set text size 30
make memblock 1,8

do
cls rgb(110,110,110)
retval=call dll(1,"GetCursorPos",get memblock ptr(1))

if mouseclick()=2
returnv=call dll(1,"TrackPopupMenu",hmenu,256,memblock word(1,0),memblock word(1,4),0,hwnd,0)
endif

text 0,0,str$(returnv)
sync
loop

sparrow Joined: 21st Feb 2003
Location: United States

Posted: 20th Oct 2003 21:51

nice stuff

ESC_ Joined: 29th Aug 2003
Location: Mass.

Posted: 20th Oct 2003 22:55

Thanks

David T Joined: 27th Aug 2002
Location: England

Posted: 20th Oct 2003 23:42

clever stuff

ESC_ Joined: 29th Aug 2003
Location: Mass.

Posted: 21st Oct 2003 0:15

Preston C Joined: 16th May 2003
Location: Penn State University Park

Posted: 21st Oct 2003 3:19

where can I find this user32.dll?

Edit: Nevermind, its the one in C:\Windows\system32, right?

ESC_ Joined: 29th Aug 2003
Location: Mass.

Posted: 21st Oct 2003 3:26

Yup. You don't need to specify a path when loading it, though

Preston C Joined: 16th May 2003
Location: Penn State University Park

Posted: 22nd Oct 2003 1:07

wow, this is neat, should implement it into Decoy

ESC_ Joined: 29th Aug 2003
Location: Mass.

Posted: 22nd Oct 2003 1:56

Go for it

There's also a way to create load/save dialogs using another windows .dll. It may be useful for your app. I'll post it here later if I can find it

Xanatus Joined: 15th Mar 2003
Location: Germany

Posted: 22nd Oct 2003 3:25

Heres a way to create a Open Dialog coded by Kulle:

+ Code Snippet

load dll "user32.dll",1
load dll "kernel32.dll",2
load dll "comdlg32.dll",3

rem Memblock Table
OFN_MB = 1
PathBuffer_MB = 2
FileFilter_MB = 3
FileBoxTitle_MB = 4

rem Offset Table OPENFILENAME Struct
lStructSize = 0
hwndOwner = 4
hInstance = 8
lpstrFilter = 12
lpstrCustomFilter = 16
nMaxCustFilter = 20
nFilterIndex = 24
lpstrFile = 28
nMaxFile = 32
lpstrFileTitle = 36
nMaxFileTitle = 40
lpstrInitialDir = 44
lpstrTitle = 48
Flags = 52
nFileOffset = 56
nFileExtension = 58
lpstrDefExt = 60
lCustData = 64
lpfnHook = 68
lpTemplateName = 72
StructEnd = 76

rem OPENFILENAME Flag Table
OFN_ALLOWMULTISELECT = 0x00000200
OFN_CREATEPROMPT = 0x00002000
OFN_ENABLEHOOK = 0x00000020
OFN_ENABLETEMPLATE = 0x00000040
OFN_ENABLETEMPLATEHANDLE = 0x00000080
OFN_EXPLORER = 0x00080000
OFN_EXTENSIONDIFFERENT = 0x00000400
OFN_FILEMUSTEXIST = 0x00001000
OFN_HIDEREADONLY = 0x00000004
OFN_LONGNAMES = 0x00200000
OFN_NOCHANGEDIR = 0x00000008
OFN_NODEREFERENCELINKS = 0x00100000
OFN_NOLONGNAMES = 0x00040000
OFN_NONETWORKBUTTON = 0x00020000
OFN_NOREADONLYRETURN = 0x00008000
OFN_NOTESTFILECREATE = 0x00010000
OFN_NOVALIDATE = 0x00000100
OFN_OVERWRITEPROMPT = 0x00000002
OFN_PATHMUSTEXIST = 0x00000800
OFN_READONLY = 0x00000001
OFN_SHAREAWARE = 0x00004000
OFN_SHOWHELP = 0x00000010

rem FileBox Info
FileFilter$ = "All Files^*.*^DarkBasic Files^*.dba;*.dbpro^^"
FileBoxTitle$ = "FileBox Example^"
FileBoxFlags = OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST or OFN_LONGNAMES
PathBufferSize = 256
hWnd = call dll(1,"GetActiveWindow")
hMod = call dll(2,"GetModuleHandleA",0)

rem Create Memblock Struct
make memblock OFN_MB,StructEnd
make memblock PathBuffer_MB,PathBufferSize
make memblock FileFilter_MB,len(FileFilter$)
make memblock FileBoxTitle_MB,len(FileBoxTitle$)
OFN = get memblock ptr(OFN_MB)
PathBuffer = get memblock ptr(PathBuffer_MB)
FileFilter = get memblock ptr(FileFilter_MB)
FileBoxTitle = get memblock ptr(FileBoxTitle_MB)

rem Dump Strings to Memblock
dump(FileFilter_MB,FileFilter$)
dump(FileBoxTitle_MB,FileBoxTitle$)

rem Write to OPENFILENAME Struct
write memblock dword OFN_MB,lStructSize,StructEnd
write memblock dword OFN_MB,hWndOwner,hWnd
write memblock dword OFN_MB,hInstance,hMod
write memblock dword OFN_MB,lpstrFilter,FileFilter
write memblock dword OFN_MB,lpstrFile,PathBuffer
write memblock dword OFN_MB,nMaxFile,PathBufferSize
write memblock dword OFN_MB,Flags,FileBoxFlags
write memblock dword OFN_MB,lpstrTitle,FileBoxTitle

rem Open FileBox
call dll 3,"GetOpenFileNameA",OFN
print getstr(PathBuffer_MB)
wait key

rem Delete Memblock Struct
delete memblock OFN_MB
delete memblock PathBuffer_MB
delete memblock FileFilter_MB
delete memblock FileBoxTitle_MB

delete dll 1
delete dll 2
delete dll 3
end

function dump(m,s$)
for p=1 to len(s$)

b=asc(mid$(s$,p))
if b=asc("^") then b=0
write memblock byte m,p-1,b

next p
endfunction

function getstr(m)
do

b=memblock byte(m,p)
if b=0 then exit
s$=s$+chr$(b)
inc p

loop
endfunction s$

ESC_ Joined: 29th Aug 2003
Location: Mass.

Posted: 22nd Oct 2003 3:43

Yup, that's the one

JPcreator Joined: 11th Jul 2003
Location: The Netherlands

Posted: 8th Nov 2003 12:44

like the pop-up (first two) the other codes won't work.
Am I the only one?

ESC_ Joined: 29th Aug 2003
Location: Mass.

Posted: 8th Nov 2003 21:05

Which one doesn't work for you?

ReD_eYe Joined: 9th Mar 2003
Location: United Kingdom

Posted: 8th Nov 2003 21:36

very nice!

JPcreator Joined: 11th Jul 2003
Location: The Netherlands

Posted: 9th Nov 2003 10:36

Which one doesn't work for you?

Only the first to work for me. So the third,fourth and last don't.
Can it has something to do with Me?

(Win Me - not myself

)
(When memblock is used my computer crashes!

)

<1 >

Sign In