117 lines
2.9 KiB
OpenEdge ABL
117 lines
2.9 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
END
|
|
Attribute VB_Name = "CSPS_OLE"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
|
|
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
|
|
'==============================================================================
|
|
'
|
|
' File : SPS_OLE.cls
|
|
' Date : 06.04.1999
|
|
' Version: 1.00
|
|
'==============================================================================
|
|
' Author : Reinhard Henning, lindner&partner
|
|
' OLE Server zum Export von Funktionen für andere Programme
|
|
|
|
' Für einen OLE Server muß unter Projekt / Eigenschaften von... / Allgemein
|
|
' gesetzt werden:
|
|
|
|
' Projekttyp = ActiveX-EXE
|
|
'
|
|
' Projektname= pruef2000
|
|
' Klassenname=CSPS_OLE
|
|
' OLE Klasse= pruef2000.CSPS_OLE
|
|
'
|
|
' Thread-Pool , 1 Threads
|
|
' Projekt / Eigenschaften / Komponente / Startmodus = Eigenständig
|
|
' Project / Eigenschaften / Debuggen / "Warten bis Komponente erstellt ist" aktivieren
|
|
' Eigenschaften der Klasse: "5 Multiuse" ist OK
|
|
' ActiveX Steuerelement aktualisieren ?
|
|
' Komponente Startmodus = Eigenständig
|
|
|
|
Option Explicit
|
|
|
|
Public Sub Msg(vText As Variant)
|
|
End Sub
|
|
|
|
'Public Sub Show()
|
|
' Dim thandle As Long
|
|
' Dim s As String
|
|
' Dim myhWnd, iret As Long
|
|
'
|
|
' 'MsgBox (Screen.ActiveForm.Caption)
|
|
'
|
|
' On Error Resume Next
|
|
' Screen.ActiveForm.Show
|
|
' Screen.ActiveForm.SetFocus
|
|
' myhWnd = GetForegroundWindow()
|
|
' s = Space(256)
|
|
' iret = GetWindowText(myhWnd, s, 256)
|
|
' ' MsgBox (myhWnd & " " & s)
|
|
' thandle = FindWindow(vbEmpty, "Pruef")
|
|
' BringWindowToTop thandle
|
|
'
|
|
' ' frmShow.Show vbModal
|
|
' frmShow.Show
|
|
' Call SetOnTop(frmShow, AlwaysOnTop)
|
|
' Call SetOnTop(frmShow, Default)
|
|
' Unload frmShow
|
|
'End Sub
|
|
|
|
Public Sub Show()
|
|
' AppActivate "Pruef2000"
|
|
|
|
Dim thandle As Long
|
|
Dim s As String
|
|
Dim myhWnd, iret As Long
|
|
'
|
|
' 'MsgBox (Screen.ActiveForm.Caption)
|
|
'
|
|
On Error Resume Next
|
|
'
|
|
Screen.ActiveForm.Show
|
|
Screen.ActiveForm.SetFocus
|
|
myhWnd = GetForegroundWindow()
|
|
s = Space(256)
|
|
iret = GetWindowText(myhWnd, s, 256)
|
|
' MsgBox (myhWnd & " " & s)
|
|
thandle = FindWindow(vbEmpty, "Pruef")
|
|
BringWindowToTop thandle
|
|
'
|
|
frmShow.Show vbModal
|
|
End Sub
|
|
|
|
Public Function GetString() As String
|
|
Dim nullhwnd, myhWnd, iret As Long
|
|
Dim s As String
|
|
|
|
nullhwnd = GetActiveWindow()
|
|
myhWnd = GetForegroundWindow()
|
|
s = Space(256)
|
|
iret = GetWindowText(nullhwnd, s, 256)
|
|
Debug.Print nullhwnd, s; s = Space(256)
|
|
iret = GetWindowText(myhWnd, s, 256)
|
|
Debug.Print myhWnd, s
|
|
|
|
|
|
GetString = GetActiveWindow()
|
|
|
|
End Function
|
|
|
|
Private Sub Class_Initialize()
|
|
'MsgBox ("SPS_OLE initialised")
|
|
End Sub
|
|
|
|
Private Sub Class_Terminate()
|
|
'MsgBox ("SPS_OLE terminated")
|
|
End Sub
|