home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Programmer'…arterly (Limited Edition)
/
Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso
/
code
/
ch26code
/
public.bas
< prev
next >
Wrap
BASIC Source File
|
1995-08-01
|
5KB
|
112 lines
Attribute VB_Name = "basPublic"
'*********************************************************************
' PUBLIC.BAS - Global constants, functions, and variables.
'*********************************************************************
Option Explicit
'*********************************************************************
' API Declarations for this module.
'*********************************************************************
#If Win32 Then
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetStr _
As String, ByVal nSize As Long, ByVal lpFileName$) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function PostMessage Lib "user32" Alias _
"PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal _
wParam As Long, lParam As Any) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd&, _
ByVal nCmdShow As Long) As Long
#Else
Private Declare Function GetPrivateProfileString Lib "Kernel" _
(ByVal lpAppName$, ByVal lpKeyName$, ByVal lpDefault$, _
ByVal lpReturnStr$, ByVal nSize%, ByVal lpFileName$) As Integer
Private Declare Function FindWindow Lib "User" (ByVal lpClassName$, _
ByVal lpWindowName As Long) As Integer
Private Declare Function PostMessage Lib "User" (ByVal hWnd%, _
ByVal wMsg As Integer, ByVal wParam%, lParam&) As Long
Private Declare Function ShowWindow Lib "User" (ByVal hWnd As Integer, _
ByVal nCmdShow As Integer) As Integer
#End If
'*********************************************************************
' These globals keep track of the new instances of frmExcel.
'*********************************************************************
Public Const MAX_WINDOWS = 4
Public Excels(MAX_WINDOWS) As New frmExcel
Public ExcelWindows As Integer
Public ActiveIndex%
'*********************************************************************
' Generic update status bar routine.
'*********************************************************************
Public Sub UpdateStatus(StatusBar As Label, Optional StatusText)
If IsMissing(StatusText) Then
StatusBar = "Ready"
Else
StatusBar = StatusText
End If
End Sub
'*********************************************************************
' Start a OLE Server, if it is not already running.
'*********************************************************************
Public Function StartServer(ClassName$, Program$) As Long
Const SW_SHOWNA = 8
#If Win32 Then
Dim hWnd As Long
#Else
Dim hWnd As Integer
#End If
'*****************************************************************
' Prevent any error messages from interrupting the program.
'*****************************************************************
On Error Resume Next
'*****************************************************************
' Check to see if its already running. If so, then activate it.
'*****************************************************************
hWnd = FindWindow(ClassName, 0&)
If hWnd Then
ShowWindow hWnd, SW_SHOWNA
'*************************************************************
' Return False to indicate that it was already running.
'*************************************************************
StartServer = False
Else
'*************************************************************
' Otherwise, start it and return its hWnd.
'*************************************************************
Shell Program, vbMinimizedNoFocus
DoEvents
StartServer = FindWindow(ClassName, 0&)
End If
End Function
'*********************************************************************
' Calls the API to read an INI file, and return the results.
'*********************************************************************
' NOTE: ByVal is used, so you can pass control values such
' as Text1.Text without surrounding it in parenthesis.
'*********************************************************************
Public Function GetINI(ByVal Section$, ByVal Key$, ByVal _
Default$, ByVal FileName$) As String
Dim res%, retVal$
retVal = Space$(32400)
res = GetPrivateProfileString(Section, Key, Default, _
retVal, Len(retVal), FileName)
GetINI = Left$(retVal, res)
End Function
'*********************************************************************
' Posts a WM_CLOSE message to an application.
'*********************************************************************
Public Sub CloseApp(hWnd As Long)
Const WM_CLOSE = &H10
#If Win32 Then
PostMessage hWnd, WM_CLOSE, 0, 0&
#Else
PostMessage CInt(hWnd), WM_CLOSE, 0, 0&
#End If
End Sub