Its a simple HelloWorld windows program, encapsulating the Api inside objects. Not very practical at the moment, but there is more to come.
You'll find discussion of the C++ original here:
http://www.relisoft.com/book/win/1hello.html
I'm working on developing some automatic error handling before progressing to the book's more complex windows example.
For those that might be interested here it is.
Code: Select all
Procedure Throw(Message.s)
MessageRequester("Error", Message)
End
EndProcedure
;- RootObject
Interface IRootObject
Free()
EndInterface
Structure RootObject_vTable
*Free.l
EndStructure
Structure RootObject_Internal
*vTable.IRootObject_vTable
MemoryID.l
EndStructure
Procedure RootObject_Free(*Self.RootObject_Internal)
If *Self\MemoryID > 0
FreeMemory(*Self\MemoryID)
EndIf
EndProcedure
;- WinClassMaker
Interface IWinClassMaker Extends IRootObject
Register()
EndInterface
Structure WinClassMaker_vTable Extends RootObject_vTable
*Register.l
EndStructure
Structure WinClassMaker_Internal Extends RootObject_Internal
_className.s
_class.WNDCLASSEX
EndStructure
Procedure WinClassMaker_Register(*Self.WinClassMaker_Internal)
If RegisterClassEx_(*Self\_class) = 0
Throw("RegisterClass failed")
EndIf
EndProcedure
Procedure WinClassMaker_Make(*WindowCallback, ClassName.s, hInst)
;Define the internal structre
DefType.WinClassMaker_Internal *Internal
;Allocate the memory that will hold the internal structure
*MemoryID = AllocateMemory(SizeOf(WinClassMaker_Internal))
*Internal = *MemoryID
*Internal\MemoryID = *MemoryID
;Set up the vTable.
;Static so that all instances share the same one.
Static vTable.WinClassMaker_vTable
vTable\register = @WinClassMaker_Register()
vTable\Free = @RootObject_Free()
*Internal\vTable = vTable
;Set the className
*Internal\_className = ClassName
;Populate _class, an instance WNDCLASSEX
*Internal\_class\lpfnWndProc = *WindowCallback
*Internal\_class\hInstance = hInst
*Internal\_class\lpszClassName = @*Internal\_className
*Internal\_class\cbSize = SizeOf(WNDCLASSEX)
*Internal\_class\hCursor = LoadCursor_(0, #IDC_ARROW)
*Internal\_class\hbrBackground = #COLOR_WINDOW + 1
*Internal\_class\style = 0
*Internal\_class\cbClsExtra = 0
*Internal\_class\cbWndExtra = 0
*Internal\_class\hIcon = 0
*Internal\_class\hIconSm = 0
*Internal\_class\lpszMenuName = 0
;Return the address of our internal structure
ProcedureReturn *Internal
EndProcedure
;- Window
Interface IWindow Extends IRootObject
Display(cmdShow)
EndInterface
Structure Window_vTable Extends RootObject_vTable
Display.l
EndStructure
Structure Window_Internal Extends RootObject_Internal
_h.l
EndStructure
Procedure Window_Display(*Self.Window_Internal, cmdShow)
If *Self\_h = 0
Throw("Window_Display() called while the windows handle is null")
Else
ShowWindow_(*Self\_h, cmdShow)
UpdateWindow_(*Self\_h)
EndIf
EndProcedure
;Procedure Window_Make(hwnd)
;Window is created by WinMaker\Create()
;- WinMaker
Interface IWinMaker Extends IRootObject
Create(Title.s)
EndInterface
Structure WinMaker_vTable Extends RootObject_vTable
Create.l
EndStructure
Structure WinMaker_Internal Extends RootObject_Internal
_className.s
_exStyle.l
_style.l
_hInst.l
_hMenu.l
_hWndParent.l
_height.l
_width.l
_x.l
_y.l
_data.l
EndStructure
Procedure WinMaker_Create(*Self.WinMaker_Internal, Title.s)
hwnd = CreateWindowEx_(*Self\_exStyle, *Self\_className, Title, *Self\_style, *Self\_x, *Self\_y, *Self\_width, *Self\_height, *Self\_hWndParent, *Self\_hMenu, *Self\_hInst, *Self\_data)
If hwnd = 0
Throw("Window Creation Failed")
EndIf
;wrap hwnd in a Window object
;Define the internal structure
DefType.Window_Internal *Internal
;Allocate the memory that will hold the internal structure
*MemoryID = AllocateMemory(SizeOf(*Internal))
*Internal = *MemoryID
*Internal\MemoryID = *MemoryID
;Set up the vTable.
;Static so that all instances share the same one.
Static vTable.Window_vTable
vTable\Free = @RootObject_Free()
vTable\Display = @Window_Display()
*Internal\vTable = @vTable
;Populate the private values
*Internal\_h = hwnd
;Return the address of our internal structure
ProcedureReturn *Internal
EndProcedure
Procedure WinMaker_Make(ClassName.s, hInst)
;Define the internal structre
DefType.WinMaker_Internal *Internal
;Allocate the memory that will hold the internal structure
*MemoryID = AllocateMemory(SizeOf(WinMaker_Internal))
*Internal = *MemoryID
*Internal\MemoryID = *MemoryID
;Set up the vTable.
;Static so that all instances share the same one.
Static vTable.WinMaker_vTable
vTable\Create = @WinMaker_Create()
vTable\Free = @RootObject_Free()
*Internal\vTable = @vTable
;Populate the private values
*Internal\_style = #WS_OVERLAPPEDWINDOW
*Internal\_exStyle = 0
*Internal\_className = ClassName
*Internal\_x = #CW_USEDEFAULT
*Internal\_y = 0
*Internal\_width = #CW_USEDEFAULT
*Internal\_height = 0
*Internal\_hWndParent = 0
*Internal\_hMenu = 0
*Internal\_data = 0
*Internal\_hInst = hInst
ProcedureReturn *Internal
EndProcedure
;- WinProcedure
Procedure WinProcedure(hwnd, Message, wParam, lParam)
Select Message
Case #WM_Destroy
PostQuitMessage_(0)
ProcedureReturn 0
EndSelect
ProcedureReturn DefWindowProc_(hwnd, Message, wParam, lParam);
EndProcedure
;- WinMain
hInst = GetModuleHandle_(0)
ClassName.s = "Winnie"
winClass.IWinClassMaker = WinClassMaker_Make(@WinProcedure(), "Winnie", hInst)
winClass\Register()
maker.IWinMaker = WinMaker_Make(ClassName, hInst)
win.IWindow = maker\Create("Hello Windows!")
win\Display(#True)
;Message loop
DefType.msg Message
Repeat
status.l = GetMessage_(@Message, 0, 0, 0)
If status > 0
DispatchMessage_(@Message)
EndIf
Until status = 0 Or status = -1
win\Free()
maker\Free()
winClass\Free()
If status = -1
End -1
Else
End Message\wParam
EndIf
