{**********************************************************************
 *                                                                    *
 *    Seth Battis                 *
 *    Introduction to Computer Programming (Pascal)                   *
 *  Baylor School, Chattanooga, TN                                    *
 *                                                                    *
 *        Part of a Pascal library of units for accessing the Windows *
 *        API. This unit contains types and subroutines related to    *
 *        processing events (mouse clicks, keystrokes, etc.)          *
 *                                                                    *
 *    Version: 0.9d5                                                  *
 *                                                                    *
 **********************************************************************}    unit events;    interface        uses environment;        type
        {a Pascal type to hold an event message}
        event = record
                message: MSG;
            end;        function GetNextEvent (const myWindow: window): event;
    {returns the next event in myWindow's event queue}        procedure DispatchEvent (const myEvent: event);
    {dispatches myEvent to the API for default processing. for
     consistency's sake, this should be done with _every_ event, so that
     the application reacts in a predictable, windows-style manner,
     handled by the API}        function IsTimer (const myEvent: event; var timerID: integer): boolean;
    {returns true if myEvent was a timer, false otherwise. if returning
     true, timerID is set to the value of the ID of the timer marked by
     the event}        function IsClick (const myEvent: event; var x, y: integer): boolean;
    {returns true if myEvent was a click, false otherwise. if returning
     true, x and y are set to the x and y coordinates of the click in the
     window in which the event was originally queued}        function IsKeystroke (const myEvent: event; var c: char): boolean;
    {returns true if myEvent was a keystroke, false otherwise. if
     returning true, c is set to the character equivalent to the
     keystroke}        function IsVirtualKeystroke (const myEvent: event;
                                var c: integer): boolean;
    {returns true if myEvent was a so-called "virtual" keystroke, false
     otherwise. A so-called "virtual" keystroke is the result of pressing
     any key on the keyboard, and is processed before a regular keystroke is
     normally received. This allows for the acquisition of system
     characters such as Home, Delete, or the arrow keys, to name but a few.
     Unfortunately, these characters are acquired as numerical codes,
     rather than characters, requiring some processing. The integer variable
     passed as c will be set to the code equivalent to the virtual
     keystroke.}        function IsClose (const myEvent: event): boolean;
    {returns true if myEvent was a close event, false otherwise}        procedure WaitForClose (const myWindow: window);
    {wait for the user to close the window}        function WaitForKeystroke (const myWindow: window): char;
    {wait for the next keystroke and return it as a char}        function WaitForVirtualKeystroke (const myWindow: window): integer;
    {wait for the next virtual keystroke and return it as a code}        procedure WaitForClick (const myWindow: window; var x, y: integer);
    {wait for the next click in the window and update x and y to that
     click's position}        procedure Pause (const myWindow: window; timeToPause: integer);
    {pauses all processes for timeToPause milliseconds}        procedure StartTimer (const myWindow: window;
                          timerID, timeToPause: integer);
    {start a timer with timerID, waiting timeToPause milliseconds. timerID
     must be a positive number for the timer to be started, as negative
     timerID's are reserved for internal procedures to this library}        function EventToString (const myEvent: event): string;
    {for debugging purposes, convert an event to a string}    implementation        const
        {all user defined timer ID's must be positive, thus all events
         unit-defined timer ID's should be negative, for safety's sake}
        PAUSE_PROCEDURE = -1;        function GetNextEvent;
    {returns the next event in myWindow's event queue}
    var
        myEvent: event;
    begin
        with myEvent do
            SetEnvironmentResult (GetMessage(@message, myWindow.handle,
                                             0, 0)
                                  and
                                  TranslateMessage (@message));            GetNextEvent := myEvent;
    end;        procedure DispatchEvent;
    {dispatches myEvent to the API for default processing. for
     consistency's sake, this should be done with _every_ event, so that
     the application reacts in a predictable, windows-style manner,
     handled by the API}
    begin
        with myEvent do
            SetEnvironmentResult (DispatchMessage (@message));
    end;        function IsTimer;
    {returns true if myEvent was a timer, false otherwise. if returning
     true, timerID is set to the value of the ID of the timer marked by
     the event}
    begin
        if (myEvent.message.message = WM_TIMER) then
        begin
            timerID := myEvent.message._wParam;
            IsTimer := true;
        end
        else
            IsTimer := false;
    end;        function IsClick;
    {returns true if myEvent was a click, false otherwise. if returning
     true, x and y are set to the x and y coordinates of the click in the
     window in which the event was originally queued}
    begin
        if (myEvent.message.message = WM_LBUTTONDOWN) then
        begin
            x := LOWORD (myEvent.message._lParam);
            y := HIWORD (myEvent.message._lParam);
            IsClick := true;
        end
        else
            IsClick := false;
    end;        function IsKeystroke;
    {returns true if myEvent was a keystroke, false otherwise. if
     returning true, c is set to the character equivalent to the
     keystroke}
    begin
        if (myEvent.message.message = WM_CHAR) then
        begin
            c := chr (myEvent.message._wParam);
            IsKeystroke := true;
        end
        else
            IsKeystroke := false;
    end;        function IsVirtualKeystroke;
    {returns true if myEvent was a so-called "virtual" keystroke, false
     otherwise. A so-called "virtual" keystroke is the result of pressing
     any key on the keyboard, and is processed before a regular keystroke is
     normally received. This allows for the acquisition of system
     characters such as Home, Delete, or the arrow keys, to name but a few.
     Unfortunately, these characters are acquired as numerical codes,
     rather than characters, requiring some processing. The integer variable
     passed as c will be set to the code equivalent to the virtual
     keystroke. Some self evident virtual keycodes are as follows:
         VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_HOME, VK_END, VK_PAGEUP}
    begin
        if (myEvent.message.message = WM_KEYDOWN) then
        begin
            c := myEvent.message._wParam;
            IsVirtualKeystroke := true;
        end
        else
            IsVirtualKeystroke := false;
    end;        function IsClose;
    {returns true if myEvent was a close event, false otherwise}
    begin
        {NOTE: This is a hack. The app will continue running in the
            background if this procedure is not run to close the window in
            question. As yet, the actual results of GetMessage and the
            Win32 SDK documentation do not match. Punks.}
        IsClose := (myEvent.message.message = WM_NCLBUTTONDOWN) and
                   (myEvent.message._wParam = HTCLOSE);
    end;        procedure WaitForClose;
    {wait for the user to close the window}
    var
        myEvent: event;
    begin
        repeat
            myEvent := GetNextEvent (myWindow);
            DispatchEvent (myEvent);
        until IsClose (myEvent);
    end;        function WaitForKeystroke: char;
    {wait for the next keystroke and return it as a char}
    var
        myEvent: event;
        c: char;
    begin
        {wait for user to press a key}
        repeat
            myEvent := GetNextEvent (myWindow);
            DispatchEvent (myEvent);
        until IsKeystroke (myEvent, c);            {return keystroke as a char}
        WaitForKeystroke := c;
    end;        function WaitForVirtualKeystroke: integer;
    {wait for the next virtual keystroke and return it as a code}
    var
        myEvent: event;
        c: integer;
    begin
        {wait for user to press a key}
        repeat
            myEvent := GetNextEvent (myWindow);
            DispatchEvent (myEvent);
        until IsVirtualKeystroke (myEvent, c);            {return keystroke code as an integer}
        WaitForVirtualKeystroke := c;
    end;        procedure WaitForClick;
    {wait for the next click in the window and update x and y to that
     click's position}
    var
        myEvent: event;
    begin
        {wait for user to click}
        repeat
            myEvent := GetNextEvent (myWindow);
            DispatchEvent (myEvent);
        until IsClick (myEvent, x, y);
    end;        procedure Pause;
    {pauses all processes for timeToPause milliseconds}
    var
        myEvent: event;
        timerID: integer;
    begin
        SetEnvironmentResult (SetTimer (myWindow.handle,
                                        PAUSE_PROCEDURE,
                                        timeToPause,
                                        nil));            repeat
            myEvent := GetNextEvent (myWindow);
            DispatchEvent (myEvent);
        until IsTimer (myEvent, timerID) and (timerID = PAUSE_PROCEDURE);
    end;        procedure StartTimer;
    {start a timer with timerID, waiting timeToPause milliseconds. timerID
     must be a positive number for the timer to be started, as negative
     timerID's are reserved for internal procedures to this library}
    begin
        if (timerID >= 0) then
            SetEnvironmentResult (SetTimer (myWindow.handle,
                                            timerID,
                                            timeToPause,
                                            nil));
    end;        function EventToString;
    {for debugging purposes, convert an event to a string}
    begin
        case myEvent.message.message of
            WM_ACTIVATE: EventToString := 'WM_ACTIVATE';
            WM_ACTIVATEAPP: EventToString := 'WM_ACTIVATEAPP';
            WM_AFXFIRST: EventToString := 'WM_AFXFIRST';
            WM_AFXLAST: EventToString := 'WM_AFXLAST';
            WM_APP: EventToString := 'WM_APP';
            WM_ASKCBFORMATNAME: EventToString := 'WM_ASKCBFORMATNAME';
            WM_CANCELJOURNAL: EventToString := 'WM_CANCELJOURNAL';
            WM_CANCELMODE: EventToString := 'WM_CANCELMODE';
            WM_CAPTURECHANGED: EventToString := 'WM_CAPTURECHANGED';
            WM_CHANGECBCHAIN: EventToString := 'WM_CHANGECBCHAIN';
            WM_CHAR: EventToString := 'WM_CHAR';
            WM_CHARTOITEM: EventToString := 'WM_CHARTOITEM';
            WM_CHILDACTIVATE: EventToString := 'WM_CHILDACTIVATE';
            WM_USER: EventToString := 'WM_USER';
            WM_CLEAR: EventToString := 'WM_CLEAR';
            WM_COMMAND: EventToString := 'WM_COMMAND';
            WM_COMMNOTIFY: EventToString := 'WM_COMMNOTIFY';
            WM_COMPACTING: EventToString := 'WM_COMPACTING';
            WM_COMPAREITEM: EventToString := 'WM_COMPAREITEM';
            WM_CONTEXTMENU: EventToString := 'WM_CONTEXTMENU';
            WM_COPY: EventToString := 'WM_COPY';
            WM_COPYDATA: EventToString := 'WM_COPYDATA';
            WM_CREATE: EventToString := 'WM_CREATE';
            WM_CTLCOLORBTN: EventToString := 'WM_CTLCOLORBTN';
            WM_CTLCOLORDLG: EventToString := 'WM_CTLCOLORDLG';
            WM_CTLCOLOREDIT: EventToString := 'WM_CTLCOLOREDIT';
            WM_CTLCOLORLISTBOX: EventToString := 'WM_CTLCOLORLISTBOX';
            WM_CTLCOLORMSGBOX: EventToString := 'WM_CTLCOLORMSGBOX';
            WM_CTLCOLORSCROLLBAR: EventToString := 'WM_CTLCOLORSCROLLBAR';
            WM_CTLCOLORSTATIC: EventToString := 'WM_CTLCOLORSTATIC';
            WM_CUT: EventToString := 'WM_CUT';
            WM_DEADCHAR: EventToString := 'WM_DEADCHAR';
            WM_DELETEITEM: EventToString := 'WM_DELETEITEM';
            WM_DESTROY: EventToString := 'WM_DESTROY';
            WM_DESTROYCLIPBOARD: EventToString := 'WM_DESTROYCLIPBOARD';
            WM_DEVICECHANGE: EventToString := 'WM_DEVICECHANGE';
            WM_DEVMODECHANGE: EventToString := 'WM_DEVMODECHANGE';
            WM_DISPLAYCHANGE: EventToString := 'WM_DISPLAYCHANGE';
            WM_DRAWCLIPBOARD: EventToString := 'WM_DRAWCLIPBOARD';
            WM_DRAWITEM: EventToString := 'WM_DRAWITEM';
            WM_DROPFILES: EventToString := 'WM_DROPFILES';
            WM_ENDSESSION: EventToString := 'WM_ENDSESSION';
            WM_ENTERIDLE: EventToString := 'WM_ENTERIDLE';
            WM_ENTERMENULOOP: EventToString := 'WM_ENTERMENULOOP';
            WM_ENTERSIZEMOVE: EventToString := 'WM_ENTERSIZEMOVE';
            WM_ERASEBKGND: EventToString := 'WM_ERASEBKGND';
            WM_EXITMENULOOP: EventToString := 'WM_EXITMENULOOP';
            WM_EXITSIZEMOVE: EventToString := 'WM_EXITSIZEMOVE';
            WM_FONTCHANGE: EventToString := 'WM_FONTCHANGE';
            WM_GETDLGCODE: EventToString := 'WM_GETDLGCODE';
            WM_GETFONT: EventToString := 'WM_GETFONT';
            WM_GETHOTKEY: EventToString := 'WM_GETHOTKEY';
            WM_GETICON: EventToString := 'WM_GETICON';
            WM_GETMINMAXINFO: EventToString := 'WM_GETMINMAXINFO';
            WM_GETTEXT: EventToString := 'WM_GETTEXT';
            WM_GETTEXTLENGTH: EventToString := 'WM_GETTEXTLENGTH';
            WM_HANDHELDFIRST: EventToString := 'WM_HANDHELDFIRST';
            WM_HANDHELDLAST: EventToString := 'WM_HANDHELDLAST';
            WM_HOTKEY: EventToString := 'WM_HOTKEY';
            WM_HSCROLL: EventToString := 'WM_HSCROLL';
            WM_HSCROLLCLIPBOARD: EventToString := 'WM_HSCROLLCLIPBOARD';
            WM_ICONERASEBKGND: EventToString := 'WM_ICONERASEBKGND';
            WM_INITDIALOG: EventToString := 'WM_INITDIALOG';
            WM_INITMENU: EventToString := 'WM_INITMENU';
            WM_INITMENUPOPUP: EventToString := 'WM_INITMENUPOPUP';
            WM_INPUTLANGCHANGE: EventToString := 'WM_INPUTLANGCHANGE';
            WM_KEYDOWN: EventToString := 'WM_KEYDOWN';
            WM_KEYUP: EventToString := 'WM_KEYUP';
            WM_KILLFOCUS: EventToString := 'WM_KILLFOCUS';
            WM_LBUTTONDBLCLK: EventToString := 'WM_LBUTTONDBLCLK';
            WM_LBUTTONDOWN: EventToString := 'WM_LBUTTONDOWN';
            WM_LBUTTONUP: EventToString := 'WM_LBUTTONUP';
            WM_MBUTTONDBLCLK: EventToString := 'WM_MBUTTONDBLCLK';
            WM_MBUTTONDOWN: EventToString := 'WM_MBUTTONDOWN';
            WM_MBUTTONUP: EventToString := 'WM_MBUTTONUP';
            WM_MDIACTIVATE: EventToString := 'WM_MDIACTIVATE';
            WM_MDICASCADE: EventToString := 'WM_MDICASCADE';
            WM_MDICREATE: EventToString := 'WM_MDICREATE';
            WM_MDIGETACTIVE: EventToString := 'WM_MDIGETACTIVE';
            WM_MDIICONARRANGE: EventToString := 'WM_MDIICONARRANGE';
            WM_MDIMAXIMIZE: EventToString := 'WM_MDIMAXIMIZE';
            WM_MDINEXT: EventToString := 'WM_MDINEXT';
            WM_MDIRESTORE: EventToString := 'WM_MDIRESTORE';
            WM_MDISETMENU: EventToString := 'WM_MDISETMENU';
            WM_MEASUREITEM: EventToString := 'WM_MEASUREITEM';
            WM_MENUCHAR: EventToString := 'WM_MENUCHAR';
            WM_MENUSELECT: EventToString := 'WM_MENUSELECT';
            WM_MOUSEACTIVATE: EventToString := 'WM_MOUSEACTIVATE';
            WM_MOUSEMOVE: EventToString := 'WM_MOUSEMOVE';
            WM_MOVE: EventToString := 'WM_MOVE';
            WM_NCACTIVATE: EventToString := 'WM_NCACTIVATE';
            WM_NCCALCSIZE: EventToString := 'WM_NCCALCSIZE';
            WM_NCCREATE: EventToString := 'WM_NCCREATE';
            WM_NCDESTROY: EventToString := 'WM_NCDESTROY';
            WM_NCHITTEST: EventToString := 'WM_NCHITTEST';
            WM_NCLBUTTONDBLCLK: EventToString := 'WM_NCLBUTTONDBLCLK';
            WM_NCLBUTTONDOWN: EventToString := 'WM_NCLBUTTONDOWN';
            WM_NCLBUTTONUP: EventToString := 'WM_NCLBUTTONUP';
            WM_NCMBUTTONDBLCLK: EventToString := 'WM_NCMBUTTONDBLCLK';
            WM_NCMBUTTONDOWN: EventToString := 'WM_NCMBUTTONDOWN';
            WM_NCMBUTTONUP: EventToString := 'WM_NCMBUTTONUP';
            WM_NCMOUSEMOVE: EventToString := 'WM_NCMOUSEMOVE';
            WM_NCPAINT: EventToString := 'WM_NCPAINT';
            WM_NCRBUTTONDBLCLK: EventToString := 'WM_NCRBUTTONDBLCLK';
            WM_NCRBUTTONDOWN: EventToString := 'WM_NCRBUTTONDOWN';
            WM_NCRBUTTONUP: EventToString := 'WM_NCRBUTTONUP';
            WM_NEXTDLGCTL: EventToString := 'WM_NEXTDLGCTL';
            WM_NEXTMENU: EventToString := 'WM_NEXTMENU';
            WM_NOTIFY: EventToString := 'WM_NOTIFY';
            WM_NULL: EventToString := 'WM_NULL';
            WM_PAINT: EventToString := 'WM_PAINT';
            WM_PAINTCLIPBOARD: EventToString := 'WM_PAINTCLIPBOARD';
            WM_PAINTICON: EventToString := 'WM_PAINTICON';
            WM_PALETTECHANGED: EventToString := 'WM_PALETTECHANGED';
            WM_PALETTEISCHANGING: EventToString := 'WM_PALETTEISCHANGING';
            WM_PASTE: EventToString := 'WM_PASTE';
            WM_PENWINFIRST: EventToString := 'WM_PENWINFIRST';
            WM_PENWINLAST: EventToString := 'WM_PENWINLAST';
            WM_POWER: EventToString := 'WM_POWER';
            WM_POWERBROADCAST: EventToString := 'WM_POWERBROADCAST';
            WM_PRINT: EventToString := 'WM_PRINT';
            WM_PRINTCLIENT: EventToString := 'WM_PRINTCLIENT';
            WM_QUERYDRAGICON: EventToString := 'WM_QUERYDRAGICON';
            WM_QUERYENDSESSION: EventToString := 'WM_QUERYENDSESSION';
            WM_QUERYNEWPALETTE: EventToString := 'WM_QUERYNEWPALETTE';
            WM_QUERYOPEN: EventToString := 'WM_QUERYOPEN';
            WM_QUEUESYNC: EventToString := 'WM_QUEUESYNC';
            WM_QUIT: EventToString := 'WM_QUIT';
            WM_RBUTTONDBLCLK: EventToString := 'WM_RBUTTONDBLCLK';
            WM_RBUTTONDOWN: EventToString := 'WM_RBUTTONDOWN';
            WM_RBUTTONUP: EventToString := 'WM_RBUTTONUP';
            WM_RENDERALLFORMATS: EventToString := 'WM_RENDERALLFORMATS';
            WM_RENDERFORMAT: EventToString := 'WM_RENDERFORMAT';
            WM_SETCURSOR: EventToString := 'WM_SETCURSOR';
            WM_SETFOCUS: EventToString := 'WM_SETFOCUS';
            WM_SETFONT: EventToString := 'WM_SETFONT';
            WM_SETHOTKEY: EventToString := 'WM_SETHOTKEY';
            WM_SETICON: EventToString := 'WM_SETICON';
            WM_SETREDRAW: EventToString := 'WM_SETREDRAW';
            WM_SETTEXT: EventToString := 'WM_SETTEXT';
            WM_SETTINGCHANGE: EventToString := 'WM_SETTINGCHANGE';
            WM_SHOWWINDOW: EventToString := 'WM_SHOWWINDOW';
            WM_SIZE: EventToString := 'WM_SIZE';
            WM_SPOOLERSTATUS: EventToString := 'WM_SPOOLERSTATUS';
            WM_STYLECHANGING: EventToString := 'WM_STYLECHANGING';
            WM_SYSCHAR: EventToString := 'WM_SYSCHAR';
            WM_SYSCOLORCHANGE: EventToString := 'WM_SYSCOLORCHANGE';
            WM_SYSCOMMAND: EventToString := 'WM_SYSCOMMAND';
            WM_SYSDEADCHAR: EventToString := 'WM_SYSDEADCHAR';
            WM_SYSKEYDOWN: EventToString := 'WM_SYSKEYDOWN';
            WM_SYSKEYUP: EventToString := 'WM_SYSKEYUP';
            WM_TCARD: EventToString := 'WM_TCARD';
            WM_TIMECHANGE: EventToString := 'WM_TIMECHANGE';
            WM_TIMER: EventToString := 'WM_TIMER';
            WM_UNDO: EventToString := 'WM_UNDO';
            WM_USERCHANGED: EventToString := 'WM_USERCHANGED';
            WM_VKEYTOITEM: EventToString := 'WM_VKEYTOITEM';
            WM_VSCROLL: EventToString := 'WM_VSCROLL';
            WM_VSCROLLCLIPBOARD: EventToString := 'WM_VSCROLLCLIPBOARD';
            WM_WINDOWPOSCHANGED: EventToString := 'WM_WINDOWPOSCHANGED';
            WM_WINDOWPOSCHANGING: EventToString := 'WM_WINDOWPOSCHANGING';
            otherwise EventToString := 'Unknown'
        end; {case}
    end; {EventToString}    end. {unit}