window.inc 8.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335
  1. {
  2. Free Pascal port of the OpenPTC C++ library.
  3. Copyright (C) 2001-2003 Nikolay Nikolov ([email protected])
  4. Original C++ version by Glenn Fiedler ([email protected])
  5. This library is free software; you can redistribute it and/or
  6. modify it under the terms of the GNU Lesser General Public
  7. License as published by the Free Software Foundation; either
  8. version 2.1 of the License, or (at your option) any later version.
  9. This library is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  12. Lesser General Public License for more details.
  13. You should have received a copy of the GNU Lesser General Public
  14. License along with this library; if not, write to the Free Software
  15. Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  16. }
  17. { $R win32\base\ptcres.res}
  18. { bug in the compiler???}
  19. { $LINKLIB ptc.owr}
  20. Constructor TWin32Window.Create(window : HWND);
  21. Begin
  22. LOG('attaching to user managed window');
  23. defaults;
  24. m_window := window;
  25. m_managed := False;
  26. End;
  27. Constructor TWin32Window.Create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer);
  28. Begin
  29. internal_create(wndclass, title, extra, style, show, x, y, width, height, center, _multithreaded, data);
  30. End;
  31. Constructor TWin32Window.Create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean);
  32. Begin
  33. internal_create(wndclass, title, extra, style, show, x, y, width, height, center, _multithreaded, Nil);
  34. End;
  35. Destructor TWin32Window.Destroy;
  36. Begin
  37. close;
  38. Inherited Destroy;
  39. End;
  40. Procedure TWin32Window.cursor(flag : Boolean);
  41. Begin
  42. If flag Then
  43. Begin
  44. SetClassLong(m_window, GCL_HCURSOR, LoadCursor(0, IDC_ARROW));
  45. End
  46. Else
  47. Begin
  48. SetClassLong(m_window, GCL_HCURSOR, 0);
  49. End;
  50. SendMessage(m_window, WM_SETCURSOR, 0, 0);
  51. End;
  52. Procedure TWin32Window.resize(width, height : Integer);
  53. Var
  54. window_rectangle : RECT;
  55. rectangle : RECT;
  56. Begin
  57. GetWindowRect(m_window, window_rectangle);
  58. With rectangle Do
  59. Begin
  60. left := 0;
  61. top := 0;
  62. right := width;
  63. bottom := height;
  64. End;
  65. AdjustWindowRectEx(rectangle, m_style, False, m_extra);
  66. SetWindowPos(m_window, HWND_TOP, window_rectangle.left,
  67. window_rectangle.top, rectangle.right - rectangle.left,
  68. rectangle.bottom - rectangle.top, 0);
  69. {
  70. todo: detect if the window is resized off the screen and let windows reposition it correctly... ?
  71. }
  72. End;
  73. Procedure TWin32Window.update(force : Boolean);
  74. Var
  75. message : MSG;
  76. Begin
  77. If (Not m_managed) And (Not force) Then
  78. Exit;
  79. If Not m_multithreaded Then
  80. Begin
  81. While PeekMessage(message, m_window, 0, 0, PM_REMOVE) Do
  82. Begin
  83. TranslateMessage(message);
  84. DispatchMessage(message);
  85. End;
  86. End
  87. Else
  88. Sleep(0);
  89. End;
  90. Procedure TWin32Window.update; {force = False}
  91. Begin
  92. update(False);
  93. End;
  94. Function TWin32Window.handle : HWND;
  95. Begin
  96. handle := m_window;
  97. End;
  98. Function TWin32Window.thread : DWord;
  99. Begin
  100. If m_multithreaded Then
  101. thread := m_id
  102. Else
  103. thread := GetCurrentThreadId;
  104. End;
  105. Function TWin32Window.managed : Boolean;
  106. Begin
  107. managed := m_managed;
  108. End;
  109. Function TWin32Window.multithreaded : Boolean;
  110. Begin
  111. multithreaded := m_multithreaded;
  112. End;
  113. Function WndProcSingleThreaded(hWnd : HWND; message : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall;
  114. Begin
  115. Case message Of
  116. WM_CLOSE : Begin
  117. LOG('TWin32Window WM_CLOSE');
  118. Halt(0);
  119. End;
  120. Else
  121. WndProcSingleThreaded := DefWindowProc(hWnd, message, wParam, lParam);
  122. End;
  123. End;
  124. Function WndProcMultiThreaded(hWnd : HWND; message : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall;
  125. Begin
  126. WndProcMultiThreaded := 0;
  127. Case message Of
  128. WM_DESTROY : Begin
  129. LOG('TWin32Window WM_DESTROY');
  130. PostQuitMessage(0);
  131. End;
  132. WM_CLOSE : Begin
  133. LOG('TWin32Window WM_CLOSE');
  134. Halt(0);
  135. End;
  136. Else
  137. WndProcMultiThreaded := DefWindowProc(hWnd, message, wParam, lParam);
  138. End;
  139. End;
  140. Procedure TWin32Window.internal_create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer);
  141. Var
  142. program_instance{, library_instance} : DWord;
  143. rectangle : RECT;
  144. display_width, display_height : Integer;
  145. wc : WNDCLASSEX;
  146. Begin
  147. LOG('creating managed window');
  148. defaults;
  149. m_multithreaded := _multithreaded;
  150. wndclass := wndclass + #0;
  151. title := title + #0;
  152. Try
  153. program_instance := GetModuleHandle(Nil);
  154. { library_instance := program_instance;}
  155. wc.cbSize := SizeOf(WNDCLASSEX);
  156. wc.hInstance := program_instance;
  157. wc.lpszClassName := @wndclass[1];
  158. wc.style := CS_VREDRAW Or CS_HREDRAW;
  159. wc.hIcon := 0{LoadIcon(library_instance, 'IDI_PTC_ICON')};
  160. wc.hIconSm := 0;
  161. wc.lpszMenuName := Nil;
  162. wc.cbClsExtra := 0;
  163. wc.cbWndExtra := 0;
  164. wc.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)}
  165. If multithreaded Then
  166. wc.lpfnWndProc := @WndProcMultiThreaded
  167. Else
  168. wc.lpfnWndProc := @WndProcSingleThreaded;
  169. wc.hCursor := LoadCursor(0, IDC_ARROW);
  170. RegisterClassEx(wc);
  171. With rectangle Do
  172. Begin
  173. left := 0;
  174. top := 0;
  175. right := width;
  176. bottom := height;
  177. End;
  178. AdjustWindowRectEx(rectangle, style, False, extra);
  179. If center Then
  180. Begin
  181. LOG('centering window');
  182. display_width := GetSystemMetrics(SM_CXSCREEN);
  183. display_height := GetSystemMetrics(SM_CYSCREEN);
  184. x := (display_width - (rectangle.right - rectangle.left)) Div 2;
  185. y := (display_height - (rectangle.bottom - rectangle.top)) Div 2;
  186. End;
  187. m_name := wndclass;
  188. m_title := title;
  189. m_extra := extra;
  190. m_style := style;
  191. m_show := show;
  192. m_x := x;
  193. m_y := y;
  194. m_width := rectangle.right - rectangle.left;
  195. m_height := rectangle.bottom - rectangle.top;
  196. m_data := data;
  197. If multithreaded Then
  198. Begin
  199. {...}
  200. End
  201. Else
  202. Begin
  203. m_window := CreateWindowEx(m_extra, PChar(m_name), PChar(m_title), m_style, m_x, m_y, m_width, m_height, 0, 0, 0, m_data);
  204. If Not IsWindow(m_window) Then
  205. Raise TPTCError.Create('could not create window');
  206. ShowWindow(m_window, m_show);
  207. SetFocus(m_window);
  208. SetActiveWindow(m_window);
  209. SetForegroundWindow(m_window);
  210. End;
  211. Except
  212. On error : TPTCError Do
  213. Raise TPTCError.Create('could not create window', error);
  214. End;
  215. End;
  216. Procedure TWin32Window.defaults;
  217. Begin
  218. m_window := 0;
  219. m_event := 0;
  220. m_thread := 0;
  221. m_id := 0;
  222. m_name := '';
  223. m_title := '';
  224. m_extra := 0;
  225. m_style := 0;
  226. m_show := 0;
  227. m_x := 0;
  228. m_y := 0;
  229. m_width := 0;
  230. m_height := 0;
  231. m_data := Nil;
  232. m_managed := True;
  233. m_multithreaded := False;
  234. End;
  235. Procedure TWin32Window.close;
  236. Begin
  237. If Not m_managed Then
  238. Begin
  239. LOG('detaching from user managed window');
  240. m_window := 0;
  241. End
  242. Else
  243. Begin
  244. LOG('closing managed window');
  245. If m_multithreaded Then
  246. Begin
  247. If (m_thread <> 0) And IsWindow(m_window) Then
  248. Begin
  249. PostMessage(m_window, WM_DESTROY, 0, 0);
  250. WaitForSingleObject(m_thread, INFINITE);
  251. End;
  252. If m_event <> 0 Then
  253. CloseHandle(m_event);
  254. If m_thread <> 0 Then
  255. CloseHandle(m_thread);
  256. SetPriorityClass(GetCurrentProcess, NORMAL_PRIORITY_CLASS);
  257. End
  258. Else
  259. If (m_window <> 0) And IsWindow(m_window) Then
  260. DestroyWindow(m_window);
  261. m_window := 0;
  262. m_event := 0;
  263. m_thread := 0;
  264. m_id := 0;
  265. UnregisterClass(PChar(m_name), GetModuleHandle(Nil));
  266. End;
  267. End;
  268. Class Procedure TWin32Window.ThreadFunction(owner : TWin32Window);
  269. Var
  270. message : MSG;
  271. Begin
  272. With owner Do
  273. Begin
  274. m_window := CreateWindowEx(m_extra, PChar(m_name), PChar(m_title), m_style, m_x, m_y, m_width, m_height, 0, 0, 0, m_data);
  275. If IsWindow(m_window) Then
  276. Begin
  277. ShowWindow(m_window, m_show);
  278. SetFocus(m_window);
  279. SetForegroundWindow(m_window);
  280. SetEvent(m_event);
  281. While GetMessage(message, 0, 0, 0) = True Do
  282. Begin
  283. TranslateMessage(message);
  284. DispatchMessage(message);
  285. End;
  286. End
  287. Else
  288. SetEvent(m_event);
  289. End;
  290. End;