diff options
Diffstat (limited to 'win/tkWinTest.c')
| -rw-r--r-- | win/tkWinTest.c | 137 |
1 files changed, 135 insertions, 2 deletions
diff --git a/win/tkWinTest.c b/win/tkWinTest.c index d73f159..da9b24b 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinTest.c,v 1.12 2007/01/18 23:56:44 nijtmans Exp $ + * RCS: @(#) $Id: tkWinTest.c,v 1.13 2007/08/01 09:02:54 patthoyts Exp $ */ #include "tkWinInt.h" @@ -27,6 +27,12 @@ static int TestclipboardObjCmd(ClientData clientData, Tcl_Obj *CONST objv[]); static int TestwineventCmd(ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv); +static int TestfindwindowObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +static int TestgetwindowinfoObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp); @@ -59,6 +65,10 @@ TkplatformtestInit( (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd, (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "testfindwindow", TestfindwindowObjCmd, + (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "testgetwindowinfo", TestgetwindowinfoObjCmd, + (ClientData) Tk_MainWindow(interp), NULL); return TCL_OK; } @@ -232,6 +242,7 @@ TestwineventCmd( CONST char **argv) /* Argument strings. */ { HWND hwnd = 0; + HWND child = 0; int id; char *rest; UINT message; @@ -243,6 +254,7 @@ TestwineventCmd( {WM_CHAR, "WM_CHAR"}, {WM_GETTEXT, "WM_GETTEXT"}, {WM_SETTEXT, "WM_SETTEXT"}, + {WM_COMMAND, "WM_COMMAND"}, {-1, NULL} }; @@ -282,7 +294,6 @@ TestwineventCmd( id = strtol(argv[2], &rest, 0); if (rest == argv[2]) { - HWND child; char buf[256]; child = GetWindow(hwnd, GW_CHILD); @@ -331,6 +342,16 @@ TestwineventCmd( Tcl_DStringFree(&ds); break; } + case WM_COMMAND: { + char buf[TCL_INTEGER_SPACE]; + if (argc < 5) { + wParam = MAKEWPARAM(id, 0); + lParam = (LPARAM)child; + } + sprintf(buf, "%d", SendMessage(hwnd, message, wParam, lParam)); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + break; + } default: { char buf[TCL_INTEGER_SPACE]; @@ -344,6 +365,118 @@ TestwineventCmd( } /* + * testfindwindow title ?class? + * Find a Windows window using the FindWindow API call. This takes the window + * title and optionally the window class and if found returns the HWND and + * raises an error if the window is not found. + * eg: testfindwindow Console TkTopLevel + * Can find the console window if it is visible. + * eg: testfindwindow "TkTest #10201" "#32770" + * Can find a messagebox window with this title. + */ + +static int +TestfindwindowObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument values. */ +{ + TkWindow *winPtr = (TkWindow *) clientData; + const char *title = NULL, *class = NULL; + HWND hwnd = NULL; + int r = TCL_OK; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "title ?class?"); + return TCL_ERROR; + } + title = Tcl_GetString(objv[1]); + if (objc == 3) + class = Tcl_GetString(objv[2]); + hwnd = FindWindowA(class, title); + + if (hwnd == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1)); + AppendSystemError(interp, GetLastError()); + r = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, Tcl_NewLongObj((long)hwnd)); + } + return r; + +} + +static BOOL CALLBACK +EnumChildrenProc(HWND hwnd, LPARAM lParam) +{ + Tcl_Obj *listObj = (Tcl_Obj *)lParam; + Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewLongObj((long)hwnd)); + return TRUE; +} + +static int +TestgetwindowinfoObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[]) +{ + HWND hwnd = NULL; + Tcl_Obj *resObj = NULL, *classObj = NULL, *textObj = NULL; + Tcl_Obj *childrenObj = NULL; + char buf[512]; + int cch, cchBuf = tkWinProcs->useWide ? 256 : 512; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "hwnd"); + return TCL_ERROR; + } + + if (Tcl_GetLongFromObj(interp, objv[1], (long *)&hwnd) != TCL_OK) + return TCL_ERROR; + + if (tkWinProcs->useWide) { + cch = GetClassNameW(hwnd, (LPWSTR)buf, sizeof(buf)/sizeof(WCHAR)); + classObj = Tcl_NewUnicodeObj((LPWSTR)buf, cch); + } else { + cch = GetClassNameA(hwnd, (LPSTR)buf, sizeof(buf)); + classObj = Tcl_NewStringObj((LPSTR)buf, cch); + } + if (cch == 0) { + Tcl_SetResult(interp, "failed to get class name: ", TCL_STATIC); + AppendSystemError(interp, GetLastError()); + return TCL_ERROR; + } + + resObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("class", -1)); + Tcl_ListObjAppendElement(interp, resObj, classObj); + + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("id", -1)); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewLongObj(GetWindowLong(hwnd, GWL_ID))); + + cch = tkWinProcs->getWindowText(hwnd, (LPTSTR)buf, cchBuf); + if (tkWinProcs->useWide) { + textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch); + } else { + textObj = Tcl_NewStringObj((LPCSTR)buf, cch); + } + + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("text", -1)); + Tcl_ListObjAppendElement(interp, resObj, textObj); + + childrenObj = Tcl_NewListObj(0, NULL); + EnumChildWindows(hwnd, EnumChildrenProc, (LPARAM)childrenObj); + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("children", -1)); + Tcl_ListObjAppendElement(interp, resObj, childrenObj); + + Tcl_SetObjResult(interp, resObj); + return TCL_OK; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 |