Sorry your browser is not supported!

Set Window On

newline$ = Chr$(13) + Chr$(10)
user32 = 1
shell32 = 2
NULL = 0

Load DLL "user32.dll",user32
Load DLL "shell32.dll",shell32


`A Message Box
Call DLL user32,"MessageBoxA",NULL,"I like Eggs","Eggs",NULL
_wait("Message Box Done!")


`A Windows About ( Windows ) Box

str1$ = "A Stupid Windows Message Box...#Windows Sucks"
str2$ = "Windows Sucks" + newline$ + "I'm Unstable!"

Call DLL shell32,"ShellAboutA",NULL,str1$,str2$,NULL
_wait("About Box Done!")




End



Function _wait(mystr$)

   Print mystr$
   While Inkey$() = "" : Sync : EndWhile

EndFunction

Set Window On
Set Window Layout 0,0,0
Maximize Window


user32 = 1

Load DLL "user32.dll",user32

wind = Call DLL(user32,"GetActiveWindow")


_make_fullscreen(user32,1,wind,32)


sw = Screen Width()
sh = Screen Height()

x = sw/2
y = sh/2

width = 0
height = 0

Call DLL user32,"MoveWindow",wind,x,y,width,height,1

Disable EscapeKey

intro = 1


Do
Cls

If intro = 1
   If width < sw And height < sh
      Dec x,8
      Dec y,6

      Inc width, 16
      Inc height, 12

      stime = Timer()
      Call DLL user32,"MoveWindow",wind,x,y,width,height,0
      etime = Timer() - stime
   Else
      intro = 0
   EndIf
EndIf


If intro = 0 And EscapeKey() = 1 Then outro = 1 : intro = 2

If intro = 0 Then Text 0,40,"Press Escape To Implode"


If outro = 1
   If width > 0 And height > 0

      Inc x,8
      Inc y,6

      Dec width, 16
      Dec height, 12

      stime = Timer()
      Call DLL user32,"MoveWindow",wind,x,y,width,height,1
      etime = Timer() - stime
   Else
      outro = 2
   EndIf
EndIf



If outro = 2 Then End




Text 0,0,"FPS: " + Str$(Screen FPS())
Text 0,20,"Time taken for DLL Call: " + Str$(etime)

Sync
Loop





Function _make_fullscreen(dllnum,memnum,window,bitdepth)


   Make Memblock memnum,20

   Call Dll dllnum,"GetWindowRect",window,Get Memblock Ptr(memnum)
   `memblock word(1,0) = left
   `memblock word(1,4) = top
   `memblock word(1,8) = right
   `memblock word(1,12) = bottom

   Set Display Mode Memblock Word(memnum,8),Memblock Word(memnum,12),bitdepth

   Delete Memblock memnum


EndFunction

Sync On : Sync Rate 0
Set Window On





file$ = _open_save("All Files ( *.* )|*.*|","C:","Open File","pei",1)

While InKey$() <> "q"
   Text 0,0,file$
   Sync
EndWhile

End



Function _open_save(filter$,initdir$,dtitle$,defext$,open)
   `filter = "Text Documents ( *.txt )|*.txt|All Files ( *.* )|*.*|"
   `initdir = "C:"
   `dtitle = "Open ~ Test"
   `defext = "txt"
   `open = 1 For Open Dialogu, 0 for save dialogue


   `Load in required DLL's
   user32 = _find_fee_dll()
   Load DLL "user32.dll",user32
   comdlg32 = _find_fee_dll()
   Load DLL "comdlg32.dll",comdlg32


   `Get handle ( unique ID ) to the calling ( this ) window
   hwnd = Call DLL(user32,"GetActiveWindow")


   `Unload DLL as it is no longer needed
   Delete DLL user32


   `Get the Memblock Number
   OPENFILENAME = _find_free_mem()
   `Make The Memblock containing the OPENFILENAME structure
   Make MemBlock OPENFILENAME,76


   `Get the pointer to the just created Structure
   lpofn = Get MemBlock Ptr(OPENFILENAME)


   `Write all the info to the Structure for the API call to handle it.
   RemStart : C++ Structure Lay-out
   typedef struct tagOFN {
     DWORD         lStructSize;
     HWND          hwndOwner;
     HINSTANCE     hInstance;
     LPCTSTR       lpstrFilter;
     LPTSTR        lpstrCustomFilter;
     DWORD         nMaxCustFilter;
     DWORD         nFilterIndex;
     LPTSTR        lpstrFile;
     DWORD         nMaxFile;
     LPTSTR        lpstrFileTitle;
     DWORD         nMaxFileTitle;
     LPCTSTR       lpstrInitialDir;
     LPCTSTR       lpstrTitle;
     DWORD         Flags;
     WORD          nFileOffset;
     WORD          nFileExtension;
     LPCTSTR       lpstrDefExt;
     LPARAM        lCustData;
     LPOFNHOOKPROC lpfnHook;
     LPCTSTR       lpTemplateName;
   #if (_WIN32_WINNT >= 0x0500)
     void *        pvReserved;
     DWORD         dwReserved;
     DWORD         FlagsEx;
   #endif // (_WIN32_WINNT >= 0x0500)
   } OPENFILENAME, *LPOPENFILENAME;
   RemEnd

   `Declare temp variables to hold data for OPENFILENAME structure
   filter$ = filter$ + "|"
   initdir$ = initdir$ + "|"
   dtitle$ = dtitle$ + "|"
   defext$ = defext$ + "|"
   filebuffer$ = "|" + _Space(255) + "|"
   filebufferptr = _get_str_ptr(filebuffer$)
   flags = 0x00001000 || 0x00000004 || 0x00000002
   size = 0

   Write MemBlock DWord OPENFILENAME,0,76                     : `lStructSize
   Write MemBlock DWord OPENFILENAME,4,hwnd                   : `hwndOwner
   `Write MemBlock DWord OPENFILENAME,8,NULL                   : `hInstance
   Write MemBlock DWord OPENFILENAME,12,_get_str_ptr(filter$)  : `lpstrFilter
   `Write MemBlock DWord OPENFILENAME,16,0                     : `lpstrCustomFilter
   `Write MemBlock DWord OPENFILENAME,20,NULL                  : `nMaxCustFilter
   Write MemBlock DWord OPENFILENAME,24,1                     : `nFilterIndex
   Write MemBlock DWord OPENFILENAME,28,filebufferptr         : `lpstrFile
   Write MemBlock DWord OPENFILENAME,32,256                   : `nMaxFile
   `Write MemBlock DWord OPENFILENAME,36,0                     : `lpstrFileTitle
   `Write MemBlock DWord OPENFILENAME,40,NULL                  : `nMaxFileTitle
   Write MemBlock DWord OPENFILENAME,44,_get_str_ptr(initdir$) : `lpstrInitialDir
   Write MemBlock DWord OPENFILENAME,48,_get_str_ptr(dtitle$)  : `lpstrTitle
   Write MemBlock DWord OPENFILENAME,52,flags                 : `Flags
   `Write MemBlock Word OPENFILENAME,56,NULL                   : `nFileOffset
   `Write MemBlock Word OPENFILENAME,58,NULL                   : `nFileExtension
   Write MemBlock DWord OPENFILENAME,60,_get_str_ptr(defext$)  : `lpstrDefExt
   `Write MemBlock DWord OPENFILENAME,64,NULL                  : `lCustData
   `Write MemBlock DWord OPENFILENAME,68,NULL                  : `lpfnHook
   `Write MemBlock DWord OPENFILENAME,72,0                     : `lpTemplateName


   `Call the Command to open the dialouge
   If open
      retval = Call DLL(comdlg32,"GetOpenFileNameA",lpofn)
   Else
      retval = Call DLL(comdlg32,"GetSaveFileNameA",lpofn)
   EndIf

   `Check if it was sucecfull
   If retval <> 0
      code$ = _get_str(filebufferptr,256)
   Else
      retval = Call DLL(comdlg32,"CommDlgExtendedError")
      Select retval
         Case 0xFFFF : code$ = "The dialog box could not be created. The common dialog box function's call to the DialogBox function failed. For example, this error occurs if the common dialog box call specifies an invalid window handle." : EndCase
         Case 0x0006 : code$ = "The common dialog box function failed to find a specified resource." : EndCase
         Case 0x0004 : code$ = "The ENABLETEMPLATE flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a corresponding instance handle." : EndCase
         Case 0x0002 : code$ = "The common dialog box function failed during initialization. This error often occurs when sufficient memory is not available." : EndCase
         Case 0x000B : code$ = "The ENABLEHOOK flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a pointer to a corresponding hook procedure." : EndCase
         Case 0x0008 : code$ = "The common dialog box function failed to lock a specified resource." : EndCase
         Case 0x0003 : code$ = "The ENABLETEMPLATE flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a corresponding template." : EndCase
         Case 0x0007 : code$ = "The common dialog box function failed to load a specified string." : EndCase
         Case 0x0001 : code$ = "The lStructSize member of the initialization structure for the corresponding common dialog box is invalid." : EndCase
         Case 0x0005 : code$ = "The common dialog box function failed to load a specified string." : EndCase
         Case 0x3003 : code$ = "The buffer pointed to by the lpstrFile part of OPENFILENAME structure is too small for the file name specified by the user." : EndCase
         Case 0x0009 : code$ = "The common dialog box function was unable to allocate memory for internal structures." : EndCase
         Case 0x3002 : code$ = "A file name is invalid." : EndCase
         Case 0x000A : code$ = "The common dialog box function was unable to lock the memory associated with a handle." : EndCase
         Case 0x3001 : code$ = "An attempt to subclass a list box failed because sufficient memory was not available." : EndCase
         Case Default : code$ = "WHOOPS!" : EndCase
      EndSelect
   EndIF

   Delete DLL comdlg32


EndFunction code$






Function _get_str_ptr(pstr$)
   `pstr$ should be a "|" ( NULL ) seperated string.



   memnum = _find_free_mem()
   strlen = Len(pstr)

   Make MemBlock memnum,strlen

   For i = 1 To strlen
      If Mid$(pstr$,i) = "|"
         char = 0
      Else
         char = Asc(Mid$(pstr$,i))
      EndIf
      Write MemBlock Byte memnum,(i - 1),char
   Next i

   memptr = Get MemBlock Ptr(memnum)

   strptr = Make Memory(strlen)

   Copy Memory strptr,memptr,strlen

   Delete MemBlock memnum


EndFunction strptr



Function _get_str(strptr,strsize)
   `strptr is the pointer returned by _get_str_ptr()
   `strsize is the Integer length of the string specified by the pointer

   memnum = _find_free_mem()

   Make MemBlock memnum,strsize

   memptr = Get MemBlock Ptr(memnum)

   Copy Memory memptr,strptr,strsize

   For i = 1 To strsize
      str = str + Chr$(MemBlock Byte(memnum,i - 1))
   Next i


EndFunction str



Function _find_fee_dll()

   retval = 0
   Repeat
      Inc retval
   Until DLL Exist(retval) = 0

EndFunction retval



Function _find_free_mem()

   retval = 0
   Repeat
      Inc retval
   Until MemBlock Exist(retval) = 0

EndFunction retval



Function _space(num)

   For i = 1 To num
      mystr$ = mystr$ + " "
   Next i

EndFunction mystr$

Sync On : Sync Rate 0
Disable EscapeKey


Global NULL               = 0

Global BM_GETSTATE        = 0x00F2

Global BST_PUSHED         = 0x0004

Global GWL_HINSTANCE      = -6
Global GWL_STYLE          = -16

Global WS_EX_ACCEPTFILES  = 0x00000010
Global WS_EX_TOPMOST      = 0x00000008

Global WS_VISIBLE         = 0x10000000
Global WS_CHILD           = 0x40000000
Global WS_CLIPCHILDREN    = 0x02000000
Global WS_CLIPSIBLINGS    = 0x04000000

Global SW_SHOW            = 5
Global SW_RESTORE         = 9

Global SWP_SHOWWINDOW     = 0x0040
Global SWP_DEFERERASE     = 0x2000
Global SWP_NOZORDER       = 0x0004
Global SWP_NOMOVE         = 0x0002
Global SWP_NOOWNERZORDER  = 0x0200

Global BCM_FIRST          = 0x1600
Global BCM_GETIDEALSIZE   = BCM_FIRST || 0x0001



`BUTTON STYLE Constants
Global BS_PUSHBUTTON      = 0x00000000
Global BS_DEFPUSHBUTTON   = 0x00000001
Global BS_CHECKBOX        = 0x00000002
Global BS_AUTOCHECKBOX    = 0x00000003
Global BS_RADIOBUTTON     = 0x00000004
Global BS_3STATE          = 0x00000005
Global BS_AUTO3STATE      = 0x00000006
Global BS_GROUPBOX        = 0x00000007
Global BS_USERBUTTON      = 0x00000008
Global BS_AUTORADIOBUTTON = 0x00000009
Global BS_OWNERDRAW       = 0x0000000B
Global BS_LEFTTEXT        = 0x00000020
Global BS_TEXT            = 0x00000000
Global BS_ICON            = 0x00000040
Global BS_BITMAP          = 0x00000080
Global BS_LEFT            = 0x00000100
Global BS_RIGHT           = 0x00000200
Global BS_CENTER          = 0x00000300
Global BS_TOP             = 0x0000040
Global BS_BOTTOM          = 0x00000800
Global BS_VCENTER         = 0x00000C00
Global BS_PUSHLIKE        = 0x00001000
Global BS_MULTILINE       = 0x00002000
Global BS_NOTIFY          = 0x00004000
Global BS_FLAT            = 0x00008000


Global DBPHwnd = 0
Global user32 = 0
Global comctl32 = 0



_initialize_API()


Global mybut = 0
Dim buts(5)
flag = 1
For i = 1 To 5

   x = x + _button_width(buts(i - 1))
   y = y + _button_height(buts(i - 1))
   buts(i) = _button("Hello World99",x,y,flag)
   flag = 0
Next i


Repeat
   Cls


   If _button_down(buts(1)) = 1
      Cls RGB(Rnd(255),Rnd(255),Rnd(255))
   EndIf


FastSync
Until EscapeKey()


For x = 1 To 5
Call DLL user32,"DestroyWindow",buts(x)
Next x
Delete DLL user32
Delete DLL comctl32





Function _initialize_API()

   `Load in the user32.dll
   user32 = _find_free_dll()
   Load DLL "user32.dll",user32

   `Set up the window so it can use window's styles;
   comctl32 = _find_free_dll()
   Load DLL "comctl32.dll",comctl32

   Call DLL comctl32,"InitCommonControls"

   `Get the handle to the window
   DBPHwnd = Call DLL(user32,"GetActiveWindow")

   `Set up the DBP window so that it doesn't draw over API screen areas
   styles = Call DLL(user32,"GetWindowLongA",DBPHwnd,GWL_STYLE)
   styles = styles || WS_CLIPCHILDREN
   styles = Call DLL(user32,"SetWindowLongA",DBPHwnd,GWL_STYLE,styles)

EndFunction





Function _button(butstr$,x,y,flag)

   pointsize = Text Size()
   Set Text Size 10
   cx = Text Width(butstr$) + 5
   cy = Text Height(butstr$) + 5
   Set Text Size pointsize

   If flag = 1
      params = WS_VISIBLE || WS_CHILD || BS_AUTOCHECKBOX || BS_PUSHLIKE
      retval = 0
      strptr = _get_str_ptr(butstr$)

      retval = Call DLL(user32,"CreateWindowExA",NULL,"BUTTON",strptr$,params,x,y,cx,cy,DBPHwnd)
   Else
      params = WS_VISIBLE || WS_CHILD || BS_PUSHBUTTON
      retval = 0
      strptr = _get_str_ptr(butstr$)

      retval = Call DLL(user32,"CreateWindowExA",NULL,"BUTTON",strptr,params,x,y,cx,cy,DBPHwnd)
   EndIf

   SIZEptr = Make Memory(8)

   tmp = Call DLL(user32,"SendMessageA",retval,BCM_GETIDEALSIZE,0,SIZEptr)


   cx = *SIZEptr
   Inc SIZEptr,4
   cy = *SIZEptr
   Dec SIZEptr,4


   tmp = Call DLL(user32,"SetWindowPos",retval,0,x,y,cx,cy,SWP_NOMOVE || SWP_NOOWNERZORDER || SWP_NOZORDER || SWP_SHOWWINDOW)

   Delete Memory SIZEptr


EndFunction retval




Function _button_set_ideal_size(but)

   ptr = Make Memory(8)

   result = Call DLL(user32,"SendMessageA",but,BCM_GETIDEALSIZE,NULL,NULL)

EndFunction




Function _button_down(but)


   result = Call DLL(user32,"SendMessageA",but,BM_GETSTATE,NULL,NULL)

   If result = 108
      ExitFunction 1
   EndIf


EndFunction 0





Function _button_width(but)


   lprect = _find_free_mem()
   Make MemBlock lprect,12
   lprectptr = Get MemBlock Ptr(lprect)

   result = Call DLL(user32,"GetWindowRect",but,lprectptr)

   result = MemBlock DWord(lprect,8) - MemBlock DWord(lprect,0)

   Delete MemBlock lprect

EndFunction result



Function _button_height(but)


   lprect = _find_free_mem()
   Make MemBlock lprect,16
   lprectptr = Get MemBlock Ptr(lprect)

   result = Call DLL(user32,"GetWindowRect",but,lprectptr)

   result = MemBlock DWord(lprect,12) - MemBlock DWord(lprect,4)

   Delete MemBlock lprect

EndFunction result




Function _get_str_ptr(pst$)
   `pstr$ should be a "|" ( NULL ) seperated string.


   memnum = _find_free_mem()
   strlen = Len(pstr$)

   Make MemBlock memnum,strlen

   For i = 1 To strlen
      If Mid$(pstr$,i) = "|"
         char = 0
      Else
         char = Asc(Mid$(pstr$,i))
      EndIf
      Write MemBlock Byte memnum,(i - 1),char
   Next i

   memptr = Get MemBlock Ptr(memnum)

   strptr = Make Memory(strlen)

   Copy Memory strptr,memptr,strlen

   Delete MemBlock memnum


EndFunction strptr



Function _get_str(strptr,strsize)
   `strptr is the pointer returned by _get_str_ptr()
   `strsize is the Integer length of the string specified by the pointer

   memnum = _find_free_mem()

   Make MemBlock memnum,strsize

   memptr = Get MemBlock Ptr(memnum)

   Copy Memory memptr,strptr,strsize

   For i = 1 To strsize
      mystr$ = mystr$ + Chr$(MemBlock Byte(memnum,i - 1))
   Next i


EndFunction mystr$



Function _find_free_dll()

   retval = 0
   Repeat
      Inc retval
   Until DLL Exist(retval) = 0

EndFunction retval



Function _find_free_mem()

   retval = 0
   Repeat
      Inc retval
   Until MemBlock Exist(retval) = 0

EndFunction retval