home *** CD-ROM | disk | FTP | other *** search
- *****************************************************************************
- * PROGRAM: WinApi.wfm
- *
- * WRITTEN BY: Borland Samples Group
- *
- * DATE: 6/28/93
- *
- * UPDATED: 6/94
- *
- * REVISION $Revision: 1.45 $
- *
- * VERSION: dBASE FOR WINDOWS 5.0
- *
- * DESCRIPTION: This program shows how to access useful Windows API functions
- * using the dBASE for Windows API interface.
- * A form is displayed with pushbuttons containing different
- * information that can be accessed with the Windows API through
- * dBASE for Windows. Pressing a pushbutton executes the selected
- * function (or series of functions). The Close pushbutton
- * closes the window.
- *
- * PARAMETERS: None
- *
- * CALLS: Buttons.cc (Custom controls file)
- * SysInfo.wfm (Form for displaying system information)
- *
- * GetWinFlags() (Windows API functions)
- * GetModuleUsage()
- * GetModuleHandle()
- * GetVersion()
- * ShowWindow()
- * GetFreeSpace()
- * SystemParametersInfo()
- * MessageBox()
- * GetWindowText()
- * CloseWindow()
- * OpenIcon()
- * GetWindowsDirectory()
- * GetPrivateProfileString()
- *
- * USAGE: DO Winapi.wfm
- *
- *
- *
- *******************************************************************************
- #include "Messdlg.h"
- #include "Winapi.h"
-
- #define ENTER chr(13)
- #define TAB chr(9)
- create session
- set talk off
- set ldCheck off
-
- ** END HEADER -- do not remove this line*
- * Generated on 05/11/94
- *
- LOCAL f
- f = NEW WINAPIFORM()
- f.Open()
-
- CLASS WINAPIFORM OF FORM
- Set Procedure to Buttons.cc Additive
- this.OnOpen = CLASS::ONOPEN
- this.OnClose = CLASS::ONCLOSE
- this.MousePointer = 1
- this.Text = "Windows API Call Demo"
- this.Width = 44.05
- this.Top = 0.93
- this.Left = 33.66
- this.Height = 14.85
- this.Minimize = .F.
- this.Maximize = .F.
- this.HelpFile = ""
- this.HelpId = ""
-
- DEFINE RECTANGLE RECTANGLE1 OF THIS;
- PROPERTY;
- ColorNormal "N/W",;
- Text "",;
- Height 13.79,;
- Width 25.74,;
- Top 0.54,;
- Left 1.32,;
- Border .T.
-
- DEFINE PUSHBUTTON SYSINFOBUTTON OF THIS;
- PROPERTY;
- OnClick CLASS::SYSINFO,;
- ColorNormal "N/W",;
- StatusMessage "Show information about the system.",;
- Text "System Information",;
- Width 23.75,;
- Top 1.06,;
- Left 1.98,;
- Height 1.60,;
- FontSize 6.00,;
- Default .T.
-
- DEFINE PUSHBUTTON OKCANBOXBUTTON OF THIS;
- PROPERTY;
- OnClick CLASS::OKCANBOX,;
- ColorNormal "N/W",;
- StatusMessage "Show a message dialog.",;
- Text " Message Box ",;
- Width 23.75,;
- Top 2.92,;
- Left 1.98,;
- Height 1.60,;
- Group .F.
-
- DEFINE PUSHBUTTON WINWALLPAPERBUTTON OF THIS;
- PROPERTY;
- OnClick CLASS::WINWALLPAPER,;
- ColorNormal "N/W",;
- StatusMessage "Show how the wallpaper can be changed from dBASEWIN.",;
- Text " Wallpaper ",;
- Width 23.75,;
- Top 4.78,;
- Left 1.98,;
- Height 1.60,;
- Group .F.
-
- DEFINE PUSHBUTTON WINDOWCAPTIONSBUTTON OF THIS;
- PROPERTY;
- OnClick CLASS::WINDOWCAPTIONS,;
- ColorNormal "N/W",;
- StatusMessage "Show the caption of the dBASEWIN frame retrieved from the Api and dBASEWIN.",;
- Text " Window Captions ",;
- Width 23.75,;
- Top 6.63,;
- Left 1.98,;
- Height 1.60,;
- Group .F.
-
- DEFINE PUSHBUTTON WINDIRECTORYBUTTON OF THIS;
- PROPERTY;
- OnClick CLASS::WINDIRECTORY,;
- ColorNormal "N/W",;
- StatusMessage "Show the Windows home directory.",;
- Text "Windows Directory ",;
- Width 23.75,;
- Top 8.48,;
- Left 1.98,;
- Height 1.60,;
- Group .F.
-
- DEFINE PUSHBUTTON DBWINICONBUTTON OF THIS;
- PROPERTY;
- OnClick CLASS::ICON,;
- ColorNormal "N/W",;
- StatusMessage "Make dBASE for Windows minimized for a short time.",;
- Text "Icon",;
- Width 23.75,;
- Top 10.34,;
- Left 1.98,;
- Height 1.60,;
- Group .F.
-
- DEFINE PUSHBUTTON WHOAMIBUTTON OF THIS;
- PROPERTY;
- OnClick CLASS::WHOAMI,;
- ColorNormal "N/W",;
- StatusMessage "Display information about the user.",;
- Text "Who Am I?",;
- Width 23.75,;
- Top 12.20,;
- Left 1.98,;
- Height 1.60,;
- Group .F.
-
- DEFINE CLOSEBUTTON CLOSEWINAPIBUTTON OF THIS;
- PROPERTY;
- StatusMessage "Leave Winapi.",;
- Width 14.11,;
- Top 1.06,;
- Left 28.38,;
- Height 1.50
-
- procedure OnOpen
- *******************************************************************************
- set procedure to Sampproc additive
-
- *******************************************************************************
- procedure OnClose
- *******************************************************************************
- close procedure Buttons.cc, Sampproc.prg
-
- *******************************************************************************
- procedure Sysinfo
- *******************************************************************************
- local info
- _app.framewin.visible = .f.
- set procedure to Sysinfo.wfm additive && if frame invisible at that time
- info = new SysInfoForm()
- info.Readmodal()
- form.visible = .t.
- _app.framewin.visible = .t.
-
- *******************************************************************************
- function OkCanBox
-
- * OkCanBox(<cMess>,<cTitle>).
- * <cMess> = Message to display in Box.
- * <cTitle> = Title of Message Box.
- *
- * Creates a MessageBox on the SCREEN with
- * a title and message text. The user must
- * press or click OK or CANCEL or press ESCAPE
- * key. This is a System Modal MessageBox.
- * Calls the User.exe function MessageBox()
- * -- the Borland version of the Windows function MessageBox().
- * choice = okcanbox("Read my lips","Message Box")
- * 2 if Escape pressed, 1 if OK button pressed,
- * 2 if CANCEL pressed. Or 0 if not enough memory.
- *
- *******************************************************************************
- * Returns 0 if not enough memory to create MessageBox.
- * Returns 1=OK,2=CANCEL,3=ABORT,4=RETRY,5=IGNORE,6=YES,7=NO,8=ONE
- * wType any combo of below
- * MODE DEFAULT BUTTON
- *0x3000h=12288D Mode Mask 0x0F00h=3840 Dec Def.Button
- *0x0000h=00000D App Modal 0x0000h=0000 Dec Button 1
- *0x1000h=04096D Sys Modal 0x0100h=0256 Dec Button 2
- *0x2000h=08192D Task Modal 0x0200h=0512 Dec Button 3
- * 0x0300h=0768 Dec Button 4
- * 0x0400h=1024 Dec Button 5
- * 0x0500h=1280 Dec Button 6
- * 0x0600h=1536 Dec Button 7
- * 0x0700h=1792 Dec Button 8
- * ICON BUTTON
- *0x00F0h=0240D Icon Mask 0x000Fh=0015Dec Type Mask
- *0x0010h=0016D Hand 0x0000h=0000Dec OK Button
- *0x0010h=0016D Stop * 0.00x0001h=0001Dec OK CANCEL
- *0x0020h=0032D Question 0x0002h=0002Dec ABORT RETRY IGNORE
- *0x0030h=0048D Exclaimation 0003h=0003Dec YES NO CANCEL
- *0x0040h=0064D Astrisk 0x0004h=0004Dec YES NO
- *0x0040h=0064D Information x0005h=0005Dec RETRY CANCEL
- * 0x0008h=0008Dec ABORT RETRY
- * 0x0009h=0009Dec OK CANCEL ABORT
- * RETRY IGNORE
- * 0x000Ah=0010Dec NO CANCEL RETRY
- * CANCEL GARBAGE
- * 0x000Bh=0011Dec OK CANCEL ABORT
- * RETRY IGNORE YES
- * NO CANCEL
- *******************************************************************************
- param cMess,cTitle
- private cMess1,cTitle1,value
-
- cMess1 = iif(empty(cMess),;
- FormatStr("Put Message Here! \n" +;
- "Syntax is: \n" +;
- "? OkCanBox('Message','Title') \n\n" +;
- "Returns: \n" +;
- "1 if OK button clicked or pressed \n" +;
- "2 if Cancel button or Escape key pressed \n" +;
- "0 if not enough memory to run"),;
- cMess)
-
- cTitle1 = iif(empty(cTitle),"OkCanBox( ) Message Function",cTitle)
- value = MessageBox(NULL,;
- ansi(cMess1),;
- ansi(cTitle1),;
- INFORMATION_MESSAGE + OK_CANCEL_BUTTONS)
- ?value
- return value
-
-
-
- *******************************************************************************
- procedure WinWallpaper
-
- * Calls the Windows WallPaper changer program.
- * First it reduces dBASE to an ICON then it
- * changes into the Windows directory and displays a
- * GETFILE() box of the *.BMP files in the Windows
- * directory then it changes the desktop wallpaper to
- * the file you choose.Next it asks if you want to keep
- * the Wallpaper or set it to (None) Then it returns to
- * the directory you started from and restores dBASE
- * from the ICON.
- *******************************************************************************
-
- *extern CLOGICAL SystemParametersInfo ( CINT,CINT,CPTR,CINT ) USER.EXE
- *extern CVOID CloseWindow( CHANDLE ) USER.EXE
- private wallpaper,newWall,orgDir,winPath,changeWallStr
-
- _app.framewin.visible = .f.
- orgDir = set("directory")
- winPath = CLASS::winDirectory(.t.)
- cd &winPath
- wallpaper = getfile("*.BMP","Select New Wallpaper")
- cd &orgDir
-
- changeWallStr = FormatStr("Press OK to change the Wallpaper \n;
- or press Cancel to keep your original wallpaper")
-
- if .not. empty(wallpaper) .and. CLASS::OkCanBox(changeWallStr) = OK
- SystemParametersInfo(20,0,ansi(wallpaper),1)
- endif
- _app.framewin.visible = .t.
-
-
-
- *******************************************************************************
- procedure WindowCaptions
-
- * Calls the Windows function GetFormText to get title of the
- * dBASE for Windows frame window
- *
- *******************************************************************************
- *extern CINT GetWindowText ( CHANDLE,CSTRING,CINT ) USER.EXE
- local winTitle,lenTitle,apiStr,objectStr
-
- winTitle = space(80) && first make empty string to be filled
- lenTitle = GetWindowText(_app.framewin.hwnd,winTitle,80)
- apiStr = FormatStr("From API call: \t %1",oem(winTitle))
- objectStr = FormatStr("From Object Model: %1",(_app.framewin.text))
- MessageBox(NULL,;
- ansi(apiStr + ENTER + objectStr),;
- ansi("Title of dBASEWIN"),;
- INFORMATION_MESSAGE + OK_BUTTON)
-
-
-
- *******************************************************************************
- procedure Icon
-
- * This example just minimizes dBASEWIN.EXE to a
- * ICON (by way of the CloseWindow funtion) waits 5
- * seconds then restores dBASEWIN.EXE from its ICON.
- *
- *******************************************************************************
- *extern CWORD CloseWindow(CWORD) user.exe
- *extern CWORD OpenIcon(CWORD) user.exe
- local frameState
-
- if messageBox(NULL,;
- ansi("This will minimize dBASEWIN for 5 seconds. Proceed?"),;
- ansi("Confirmation"),;
- CONFIRMATION_MESSAGE + YES_NO_BUTTONS) = YES
- frameState = _app.framewin.windowState + 1 && save previous frame state
- CloseWindow(_app.framewin.hwnd) && reduce dBASE to an ICON
- inkey(5) && wait 5 seconds
- ShowWindow(_app.framewin.hwnd,frameState) && restore dBASE from an ICON
- endif
-
- *******************************************************************************
- function WinDirectory
-
- * Calls the Windows Funnction GetWindowsDirectory( ) which
- * is used to get the Directory that Windows is
- * installed in.
- *
- *******************************************************************************
- *extern CWORD GetWindowsDirectory(CSTRING,CWORD) krnl386.exe
- param dontShowBox
- local cWinDir
-
- cWinDir = space(144)
- GetWindowsDirectory(cWinDir,144)
- if .not. dontShowBox
- MessageBox(0,;
- cWinDir,;
- ansi("Windows Directory"),;
- INFORMATION_MESSAGE + OK_BUTTON)
- endif
- return oem(cWinDir)
-
- *******************************************************************************
- procedure WhoAmI
-
- * Displays Windows and Dbase registration information.
- *******************************************************************************
- *extern CWORD GetPrivateProfileString ( CSTRING,CPTR,CPTR,CPTR,CWORD,CPTR ) KRNL386.EXE
- *extern CWORD MessageBox ( CWORD,CPTR,CPTR,CWORD) USER.EXE
-
- local cUser,cComp,nUserLen,nOrgLen,cIniDir,cWinUsr,cWinComp,nWinUsr,nWinComp
-
- cWinUsr = rtrim( oem(Resource( 514, "USER.EXE" )) )
- cWinComp = rtrim( oem(Resource( 515, "USER.EXE" )) )
- cUser = space( 50 )
- cComp = space( 50 )
- cIniDir = _dbwinhome + "BIN\DBASEWIN.INI"
- nUserLen = GetPrivateProfileString( "Install","Username",'Unknown',cUser,50,;
- cIniDir)
- nCompLen = GetPrivateProfileString( "Install","Company",'Unknown', cComp,50,;
- cIniDir)
- nWinUsr = len( cWinUsr )
- nWinComp = len( cWinComp )
-
- cUser = iif( nUserLen = 0, 'Unknown', left( oem(cUser), nUserLen ) )
- cComp = iif( nCompLen = 0, 'Unknown', left( oem(cComp), nCompLen ) )
- cWinUsr = iif( nWinUsr = 0, 'Unknown', cWinUsr )
- cWinComp = iif( nWinComp = 0, 'Unknown', cWinComp )
-
- MessageBox(NULL,; && Display window
- ansi(FormatStr("dBASE Registered to:\n" + ; && Message
- " Customer Name: \t %1 \n" + ;
- " User Company: \t %2 \n\n" + ;
- "Windows Registered to:\n" + ;
- " Customer Name: \t %3 \n" + ;
- " User Company: \t %4", ;
- cUser, cComp, cWinUsr, cWinComp)), ;
- ansi("dBASE for Windows User Information"), ; && Title
- INFORMATION_MESSAGE + OK_BUTTON) && Window Style
-
-
- ENDCLASS
-
-
-