Dialog Template
- Posted by euman at bellsouth.net May 14, 2003
- 371 views
-- 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( )