efgee
12-09-2010, 04:14
Hi,
the following code shows how an oop framework could be implemented.
In any case there is a oxygen bug that reveals himself - as 2 lines in the "FrameworkTest.o2inc" need to be commented out in order to make the compiled exe not crash but run smoothly...
This is the framework dll:
' Framework.o2bas
'
' OOP Application Framework
' efgee
#file "oFramework.dll"
; =======
; imports
; =======
dim as long kernel32 = LoadLibrary ("kernel32.dll")
bind kernel32 (
GetCommandLine_ GetCommandLineA : @0
GetModuleHandle_ GetModuleHandleA : @4
ExitProcess_ ExitProcess : @4
)
dim as long user32 = LoadLibrary "user32.dll"
bind user32 (
MessageBox_ MessageBoxA : @16
DestroyWindow_ DestroyWindow : @4
GetMessage_ GetMessageA : @16
TranslateMessage_ TranslateMessage : @4
DispatchMessage_ DispatchMessageA : @4
PostMessage_ PostMessageA : @16
PostQuitMessage_ PostQuitMessage : @4
DefWindowProc_ DefWindowProcA : @16
LoadIcon_ LoadIconA : @8
LoadCursor_ LoadCursorA : @8
RegisterClass_ RegisterClassA : @4
CreateWindowEx_ CreateWindowExA : @48
ShowWindow_ ShowWindow : @8
UpdateWindow_ UpdateWindow : @4
' BeginPaint_ BeginPaint : @8
' EndPaint EndPaint : @8
' GetClientRect GetClientRect : @8
' DrawText DrawTextA : @20
' SetParent SetParent : @8
' SetClassLong SetClassLong : @12
)
dim as long GDI32 = LoadLibrary ("GDI32.dll")
bind GDI32 (
GetStockObject_ GetStockObject : @4
)
; ==========
; structures
; ==========
type WNDCLASS
;40 bytes
STYLE as long
lpfnwndproc as long
cbClsextra as long
cbWndExtra as long
hInstance as long
hIcon as long
hCursor as long
hbrBackground as long
lpszMenuName as long
lpszClassName as long
end type
; c style definition is possible too...
struct point {
x as long
y as long
}
type MSG
; 28 bytes
hwnd as long
message as long
wParam as long
lParam as long
time as long
pt as point
end type
; ========
; declares
; ========
declare function WndProc (byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long
; =========
; constants
; =========
def true 1
def false 0
def fail -1
def CS_VREDRAW 1
def CS_HREDRAW 2
def IDI_APPLICATION 32512
def IDC_ARROW 32512
def WHITE_BRUSH 0
def MB_ICONERROR 16
def CW_USEDEFAULT 0x80000000
def WS_OVERLAPPEDWINDOW 0x00cf0000
def SW_NORMAL 1
def SW_SHOWDEFAULT 10
def WM_CREATE 1
def WM_DESTROY 2
def WM_PAINT 15
def WM_CLOSE 16
def WM_KEYDOWN 256
def WS_VISIBLE 0x10000000
def WS_CHILD 0x40000000
def BS_TEXT 0
def MB_OK 0
def MB_ICONERROR 0x00000010
def MB_ICONQUESTION 0x00000020
def MB_ICONWARNING 0x00000030
def MB_ICONINFORMATION 0x00000040
; =========
; variables
; =========
; public static _MainWindow as LONG
extern
' ============================================================================
'
' oAPP - is the application class
' -
' - Run - message loop, returns error code if occured...
' - Quit - kills main window, initiates message loop to end
' - CommandLine - returns the command line (at start of program)
' - InfoBox - info message box
' - ErrorBox - error message box
' - QuestionBox - question message box
' - WarningBox - warning message box
'
' ============================================================================
class oAPP alias "oAPP" export
private static _Instance as LONG
private static _Return as LONG
private static _Message as MSG
private static _Command as string
private static _LastWindow as LONG
private static _LastChild as long
private static _ExitCode as long
method ctor()
method dtor()
method Instance() as long
method Run()
method Quit()
method CommandLine() as string
method InfoBox(_Text as string)
method ErrorBox(_Text as string)
method QuestionBox(_Text as string)
method WarningBox(_Text as string)
/
end class
methods of oAPP
' ===========
' CONSTRUCTOR
' ===========
method ctor()
print "APP ctor"
this._Instance = GetModuleHandle_(0)
zstring ptr _cmd
&_cmd = GetCommandLine_()
this._Command = _cmd
end method
' ==========
' DESTRUCTOR
' ==========
method dtor()
' do something
print "APP dtor"
freelibrary (kernel32)
freelibrary (user32)
'freelibrary (gdi32)
'PostQuitMessage_( 0 )
ExitProcess_(this._ExitCode)
end method
' ========
' INSTANCE
' ========
method Instance() as long
method = this._Instance
end method
' ===
' RUN
' ===
method run()
;MESSAGE LOOP
;
do while this._Return := GetMessage_(&this._message, 0, 0, 0)
if this._Return == -1 then
'do something significant
'like closing open files etc.
else
TranslateMessage_(&this._message)
DispatchMessage_(&this._message)
end if
wend
;
this._ExitCode = this._message.wparam
end method
' ====
' Quit
' ====
method Quit()
; DestroyWindow_(this._MainWindow)
PostQuitMessage_( 0 )
end method
' ===========
' COMMANDLINE
' ===========
method CommandLine() as string
method = this._Command
end method
' =======
' INFOBOX
' =======
method InfoBox(_Text as string)
long style
style = MB_ICONINFORMATION | MB_OK
MessageBox_(_LastWindow, *_Text, "Info", style)
end method
' ========
' ErrorBOX
' ========
method ErrorBox(_Text as string)
long style
style = MB_ICONERROR | MB_OK
MessageBox_(_LastWindow, *_Text, "Error", style)
end method
' ===========
' QuestionBOX
' ===========
method QuestionBox(_Text as string)
long style
style = MB_ICONQUESTION | MB_OK
MessageBox_(_LastWindow, *_Text, "Question", style)
end method
' ==========
' WarningBOX
' ==========
method WarningBox(_Text as string)
long style
style = MB_ICONWARNING | MB_OK
MessageBox_(_LastWindow, *_Text, "Warning", style)
end method
end methods
'end extern
'extern
' ====
' FORM - proper description still missing...
' ====
class oFORM alias "oFORM" export
protected static _Instance as LONG
protected static _MainWindow as LONG
protected static _LastWindow as LONG
protected static _LastChild as LONG
hwnd as long
wc as WndClass
method ctor ()
print "FORM ctor"
this._Instance = GetModuleHandle_(0)
with this.wc
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = &WndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = this._Instance
.hIcon = LoadIcon_(0, IDI_APPLICATION)
.hCursor = LoadCursor_(0, IDC_ARROW)
.hbrBackground = GetStockObject_(WHITE_BRUSH)
.lpszMenuName = 0
.lpszClassName = "HelloWin"
end with
if not RegisterClass_(&this.wc)
MessageBox_(0, "Registration failed", "Problem", MB_ICONERROR)
exit method
end if
this.hWnd = CreateWindowEx_(0,
wc.lpszClassName,
"Hello OOP Window",
WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT,
CW_USEDEFAULT,
CW_USEDEFAULT,
CW_USEDEFAULT,
0,
0,
this._Instance,
0)
if not this.hWnd then
MessageBox_(0, "Unable to create window", "problem", MB_ICONERROR)
exit method
end if
if not this._MainWindow
this._MainWindow = this.hWnd
end if
_LastWindow = this.hWnd
'this._LastWindow = this.hWnd
'print this._LastWindow
end method
method dtor()
print "FORM dtor"
;freelibrary (kernel32)
;freelibrary (user32)
'freelibrary (gdi32)
end method
public
method show()
ShowWindow_(this.hWnd, true)
UpdateWindow_(this.hWnd)
end method
end class
end extern
;-----------------------------------------
function WndProc (byval hWnd as long,
byval wMsg as long,
byval wParam as long,
byval lparam as long)
as long callback
;=========================================
function = 0
select wMsg
'--------------
case WM_CREATE
'=============
'--------------
case WM_DESTROY
'===============
PostQuitMessage_( 0 )
'--------
case else
'========
function = DefWindowProc_(hWnd, wMsg, wParam, lParam)
end select
end function ;WndProc
This is the test program:
' FrameworkTest.o2bas
'
' Test of OOP Application Framework
' efgee
#file "oFrameworkTest.exe"
#include "oFrameworkTest.o2inc"
; =====
; ENTRY
; =====
new oAPP app
new oFORM frm
app.infobox("Hi")
app.errorbox("Huh...")
app.warningbox("Wait")
app.questionbox("What")
frm.Show
app.run()
delete frm
delete app
; =========
; end entry
; =========
This is the include file for the test program (has 2 line commented out because of oxygen bug):
' FrameworkTest.o2inc
'
' Test of OOP Application Framework - Include File
' efgee
; ======
; macros
; ======
def new
dim as %1 byref %2
&%2 = news sizeof %1
%2.ctor()
end def
def delete
%1.dtor()
frees &%1
end def
extern lib "oFramework.dll"
class oAPP alias "oAPP"
protected static _Instance as LONG
protected static _Return as LONG
protected static _Message as MSG
protected static _Command as string
protected static _LastWindow as LONG
'protected static _LastChild as long ' this line needs to be commented out
'protected static _ExitCode as long ' this line needs to be commented out
method ctor()
method dtor()
method Instance() as long
method Run()
method Quit()
method CommandLine() as string
method InfoBox(_Text as string)
method ErrorBox(_Text as string)
method QuestionBox(_Text as string)
method WarningBox(_Text as string)
/
end class
class oFORM alias "oFORM"
protected static _Instance as LONG
protected static _MainWindow as LONG
protected static _LastWindow as LONG
protected static _LastChild as LONG
method ctor()
method dtor()
method show()
/
end class
end extern
; =========
; variables
; =========
----
Also it would be nice if the dll and the test program could share the class definition (when methods/end methods in the dll code is used) as they are the same except the first 2 lines (with big classes it would ease coding):
DLL code:
extern
class oAPP alias "oAPP" export
...
INC code:
extern lib "oFramework.dll"
class oAPP alias "oAPP"
...
If the syntax could be changed to:
DLL code:
extern lib export
#include "oFrameworkTest.o2inc"
end extern
methods of oAPP
...
end methods
INC code:
extern lib "oFramework.dll"
#include "oFrameworkTest.o2inc"
end extern
...and in the "oFrameworkTest.o2inc" file there would be the class definition:
class oAPP alias "oAPP"
...
end class
Or similar...
bye
efgee
the following code shows how an oop framework could be implemented.
In any case there is a oxygen bug that reveals himself - as 2 lines in the "FrameworkTest.o2inc" need to be commented out in order to make the compiled exe not crash but run smoothly...
This is the framework dll:
' Framework.o2bas
'
' OOP Application Framework
' efgee
#file "oFramework.dll"
; =======
; imports
; =======
dim as long kernel32 = LoadLibrary ("kernel32.dll")
bind kernel32 (
GetCommandLine_ GetCommandLineA : @0
GetModuleHandle_ GetModuleHandleA : @4
ExitProcess_ ExitProcess : @4
)
dim as long user32 = LoadLibrary "user32.dll"
bind user32 (
MessageBox_ MessageBoxA : @16
DestroyWindow_ DestroyWindow : @4
GetMessage_ GetMessageA : @16
TranslateMessage_ TranslateMessage : @4
DispatchMessage_ DispatchMessageA : @4
PostMessage_ PostMessageA : @16
PostQuitMessage_ PostQuitMessage : @4
DefWindowProc_ DefWindowProcA : @16
LoadIcon_ LoadIconA : @8
LoadCursor_ LoadCursorA : @8
RegisterClass_ RegisterClassA : @4
CreateWindowEx_ CreateWindowExA : @48
ShowWindow_ ShowWindow : @8
UpdateWindow_ UpdateWindow : @4
' BeginPaint_ BeginPaint : @8
' EndPaint EndPaint : @8
' GetClientRect GetClientRect : @8
' DrawText DrawTextA : @20
' SetParent SetParent : @8
' SetClassLong SetClassLong : @12
)
dim as long GDI32 = LoadLibrary ("GDI32.dll")
bind GDI32 (
GetStockObject_ GetStockObject : @4
)
; ==========
; structures
; ==========
type WNDCLASS
;40 bytes
STYLE as long
lpfnwndproc as long
cbClsextra as long
cbWndExtra as long
hInstance as long
hIcon as long
hCursor as long
hbrBackground as long
lpszMenuName as long
lpszClassName as long
end type
; c style definition is possible too...
struct point {
x as long
y as long
}
type MSG
; 28 bytes
hwnd as long
message as long
wParam as long
lParam as long
time as long
pt as point
end type
; ========
; declares
; ========
declare function WndProc (byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long
; =========
; constants
; =========
def true 1
def false 0
def fail -1
def CS_VREDRAW 1
def CS_HREDRAW 2
def IDI_APPLICATION 32512
def IDC_ARROW 32512
def WHITE_BRUSH 0
def MB_ICONERROR 16
def CW_USEDEFAULT 0x80000000
def WS_OVERLAPPEDWINDOW 0x00cf0000
def SW_NORMAL 1
def SW_SHOWDEFAULT 10
def WM_CREATE 1
def WM_DESTROY 2
def WM_PAINT 15
def WM_CLOSE 16
def WM_KEYDOWN 256
def WS_VISIBLE 0x10000000
def WS_CHILD 0x40000000
def BS_TEXT 0
def MB_OK 0
def MB_ICONERROR 0x00000010
def MB_ICONQUESTION 0x00000020
def MB_ICONWARNING 0x00000030
def MB_ICONINFORMATION 0x00000040
; =========
; variables
; =========
; public static _MainWindow as LONG
extern
' ============================================================================
'
' oAPP - is the application class
' -
' - Run - message loop, returns error code if occured...
' - Quit - kills main window, initiates message loop to end
' - CommandLine - returns the command line (at start of program)
' - InfoBox - info message box
' - ErrorBox - error message box
' - QuestionBox - question message box
' - WarningBox - warning message box
'
' ============================================================================
class oAPP alias "oAPP" export
private static _Instance as LONG
private static _Return as LONG
private static _Message as MSG
private static _Command as string
private static _LastWindow as LONG
private static _LastChild as long
private static _ExitCode as long
method ctor()
method dtor()
method Instance() as long
method Run()
method Quit()
method CommandLine() as string
method InfoBox(_Text as string)
method ErrorBox(_Text as string)
method QuestionBox(_Text as string)
method WarningBox(_Text as string)
/
end class
methods of oAPP
' ===========
' CONSTRUCTOR
' ===========
method ctor()
print "APP ctor"
this._Instance = GetModuleHandle_(0)
zstring ptr _cmd
&_cmd = GetCommandLine_()
this._Command = _cmd
end method
' ==========
' DESTRUCTOR
' ==========
method dtor()
' do something
print "APP dtor"
freelibrary (kernel32)
freelibrary (user32)
'freelibrary (gdi32)
'PostQuitMessage_( 0 )
ExitProcess_(this._ExitCode)
end method
' ========
' INSTANCE
' ========
method Instance() as long
method = this._Instance
end method
' ===
' RUN
' ===
method run()
;MESSAGE LOOP
;
do while this._Return := GetMessage_(&this._message, 0, 0, 0)
if this._Return == -1 then
'do something significant
'like closing open files etc.
else
TranslateMessage_(&this._message)
DispatchMessage_(&this._message)
end if
wend
;
this._ExitCode = this._message.wparam
end method
' ====
' Quit
' ====
method Quit()
; DestroyWindow_(this._MainWindow)
PostQuitMessage_( 0 )
end method
' ===========
' COMMANDLINE
' ===========
method CommandLine() as string
method = this._Command
end method
' =======
' INFOBOX
' =======
method InfoBox(_Text as string)
long style
style = MB_ICONINFORMATION | MB_OK
MessageBox_(_LastWindow, *_Text, "Info", style)
end method
' ========
' ErrorBOX
' ========
method ErrorBox(_Text as string)
long style
style = MB_ICONERROR | MB_OK
MessageBox_(_LastWindow, *_Text, "Error", style)
end method
' ===========
' QuestionBOX
' ===========
method QuestionBox(_Text as string)
long style
style = MB_ICONQUESTION | MB_OK
MessageBox_(_LastWindow, *_Text, "Question", style)
end method
' ==========
' WarningBOX
' ==========
method WarningBox(_Text as string)
long style
style = MB_ICONWARNING | MB_OK
MessageBox_(_LastWindow, *_Text, "Warning", style)
end method
end methods
'end extern
'extern
' ====
' FORM - proper description still missing...
' ====
class oFORM alias "oFORM" export
protected static _Instance as LONG
protected static _MainWindow as LONG
protected static _LastWindow as LONG
protected static _LastChild as LONG
hwnd as long
wc as WndClass
method ctor ()
print "FORM ctor"
this._Instance = GetModuleHandle_(0)
with this.wc
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = &WndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = this._Instance
.hIcon = LoadIcon_(0, IDI_APPLICATION)
.hCursor = LoadCursor_(0, IDC_ARROW)
.hbrBackground = GetStockObject_(WHITE_BRUSH)
.lpszMenuName = 0
.lpszClassName = "HelloWin"
end with
if not RegisterClass_(&this.wc)
MessageBox_(0, "Registration failed", "Problem", MB_ICONERROR)
exit method
end if
this.hWnd = CreateWindowEx_(0,
wc.lpszClassName,
"Hello OOP Window",
WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT,
CW_USEDEFAULT,
CW_USEDEFAULT,
CW_USEDEFAULT,
0,
0,
this._Instance,
0)
if not this.hWnd then
MessageBox_(0, "Unable to create window", "problem", MB_ICONERROR)
exit method
end if
if not this._MainWindow
this._MainWindow = this.hWnd
end if
_LastWindow = this.hWnd
'this._LastWindow = this.hWnd
'print this._LastWindow
end method
method dtor()
print "FORM dtor"
;freelibrary (kernel32)
;freelibrary (user32)
'freelibrary (gdi32)
end method
public
method show()
ShowWindow_(this.hWnd, true)
UpdateWindow_(this.hWnd)
end method
end class
end extern
;-----------------------------------------
function WndProc (byval hWnd as long,
byval wMsg as long,
byval wParam as long,
byval lparam as long)
as long callback
;=========================================
function = 0
select wMsg
'--------------
case WM_CREATE
'=============
'--------------
case WM_DESTROY
'===============
PostQuitMessage_( 0 )
'--------
case else
'========
function = DefWindowProc_(hWnd, wMsg, wParam, lParam)
end select
end function ;WndProc
This is the test program:
' FrameworkTest.o2bas
'
' Test of OOP Application Framework
' efgee
#file "oFrameworkTest.exe"
#include "oFrameworkTest.o2inc"
; =====
; ENTRY
; =====
new oAPP app
new oFORM frm
app.infobox("Hi")
app.errorbox("Huh...")
app.warningbox("Wait")
app.questionbox("What")
frm.Show
app.run()
delete frm
delete app
; =========
; end entry
; =========
This is the include file for the test program (has 2 line commented out because of oxygen bug):
' FrameworkTest.o2inc
'
' Test of OOP Application Framework - Include File
' efgee
; ======
; macros
; ======
def new
dim as %1 byref %2
&%2 = news sizeof %1
%2.ctor()
end def
def delete
%1.dtor()
frees &%1
end def
extern lib "oFramework.dll"
class oAPP alias "oAPP"
protected static _Instance as LONG
protected static _Return as LONG
protected static _Message as MSG
protected static _Command as string
protected static _LastWindow as LONG
'protected static _LastChild as long ' this line needs to be commented out
'protected static _ExitCode as long ' this line needs to be commented out
method ctor()
method dtor()
method Instance() as long
method Run()
method Quit()
method CommandLine() as string
method InfoBox(_Text as string)
method ErrorBox(_Text as string)
method QuestionBox(_Text as string)
method WarningBox(_Text as string)
/
end class
class oFORM alias "oFORM"
protected static _Instance as LONG
protected static _MainWindow as LONG
protected static _LastWindow as LONG
protected static _LastChild as LONG
method ctor()
method dtor()
method show()
/
end class
end extern
; =========
; variables
; =========
----
Also it would be nice if the dll and the test program could share the class definition (when methods/end methods in the dll code is used) as they are the same except the first 2 lines (with big classes it would ease coding):
DLL code:
extern
class oAPP alias "oAPP" export
...
INC code:
extern lib "oFramework.dll"
class oAPP alias "oAPP"
...
If the syntax could be changed to:
DLL code:
extern lib export
#include "oFrameworkTest.o2inc"
end extern
methods of oAPP
...
end methods
INC code:
extern lib "oFramework.dll"
#include "oFrameworkTest.o2inc"
end extern
...and in the "oFrameworkTest.o2inc" file there would be the class definition:
class oAPP alias "oAPP"
...
end class
Or similar...
bye
efgee