Posted to tcl by patthoyts at Fri Oct 10 14:16:03 GMT 2008view raw

  1. set compiler [tcc::new]
  2. $compiler compile {
  3. #include <tcl.h>
  4. #include <tk.h>
  5. #define _WIN32_WINNT 0x0502
  6. #include <windows.h>
  7. static HWND
  8. GetHWNDFromObj(Tcl_Interp *interp, Tcl_Obj *pathObj)
  9. {
  10. Tk_Window tkwin = (Tk_Window)NULL;
  11. Window window = None;
  12. HWND hwnd = (HWND)NULL;
  13.  
  14. tkwin = Tk_NameToWindow(interp, Tcl_GetString(pathObj),
  15. Tk_MainWindow(interp));
  16. if (tkwin != NULL)
  17. window = Tk_WindowId(tkwin);
  18. if (window != None)
  19. hwnd = Tk_GetHWND(window);
  20. if (hwnd != NULL && Tk_IsTopLevel(tkwin))
  21. hwnd = GetParent(hwnd); /* toplevels have a wrapper window */
  22. return hwnd;
  23. }
  24.  
  25. int PrintDlg(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  26. {
  27. PRINTDLG pd;
  28. int oldMode = 0;
  29.  
  30. ZeroMemory(&pd, sizeof(PRINTDLG));
  31. pd.lStructSize = sizeof(PRINTDLG);
  32. pd.hwndOwner = GetHWNDFromObj(interp, parent);
  33. pd.Flags = PD_ALLPAGES | PD_NOSELECTION;
  34.  
  35. oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
  36. if (PrintDlg(&pd)) {
  37. Tcl_Obj *resObj = NULL;
  38. LPDEVNAMES lpDev = NULL;
  39.  
  40. lpDev = (LPDEVNAMES)GlobalLock(pd.hDevNames);
  41. if (lpDev != NULL) {
  42. LPCTSTR szName = ((LPCTSTR)lpDev) + lpDev->wDeviceOffset;
  43. if (szName && *szName) {
  44. resObj = Tcl_NewStringObj(szName, -1);
  45. }
  46. }
  47. if (resObj != NULL) {
  48. Tcl_SetObjResult(interp, resObj);
  49. }
  50. }
  51.  
  52. Tcl_SetServiceMode(oldMode);
  53. return TCL_OK;
  54. }
  55. }
  56. $compiler command PrintDlg PrintDlg