1. Dialog Template
- Posted by euman at bellsouth.net
May 14, 2003
-- TITLE : EuDT (Euphoria Dialog template)
-- AUTHOR: Euman 2003 aka: H.W Overman
-- USE : (template) for creating dialog based applications.
-- using .rc files produced by commercial resource editors.
-- NOTE : You MUST use the Euphoria to C Translators with this.
include machine.e
include dll.e
include winconst.ew -- Jacques Deschenes constant wrapper (6000 constants)
without type_check
without trace
without warning
object ret, void, junk
global function or_all(sequence s)
atom result
result = 0
for i 1 to length(s) do
result = or_bits(result, s[i])
end for
return result
end function
--------------------------------------------------------------------------
-- Dynamic Link Libraries ------------------------------------------------
--------------------------------------------------------------------------
procedure not_found(sequence name)
puts(1, "Couldn't find " & name & '\n')
if getc(0) then
end if
abort(1)
end procedure
atom kernel32, comctl32, user32, gdi32
kernel32 = open_dll("kernel32.dll")
if kernel32 NULL then
not_found("kernel32.dll")
end if
comctl32 = open_dll("comctl32.dll")
if comctl32 NULL then
not_found("comctl32.dll")
end if
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
constant
xShowWindow define_c_proc(user32, "ShowWindow", {C_INT, C_INT),
xPostQuitMessage = define_c_proc(user32, "PostQuitMessage", {C_INT})
--------------------------------------------------------------------------
-- DialogItem Handling ---------------------------------------------------
--------------------------------------------------------------------------
constant
xGetDlgItem = define_c_func(user32,"GetDlgItem",{C_INT,C_INT},C_UINT),
xSendMessage define_c_func(user32, "SendMessageA",
{C_LONG, C_LONG, C_INT, C_LONG, C_LONG),
xEnableWindow define_c_proc(user32,"EnableWindow",{C_INT,C_INT}),
xSetFocus = define_c_func(user32,"SetFocus",{C_INT,C_INT)
global function GetDlgItem(atom hDlg, atom Id)
return c_func(xGetDlgItem,{hDlg, Id})
end function
global function shift_left (atom x, integer count)
return x * power (2, count)
end function
global function MAKELONG (atom a, atom b)
return or_bits(a, shift_left (b, 16))
end function
--------------------------------------------------------------------------
-- Device Context (DC) Handling ------------------------------------------
--------------------------------------------------------------------------
constant
xGetDC = define_c_func(user32, "GetDC", {C_POINTER, C_UINT),
xReleaseDC define_c_proc(user32, "ReleaseDC", {C_INT, C_INT}),
xDeleteDC = define_c_func(gdi32, "DeleteDC", {C_POINTER}, C_POINTER),
xCreateCompatibleDC = define_c_func(gdi32, "CreateCompatibleDC", {C_POINTER,
C_POINTER)
--------------------------------------------------------------------------
-- Paint Handling --------------------------------------------------------
--------------------------------------------------------------------------
constant
xBeginPaint define_c_func(user32, "BeginPaint", {C_INT, C_POINTER}, C_INT),
xBitBlt define_c_func(gdi32, "BitBlt",
{C_POINTER,C_INT,C_INT,C_INT,C_INT,C_POINTER,C_INT,C_INT,C_LONG},C_LONG),
xEndPaint define_c_proc(user32, "EndPaint", {C_INT, C_INT}),
xLoadBitmap
define_c_func(user32,"LoadBitmapA",{C_INT,C_POINTER},C_POINTER),
xGetClientRect = define_c_proc(user32, "GetClientRect", {C_INT, C_POINTER)
constant
psHdc = 0,
psErase 4,
psPaintRect = 8,
psRestore = 24,
psIncUpdate = 28,
psRgbReserved = 32,
SIZEOF_PAINTSTRUCT = 64
constant
rLeft 0,
rTop 4,
rRight 8,
rBottom 12,
SIZEOF_RECT = 16
atom ps, rect
ps = allocate(SIZEOF_PAINTSTRUCT)
rect allocate(SIZEOF_RECT)
--------------------------------------------------------------------------
-- Object Handling -------------------------------------------------------
--------------------------------------------------------------------------
constant
xSelectObject define_c_func(gdi32, "SelectObject",
{C_POINTER, C_POINTER}, C_POINTER),
xDeleteObject = define_c_proc(gdi32, "DeleteObject", {C_LONG)
-- if a c_func or c_proc is used more than 2-3 times, its better to wrap them
-- to save space in your translated or bound euphoria .exe (like Ive done
below)
global function SelectObject(atom dc, atom item)
return c_func(xSelectObject,{dc, item})
end function
global function DeleteObject(atom obj)
return c_func(xDeleteObject, {obj)
end function
--------------------------------------------------------------------------
-- DlgProc ---------------------------------------------------------------
--------------------------------------------------------------------------
-- Processing of dialog messages. ----------------------------------------
--------------------------------------------------------------------------
-- hWnd window handle. --------------------------------------------
-- uMsg message identifier. ---------------------------------------
-- wParam wParam message parameter data type. -----------------------
-- lParam lParam message parameter data type. -----------------------
--------------------------------------------------------------------------
atom hInst, hDC, memDC
integer id, TRUE, FALSE, x1, y1, x2, y2
TRUE = 1
FALSE = 0
function DlgProc(atom hWnd, integer uMsg, atom wParam, atom lParam)
----------------------------------------------------------------------
-- WM_INITDIALOG -----------------------------------------------------
----------------------------------------------------------------------
if uMsg = WM_INITDIALOG then
-- Program Specific (Initialize Controls)
--------------------------------------------------------------------------
-- WM_CLOSE --------------------------------------------------------------
--------------------------------------------------------------------------
elsif uMsg = WM_CLOSE then
abort(0) -- end all!
--------------------------------------------------------------------------
-- WM_DESTROY ------------------------------------------------------------
--------------------------------------------------------------------------
elsif uMsg = WM_DESTROY then
c_proc(xPostQuitMessage, {0})
--------------------------------------------------------------------------
-- WM_PAINT --------------------------------------------------------------
--------------------------------------------------------------------------
elsif uMsg = WM_PAINT then
hDC = c_func(xBeginPaint, {hWnd, ps})
void c_func(xBitBlt, {hDC, x1, y1, x2, y2, memDC, 0,0, SRCCOPY})
c_proc(xEndPaint, {hWnd, ps)
--------------------------------------------------------------------------
-- WM_COMMAND ------------------------------------------------------------
--------------------------------------------------------------------------
elsif uMsg WM_COMMAND then
-- Program Specific (Handle Controls)
end if
return 0
end function -- DlgProc
atom iDlgProc
iDlgProc = call_back(routine_id("DlgProc"))
--------------------------------------------------------------------------
-- Message Loop ----------------------------------------------------------
--------------------------------------------------------------------------
-- Allow processing of a waiting message ---------------------------------
--------------------------------------------------------------------------
constant
xTranslateMessage = define_c_proc(user32, "TranslateMessage", {C_INT}),
xDispatchMessage = define_c_proc(user32, "DispatchMessageA", {C_INT}),
xPeekMessage = define_c_func(user32, "PeekMessageA",
{C_POINTER,C_LONG,C_UINT,C_UINT,C_UINT},C_LONG)
atom msg
msg = allocate(40)
mem_set(msg, 0,40)
function MessageLoop( )
ret = c_func(xPeekMessage,{msg, NULL, 0, 0, PM_REMOVE})
if ret != 0 then
c_proc(xTranslateMessage, {msg})
c_proc(xDispatchMessage, {msg)
end if
return 0
end function
--------------------------------------------------------------------------
-- Common Controls Init --------------------------------------------------
--------------------------------------------------------------------------
-- Initialize Common Control for application -----------------------------
--------------------------------------------------------------------------
constant
xInitCommonControlsEx
define_c_func(comctl32,"InitCommonControlsEx",{C_LONG}, C_LONG)
global constant
ICC_LISTVIEW_CLASSES #1,
ICC_TREEVIEW_CLASSES #2,
ICC_WIN95_CLASSES #FF,
ICC_PROGRESS_CLASS #20,
INITCOMMONCONTROLSEX_dwSize 0,
INITCOMMONCONTROLSEX_dwICC = 4,
SIZEOF_INITCOMMONCONTROLSEX = 8
atom icc
icc = allocate(SIZEOF_INITCOMMONCONTROLSEX)
procedure InitCommonControls()
poke4(icc + INITCOMMONCONTROLSEX_dwSize, SIZEOF_INITCOMMONCONTROLSEX)
poke4(icc + INITCOMMONCONTROLSEX_dwICC, or_all({ICC_LISTVIEW_CLASSES,
ICC_TREEVIEW_CLASSES,
ICC_PROGRESS_CLASS,
ICC_WIN95_CLASSES
))
if not c_func( xInitCommonControlsEx, {icc ) then
puts(1,"Unable to Initialize CommonControls")
end if
end procedure
constant
seterrmode = define_c_func(kernel32,"SetErrorMode",{C_UINT,C_UINT)
constant
SEM_FAILCRITICALERRORS = 1
junk = c_func(seterrmode,{SEM_FAILCRITICALERRORS})
--------------------------------------------------------------------------
-- WinMain ---------------------------------------------------------------
--------------------------------------------------------------------------
-- Create the main dialog. -----------------------------------------------
--------------------------------------------------------------------------
-- hInst = the instance of this application. ---------------------
-- hPrevInst = the previous instance of this application. ------------
-- CmdLine = a pointer to the commandline. -------------------------
-- CmdShow = the show state. ---------------------------------------
--------------------------------------------------------------------------
constant xDialogBoxParam define_c_func(user32,"DialogBoxParamA",
{C_LONG,C_POINTER,C_LONG,C_POINTER,C_LONG,C_LONG)
atom pDlg
pDlg = allocate_string("MYDIALOG")
function WinMain(atom hInst, atom hPrevInst, object CmdLine, object CmdShow )
InitCommonControls( )
-- (-1) if not translated and a .rc file is not compiled with your .exe
void c_func(xDialogBoxParam,{hInst, pDlg, 0, iDlgProc, 0})
return 0
end function
--########################################################################
--------------------------------------------------------------------------
-- start -----------------------------------------------------------------
--------------------------------------------------------------------------
-- Entry point to application. -------------------------------------------
--------------------------------------------------------------------------
constant xGetModuleHandle = define_c_func(kernel32,
"GetModuleHandleA",{C_POINTER}, C_POINTER)
constant xGetCommandLine define_c_func(kernel32, "GetCommandLineA", {},
C_LONG)
constant xExitProcess = define_c_proc(kernel32, "ExitProcess",{C_UINT})
atom CommandLine
procedure start( )
hInst c_func(xGetModuleHandle,{NULL})
CommandLine = c_func(xGetCommandLine, {})
void WinMain( hInst, NULL, CommandLine, SW_SHOWDEFAULT )
-- c_proc(xExitProcess,{void}) -- Euphorians shouldnt ExitProcess but allow
Eu to.
end procedure
start( )
