------------------------------------------------------------------------------ -- -- -- J E W L . M E S S A G E _ H A N D L I N G -- -- -- -- The body of a private package which defines the message-handling task -- -- required by JEWL.Windows, the protected record used to communicate -- -- with it, and related operations. -- -- -- -- Copyright (C) John English 2000. Contact address: je@brighton.ac.uk -- -- This software is released under the terms of the GNU General Public -- -- License and is intended primarily for educational use. Please contact -- -- the author to report bugs, suggestions and modifications. -- -- -- ------------------------------------------------------------------------------ -- $Id: jewl-message_handling.adb 1.6 2001/11/02 16:00:00 JE Exp JE $ ------------------------------------------------------------------------------ -- -- $Log: jewl-message_handling.adb $ -- Revision 1.6 2001/11/02 16:00:00 JE -- * Fixed canvas bug when saving an empty canvas -- * Restore with no prior save now acts as erase -- * Removed redundant variable declaration in Image function -- -- Revision 1.5 2001/08/22 15:00:00 JE -- * Minor bugfix to Get_Text for combo boxes -- * Minor changes to documentation (including new example involving dialogs) -- -- Revision 1.4 2001/01/25 09:00:00 je -- Changes visible to the user: -- -- * Added support for drawing bitmaps on canvases (Draw_Image operations -- and new type Image_Type) -- * Added Play_Sound -- * Added several new operations on all windows: Get_Origin, Get_Width, -- Get_Height, Set_Origin, Set_Size and Focus -- * Added several functions giving screen and window dimensions: Screen_Width, -- Screen_Height, Frame_Width, Frame_Height, Dialog_Width, Dialog_Height and -- Menu_Height -- * Canvases can now handle keyboard events: new constructor and Key_Code added -- * Added procedure Play_Sound -- * Operations "+" and "-" added for Point_Type -- * Pens can now be zero pixels wide -- * The absolute origin of a frame can now have be specified when the frame -- is created -- * Added new File_Dialog operations Add_Filter and Set_Directory -- * Added Get_Line renames to JEWL.IO for compatibility with Ada.Text_IO -- * Added all the Get(File,Item) operations mentioned in documentation but -- unaccountably missing :-( -- * Documentation updated to reflect the above changes -- * HTML versions of public package specifications added with links from -- main documentation pages -- -- Other internal changes: -- -- * Canvas fonts, pens etc. now use JEWL.Reference_Counted_Type rather than -- reinventing this particular wheel, as do images -- * Various minor code formatting changes: some code reordered for clarity, -- some comments added or amended, -- * Changes introduced in 1.2 to support GNAT 3.10 have been reversed, since -- GNAT 3.10 still couldn't compile this code correctly... ;-( -- -- Outstanding issues: -- -- * Optimisation breaks the code (workaround: don't optimise) -- -- Revision 1.3 2000/07/07 12:00:00 je -- * JEWL.Simple_Windows added; JEWL.IO modified to use JEWL.Simple_Windows. -- * JEWL.IO bug fix: Put_Line to file wrote newline to standard output -- instead of to the file (thanks to Jeff Carter for pointing this out). -- * Panels fixed so that mouse clicks are passed on correctly to subwindows. -- * Memos fixed so that tabs are handled properly. -- * Password feature added to editboxes. -- * Minor typos fixed in comments within the package sources. -- * Documentation corrected and updated following comments from Moti Ben-Ari -- and Don Overheu. -- -- Revision 1.2 2000/04/18 20:00:00 je -- * Minor code changes to enable compilation by GNAT 3.10 -- * Minor documentation errors corrected -- * Some redundant "with" clauses removed -- -- Revision 1.1 2000/04/09 21:00:00 je -- Initial revision -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion; package body JEWL.Message_Handling is use JEWL.Window_Implementation; use JEWL.Win32_Interface; use Ada.Exceptions; use type System.Address; use type Win32_BOOL, Win32_DWORD, Win32_LONG, Win32_UINT; ----------------------------------------------------------------------------- -- Type conversions (needed below) ----------------------------------------------------------------------------- function To_Window_Ptr is new Ada.Unchecked_Conversion (Win32_LONG,Window_Ptr); function To_LONG is new Ada.Unchecked_Conversion (Window_Ptr,Win32_LONG); ---------------------------------------------------------------------------- -- -- W I N D O W _ I N F O -- ---------------------------------------------------------------------------- protected body Window_Info is -------------------------------------------------------------------------- -- -- Get_Command: block until a command is available (or the message loop -- has failed) and then return it. The command is also reset. -- Program_Error is raised if the message loop has failed. -- entry Get_Command (Cmd : out Natural) when Command /= 0 or Task_Failed is begin if Task_Failed then Raise_Exception (Program_Error'Identity, "caused by " & Exception_Name(Failure_Info) & ": " & Exception_Message(Failure_Info)); end if; Cmd := Command - WM_USER; Command := 0; end Get_Command; -------------------------------------------------------------------------- -- -- Test_Command: test if a command is pending. Program_Error is raised -- if the message loop task has failed. -- function Test_Command return Boolean is begin if Task_Failed then Raise_Exception (Program_Error'Identity, "caused by " & Exception_Name(Failure_Info) & ": " & Exception_Message(Failure_Info)); end if; return Command /= 0; end Test_Command; -------------------------------------------------------------------------- -- -- Set_Command: store the code for an available command. This is a -- procedure, not an entry, so the the message loop won't -- stall. If commands aren't handled in time, they'll be -- overwritten by the next one that comes along. -- procedure Set_Command (Cmd : in Natural) is begin Command := Cmd; end Set_Command; -------------------------------------------------------------------------- -- -- Get_Dialog: swap the handle of the current active window with the -- parameter (i.e. record the new handle and return the -- old one). -- procedure Get_Dialog (Dlg : in out Win32_HWND) is D : Win32_HWND := Dialog; begin Dialog := Dlg; Dlg := D; end Get_Dialog; -------------------------------------------------------------------------- -- -- Active_Window: get the handle of the current active window. -- function Active_Window return Win32_HWND is begin return Dialog; end Active_Window; -------------------------------------------------------------------------- -- -- Record_Error : record the occurrence of an exception which aborted -- the message loop task. -- procedure Record_Error (Err : in Ada.Exceptions.Exception_Occurrence) is begin Task_Failed := True; Ada.Exceptions.Save_Occurrence (Failure_Info, Err); end Record_Error; end Window_Info; ---------------------------------------------------------------------------- -- -- U T I L I T Y F U N C T I O N S -- ---------------------------------------------------------------------------- -- -- Get_Actual_Bounds: check if any bounds supplied are non-positive -- (i.e. relative to parent size) and recalculate -- the bounds if so. Resize is set True if any -- bounds have been updated. -- procedure Get_Actual_Bounds (Parent : in Win32_HWND; Top : in out Integer; Left : in out Integer; Width : in out Integer; Height : in out Integer; Resize : out Boolean) is R : aliased Win32_RECT; begin -- Do any bounds need recalculationg? Resize := Top < 0 or Left < 0 or Width <= 0 or Height <= 0; if Resize then -- Top-level windows take their bounds from the screen, child windows -- take them from their parent if Parent = System.Null_Address then R := (0, 0, Win32_LONG(GetSystemMetrics(SM_CXSCREEN)), Win32_LONG(GetSystemMetrics(SM_CYSCREEN))); else Bool_Dummy := GetClientRect (Parent, R'Unchecked_Access); end if; -- Recalculate left side relative to parent bounds if necessary if Left < 0 then Left := Left + Integer(R.Right); end if; -- Recalculate top relative to parent bounds if necessary if Top < 0 then Top := Top + Integer(R.Bottom); end if; -- Recalculate width relative to parent bounds if necessary if Width <= 0 then Width := Width + Integer(R.Right); end if; -- Recalculate height relative to parent bounds if necessary if Height <= 0 then Height := Height + Integer(R.Bottom); end if; end if; end Get_Actual_Bounds; ---------------------------------------------------------------------------- -- -- Build_Window: construct a top-level window of the specified class, -- with extended and normal styles as specified, and -- make the window visible or invisible as requested. -- procedure Build_Window (Window : in Main_Window_Ptr; Class : in Win32_String; Title : in Win32_String; XStyle : in Win32_DWORD; Style : in Win32_DWORD; Show : in Boolean) is S : Win32_DWORD := Style; begin -- Add the VISIBLE style if the window is to be shown if Show then S := S or WS_VISIBLE; end if; -- Create the window using the supplied parameters Window.Handle := CreateWindowEx (XStyle, To_LPCSTR(Class), To_LPCSTR(Title), S, Win32_INT(Window.Left), Win32_INT(Window.Top), Win32_INT(Window.Width), Win32_INT(Window.Height), System.Null_Address, System.Null_Address, Get_hInstance, Window.all'Address); -- Store a pointer to the Window_Internals in the user data area -- so that the message loop can find it Long_Dummy := SendMessage (Window.Handle, WM_SETFONT, To_WPARAM(Window.Font),0); -- Show or hide the window as requested if Show then Bool_Dummy := ShowWindow (Window.Handle, SW_SHOWNORMAL); else Bool_Dummy := ShowWindow (Window.Handle, SW_HIDE); end if; -- Mark the window for repainting Bool_Dummy := UpdateWindow (Window.Handle); end Build_Window; ---------------------------------------------------------------------------- -- -- Build_Child: build a child window attached to the specified parent -- belonging to the specified class, using the specified -- title (caption text) as appropriate. Use the specified -- extended styles and normal styles, and set the window -- dimensions (relative to the parent's client area). -- procedure Build_Child (Window : in Window_Ptr; Parent : in Container_Ptr; Class : in Win32_String; Title : in Win32_String; XStyle : in Win32_DWORD; Style : in Win32_DWORD; Top : in Integer; Left : in Integer; Width : in Integer; Height : in Integer) is W : Window_Ptr := Window; H : Win32_HWND; S : Win32_DWORD := Style; begin -- The parent window's Group flag determines whether the WS_GROUP style -- should be applied to the child control in case it isn't already set. if Parent.Group then S := S or WS_GROUP; end if; -- All child windows except radiobuttons have WS_GROUP set anyway; the -- first radiobutton in a group also needs it set, so record if it was -- already set in the requested style to ensure that it will be applied -- to the next control regardless. Parent.Group := (Style and WS_GROUP) /= 0; -- Create the window using the supplied parameters Window.Handle := CreateWindowEx (XStyle, To_LPCSTR(Class), To_LPCSTR(Title), S or WS_CHILD or WS_VISIBLE, Win32_INT(Left), Win32_INT(Top), Win32_INT(Width), Win32_INT(Height), Parent.Handle, To_Handle(Window.Action), Get_hInstance, System.Null_Address); -- Store a pointer to the Window_Internals in the user data area -- so that the message loop can find it Long_Dummy := SetWindowLong (Window.Handle, GWL_USERDATA, To_LONG(Window)); -- Scan the parent chain until a font is found if there isn't one -- for this window (i.e. Parent_Font has been used) while W.Font = System.Null_Address and W.Parent /= null loop W := Window_Ptr(W.Parent); end loop; -- If a font was found, select it if W.Font /= System.Null_Address then Long_Dummy := SendMessage (Window.Handle, WM_SETFONT, To_WPARAM(W.Font),0); end if; -- If this is a tabstop control (i.e. the tab key will activate it), -- find the top-level parent and check if it's the first tabstop in -- the window. If it is, give it the keyboard focus. The WM_ACTIVATE -- message handler will track it once it's been set. Don't explicitly -- set the focus unless the control is visible. if (Style and WS_TABSTOP) /= 0 then while W.Parent /= null loop W := Window_Ptr(W.Parent); -- climb the parent chain end loop; if Main_Window_Ptr(W).Focus = System.Null_Address then -- At this point, we know that this is the first tabstop control -- to be attached to the top-level window W. Record the fact, and -- focus on this window if it's visible. Main_Window_Ptr(W).Focus := Window.Handle; if IsWindowVisible(W.Handle) /= 0 then H := SetFocus (Window.Handle); -- set focus if visible end if; end if; end if; end Build_Child; ---------------------------------------------------------------------------- -- -- M E S S A G E _ L O O P -- -- This task drives the Windows message loop, and starts as soon as the -- package body is elaborated. It uses a global variable Frames to keep -- track of the number of top-level windows to allow it to terminate if -- there are no top-level windows open. The repetition of entry handlers -- is required because we need a terminate alternative (which rules out -- having an else part) and we also need to handle Windows messages (which -- must be done by the task that creates the windows, i.e. this one) which -- can only be done by checking for messages in an else part. -- ---------------------------------------------------------------------------- Frames : Integer := 0; -- a global variable used by the message loop -- to record the number of top-level windows. task body Message_Loop is M : aliased Win32_MSG; H : Win32_HWND; begin loop -- The following select statement is executed when there are no -- top level windows. The alternatives are to create a window, -- destroy a window, show a common dialog or to terminate. The -- destroy alternative is needed because the main window cleanup -- operation will call it if the window handle is still valid -- when the internal window structure is being finalized. select accept Create_Window (Window : in Main_Window_Ptr; Class : in Win32_String; Title : in Win32_String; XStyle : in Win32_DWORD; Style : in Win32_DWORD; Show : in Boolean) do Build_Window (Window, Class, Title, XStyle, Style, Show); Frames := Frames + 1; end Create_Window; or accept Destroy_Window (Handle : in Win32_HWND) do Bool_Dummy := DestroyWindow (Handle); end Destroy_Window; or accept Show_Dialog (Dialog : in Common_Dialog_Ptr; Result : out Boolean) do Result := Show_Dialog(Dialog); end Show_Dialog; or terminate; end select; -- Once the first top-level window has been created, this inner loop -- will accept requests to create top-level or child windows, to show -- common dialogs or to destroy windows. When there are no pending -- requests it will look to see if there is a pending Windows message -- and process it if so. The loop ends when the last top-level window -- is destroyed, which then takes us back to the top of the outer loop -- to wait for a top-level window to be created or destroyed, or a -- termination request. while Frames > 0 loop select accept Create_Child (Window : in Window_Ptr; Parent : in Container_Ptr; Class : in Win32_String; Title : in Win32_String; XStyle : in Win32_DWORD; Style : in Win32_DWORD; Top : in Integer; Left : in Integer; Width : in Integer; Height : in Integer) do Build_Child (Window, Parent, Class, Title, XStyle, Style, Top, Left, Width, Height); end Create_Child; or accept Create_Window (Window : in Main_Window_Ptr; Class : in Win32_String; Title : in Win32_String; XStyle : in Win32_DWORD; Style : in Win32_DWORD; Show : in Boolean) do Build_Window (Window, Class, Title, XStyle, Style, Show); Frames := Frames + 1; end Create_Window; or accept Set_Focus (Window : in Win32_HWND) do Long_Dummy := To_LONG (SetFocus(Window)); end Set_Focus; or accept Destroy_Window (Handle : in Win32_HWND) do Bool_Dummy := DestroyWindow (Handle); end Destroy_Window; or accept Show_Dialog (Dialog : in Common_Dialog_Ptr; Result : out Boolean) do Result := Show_Dialog(Dialog); end Show_Dialog; else -- If nothing else appeals: there is at least one window in -- existence, so try to pump any pending Windows messages while PeekMessage(M'Unchecked_Access, System.Null_Address, 0, 0, PM_REMOVE) /= 0 loop -- A message is pending, so find the top-level parent of the -- window it's aimed at H := M.hwnd; while GetParent(H) /= System.Null_Address loop H := GetParent(H); end loop; -- Now dispatch it in the classic Windows fashion, using the -- top-level window handle to ensure that dialog messages -- (TAB and other navigation keys) are translated before -- any other processing if IsDialogMessage (H, M'Unchecked_Access) = 0 then Bool_Dummy := TranslateMessage(M'Unchecked_Access); Long_Dummy := DispatchMessage(M'Unchecked_Access); end if; end loop; end select; end loop; end loop; exception when E : others => -- task failure Window_Info.Record_Error (E); end Message_Loop; ---------------------------------------------------------------------------- -- -- C A L L B A C K F U N C T I O N S -- -- These functions are called from the Windows message handler callbacks. -- -- Enable (Window, Active): enable or disable the specified window -- Resize (Window, unused): recalculate the size of the specified window -- ---------------------------------------------------------------------------- function Enable (Window : Win32_HWND; Active : Win32_LPARAM) return Win32_BOOL; pragma Convention(StdCall, Enable); function Resize (Window : Win32_HWND; unused : Win32_LPARAM) return Win32_BOOL; pragma Convention(StdCall, Resize); ---------------------------------------------------------------------------- -- -- Enable Window to the opposite of its current state -- function Enable (Window : Win32_HWND; Active : Win32_LPARAM) return Win32_BOOL is begin if Window /= Window_Info.Active_Window then Bool_Dummy := EnableWindow (Window, Boolean'Pos(Active=0)); end if; return 1; -- continue with next window end Enable; ---------------------------------------------------------------------------- -- -- Resize Window if necessary by reference to the size of its parent. -- function Resize (Window : Win32_HWND; unused : Win32_LPARAM) return Win32_BOOL is P : Window_Ptr; T : Integer; L : Integer; W : Integer; H : Integer; B : Boolean; X : Win32_LONG := GetWindowLong(Window,GWL_USERDATA); begin -- Not all windows will have been created by this library, but all that -- haven't will have their user data (now in X) set to zero. if X /= 0 then -- X is really a Window_Ptr if we reach this point P := To_Window_Ptr(X); -- Copy the original (relative) coordinates T := P.Top; L := P.Left; W := P.Width; H := P.Height; -- Convert them to absolute (parent-based) coordinates Get_Actual_Bounds (GetParent(Window), T, L, W, H, B); -- B will have been set true if any of T/L/W/H are relative coordinates -- and T/L/W/H will have been set to absolute (parent-based) values, so -- resize the window if necessary if B then Bool_Dummy := SetWindowPos(Window, System.Null_Address, Win32_INT(L), Win32_INT(T), Win32_INT(W), Win32_INT(H), SWP_NOZORDER); end if; end if; return 1; -- continue with next window end Resize; ---------------------------------------------------------------------------- -- -- F R A M E _ P R O C -- -- The Windows message handler callback for Frame_Type windows. -- ---------------------------------------------------------------------------- function Frame_Proc (hwnd : Win32_HWND; msg : Win32_UINT; wParam : Win32_WPARAM; lParam : Win32_LPARAM) return Win32_LONG is L : Win32_LONG := GetWindowLong(hwnd,GWL_USERDATA); P : Main_Window_Ptr := Main_Window_Ptr(To_Window_Ptr(L)); H : Win32_HWND; N : Natural; begin case msg is -- Frame creation: a pointer to the Window_Internals is passed -- in the CREATESTRUCT pointed to by lParam, so save this for -- later use in the user data area of the Windows data structure -- (retrieved into P, above, which will be zero until initialised). when WM_CREATE => L := To_LONG(To_CREATESTRUCT(lParam).lpCreateParams); Long_Dummy := SetWindowLong (hwnd, GWL_USERDATA, L); -- Frame activation or deactivation: save or restore the focused -- control for the next activation when WM_ACTIVATE => if (wParam and 16#FFFF#) /= 0 then -- activation H := SetFocus (P.Focus); elsif GetFocus /= System.Null_Address then -- deactivation P.Focus := GetFocus; end if; return 0; -- don't do anything else -- Frame closing: issue the command for this frame when WM_CLOSE => Window_Info.Set_Command (P.Action + WM_USER); -- Frame being destroyed: decrement the frame count and clear the -- window handle when WM_DESTROY => Frames := Frames - 1; -- Frame resized: resize all the child windows which have relative -- sizes or positions when WM_SIZE => Bool_Dummy := EnumChildWindows (hwnd, Resize'Access, 0); -- An action has occurred (command code in low 16 bits of wParam); -- issue a command code if it's in the appropriate range, or ignore -- it if not when WM_COMMAND => N := Natural(wParam and 16#FFFF#); if N in WM_USER .. 16#7FFF# then Window_Info.Set_Command (N); return 0; -- don't do anything else end if; -- Ignore all other messages when others => null; end case; -- Perform the default action for any messages that don't return before -- this point return DefWindowProc(hwnd, msg, wParam, lParam); end Frame_Proc; ---------------------------------------------------------------------------- -- -- D I A L O G _ P R O C -- -- The Windows message handler callback for Dialog_Type windows. -- ---------------------------------------------------------------------------- function Dialog_Proc (hwnd : Win32_HWND; msg : Win32_UINT; wParam : Win32_WPARAM; lParam : Win32_LPARAM) return Win32_LONG is P : Window_Ptr := To_Window_Ptr(GetWindowLong(hwnd,GWL_USERDATA)); H : Win32_HWND; begin case msg is -- Dialog deactivation: don't do anything more so that the current -- focused control isn't saved, and so the first control will get -- the focus the next time the dialog is activated when WM_ACTIVATE => if (wParam and 16#FFFF#) = 0 then return 0; -- don't do anything else end if; -- Dialog being shown/hidden: disable/enable all the other windows -- for this thread (i.e. this application), and set a new active -- window if the dialog is being hidden when WM_SHOWWINDOW => Bool_Dummy := EnumThreadWindows (GetCurrentThreadID, Enable'Access, Win32_LONG(wParam)); if wParam = 0 then H := SetActiveWindow(GetWindow(P.Handle,GW_HWNDNEXT)); end if; -- Dialog closing: don't close, just hide when WM_CLOSE => Bool_Dummy := ShowWindow (hwnd, SW_HIDE); Window_Info.Set_Command (P.Action + WM_USER); return 0; -- don't do anything else -- Ignore all other messages when others => null; end case; -- If nothing else has happened yet, treat this the same way as a -- Frame_Type top-level window return Frame_Proc(hwnd, msg, wParam, lParam); end Dialog_Proc; ---------------------------------------------------------------------------- -- -- C A N V A S _ P R O C -- -- The Windows message handler callback for Canvas_Type windows. -- ---------------------------------------------------------------------------- function Canvas_Proc (hwnd : Win32_HWND; msg : Win32_UINT; wParam : Win32_WPARAM; lParam : Win32_LPARAM) return Win32_LONG is C : Canvas_Ptr := Canvas_Ptr(To_Window_Ptr(GetWindowLong(hwnd,GWL_USERDATA))); H : Win32_HWND; M : Win32_POINTS; begin case msg is -- Canvas background being erased: get the client area rectangle and -- fill it with the chosen background colour (from the canvas monitor) when WM_ERASEBKGND => declare R : aliased Win32_RECT; I : Win32_INT; begin Bool_Dummy := GetClientRect(hwnd,R'Unchecked_Access); I := FillRect (To_HDC(wParam), R'Unchecked_Access, C.Monitor.Background); end; return 1; -- result of this message must be 1, not 0 -- Canvas being painted: ask the monitor to draw all the objects in the -- drawing list when WM_PAINT => C.Monitor.Draw (hwnd, C.Font); -- Mouse button down (ignored if this canvas does not generate a -- command): capture the mouse and ask the canvas monitor to record -- the mouse position and button state, then issue the command when WM_LBUTTONDOWN => if C.Action >= 0 then H := SetCapture(hwnd); M := MakePoint (lParam); C.Monitor.Set_Start (Integer(M.X), Integer(M.Y)); C.Monitor.Set_Button (True); Window_Info.Set_Command (C.Action + WM_USER); return 0; -- don't do anything else end if; -- Mouse button up (ignored if this canvas does not generate a -- a command): release the mouse and ask the canvas monitor to -- record the current position and button state when WM_LBUTTONUP => if C.Action >= 0 then Bool_Dummy := ReleaseCapture; M := MakePoint (lParam); C.Monitor.Set_End (Integer(M.X), Integer(M.Y)); C.Monitor.Set_Button (False); return 0; -- don't do anything else end if; -- Mouse has moved (ignored if this canvas does not generate -- a command or the mouse button isn't down): ask the canvas -- monitor to record the current mouse position when WM_MOUSEMOVE => if C.Action >= 0 and C.Monitor.Mouse_Down then M := MakePoint (lParam); C.Monitor.Set_End (Integer(M.X), Integer(M.Y)); return 0; -- don't do anything else end if; -- Key pressed (ignored if this canvas does not generate a keypress -- command): capture the mouse and ask the canvas monitor to record -- the mouse position and button state, then issue the command when WM_CHAR => if C.Keypress >= 0 then C.Monitor.Set_Key (Character'Val(wParam and 16#FF#)); Window_Info.Set_Command (C.Keypress + WM_USER); return 0; -- don't do anything else end if; -- Because messages are processed by IsDialogMessage, WM_CHAR messages -- won't be seen unless they are asked for in response to WM_GETDLCODE when WM_GETDLGCODE => return DLGC_WANTMESSAGE; -- request WM_CHAR for all keyboard input -- Ignore all other messages when others => null; end case; -- Perform the default action for any messages that don't return before -- this point return DefWindowProc(hwnd, msg, wParam, lParam); end Canvas_Proc; ---------------------------------------------------------------------------- -- -- P A N E L _ P R O C -- -- The Windows message handler callback for Panel_Type windows. Command -- messages are sent to the parent window, all others are processed in -- the normal way. -- ---------------------------------------------------------------------------- function Panel_Proc (hwnd : Win32_HWND; msg : Win32_UINT; wParam : Win32_WPARAM; lParam : Win32_LPARAM) return Win32_LONG is W : Window_Ptr := To_Window_Ptr(GetWindowLong(hwnd,GWL_USERDATA)); begin case msg is when WM_COMMAND => Long_Dummy := SendMessage (GetParent(hwnd), msg, wParam, lParam); when others => null; end case; return CallWindowProc (W.WndProc, hwnd, msg, wParam, lParam); end Panel_Proc; ---------------------------------------------------------------------------- -- -- M E M O _ P R O C -- -- The Windows message handler callback for Memo_Type windows. Tab keys -- cause a tab to be inserted, all other messages are processed in the -- normal way. -- ---------------------------------------------------------------------------- function Memo_Proc (hwnd : Win32_HWND; msg : Win32_UINT; wParam : Win32_WPARAM; lParam : Win32_LPARAM) return Win32_LONG is W : Window_Ptr := To_Window_Ptr(GetWindowLong(hwnd,GWL_USERDATA)); S : aliased Win32_String := To_Array (ASCII.HT & ASCII.NUL); begin case msg is when WM_KEYDOWN => if wParam = Character'Pos(ASCII.HT) then Long_Dummy := SendMessage (hwnd, EM_REPLACESEL, 1, To_LPARAM(S)); end if; when others => null; end case; return CallWindowProc (W.WndProc, hwnd, msg, wParam, lParam); end Memo_Proc; end JEWL.Message_Handling;