Previous lessons in this tutorial have frequently called Win32 API functions which are not yet a part of Win32lib. This tutorial goes to an extreme, by presenting a program which does not use Win32lib at all !
It may seem out of place, but I wanted to include a pair of programs in these 'tuts', which appeared almost identical, so I could illustrate how to 'clone' a simple program without using Win32lib.
The Win32lib example, speed-win32.exw, which I won't detail here, is very similar to the example in Lesson 4, only adding an LText() control in the main window. Since I'm also a bit of a benchmarking 'freak', more out of curiosity than anything else, I've tried to include a timing routine which shows how long it takes for each of these programs to start up. The results are displayed in the LText(). If the results occasionally look suspicious, it's because I'm only using the lowest four bytes of an 8 byte counter, which may have 'rolled' over during the timing interval.
So here's Euman's code, which is not really that much different than the Euphoria example Window.exw, only adding a few more controls in it's WndProc().
Folks familiar with Win32lib code might argue that the results of this speed test are unfair, because the timer results are calculated before the program goes into it's message loop. I did, however, modify a copy of win32lib.ew, and placed the ( timer ) code at the top of win32lib's WndProc() routine. In 'bound' examples of both win32lib programs, there was very little difference. speed-api32.exe was still over 12 times faster starting up, on average, than speed-win32.exe.
Another difference, of course, is that the 'bound' version of speed-api32.exe is over 60 kilobytes smaller than the win32lib version.
Doing a simple 'startup' benchmark like this doesn't always give an accurate picture. In another test, I simply added some code like the example below to both programs, just to call an API function an additional 100 times. Using 'bound' versions of both, speed-api32.exe was only 6 times faster.
Doing a comparison without binding would really be unfair, because EU would have to load win32lib.ew from disk or cache during the timing interval.
( using Euphoria version 2.3, which already 'strips' most unused constants/routines etc., and win32lib version 0.57.0 )
RE: -- tricky code ! When the TextBox is created, he's using the SS_OWNERDRAW style. ..end of lesson.
-- speed-api32.exw
-- Wolf's Tutorials Example, BUT only API is used!
-- Please DO NOT Edit this Demo!
-- This Demo does exactly the same thing as Wolf's
-- Wolf wanted a speed test for some reason...
-- here tis' enjoy!
-- H.W Overman - aka: Euman > euman@bellsouth.net
without type_check
include misc.e
include machine.e
include dll.e
-- counter code variables.
object jk, output
atom arg, t1, t2, speed, diff
output = 0
-- 8 bytes for counter return value !,
-- but I'm only using 4.
arg=allocate(8)
-- since the two functions required to time this demo are
-- in kernel32, we have to link to them now.
constant kernel32=open_dll("kernel32.dll"),
ctr = define_c_func( kernel32,"QueryPerformanceCounter",{C_INT},C_INT),
freq = define_c_func( kernel32,"QueryPerformanceFrequency",{C_INT},C_INT)
-- get counter's frequency
jk=c_func(freq,{arg})
-- if the 'freq' function returns zero,
-- this CPU has no counter ?
if jk = 0 then
printf(1,"%s\n",{"...OOPS,NO COUNTER FOUND !"})
else
-- get our 'frequency' divisor
speed=peek4u(arg)
jk=c_func(ctr,{arg})
-- get 'start' counter value
t1=peek4u(arg)
end if
-- the next group of constants is our WNDCLASS structure definition.
-- These are actually used as pointers into an allocated block
-- of memory.
constant cbSize = 0,
style = 4,
lpfnWndProc = 8,
cbClsExtra = 12,
cbWndExtra = 16,
hInstance = 20,
hIcon = 24,
hCursor = 28,
hbrBackground = 32,
lpszMenuName = 36,
lpszClassName = 40,
hIconSm = 44,
SIZE_OF_WNDCLASS = 48
constant SIZE_OF_MESSAGE = 40
constant SW_SHOWNORMAL = 1
-- the Windows messages we will look for in our WndProc() callback function.
constant WM_CREATE = #01,
WM_COMMAND = #111,
WM_DESTROY= #02,
WM_SETFONT = #30,
WM_DRAWITEM = 43,
WM_ACTIVATE = 6
constant MF_STRING = 0,
MF_POPUP = #10
constant SS_OWNERDRAW = #D,
ES_LEFT = 0
constant DEFAULT_GUI_FONT = 17
constant TRANSPARENT = 1
constant COLOR_BTNFACE = 15
-- refers to the Windows 'stock' application icon.
constant IDI_APPLICATION = 32512
function or_all(sequence s)
-- or together all elements of a sequence
atom result
result = 0
for i = 1 to length(s) do
result = or_bits(result, s[i])
end for
return result
end function
constant MB_OK = 0,
MB_APPLMODAL = 0
-- our Window 'style' parameters.
constant WS_OVERLAPPED = #00000000,
WS_CAPTION = #00C00000,
WS_SYSMENU = #00080000,
WS_THICKFRAME = #00040000,
WS_MINIMIZEBOX = #00020000,
WS_MAXIMIZEBOX = #00010000,
WS_CHILD = #40000000,
WS_VISIBLE = #10000000
constant IDC_ARROW = 32512, -- the 'stock' mouse pointer.
CW_USEDEFAULT = #80000000,
-- the 'generic' window style
WS_OVERLAPPEDWINDOW = or_all({WS_OVERLAPPED,WS_CAPTION,
WS_SYSMENU, WS_THICKFRAME, WS_MINIMIZEBOX, WS_MAXIMIZEBOX})
-- The following integer variables will be used to 'hold'
-- all the 'links' to the API functions and procedures
-- that this program uses.
integer
LoadIcon, LoadCursor, GetStockObject, RegisterClassEx,
xCreateWindow, ShowWindow, UpdateWindow, DestroyWindow, GetMessage,
TranslateMessage, DispatchMessage, PostQuitMessage, DefWindowProc,
CreateMenu, CreatePopupMenu, AppendMenu, xMessageBox, xSendMessage,
SetFocus, SetWindowText, xTextOut, xSetBkMode, xlstrlen
-- this is used to report errors
procedure not_found(sequence name)
puts(1, "Couldn't find " & name & '\n')
sleep(2)
abort(1)
end procedure
function link_c_func(atom dll, sequence name, sequence args, atom result)
-- dynamically link a C routine as a Euphoria function
integer handle
handle = define_c_func(dll, name, args, result)
if handle = -1 then
not_found(name)
else
return handle
end if
end function
function link_c_proc(atom dll, sequence name, sequence args)
-- dynamically link a C routine as a Euphoria procedure
-- ignoring any return value.
integer handle
handle = define_c_proc(dll, name, args)
if handle = -1 then
not_found(name)
else
return handle
end if
end function
procedure link_dll_routines()
-- get handles to the dll's,
-- and the dll routines, that we need
atom user32, gdi32
user32 = open_dll("user32.dll")
if user32 = NULL then
not_found("user32.dll")
end if
gdi32 = open_dll("gdi32.dll")
if gdi32 = NULL then
not_found("gdi32.dll")
end if
LoadIcon = link_c_func(user32, "LoadIconA", {C_POINTER, C_INT}, C_INT)
LoadCursor = link_c_func(user32, "LoadCursorA", {C_POINTER, C_INT}, C_INT)
GetStockObject = link_c_func(gdi32, "GetStockObject", {C_INT}, C_INT)
RegisterClassEx = link_c_func(user32, "RegisterClassExA", {C_POINTER}, C_INT)
xCreateWindow = link_c_func(user32, "CreateWindowExA",
{C_INT, C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT},C_INT)
ShowWindow = link_c_proc(user32, "ShowWindow", {C_INT, C_INT})
UpdateWindow = link_c_proc(user32, "UpdateWindow", {C_INT})
DestroyWindow = link_c_func(user32, "DestroyWindow", {C_INT}, C_INT)
GetMessage = link_c_func(user32, "GetMessageA", {C_INT, C_INT, C_INT, C_INT}, C_INT)
TranslateMessage = link_c_proc(user32, "TranslateMessage", {C_INT})
DispatchMessage = link_c_proc(user32, "DispatchMessageA", {C_INT})
PostQuitMessage = link_c_proc(user32, "PostQuitMessage", {C_INT})
DefWindowProc = link_c_func(user32, "DefWindowProcA",
{C_INT, C_INT, C_INT, C_INT}, C_INT)
-- Menu Handling
CreateMenu = link_c_func(user32, "CreateMenu", {}, C_LONG)
CreatePopupMenu = link_c_func(user32, "CreatePopupMenu", {}, C_LONG)
AppendMenu = link_c_func(user32, "AppendMenuA", {C_LONG, C_LONG, C_LONG, C_POINTER}, C_LONG)
xMessageBox = link_c_func(user32, "MessageBoxA",
{C_LONG, C_POINTER, C_POINTER, C_LONG}, C_LONG)
xSendMessage = link_c_func(user32, "SendMessageA", {C_LONG, C_LONG, C_INT, C_LONG}, C_LONG)
SetFocus=link_c_proc(user32,"SetFocus",{C_POINTER})
SetWindowText=link_c_func(user32,"SetWindowTextA",{C_POINTER,C_POINTER},C_INT)
xTextOut = link_c_proc(gdi32, "TextOutA", {C_POINTER, C_INT, C_INT, C_POINTER, C_INT})
xSetBkMode = link_c_func(gdi32, "SetBkMode", {C_POINTER, C_INT}, C_INT)
xlstrlen = link_c_func(kernel32,"lstrlen",{C_POINTER},C_INT)
end procedure
link_dll_routines() -- run the above procedure
function LOWORD(atom long)
return remainder(long,65536)
end function
object junk
-- we call the next function from our WinMain() once,
-- to create the main window, then twice from our WndProc(),
-- to create our button and text box controls.
function CreateWindow(atom dwExStyle, object ClassName, object WindowName,
atom dwStyle, atom x, atom y, atom Width, atom Height,
atom Parent, atom Mnu, atom Instance, integer void)
atom classname, windowname, id
if atom(ClassName) then
classname = ClassName
else
classname = allocate_string(ClassName)
end if
if atom(WindowName) then
windowname = WindowName
else
windowname = allocate_string(WindowName)
end if
id = c_func(xCreateWindow,{dwExStyle,classname,windowname,dwStyle,
x,y,Width,Height,Parent,Mnu,Instance,void})
free(classname)
free(windowname)
return id
end function
-- sends text out to the TextBox device context
procedure TextOut(atom hdc, integer x,integer y, atom pStr, integer size)
c_proc(xTextOut,{hdc,x,y,pStr,size})
end procedure
-- returns a string from memory
function peek_zstring(atom lpzString)
return peek({lpzString,c_func(xlstrlen,{lpzString})})
end function
atom hMenu, pMenu, IDM_EXIT
IDM_EXIT = 100
function createMenu()
-- create a popup menu ( which *IS* a dropdown menu ;-) )
pMenu = c_func(CreatePopupMenu, {})
-- add an item to the dropdown
junk = c_func(AppendMenu, {pMenu, MF_STRING,
IDM_EXIT, allocate_string("&Now!")})
-- create our main menu
hMenu = c_func(CreateMenu, {})
-- add an item to the main menu, *and* pass the handle of our dropdown
junk = c_func(AppendMenu, {hMenu, MF_STRING + MF_POPUP,
pMenu, allocate_string("&Exit")})
return hMenu
end function
atom AboutBox, TextBox, IDM_ABOUTBOX, txtbuff, title, stdc
IDM_ABOUTBOX = 101
integer cmd
global function WndProc(atom hwnd, atom iMsg, atom wParam, atom lParam)
-- callback routine to handle this window's messages
if iMsg = WM_CREATE then
-- the main window has been created, so create the AboutBox,
-- the TextBox, set their fonts, and set the focus.
AboutBox = CreateWindow(0,"button","About",
or_all({WS_CHILD,WS_VISIBLE}),10, 10, 50, 25, hwnd, IDM_ABOUTBOX, 0, 0)
TextBox = CreateWindow(0,"STATIC","",
or_all({WS_CHILD,WS_VISIBLE,ES_LEFT,SS_OWNERDRAW}),5,50,180,40,hwnd,0,0,0)
junk = c_func(xSendMessage,{AboutBox,
WM_SETFONT, c_func(GetStockObject,{DEFAULT_GUI_FONT}), 0})
junk = c_func(xSendMessage,{TextBox,
WM_SETFONT, c_func(GetStockObject,{DEFAULT_GUI_FONT}), 0})
c_proc(SetFocus,{AboutBox})
return 0
elsif iMsg=WM_DRAWITEM then -- tricky code !
stdc = peek4s(lParam + 24)
junk = c_func(xSetBkMode, {stdc, TRANSPARENT})
if output != 0 then
c_proc(xTextOut,{stdc,0,0,output,length(peek_zstring(output))})
end if
return 0
-- the following sets the focus to the button whenever
-- the main window receives focus.
elsif iMsg=WM_ACTIVATE then
if LOWORD(wParam) > 0 then
c_proc(SetFocus,{AboutBox})
-- else
-- Loosing Focus
end if
return 0
elsif iMsg = WM_COMMAND then
cmd = LOWORD(wParam)
if cmd = IDM_EXIT then
junk = c_func(DestroyWindow, {hwnd})
elsif cmd = IDM_ABOUTBOX then
-- this MessageBox is a 'stock' control that's
-- created every time we click on the button,
-- and automatically destroyed by Windows
-- when it's 'Okay' button is clicked.
txtbuff = allocate_string("...it's GREAT !")
title = allocate_string("* Euphoria *")
junk = c_func(xMessageBox, {hwnd, txtbuff, title,
or_all({MB_APPLMODAL, MB_OK})})
free(txtbuff)
free(title)
end if
return 0
elsif iMsg = WM_DESTROY then
c_proc(PostQuitMessage, {0})
return 0
end if
-- any messages not handled by our WndProc routine, are returned
-- to Windows for it's default message handler routines...
return c_func(DefWindowProc, {hwnd, iMsg, wParam, lParam})
end function
atom my_title
my_title = allocate_string("..using API")
procedure WinMain()
-- the main routine,
-- which creates our main window,
-- sets up the callback to our WndProc() routine, and
-- starts the message loop for our whole program.
atom szAppName
atom hwnd
atom msg
atom wndclass
atom WndProcAddress
atom class
integer id
atom icon_handle
wndclass = allocate(SIZE_OF_WNDCLASS)
msg = allocate(SIZE_OF_MESSAGE)
szAppName = allocate_string("EumansWin")
id = routine_id("WndProc")
if id = -1 then
puts(1, "routine_id failed!\n")
sleep(2)
abort(1)
end if
WndProcAddress = call_back(id) -- get 32-bit address for callback
-- fill in the WNDCLASS structure
poke4(wndclass + cbSize, SIZE_OF_WNDCLASS)
poke4(wndclass + style, 0) --or_bits(CS_HREDRAW, CS_VREDRAW))
poke4(wndclass + lpfnWndProc, WndProcAddress)
poke4(wndclass + cbClsExtra, 0)
poke4(wndclass + cbWndExtra, 0)
poke4(wndclass + hInstance, 0) --hInstance
icon_handle=c_func(LoadIcon, {NULL, IDI_APPLICATION})
poke4(wndclass+hIcon,icon_handle)
poke4(wndclass+hIconSm,icon_handle)
poke4(wndclass+hCursor,c_func(LoadCursor,{NULL,IDC_ARROW}))
poke4(wndclass+hbrBackground,COLOR_BTNFACE+1)
poke4(wndclass + lpszMenuName, NULL)
poke4(wndclass + lpszClassName, szAppName)
class = c_func(RegisterClassEx, {wndclass})
if class = 0 then
puts(1, "Couldn't register class\n")
sleep(2)
abort(1)
end if
-- create menu *before* creating main window
hMenu = createMenu()
-- create main window
hwnd = CreateWindow(
0, -- extended style
szAppName, -- window class name
my_title, -- window caption
WS_OVERLAPPEDWINDOW, -- window style
CW_USEDEFAULT, -- initial x position
CW_USEDEFAULT, -- initial y position
200, -- initial x size
150, -- initial y size
NULL, -- parent window handle
hMenu, -- window menu handle
0, -- hInstance // program instance handle
NULL) -- creation parameters
if hwnd = 0 then
puts(1, "Couldn't CreateWindow\n")
sleep(2)
abort(1)
end if
-- show, and repaint the main window
c_proc(ShowWindow,{hwnd,SW_SHOWNORMAL})
c_proc(UpdateWindow,{hwnd})
-- calculate, and display elapsed time
jk=c_func(ctr,{arg})
t2=peek4u(arg)
diff=t2-t1
output=allocate_string(sprintf(
"program time = %.8f sec.",{(diff/speed)}))
jk=c_func(SetWindowText,{TextBox,output})
-- the message loop !
while c_func(GetMessage, {msg, NULL, 0, 0}) do
c_proc(TranslateMessage, {msg})
c_proc(DispatchMessage, {msg})
end while
end procedure
WinMain()
--------
for i = 1 to 100 do -- for win32 example
setText(SpText," ")
end for
--------
for i = 1 to 100 do -- for api32 example
str = allocate_string(" ")
jk = c_func(SetWindowText,{TextBox, str})
free(str)
end for
Euman's used some rather unusual code to give the text box the same background color as our main window.
Upon creation of this control, Windows sends a WM_DRAWITEM message to our WndProc().
lParam of this message contains a pointer to a DRAWITEMSTRUCT structure, in which offset 24 contains the hDC of the TextBox.
He then sets the background mode of this DC to transparent, so the main window's background shows 'thru'.