/*
    ###########################################################################
    # helper routines
    #
    # $Id: GUI_Helpers.cpp,v 1.28 2011/07/16 14:51:03 acalpini Exp $
    #
    ###########################################################################
        */
#include "GUI.h"
/*
 * Create callback control table
 * Warning : Use some order than WIN32__GUI__* constant value
 */
#define CREATE_CONTROL_TABLE(n,T) \
 T = { \
    Window##n,      \
    DialogBox##n,   \
    Label##n,       \
    Button##n,      \
    Textfield##n,   \
    Listbox##n,     \
    Combobox##n,    \
    Checkbox##n,    \
    RadioButton##n, \
    Groupbox##n,    \
    Toolbar##n,     \
    ProgressBar##n, \
    StatusBar##n,   \
    TabStrip##n,    \
    RichEdit##n,    \
    ListView##n,    \
    TreeView##n,    \
    Trackbar##n,    \
    UpDown##n,      \
    Tooltip##n,     \
    Animation##n,   \
    Rebar##n,       \
    Header##n,      \
    ComboboxEx##n,  \
    DateTime##n,    \
    Graphic##n,     \
    Splitter##n,    \
    MDIFrame##n,    \
    MDIClient##n,   \
    MDIChild##n,    \
    MonthCal##n     \
    };
/*
 * Create callback table (Probably nicer to turn into plugin API)
 */
CREATE_CONTROL_TABLE(_onPreCreate,   void (*OnPreCreate[])(NOTXSPROC LPPERLWIN32GUI_CREATESTRUCT));
CREATE_CONTROL_TABLE(_onParseOption, BOOL (*OnParseOption[])(NOTXSPROC char *, SV*,LPPERLWIN32GUI_CREATESTRUCT));
CREATE_CONTROL_TABLE(_onPostCreate,  void (*OnPostCreate[])(NOTXSPROC HWND, LPPERLWIN32GUI_CREATESTRUCT));
CREATE_CONTROL_TABLE(_onParseEvent,  BOOL (*OnParseEvent[])(NOTXSPROC char*, int*));
CREATE_CONTROL_TABLE(_onEvent,       int  (*OnEvent[])(NOTXSPROC LPPERLWIN32GUI_USERDATA, UINT, WPARAM , LPARAM));
/*
 * Free perlud structure
 */
void Perlud_Free(NOTXSPROC LPPERLWIN32GUI_USERDATA perlud) {
    // Check perlpud
    if (perlud != NULL) {
        HWND hwnd_self = SvOK(perlud->svSelf) ? handle_From(NOTXSCALL perlud->svSelf) : NULL;
        // Free event hash
        if (perlud->hvEvents != NULL) {
            // Test ref-count - warn if not one
            if(SvREFCNT(perlud->hvEvents) != 1)
                W32G_WARN("hvEvents ref count not 1 during destruction - please report this");
            SvREFCNT_dec(perlud->hvEvents);
            perlud->hvEvents = NULL;
        }
        // Free hook hash
        if (perlud->avHooks != NULL) {
            // Test ref-count - warn if not one
            if(SvREFCNT(perlud->avHooks) != 1)
                W32G_WARN("avHooks ref count not 1 during destruction - please report this");
            SvREFCNT_dec(perlud->avHooks);
            perlud->avHooks = NULL;
        }
        // Free self
        if (perlud->svSelf != NULL && SvREFCNT(perlud->svSelf) > 0) {
            /* Free into parent */
            if(SvOK(perlud->svSelf)) {
                HWND parent = GetParent(hwnd_self);
                if (parent != NULL && *perlud->szWindowName != '\0')  {
                    SV* SvParent = SV_SELF_FROM_WINDOW(parent);
                    if (SvParent != NULL && SvROK(SvParent)) {
                        /* During global destruction it is possible that the
                         * underlying object supporting our tied hash is
                         * destroyed before the object itself, this results in
                         * fatal errors "(during cleanup) Can't call method
                         * "DELETE" on an undefined value" - so we check that
                         * the tied magic is still there before we try to
                         * delete from the parent
                         */
                        MAGIC* mg;
                        if ( (mg = mg_find(SvRV(SvParent), PERL_MAGIC_tied)) && SvROK(mg->mg_obj) ) {
                            hv_delete((HV*) SvRV(SvParent), perlud->szWindowName,
                                        strlen(perlud->szWindowName), G_DISCARD);
                        }
                    }
                }
            }
            SvREFCNT_dec(perlud->svSelf);
            perlud->svSelf = NULL;
        }
        // If we stored a hash in userData, drop it's
        // ref count to free it (and it's members)
        if (perlud->userData != NULL) {
            // Test ref-count - warn if not one
            if(SvREFCNT(perlud->userData) != 1)
                W32G_WARN("userData ref count not 1 during destruction - please report this");
            SvREFCNT_dec(perlud->userData);
            perlud->userData = NULL;
        }
        // If we stored a brush, destroy it
        if (perlud->bDeleteBackgroundBrush && perlud->hBackgroundBrush != NULL) {
                DeleteObject((HGDIOBJ) perlud->hBackgroundBrush);
        }
        // If we stored an original wndproc, then restore it so that
        // WM_NCDESTORY messages get there.
        if (hwnd_self && perlud->WndProc) {
            SetWindowLongPtr(hwnd_self, GWLP_WNDPROC, (LONG_PTR)(perlud->WndProc));
        }
         
        // Free perlpud
        safefree (perlud);
    }
}
SV *
SV_SELF_FROM_WINDOW(HWND hwnd) {
    LPPERLWIN32GUI_USERDATA perlud;
    perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLongPtr(hwnd, GWLP_USERDATA);
    if( ValidUserData(perlud) ) {
        return perlud->svSelf;
    } else {
        return NULL;
    }
}
static void
hv_magic_check (NOTXSPROC HV *hv, bool *needs_copy, bool *needs_store)
{
    MAGIC *mg = SvMAGIC(hv);
    *needs_copy = FALSE;
    *needs_store = TRUE;
    while (mg) {
        if (isUPPER(mg->mg_type)) {
            *needs_copy = TRUE;
            switch (mg->mg_type) {
            case 'P':
            case 'S':
                *needs_store = FALSE;
            }
        }
#ifdef PERLWIN32GUI_STRONGDEBUG
    printf("!XS(hv_magic_check) magic='%c' needs_store='%d'\n", mg->mg_type, *needs_store);
#endif
        mg = mg->mg_moremagic;
    }
}
SV**
hv_fetch_mg(NOTXSPROC HV *hv, char *key, U32 klen, I32 lval) {
        SV** tempsv;
        tempsv = hv_fetch(hv, key, klen, lval);
        if(SvMAGICAL(hv)) mg_get(*tempsv);
        return tempsv;
}
SV**
hv_store_mg(NOTXSPROC HV *hv, char *key, U32 klen, SV* val, U32 hash) {
        SV** tempsv;
        tempsv = hv_store(hv, key, klen, val, hash);
        if(SvMAGICAL(hv)) mg_set(val);
        return tempsv;
}
    /*
     ##########################################################################
     # (@)INTERNAL:handle_From(SV*)
     # gets the handle from either the blessed object
     # or the SV passed
     */
HWND handle_From(NOTXSPROC SV *pSv) {
    HWND hReturn = 0;
     //printf("handle_From %p \n",pSv);
    if(NULL != pSv)  {
        if( SvROK(pSv)) {
            SV **pHv;
            //sv_dump(SvRV(pSv));
            pHv = hv_fetch_mg(NOTXSCALL (HV*) SvRV(pSv), "-handle", 7, 0);
            if(pHv != NULL) {
                hReturn = INT2PTR(HWND,SvIV(*pHv));
                //printf("hReturn(1) is %i \n",hReturn);
            }
        } else {
            hReturn = INT2PTR(HWND,SvIV(pSv));
            //printf("hReturn(2) is %i \n",hReturn);
        }
    }
    return(hReturn);
}
    /*
     ##########################################################################
     # (@)INTERNAL:classname_From(SV*)
     # gets the window class name from either the blessed object
     # or the SV passed
     */
char *classname_From(NOTXSPROC SV *pSv) {
    char *pszName = NULL;
    if(NULL != pSv) {
        if(SvROK(pSv)) {
            SV **pHv;
            pHv = hv_fetch_mg(NOTXSCALL (HV*) SvRV(pSv), "-name", 5, 0);
            if(pHv != NULL) {
                pszName = SvPV_nolen(*pHv);
            }
        } else {
            pszName = SvPV_nolen(pSv);
        }
    }
    return(pszName);
}
    /*
     ##########################################################################
     # (@)INTERNAL:GetDefClassProc( *name)
     */
WNDPROC GetDefClassProc (NOTXSPROC const char *Name) {
    HV* hash;
    SV** wndproc;
    hash = perl_get_hv("Win32::GUI::DefClassProc", FALSE);
    wndproc = hv_fetch_mg(NOTXSCALL hash, (char*) Name, strlen(Name), FALSE);
    if(wndproc == NULL) return NULL;
    return INT2PTR(WNDPROC,SvIV(*wndproc));
}
    /*
     ##########################################################################
     # (@)INTERNAL:SetDefClassProc( *name, defproc )
     */
BOOL SetDefClassProc (NOTXSPROC const char *Name, WNDPROC DefClassProc) {
    HV* hash    = perl_get_hv("Win32::GUI::DefClassProc", FALSE);
    return (hv_store_mg(NOTXSCALL hash, (char*) Name, strlen(Name), newSViv(PTR2IV(DefClassProc)), 0) != NULL);
}
    /*
     ##########################################################################
     # (@)INTERNAL:SvCOLORREF(SV*)
     # returns a COLORREF from either a numerical value
     # or a color expressed as [RR, GG, BB]
     # or a color expressed in HTML notation (#RRGGBB)
     */
COLORREF SvCOLORREF(NOTXSPROC SV* c) {
    SV** t;
    int r;
    int g;
    int b;
    char html_color[8];
    char html_color_component[3];
    ZeroMemory(html_color, 8);
    ZeroMemory(html_color_component, 3);
    r = 0;
    g = 0;
    b = 0;
    if(SvROK(c) && SvTYPE(SvRV(c)) == SVt_PVAV) {
        t = av_fetch((AV*)SvRV(c), 0, 0);
        if(t != NULL) {
            r = SvIV(*t);
        }
        t = av_fetch((AV*)SvRV(c), 1, 0);
        if(t!= NULL) {
            g = SvIV(*t);
        }
        t = av_fetch((AV*)SvRV(c), 2, 0);
        if(t != NULL) {
            b = SvIV(*t);
        }
        return RGB((BYTE) r, (BYTE) g, (BYTE) b);
    } else {
        if(SvPOK(c)) {
            strncpy(html_color, SvPV_nolen(c), 7);
            if(strncmp(html_color, "#", 1) == 0) {
                strncpy(html_color_component, html_color+1, 2);
                *(html_color_component+2) = 0;
                sscanf(html_color_component, "%x", &r);
                strncpy(html_color_component, html_color+3, 2);
                *(html_color_component+2) = 0;
                sscanf(html_color_component, "%x", &g);
                strncpy(html_color_component, html_color+5, 2);
                *(html_color_component+2) = 0;
                sscanf(html_color_component, "%x", &b);
                return RGB((BYTE) r, (BYTE) g, (BYTE) b);
            } else {
                return (COLORREF) SvIV(c);
            }
        } else {
            return (COLORREF) SvIV(c);
        }
    }
}
    /*
     ##########################################################################
     # (@)INTERNAL:CreateTooltip(parent)
     */
HWND CreateTooltip(
                   NOTXSPROC
                   HV* parent
                   ) {
    HWND hTooltip;
    HWND hParent;
    SV** t;
    t = hv_fetch_mg(NOTXSCALL parent, "-handle", 7, 0);
    if(t != NULL) {
        hParent = INT2PTR(HWND,SvIV(*t));
    } else {
        return NULL;
    }
    hTooltip = CreateWindowEx(
        0, TOOLTIPS_CLASS, NULL,
        WS_POPUP | TTS_NOPREFIX | TTS_ALWAYSTIP,
        CW_USEDEFAULT, CW_USEDEFAULT,
        CW_USEDEFAULT, CW_USEDEFAULT,
        hParent, NULL, NULL,
        NULL
        );
    if(hTooltip != NULL) {
        SetWindowPos(
            hTooltip, HWND_TOPMOST,0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE
            );
        hv_store_mg(NOTXSCALL parent, "-tooltip", 8, newSViv(PTR2IV(hTooltip)), 0);
    }
    return hTooltip;
}
    /*
     ##########################################################################
     # (@)INTERNAL:CalcControlSize(*perlcs, add_x, add_y)
     # Used by some control to automatically set width and height at creation
     # time.
     */
void CalcControlSize(
    NOTXSPROC
    LPPERLWIN32GUI_CREATESTRUCT perlcs,
    int add_x,
    int add_y) {
    SIZE mySize;
    HDC hdc;
    SV** font;
    HFONT hfont, oldhfont;
    if(perlcs->cs.lpszName != NULL) {
        if(perlcs->cs.cx == 0 || perlcs->cs.cy == 0) {
            hdc = GetDC(perlcs->cs.hwndParent);
            if(perlcs->hFont != NULL) {
                hfont = perlcs->hFont;
            } else {
                hfont = (HFONT) GetStockObject(DEFAULT_GUI_FONT);
                if(perlcs->hvParent != NULL) {
                    font = hv_fetch_mg(NOTXSCALL perlcs->hvParent, "-font", 5, FALSE);
                    if(font != NULL && SvOK(*font)) {
                        hfont = (HFONT) handle_From(NOTXSCALL *font);
                    }
                }
            }
            oldhfont = (HFONT)SelectObject(hdc, hfont);
            if(GetTextExtentPoint32(
                hdc, perlcs->cs.lpszName, strlen(perlcs->cs.lpszName), &mySize
                )) {
                if(perlcs->cs.cx == 0) perlcs->cs.cx = mySize.cx + add_x;
                if(perlcs->cs.cy == 0) perlcs->cs.cy = mySize.cy + add_y;
            }
            SelectObject(hdc, oldhfont);
            ReleaseDC(perlcs->cs.hwndParent, hdc);
        }
    }
}
    /*
     ##########################################################################
     # (@)INTERNAL:GetObjectName(hwnd, *name)
     # Gets the object's name;
     # returns FALSE if no name found.
     */
BOOL GetObjectName(NOTXSPROC HWND hwnd, char *Name) {
    LPPERLWIN32GUI_USERDATA perlud;
    perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLongPtr(hwnd, GWLP_USERDATA);
    if( ValidUserData(perlud) ) {
        if(NULL != perlud->szWindowName) {
            strcat(Name, (char *) perlud->szWindowName);
            return TRUE;
        } else {
            return FALSE;
        }
    } else {
        return FALSE;
    }
}
    /*
     ##########################################################################
     # (@)INTERNAL:GetObjectNameAndClass(hwnd, *name, *class)
     # Gets the object's name AND class (integer);
     # returns FALSE if no name found.
     */
BOOL GetObjectNameAndClass(NOTXSPROC HWND hwnd, char *Name, int *obj_class) {
    LPPERLWIN32GUI_USERDATA perlud;
    perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLongPtr(hwnd, GWLP_USERDATA);
    if( ValidUserData(perlud) ) {
        if(NULL != perlud->szWindowName) {
            strcat(Name, (char *) perlud->szWindowName);
            *obj_class = perlud->iClass;
            return TRUE;
        } else {
            return FALSE;
        }
    } else {
        return FALSE;
    }
}
    /*
     ##########################################################################
     # (@)INTERNAL:CreateObjectWithHandle(char* class_name, HWND handle)
     # Create a bless object in specified class with -handle property set.
     */
SV* CreateObjectWithHandle(NOTXSPROC char* class_name, HWND handle) {
    HV* hv = newHV();
    hv_store(hv, "-handle", 7, newSViv(PTR2IV(handle)), 0);
    SV* cv = sv_2mortal(newRV((SV*)hv));
    sv_bless(cv, gv_stashpv(class_name, 0));
    SvREFCNT_dec(hv);
    return cv;
}
    /*
     ##########################################################################
     # (@)INTERNAL:GetMenuFromID(ID, *name)
     # Gets the menu handle (HMENU) from the ID, searching in Perl's global
         # %Win32::GUI::Menus hash; returns NULL if the handle is not found.
     */
HMENU GetMenuFromID(NOTXSPROC int nID) {
    HV* hash;
    SV** handle;
    char temp[80];
    hash = perl_get_hv("Win32::GUI::Menus", FALSE);
    itoa(nID, temp, 10);
    handle = hv_fetch(hash, temp, strlen(temp), FALSE);
    if(handle == NULL) return NULL;
    return INT2PTR(HMENU,SvIV(*handle));
}
    /*
     ##########################################################################
     # (@)INTERNAL:GetMenuName(ID, *name)
     # Gets the menu name from the ID;
     # returns FALSE if no name found.
     */
BOOL GetMenuName(NOTXSPROC HWND hwnd, int nID, char *Name) {
    MENUITEMINFO mii;
    HMENU hmenu;
    LPPERLWIN32GUI_MENUITEMDATA perlmid;
    ZeroMemory(&mii, sizeof(MENUITEMINFO));
    mii.cbSize = sizeof(MENUITEMINFO);
    mii.fMask = MIIM_DATA;
    /* HEURISTIC: assume the message was from the window's own menu */
    hmenu = GetMenu(hwnd);
    /* HEURISTIC: no, it wasn't, search in Perl's global hash  */
    if(hmenu == NULL) hmenu = GetMenuFromID( NOTXSCALL nID );
    /* HEURISTIC: if we can get to the item, it's ok, otherwise search in Perl's global hash  */
    if(GetMenuItemInfo( hmenu, nID, 0, &mii ) == 0) {
        hmenu = GetMenuFromID( NOTXSCALL nID );
    }
    if(GetMenuItemInfo( hmenu, nID, 0, &mii )) {
        perlmid = (LPPERLWIN32GUI_MENUITEMDATA) mii.dwItemData;
        if(perlmid != NULL && perlmid->dwSize == sizeof(PERLWIN32GUI_MENUITEMDATA)) {
            strcpy(Name, perlmid->szName);
            return TRUE;
        } else {
            return FALSE;
        }
    } else {
        return FALSE;
    }
}
    /*
     ##########################################################################
     # (@)INTERNAL:GetAcceleratorName(ID, *name)
     # Gets the accelerator name from the ID;
     # returns FALSE if no name found.
     */
BOOL GetAcceleratorName(NOTXSPROC int nID, char *Name) {
    HV* hash;
    SV** name;
    char temp[80];
    hash = perl_get_hv("Win32::GUI::Accelerators", FALSE);
    itoa(nID, temp, 10);
    name = hv_fetch_mg(NOTXSCALL hash, temp, strlen(temp), FALSE);
    if(name == NULL) return FALSE;
    strcpy(Name, (char *) SvPV_nolen(*name));
    return TRUE;
}
    /*
     ##########################################################################
     # (@)INTERNAL:GetTimerName(hwnd, id, *name)
     # Gets the timer name;
     # returns FALSE if no name found.
     */
BOOL GetTimerName(NOTXSPROC HWND hwnd, UINT nID, char *Name) {
    HV*  parent;
    SV** name;
    SV** robjarray;
    HV*  objarray;
    SV** robj;
    HV*  obj;
    char temp[80];
    parent = HV_SELF_FROM_WINDOW(hwnd);
    if(parent == NULL) return FALSE;
    itoa(nID, temp, 10);
    robjarray = hv_fetch_mg(NOTXSCALL parent, "-timers", 7, FALSE);
    if(robjarray == NULL) return FALSE;
    objarray = (HV*) SvRV(*robjarray);
    robj = hv_fetch_mg(NOTXSCALL objarray, temp, strlen(temp), FALSE);
    if(robj == NULL) return FALSE;
    obj = (HV*) SvRV(*robj);
    if(obj == NULL) return FALSE;
    name = hv_fetch_mg(NOTXSCALL obj, "-name", 5, FALSE);
    if(name == NULL) return FALSE;
    strcpy(Name, (char *) SvPV_nolen(*name));
    return TRUE;
}
    /*
     ##########################################################################
     # (@)INTERNAL:GetNotifyIconName(hwnd, id, *name)
     # Gets the NotifyIcon name;
     # returns FALSE if no name found.
     */
BOOL GetNotifyIconName(NOTXSPROC HWND hwnd, UINT nID, char *Name) {
    HV*  parent;
    SV** name;
    SV** robjarray;
    HV*  objarray;
    SV** robj;
    HV*  obj;
    char temp[80];
    parent = HV_SELF_FROM_WINDOW(hwnd);
    if(parent == NULL) return FALSE;
    itoa(nID, temp, 10);
    robjarray = hv_fetch_mg(NOTXSCALL parent, "-notifyicons", 12, FALSE);
    if(robjarray == NULL) return FALSE;
    objarray = (HV*) SvRV(*robjarray);
    robj = hv_fetch_mg(NOTXSCALL objarray, temp, strlen(temp), FALSE);
    if(robj == NULL) return FALSE;
    obj = (HV*) SvRV(*robj);
    name = hv_fetch_mg(NOTXSCALL obj, "-name", 5, FALSE);
    if(name == NULL) return FALSE;
    strcpy(Name, (char *) SvPV_nolen(*name));
    return TRUE;
}
DWORD CALLBACK RichEditSave(DWORD_PTR dwCookie, LPBYTE pbBuff, LONG cb, LONG FAR *pcb) {
    HANDLE hfile;
    hfile = (HANDLE) dwCookie;
    WriteFile(hfile, (LPCVOID) pbBuff, (DWORD) cb, (LPDWORD) pcb, NULL);
    return(0);
}
DWORD CALLBACK RichEditLoad(DWORD_PTR dwCookie, LPBYTE pbBuff, LONG cb, LONG FAR *pcb) {
    HANDLE hfile;
    hfile = (HANDLE) dwCookie;
    ReadFile(hfile, (LPVOID) pbBuff, (DWORD) cb, (LPDWORD) pcb, NULL);
    return(0);
}
int CALLBACK BrowseForFolderProc(HWND hWnd, UINT uMsg, LPARAM lParam, LPARAM lpData) {
        UNREFERENCED_PARAMETER(lParam);
    if (uMsg == BFFM_INITIALIZED && lpData != 0) {
           SendMessage(hWnd, BFFM_SETSELECTION, TRUE, lpData);
    }
    return(0);
}
    /*
     ##########################################################################
     # (@)INTERNAL:AdjustSplitterCoord(self, x)
     */
int AdjustSplitterCoord(NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, int x, int w, HWND phwnd) {
    int min, max;
    int adjusted;
    RECT rc;
    adjusted = x;
    min = -1;
    min = perlud->iMinWidth;
    if(min == -1) min = 0;
    GetClientRect(phwnd, &rc);
    max = -1;
    max = perlud->iMaxWidth;
    if(max == -1) max = rc.right - w;
    if(adjusted < min) adjusted = min;
    if(adjusted > max) adjusted = max;
    return(adjusted);
}
    /*
     ##########################################################################
     # (@)INTERNAL:DrawSplitter(hwnd)
     */
void DrawSplitter(NOTXSPROC HWND hwnd, int x, int y, int w, int h) {
    static WORD _dotPatternBmp[8] = { 0x00aa, 0x0055, 0x00aa, 0x0055, 
                                      0x00aa, 0x0055, 0x00aa, 0x0055};
    HDC hdc;
    HBITMAP hbm;
    HBRUSH  hbr, hbrushOld;
    /* create a monochrome checkered pattern */
    hbm = CreateBitmap(8, 8, 1, 1, _dotPatternBmp);
    hbr = CreatePatternBrush(hbm);
    /* get a DC on which we can draw, even if the
     * class has CS_CLIPCHILDREN or the window
     * has WS_CLIPCHILDREN
     */
    hdc = GetDCEx(hwnd, NULL, DCX_PARENTCLIP);
    SetBrushOrgEx(hdc, x, y, NULL);
    hbrushOld = (HBRUSH)SelectObject(hdc, hbr);
    /* draw the checkered rectangle to the screen */
    PatBlt(hdc, x, y, w, h, PATINVERT);
    SelectObject(hdc, hbrushOld);
    ReleaseDC(hwnd, hdc);
    DeleteObject(hbr);
    DeleteObject(hbm);
}
    /*
     ##########################################################################
     # (@)INTERNAL:EnumMyWindowsProc(hwnd, lparam)
     */
BOOL CALLBACK EnumMyWindowsProc(HWND hwnd, LPARAM lparam) {
    dTHX;       /* fetch context */
    AV* ary;
    DWORD pid;
    ary = (AV*) lparam;
    GetWindowThreadProcessId(hwnd, &pid);
    if(pid == GetCurrentProcessId()) {
                        av_push(ary, newSViv(PTR2IV(hwnd)));
    }
    return TRUE;
}
    /*
     ##########################################################################
     # (@)INTERNAL:CountMyWindowsProc(hwnd, lparam)
     # specialized version of EnumMyWindowsProc for DoModal
     */
BOOL CALLBACK CountMyWindowsProc(HWND hwnd, LPARAM lparam) {
    DWORD pid;
    DWORD style;
    int * i;
    i = (int *) lparam;
    GetWindowThreadProcessId(hwnd, &pid);
    if(pid == GetCurrentProcessId()) {
        style = (DWORD) GetWindowLongPtr(hwnd, GWL_STYLE);
        if(!(style & GW_CHILD)) {
            *i += 1;
        }
    }
    return TRUE;
}
    /*
     ##########################################################################
     # (@)INTERNAL:EnableWindowsProc(hwnd, lparam)
     # Activate or Deactivate current thread top window.
     */
BOOL CALLBACK EnableWindowsProc(HWND hwnd, LPARAM lParam) {
    EnableWindow (hwnd, (BOOL) lParam);
    return TRUE;
}
    /*
     ##########################################################################
     # (@)INTERNAL:FindChildWindowsProc(hwnd, lparam)
     # Activate or Deactivate current thread top window.
     */
BOOL CALLBACK FindChildWindowsProc(HWND hwnd, LPARAM lParam) {
    st_FindChildWindow * st = (st_FindChildWindow*) lParam;
    LPPERLWIN32GUI_USERDATA perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLongPtr(hwnd, GWLP_USERDATA);
    if( !ValidUserData(perlud) )
        return TRUE;
    if (strcmp (perlud->szWindowName, st->Name) == 0) {
        st->perlchild = perlud;
        return FALSE;
    }
    return TRUE;
}
    /*
     ##########################################################################
     # (@)INTERNAL:WindowsHookMsgProc(code, wparam, lparam)
     # Callback set by SetWindowsHookEx in TrackPopupMenu()
     */
LRESULT CALLBACK WindowsHookMsgProc(int code, WPARAM wParam, LPARAM lParam) {
  SV* perlsub;
  SV** arrayref;
  SV** arrayval;
  AV* array;
  MSG* pmsg;
  LPPERLWIN32GUI_USERDATA perlud;
  I32 count;
  int PerlResult;
  int i;
  if(code == MSGF_MENU) {
    PerlResult = 1;
    pmsg = (MSG *)lParam;
    perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLongPtr(pmsg->hwnd, GWLP_USERDATA);
    if(ValidUserData(perlud)) {
      PERLUD_FETCH;       /* fetch context */
      //Tracker 1941264: Check if perlud->avHooks contains NULL. This was causing
      //a crash although it should not be possible that this is zero. It's likely
      //a bug elsewhere...No harm in the null pointer check though.
      if (perlud->avHooks != NULL) {
      arrayref = av_fetch(perlud->avHooks, WM_TRACKPOPUP_MSGHOOK, 0);
      if(arrayref != NULL) {
        array = (AV*) SvRV(*arrayref);
        SvREFCNT_inc((SV*) array);
        for(i = 0; i <= (int) av_len(array); i++) {
          arrayval = av_fetch(array,(I32) i,0);
          if(arrayval != NULL) {
            perlsub = *arrayval;
            SvREFCNT_inc(perlsub);
            dSP;
            ENTER;
            SAVETMPS;
            PUSHMARK(SP);
              XPUSHs(perlud->svSelf);
              XPUSHs(sv_2mortal(newSViv(pmsg->message)));
              XPUSHs(sv_2mortal(newSViv(pmsg->wParam)));
              XPUSHs(sv_2mortal(newSViv(pmsg->lParam)));
            PUTBACK;
            count = call_sv(perlsub, G_ARRAY|G_EVAL);
            SPAGAIN;
            if(SvTRUE(ERRSV)) {
              ProcessEventError(NOTXSCALL "TrackPopupMenu(WindowsHookMsgProc)", &PerlResult);
            } else {
              if(count > 0) { PerlResult = POPi; }
            }
            PUTBACK;
            FREETMPS;
            LEAVE;
            SvREFCNT_dec(perlsub);
          }
        }
        SvREFCNT_dec((SV*) array);
        // PerlResult = 0: do not pass event to rest of chain or target windows procedure
        // PerlResult = -1: as 0, and terminate application
        // PerlResult = anything else, pass event on
        if(PerlResult == 0) {
          return 1;  // stops message being passed along hook chain and to target windows procedure
        } else if (PerlResult == -1) {
          //send a WM_CANCELMODE to get menu to close
          SendMessage(pmsg->hwnd, WM_CANCELMODE, 0, 0);
          //post a message to get the main loop to exit
          PostMessage(pmsg->hwnd, WM_EXITLOOP, (WPARAM) -1, 0);
          return 1;  // stops message being passed along hook chain and to target windows procedure
        }
      }
    }
  }
  }
  // pass message along hook chain
  return CallNextHookEx(0, code, wParam, lParam);
}