Here's a slight upgrade to it.
If you guys want you can mess around with the source code. I'm trying to make it so you can add active X controls using only the windows API. I am testing myself to see if I have the skills to mess with the windows API.
It's just something for fun!
Here's the code:
Rem Project: API Functions
Rem Created: Sunday, November 28, 2010
Rem ***** Main Source File *****
sync on
#constant IUNKNOWN as string = "00000000-0000-0000-C000-000000000046"
#constant DVASPECT_CONTENT = 1
#constant DVASPECT_THUMBNAIL = 2
#constant DVASPECT_ICON = 4
#constant DVASPECT_DOCPRINT = 8
global maxdlls as integer
maxdlls = 10
Dim dllname$(maxdlls)
dllname$(1)="user32.dll"
dllname$(2)="kernel32.dll"
Dim dll(maxdlls) as integer
for x=1 to maxdlls
dll(x)=find free dll(x,1000000)
if file exist("c:/windows/system32/"+dllname$(x))
load dll dllname$(x),dll(x)
endif
next x
global dbphwnd
dbphwnd=get dbpro window()
global maxmsgs as integer
maxmsgs=3
if maxmsgs>0
global maxcaptions=maxmsgs
global maxboxes=maxcaptions
global maxlanguageIDs=maxboxes
global maxmsgtimes=maxlanguageIDs
Dim lp_text$(maxmsgs) as string
Dim lp_caption$(maxcaptions) as string
Dim get_lptext$(maxmsgs) as string
Dim get_lpcaption$(maxmsgs) as string
Dim boxtype(maxboxes) as integer
Dim languageID(maxlanguageids) as integer
Dim msgboxtime(maxmsgtimes) as integer
get_lptext$(0)="Welcome To The MsgBox API"
get_lptext$(1)="Today we will create a multi-message with a time limit!"
get_lptext$(2)="What are you waiting for?"
`Uncomment the below and delete the above get_lptext$() variables to enable a multiple multi message.
Remstart
for x=0 to maxmsgs-1
get lptext$(x)="My message "+str$(x)
next x
Remend
get_lpcaption$(0)="Welcome!"
get_lpcaption$(1)="Welcome!"
get_lpcaption$(2)="Welcome!"
`Same as above basically. Uncomment the below and delete the above get_lpcaption$() variables to enable a multiple multi caption.
Remstart
for x=0 to maxmsgs-1
get lpcaption$(x)="My caption "+str$(x)
next x
Remend
for x=0 to maxmsgs-1
if get_lptext$(x)=""
get_lptext$(x)="No Data"
endif
if get_lpcaption$(x)=""
get_lpcaption$(x)="No Data"
endif
next x
global multimsg as boolean
multimsg=1
if multimsg = 1
for x=0 to maxmsgs-1
lp_text$(x)=get_lptext$(x)
lp_caption$(x)=get_lpcaption$(x)
boxtype(x)=0
languageID(x)=0
msgboxtime(x)=5000
next x
else
msg$="Test"
caption$="Test"
boxtype=0
langid=0
msgtime=5000
endif
global msgbox as integer
msgbox=Call_MessageBoxAuto(multimsg,msg$,caption$,boxtype,langid,msgtime)
else
msgbox=Call_MessageBoxAuto(0,"ERROR: Please use a value > 0 and NOT a decimal...","WARNING!",0,0,10000)
endif
do
sync
loop
function Call_MessageBoxAuto(multimsg,msg$,caption$,boxtype,langid,msgtime)
if multimsg=1
if msg$="" and caption$="" and boxtype<=0 and langid<=0 and msgtime<=0
for x=0 to maxmsgs-1
msg=MessageBoxTimeoutA(dll(1),dbphwnd,lp_text$(x),lp_caption$(x),boxtype(x),languageID(x),msgboxtime(x))
next x
endif
else
if multimsg=0
msg=MessageBoxTimeoutA(dll(1),dbphwnd,msg$,caption$,boxtype,langid,msgtime)
else
if multimsg<>1 or multimsg<>0
msg=MessageBoxTimeOutA(dll(1),dbpwhnd,"ERROR: Please use ONLY 1 or 0 for multimsg...","WARNING!",0,0,10000)
endif
endif
endif
endfunction multimsg
function MessageBoxTimeoutA(dll, winhandle, lpText$, lpCaption$, uType, wLanguageId, dwMilliseconds)
funcname$ = "MessageBoxTimeoutA"
call=call dll(dll,funcname$, winhandle, lpText$, lpCaption$, uType, wLanguageId, dwMilliseconds)
endfunction call
Remstart
__in REFCLSID rclsid,
__in REFIID riid,
__in DWORD renderopt,
__in LPFORMATETC pFormatEtc,
__in LPOLECLIENTSITE pClientSite,
__in LPSTORAGE pStg,
__out LPVOID *ppvObj
Remend
function Create_OLE(dll,ClassID$,refid,renderopt,LPFORMATETC,LPOLECLIENTSIZE,LPSTORAGE,ppvObj)
funcname$ = "OleCreate"
call=call dll(dll,funcname$,ClassID$,refid,renderopt,LPFORMATETC,LPOLECLIENTSIZE,LPSTORAGE,ppvObj)
endfunction call
Remstart
OleDraw(
__in LPUNKNOWN pUnknown,
__in DWORD dwAspect,
__in HDC hdcDraw,
__in LPCRECT lprcBounds
);
Remend
function OLE_Draw(LPUNKNOWN,DVAspect,hdcDraw,lproBounds)
funcname$ = "OleDraw"
call=call dll(dll,funcname$,LPUNKNOWN,DVAspect,hdcDraw,lproBounds)
endfunction call
Feel free to fix it up!
Thanks!
CHECK OUT SOME MUSIC FROM MY NEW TECHNO CD! TECHNOKINESIS
http://www.youtube.com/watch?v=4a8KedfgVv0
ALSO, CHECK OUT MY NEW TECHNO CD AT Amazon.com!
