'-----------------------------------------------------------
' This macro was created by Andrew Becherer
' Using the example code included with Extra! Enterprise2000
' Date: Monday, January 30, 2006
'-----------------------------------------------------------
' Global variable declarations
Global g_HostSettleTime%
Global g_szPassword$
Global screenbuf$
Global screenNumber%
Declare Sub PrintScr()
Declare Sub ScrapeScr()
[b]Sub Main()[/b]
'-----------------------------------------------------------
' Get the main system object
Dim Sessions As Object
Dim System As Object
Set System = CreateObject("EXTRA.System")
' Gets the system object
If (System is Nothing) Then
Msgbox "Could not create the EXTRA System object. Stopping macro playback."
STOP
End If
Set Sessions = System.Sessions
If (Sessions is Nothing) Then
Msgbox "Could not create the Sessions collection object. Stopping macro playback."
STOP
End If
'-----------------------------------------------------------
' Set the default wait timeout value
g_HostSettleTime = 3000 ' milliseconds
OldSystemTimeout& = System.TimeoutValue
If (g_HostSettleTime > OldSystemTimeout) Then
System.TimeoutValue = g_HostSettleTime
End If
' Get the necessary Session Object
Dim Sess0 As Object
Set Sess0 = System.ActiveSession
If (Sess0 is Nothing) Then
Msgbox "Could not create the Session object. Stopping macro playback."
STOP
End If
If Not Sess0.Visible Then Sess0.Visible = TRUE
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
' Initialize Screen Buffer
screenbuf$ = ""
' Initialize screenNumber%
screenNumber% = 0
' Get the Screen 1 Screen
Sess0.Screen.MoveTo 1, 16
Sess0.Screen.Sendkeys("ScreenCode1<Enter>")
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
ScrapeScr
' Get the Screen 2 Screen
Sess0.Screen.MoveTo 1, 16
Sess0.Screen.Sendkeys("ScreenCode2<Enter>")
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
ScrapeScr
' Get the Screen 3 Screen
Sess0.Screen.MoveTo 1, 16
Sess0.Screen.Sendkeys("ScreenCode3<Enter>")
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
ScrapeScr
' Get the Screen 4 Screen
Sess0.Screen.MoveTo 1, 16
Sess0.Screen.Sendkeys("ScreenCode4<Enter>")
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
ScrapeScr
' Get the Screen 4 Screen
Sess0.Screen.Sendkeys("ScreenCode4<Enter>")
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
Sess0.Screen.Sendkeys("<Enter>")
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
ScrapeScr
' Get the Screen 4 Screen
Sess0.Screen.Sendkeys("ScreenCode4<Enter>")
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
Sess0.Screen.MoveTo 9, 42
Sess0.Screen.Sendkeys("ScreenOptionCode<Enter>")
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
ScrapeScr
' Print the Screens
PrintScr
System.TimeoutValue = OldSystemTimeout
[b]End Sub
Sub ScrapeScr[/b]
' Dimension macro variables and objects
Dim rc%, row%, MaxColumns%, MaxRows%, filenum%
Dim linebuf$, FileName$
Dim System As Object
Dim Session as Object
' Get the main system object
Set System = CreateObject("EXTRA.System")
If (System is Nothing) Then
Msgbox "Could not create the EXTRA System object. Aborting macro playback."
Stop
End If
' Get the necessary Session Object
Set Session = System.ActiveSession
If (Session is Nothing) Then
Msgbox "Could not create the Session object. Aborting macro playback."
Stop
End If
' Determine the size of the Presentation Space
MaxRows% = Session.Screen.Rows()
MaxColumns% = Session.Screen.Cols()
' Initialize variables to hold screen information
linebuf$ = Space$ (MaxColumns%)
' Add a line identifying this as a pricing request
linebuf$ = "Example Report Name"
screenbuf$ = screenbuf$ + linebuf$ + Chr$ (13) + Chr$ (10)
linebuf$ = ""
screenbuf$ = screenbuf$ + linebuf$ + Chr$ (13) + Chr$ (10)
' Copy the Presentation space
For row% = 1 to MaxRows%
' Get a row of data from the host screen
linebuf$ = Session.Screen.Area(row%, 1, row%, MaxColumns%, , xBlock)
' Store the line read into screenbuf$
screenbuf$ = screenbuf$ + linebuf$ + Chr$ (13) + Chr$ (10)
Next
' Add a blank line after the screen for readability
linebuf$ = ""
screenbuf$ = screenbuf$ + linebuf$ + Chr$ (13) + Chr$ (10)
' Increment the screen number
screenNumber% = screenNumber% + 1
' This conditional code is specific to my screens and printer
' It is used to ensure good page wrapping
If screenNumber% = 2 Then
linebuf$ = ""
For row% = 1 to 6
screenbuf$ = screenbuf$ + linebuf$ + Chr$ (13) + Chr$ (10)
Next
ElseIf screenNumber% = 4 Then
linebuf$ = ""
For row% = 1 to 6
screenbuf$ = screenbuf$ + linebuf$ + Chr$ (13) + Chr$ (10)
Next
End If
[b]End Sub
Sub PrintScr[/b]
' Get the next available file number
filenum% = FreeFile
' Open the printer. To print to a file, set FileName$ to a file name.
' In this example, "\\TES\L4S_HP" is a network printer name.
' Change this to your printer name.
FileName$ = "\\gc05\Queue3"
Open FileName$ For Output as filenum%
' Print the screen with a form feed
Print # filenum%, screenbuf$; Chr$ (12)
'Close printer
Close filenum%
[b]End Sub[/b]