home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April B / Pcwk4b98.iso / Borland / Dbase50w / SAMPLES1.PAK / WINAPI.WFM < prev   
Text File  |  1994-08-02  |  15KB  |  413 lines
  1. *****************************************************************************
  2. *  PROGRAM:      WinApi.wfm
  3. *
  4. *  WRITTEN BY:   Borland Samples Group
  5. *
  6. *  DATE:         6/28/93
  7. *
  8. *  UPDATED:      6/94
  9. *
  10. *  REVISION      $Revision:   1.45  $
  11. *
  12. *  VERSION:      dBASE FOR WINDOWS 5.0
  13. *
  14. *  DESCRIPTION:  This program shows how to access useful Windows API functions
  15. *                using the dBASE for Windows API interface.
  16. *                A form is displayed with pushbuttons containing different
  17. *                information that can be accessed with the Windows API through
  18. *                dBASE for Windows.  Pressing a pushbutton executes the selected
  19. *                function (or series of functions).  The Close pushbutton
  20. *                closes the window.
  21. *
  22. *  PARAMETERS:   None
  23. *
  24. *  CALLS:        Buttons.cc       (Custom controls file)
  25. *                SysInfo.wfm      (Form for displaying system information)
  26. *
  27. *                GetWinFlags()    (Windows API functions)
  28. *                GetModuleUsage()
  29. *                GetModuleHandle()
  30. *                GetVersion()
  31. *                ShowWindow()
  32. *                GetFreeSpace()
  33. *                SystemParametersInfo()
  34. *                MessageBox()
  35. *                GetWindowText()
  36. *                CloseWindow()
  37. *                OpenIcon()
  38. *                GetWindowsDirectory()
  39. *                GetPrivateProfileString()
  40. *
  41. *  USAGE:        DO Winapi.wfm
  42. *
  43. *
  44. *
  45. *******************************************************************************
  46. #include "Messdlg.h"
  47. #include "Winapi.h"
  48.  
  49. #define  ENTER    chr(13)
  50. #define  TAB      chr(9)
  51. create session
  52. set talk off
  53. set ldCheck off
  54.  
  55. ** END HEADER -- do not remove this line*
  56. * Generated on 05/11/94
  57. *
  58. LOCAL f
  59. f = NEW WINAPIFORM()
  60. f.Open()
  61.  
  62. CLASS WINAPIFORM OF FORM
  63.    Set Procedure to Buttons.cc Additive
  64.    this.OnOpen = CLASS::ONOPEN
  65.    this.OnClose = CLASS::ONCLOSE
  66.    this.MousePointer =          1
  67.    this.Text = "Windows API Call Demo"
  68.    this.Width =         44.05
  69.    this.Top =          0.93
  70.    this.Left =         33.66
  71.    this.Height =         14.85
  72.    this.Minimize = .F.
  73.    this.Maximize = .F.
  74.    this.HelpFile = ""
  75.    this.HelpId = ""
  76.  
  77.    DEFINE RECTANGLE RECTANGLE1 OF THIS;
  78.        PROPERTY;
  79.          ColorNormal "N/W",;
  80.          Text "",;
  81.          Height         13.79,;
  82.          Width         25.74,;
  83.          Top          0.54,;
  84.          Left          1.32,;
  85.          Border .T.
  86.  
  87.    DEFINE PUSHBUTTON SYSINFOBUTTON OF THIS;
  88.        PROPERTY;
  89.          OnClick CLASS::SYSINFO,;
  90.          ColorNormal "N/W",;
  91.          StatusMessage "Show information about the system.",;
  92.          Text "System Information",;
  93.          Width         23.75,;
  94.          Top          1.06,;
  95.          Left          1.98,;
  96.          Height          1.60,;
  97.          FontSize          6.00,;
  98.          Default .T.
  99.  
  100.    DEFINE PUSHBUTTON OKCANBOXBUTTON OF THIS;
  101.        PROPERTY;
  102.          OnClick CLASS::OKCANBOX,;
  103.          ColorNormal "N/W",;
  104.          StatusMessage "Show a message dialog.",;
  105.          Text "   Message Box    ",;
  106.          Width         23.75,;
  107.          Top          2.92,;
  108.          Left          1.98,;
  109.          Height          1.60,;
  110.          Group .F.
  111.  
  112.    DEFINE PUSHBUTTON WINWALLPAPERBUTTON OF THIS;
  113.        PROPERTY;
  114.          OnClick CLASS::WINWALLPAPER,;
  115.          ColorNormal "N/W",;
  116.          StatusMessage "Show how the wallpaper can be changed from dBASEWIN.",;
  117.          Text "    Wallpaper     ",;
  118.          Width         23.75,;
  119.          Top          4.78,;
  120.          Left          1.98,;
  121.          Height          1.60,;
  122.          Group .F.
  123.  
  124.    DEFINE PUSHBUTTON WINDOWCAPTIONSBUTTON OF THIS;
  125.        PROPERTY;
  126.          OnClick CLASS::WINDOWCAPTIONS,;
  127.          ColorNormal "N/W",;
  128.          StatusMessage "Show the caption of the dBASEWIN frame retrieved from the Api and dBASEWIN.",;
  129.          Text " Window Captions  ",;
  130.          Width         23.75,;
  131.          Top          6.63,;
  132.          Left          1.98,;
  133.          Height          1.60,;
  134.          Group .F.
  135.  
  136.    DEFINE PUSHBUTTON WINDIRECTORYBUTTON OF THIS;
  137.        PROPERTY;
  138.          OnClick CLASS::WINDIRECTORY,;
  139.          ColorNormal "N/W",;
  140.          StatusMessage "Show the Windows home directory.",;
  141.          Text "Windows Directory ",;
  142.          Width         23.75,;
  143.          Top          8.48,;
  144.          Left          1.98,;
  145.          Height          1.60,;
  146.          Group .F.
  147.  
  148.    DEFINE PUSHBUTTON DBWINICONBUTTON OF THIS;
  149.        PROPERTY;
  150.          OnClick CLASS::ICON,;
  151.          ColorNormal "N/W",;
  152.          StatusMessage "Make dBASE for Windows minimized for a short time.",;
  153.          Text "Icon",;
  154.          Width         23.75,;
  155.          Top          10.34,;
  156.          Left          1.98,;
  157.          Height          1.60,;
  158.          Group .F.
  159.  
  160.    DEFINE PUSHBUTTON WHOAMIBUTTON OF THIS;
  161.        PROPERTY;
  162.          OnClick CLASS::WHOAMI,;
  163.          ColorNormal "N/W",;
  164.          StatusMessage "Display information about the user.",;
  165.          Text "Who Am I?",;
  166.          Width         23.75,;
  167.          Top         12.20,;
  168.          Left          1.98,;
  169.          Height          1.60,;
  170.          Group .F.
  171.  
  172.    DEFINE CLOSEBUTTON CLOSEWINAPIBUTTON OF THIS;
  173.        PROPERTY;
  174.          StatusMessage "Leave Winapi.",;
  175.          Width         14.11,;
  176.          Top          1.06,;
  177.          Left         28.38,;
  178.          Height          1.50
  179.  
  180. procedure OnOpen
  181. *******************************************************************************
  182. set procedure to Sampproc additive
  183.  
  184. *******************************************************************************
  185. procedure OnClose
  186. *******************************************************************************
  187. close procedure Buttons.cc, Sampproc.prg
  188.  
  189. *******************************************************************************
  190. procedure Sysinfo
  191. *******************************************************************************
  192. local info
  193. _app.framewin.visible = .f.
  194. set procedure to Sysinfo.wfm additive && if frame invisible at that time
  195. info = new SysInfoForm()
  196. info.Readmodal()
  197. form.visible = .t.
  198. _app.framewin.visible = .t.
  199.  
  200. *******************************************************************************
  201. function OkCanBox
  202.  
  203. * OkCanBox(<cMess>,<cTitle>).
  204. * <cMess>  = Message to display in Box.
  205. * <cTitle> = Title of Message Box.
  206. *
  207. * Creates a MessageBox on the SCREEN with
  208. * a title and message text. The user must
  209. * press or click OK or CANCEL or press ESCAPE
  210. * key. This is a System Modal MessageBox.
  211. * Calls the User.exe function MessageBox()
  212. * -- the Borland version of the Windows function MessageBox().
  213. * choice = okcanbox("Read my lips","Message Box")
  214. * 2 if Escape pressed, 1 if OK button pressed,
  215. * 2 if CANCEL pressed. Or 0 if not enough memory.
  216. *
  217. *******************************************************************************
  218. * Returns 0 if not enough memory to create MessageBox.
  219. * Returns 1=OK,2=CANCEL,3=ABORT,4=RETRY,5=IGNORE,6=YES,7=NO,8=ONE
  220. *   wType any combo of below
  221. *       MODE                         DEFAULT BUTTON
  222. *0x3000h=12288D Mode Mask  0x0F00h=3840 Dec Def.Button
  223. *0x0000h=00000D App Modal  0x0000h=0000 Dec Button 1
  224. *0x1000h=04096D Sys Modal  0x0100h=0256 Dec Button 2
  225. *0x2000h=08192D Task Modal 0x0200h=0512 Dec Button 3
  226. *                          0x0300h=0768 Dec Button 4
  227. *                          0x0400h=1024 Dec Button 5
  228. *                          0x0500h=1280 Dec Button 6
  229. *                          0x0600h=1536 Dec Button 7
  230. *                          0x0700h=1792 Dec Button 8
  231. *        ICON                           BUTTON
  232. *0x00F0h=0240D Icon Mask  0x000Fh=0015Dec Type Mask
  233. *0x0010h=0016D Hand       0x0000h=0000Dec OK Button
  234. *0x0010h=0016D Stop *     0.00x0001h=0001Dec OK CANCEL
  235. *0x0020h=0032D Question   0x0002h=0002Dec ABORT RETRY IGNORE
  236. *0x0030h=0048D Exclaimation 0003h=0003Dec YES NO CANCEL
  237. *0x0040h=0064D Astrisk    0x0004h=0004Dec YES NO
  238. *0x0040h=0064D Information x0005h=0005Dec RETRY CANCEL
  239. *                         0x0008h=0008Dec ABORT RETRY
  240. *                         0x0009h=0009Dec OK CANCEL ABORT
  241. *                                         RETRY IGNORE
  242. *                         0x000Ah=0010Dec NO CANCEL RETRY
  243. *                                         CANCEL GARBAGE
  244. *                         0x000Bh=0011Dec OK CANCEL ABORT
  245. *                                         RETRY IGNORE YES
  246. *                                         NO CANCEL
  247. *******************************************************************************
  248. param cMess,cTitle
  249. private cMess1,cTitle1,value
  250.  
  251. cMess1 = iif(empty(cMess),;
  252.              FormatStr("Put Message Here! \n" +;
  253.                        "Syntax is: \n" +;
  254.                        "? OkCanBox('Message','Title') \n\n" +;
  255.                        "Returns: \n" +;
  256.                        "1 if OK button clicked or pressed \n" +;
  257.                        "2 if Cancel button or Escape key pressed \n" +;
  258.                        "0 if not enough memory to run"),;
  259.              cMess)
  260.  
  261. cTitle1 = iif(empty(cTitle),"OkCanBox( ) Message Function",cTitle)
  262. value = MessageBox(NULL,;
  263.                    ansi(cMess1),;
  264.                    ansi(cTitle1),;
  265.                    INFORMATION_MESSAGE + OK_CANCEL_BUTTONS)
  266. ?value
  267. return value
  268.  
  269.  
  270.  
  271. *******************************************************************************
  272. procedure WinWallpaper
  273.  
  274. * Calls the Windows WallPaper changer program.
  275. * First it reduces dBASE to an ICON then it
  276. * changes into the Windows directory and displays a
  277. * GETFILE() box of the *.BMP files in the Windows
  278. * directory then it changes the desktop wallpaper to
  279. * the file you choose.Next it asks if you want to keep
  280. * the Wallpaper or set it to (None) Then it returns to
  281. * the directory you started from and restores dBASE
  282. * from the ICON.
  283. *******************************************************************************
  284.  
  285. *extern  CLOGICAL  SystemParametersInfo ( CINT,CINT,CPTR,CINT )  USER.EXE
  286. *extern  CVOID     CloseWindow( CHANDLE ) USER.EXE
  287. private wallpaper,newWall,orgDir,winPath,changeWallStr
  288.  
  289. _app.framewin.visible = .f.
  290. orgDir = set("directory")
  291. winPath = CLASS::winDirectory(.t.)
  292. cd &winPath
  293. wallpaper = getfile("*.BMP","Select New Wallpaper")
  294. cd &orgDir
  295.  
  296. changeWallStr = FormatStr("Press OK to change the Wallpaper \n;
  297. or press Cancel to keep your original wallpaper")
  298.  
  299. if .not. empty(wallpaper) .and. CLASS::OkCanBox(changeWallStr) = OK
  300.       SystemParametersInfo(20,0,ansi(wallpaper),1)
  301. endif
  302. _app.framewin.visible = .t.
  303.  
  304.  
  305.  
  306. *******************************************************************************
  307. procedure WindowCaptions
  308.  
  309. * Calls the Windows function GetFormText to get title of the
  310. * dBASE for Windows frame window
  311. *
  312. *******************************************************************************
  313. *extern  CINT      GetWindowText ( CHANDLE,CSTRING,CINT ) USER.EXE
  314. local winTitle,lenTitle,apiStr,objectStr
  315.  
  316. winTitle = space(80)      && first make empty string to be filled
  317. lenTitle = GetWindowText(_app.framewin.hwnd,winTitle,80)
  318. apiStr    = FormatStr("From API call: \t %1",oem(winTitle))
  319. objectStr = FormatStr("From Object Model: %1",(_app.framewin.text))
  320. MessageBox(NULL,;
  321.            ansi(apiStr + ENTER + objectStr),;
  322.            ansi("Title of dBASEWIN"),;
  323.            INFORMATION_MESSAGE + OK_BUTTON)
  324.  
  325.  
  326.  
  327. *******************************************************************************
  328. procedure Icon
  329.  
  330. * This example just minimizes dBASEWIN.EXE to a
  331. * ICON (by way of the CloseWindow funtion) waits 5
  332. * seconds then restores dBASEWIN.EXE from its ICON.
  333. *
  334. *******************************************************************************
  335. *extern CWORD CloseWindow(CWORD)  user.exe
  336. *extern CWORD OpenIcon(CWORD)  user.exe
  337. local frameState
  338.  
  339. if messageBox(NULL,;
  340.               ansi("This will minimize dBASEWIN for 5 seconds. Proceed?"),;
  341.               ansi("Confirmation"),;
  342.               CONFIRMATION_MESSAGE + YES_NO_BUTTONS) = YES
  343.    frameState = _app.framewin.windowState + 1   && save previous frame state
  344.    CloseWindow(_app.framewin.hwnd)              && reduce dBASE to an ICON
  345.    inkey(5)                                     && wait 5 seconds
  346.    ShowWindow(_app.framewin.hwnd,frameState)    && restore dBASE from an ICON
  347. endif
  348.  
  349. *******************************************************************************
  350. function WinDirectory
  351.  
  352. * Calls the Windows Funnction GetWindowsDirectory( ) which
  353. * is used to get the Directory that Windows is
  354. * installed in.
  355. *
  356. *******************************************************************************
  357. *extern CWORD GetWindowsDirectory(CSTRING,CWORD) krnl386.exe
  358. param dontShowBox
  359. local cWinDir
  360.  
  361. cWinDir = space(144)
  362. GetWindowsDirectory(cWinDir,144)
  363. if .not. dontShowBox
  364.    MessageBox(0,;
  365.               cWinDir,;
  366.               ansi("Windows Directory"),;
  367.               INFORMATION_MESSAGE + OK_BUTTON)
  368. endif
  369. return oem(cWinDir)
  370.  
  371. *******************************************************************************
  372. procedure WhoAmI
  373.  
  374. * Displays Windows and Dbase registration information.
  375. *******************************************************************************
  376. *extern  CWORD  GetPrivateProfileString ( CSTRING,CPTR,CPTR,CPTR,CWORD,CPTR ) KRNL386.EXE
  377. *extern  CWORD  MessageBox ( CWORD,CPTR,CPTR,CWORD) USER.EXE
  378.  
  379. local cUser,cComp,nUserLen,nOrgLen,cIniDir,cWinUsr,cWinComp,nWinUsr,nWinComp
  380.  
  381. cWinUsr = rtrim( oem(Resource( 514, "USER.EXE" )) )
  382. cWinComp = rtrim( oem(Resource( 515, "USER.EXE" )) )
  383. cUser   = space( 50 )
  384. cComp    = space( 50 )
  385. cIniDir = _dbwinhome + "BIN\DBASEWIN.INI"
  386. nUserLen   = GetPrivateProfileString( "Install","Username",'Unknown',cUser,50,;
  387.                                       cIniDir)
  388. nCompLen    = GetPrivateProfileString( "Install","Company",'Unknown', cComp,50,;
  389.                                       cIniDir)
  390. nWinUsr = len( cWinUsr )
  391. nWinComp = len( cWinComp )
  392.  
  393. cUser   = iif( nUserLen = 0, 'Unknown', left( oem(cUser), nUserLen ) )
  394. cComp   = iif( nCompLen = 0, 'Unknown', left( oem(cComp), nCompLen ) )
  395. cWinUsr = iif( nWinUsr = 0, 'Unknown', cWinUsr )
  396. cWinComp = iif( nWinComp = 0, 'Unknown', cWinComp )
  397.  
  398. MessageBox(NULL,;                                             && Display window
  399.            ansi(FormatStr("dBASE Registered to:\n"       + ;  && Message
  400.                           "   Customer Name: \t %1 \n"   + ;
  401.                           "   User Company:  \t %2 \n\n" + ;
  402.                           "Windows Registered to:\n"     + ;
  403.                           "   Customer Name: \t %3 \n"   + ;
  404.                           "   User Company:  \t %4",       ;
  405.                 cUser, cComp, cWinUsr, cWinComp)),         ;
  406.            ansi("dBASE for Windows User Information"),     ;  && Title
  407.            INFORMATION_MESSAGE + OK_BUTTON)                   && Window Style
  408.  
  409.  
  410. ENDCLASS
  411.  
  412.  
  413.